2 # Convert Debtags vocabulary.gz files into Sleepycat db files
4 # $Id: parse-packages 227 2006-11-12 20:24:48Z djpig $
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.
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.
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
34 use Packages::Template;
35 use Packages::Config qw( $TOPDIR );
37 &Packages::Config::init( './' );
38 my $debtagsdir = "$TOPDIR/files/debtags";
39 my $wwwdir = "$TOPDIR/www/about";
40 my $voc_file = "$debtagsdir/vocabulary";
45 delete $ENV{'LANGUAGE'};
47 delete $ENV{'LC_ALL'};
48 delete $ENV{'LC_MESSAGES'};
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: $!";
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];
68 my $voc_key = $data{facet} || $data{tag};
70 warn "No key found in ".Dumper(\%data);
74 warn "Duplicated key found: $voc_key\n";
77 my ($sdesc,$ldesc) = split /\n/, encode_entities($data{description}), 2;
80 $ldesc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
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;
86 $data{html_description} = [ $sdesc, $ldesc||"" ];
88 $voc_db{$voc_key} = $sdesc || "";
89 $voc{$voc_key} = \%data;
92 close VOC or warn "Couldn't close vocabulary: $!";
94 #print Dumper(\%voc,\%voc_db);
96 print "Creating tag list...\n";
98 -d $wwwdir || mkpath( $wwwdir );
99 open TAGLST, '>', "$wwwdir/debtags.en.html.new"
100 or die "Error creating tag list: $!";
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 );
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}}, $_;
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(@_) };
122 print TAGLST $template->page( 'tag_index', \%content );
123 print TAGLST $template->trailer();
124 close TAGLST or warn "Couldn't close tag list: $!";
126 rename( "$wwwdir/debtags.en.html.new",
127 "$wwwdir/debtags.en.html" );
130 rename( "$debtagsdir/vocabulary.db.new",
131 "$debtagsdir/vocabulary.db" );