bin/parse-debtags-voc

   1 #!/usr/bin/perl -w
   2 # Convert Debtags vocabulary.gz files into Sleepycat db files
   3 #
   4 # $Id: parse-packages 227 2006-11-12 20:24:48Z djpig $
   5 #
   6 # Copyright (C) 2006  Frank Lichtenheld <djpig@debian.org>
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20
  21 use strict;
  22 use warnings;
  23 use lib './lib';
  24
  25 $| = 1;
  26
  27 use DB_File;
  28 use File::Path;
  29 use Data::Dumper;
  30 use HTML::Entities;
  31 use URI::Escape;
  32
  33 use Deb::Versions;
  34 use Packages::Template;
  35 use Packages::Config qw( $TOPDIR );
  36 use Packages::CGI;
  37 &Packages::Config::init( './' );
  38 my $debtagsdir = "$TOPDIR/files/debtags";
  39 my $wwwdir = "$TOPDIR/www/about";
  40 my $voc_file = "$debtagsdir/vocabulary";
  41 my (%voc, %voc_db);
  42
  43 $/ = "";
  44
  45 delete $ENV{'LANGUAGE'};
  46 delete $ENV{'LANG'};
  47 delete $ENV{'LC_ALL'};
  48 delete $ENV{'LC_MESSAGES'};
  49
  50 print "Parsing Vocabulary...\n";
  51 tie %voc_db, "DB_File", "$debtagsdir/vocabulary.db.new",
  52     O_RDWR|O_CREAT, 0666, $DB_BTREE
  53     or die "Error creating DB: $!";
  54 open VOC, '<', $voc_file or die "Error opening vocabulary: $!";
  55
  56 while (<VOC>) {
  57     next if /^\s*$/;
  58     my $data = "";
  59     my %data = ();
  60     chomp;
  61     s/\n /\377/g;
  62     while (/^(\S+):\s*(.*)\s*$/mg) {
  63         my ($key, $value) = ($1, $2);
  64         $value =~ s/\377/\n /g;
  65         $key =~ tr [A-Z] [a-z];
  66         $data{$key} = $value;
  67     }
  68     my $voc_key = $data{facet} || $data{tag};
  69     unless ($voc_key) {
  70         warn "No key found in ".Dumper(\%data);
  71         next;
  72     }
  73     if ($voc{$voc_key}) {
  74         warn "Duplicated key found: $voc_key\n";
  75         next;
  76     }
  77     my ($sdesc,$ldesc) = split /\n/, encode_entities($data{description}), 2;
  78
  79     if ($ldesc) {
  80         $ldesc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
  81         $ldesc =~ s/\A //o;
  82         $ldesc =~ s/\n /\n/sgo;
  83         $ldesc =~ s/\n.\n/\n<p>\n/go;
  84         $ldesc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
  85     }
  86     $data{html_description} = [ $sdesc, $ldesc||"" ];
  87
  88     $voc_db{$voc_key} = $sdesc || "";
  89     $voc{$voc_key} = \%data;
  90 }
  91
  92 close VOC or warn "Couldn't close vocabulary: $!";
  93
  94 #print Dumper(\%voc,\%voc_db);
  95
  96 print "Creating tag list...\n";
  97
  98 -d $wwwdir || mkpath( $wwwdir );
  99 open TAGLST, '>', "$wwwdir/debtags.en.html.new"
 100     or die "Error creating tag list: $!";
 101
 102 my $template = new Packages::Template( "$TOPDIR/templates", 'html', {} );
 103 my @facets = sort( grep { exists $voc{$_}{facet} } keys %voc );
 104 my @tags = sort( grep { exists $voc{$_}{tag} } keys %voc );
 105 my %tags_by_facet;
 106 foreach (@tags) {
 107     my ($facet, $tag) = split /::/, $_, 2;
 108     warn "No facet data available for $facet\n"
 109         unless exists $voc{$facet};
 110     $tags_by_facet{$facet} ||= [];
 111     push @{$tags_by_facet{$facet}}, $_;
 112 }
 113 my %content = ( vocabulary => \%voc,
 114                 facets => \@facets, tags => \@tags,
 115                 tags_by_facet => \%tags_by_facet );
 116 # needed to work around the limitations of the the FILTER syntax
 117 $content{html_encode} = sub { return HTML::Entities::encode_entities(@_,'<>&"') };
 118 $content{uri_escape} = sub { return URI::Escape::uri_escape(@_) };
 119 $content{quotemeta} = sub { return quotemeta($_[0]) };
 120 $content{string2id} = sub { return &Packages::CGI::string2id(@_) };
 121
 122 print TAGLST $template->page( 'tag_index', \%content );
 123 close TAGLST or warn "Couldn't close tag list: $!";
 124
 125 rename( "$wwwdir/debtags.en.html.new",
 126         "$wwwdir/debtags.en.html" );
 127
 128 untie %voc_db;
 129 rename( "$debtagsdir/vocabulary.db.new",
 130         "$debtagsdir/vocabulary.db" );