2 # Convert Debtags vocabulary.gz files into Sleepycat db files
4 # Copyright (C) 2006 Frank Lichtenheld <djpig@debian.org>
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
33 use Packages::Template;
34 use Packages::Config qw( $TOPDIR @LANGUAGES );
35 use Packages::I18N::Locale;
36 &Packages::Config::init( './' );
37 &Packages::I18N::Locale::load( "$TOPDIR/po" );
38 my $debtagsdir = "$TOPDIR/files/debtags";
39 my $wwwdir = "$TOPDIR/www/about";
40 my $voc_file = "$debtagsdir/vocabulary";
49 $desc = encode_entities($desc);
51 $desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
53 $desc =~ s/\n /\n/sgo;
54 $desc =~ s/\n.\n/\n<p>\n/go;
55 $desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
60 print "Parsing Vocabulary...\n";
61 tie %voc_db, "DB_File", "$debtagsdir/vocabulary.db.new",
62 O_RDWR|O_CREAT, 0666, $DB_BTREE
63 or die "Error creating DB: $!";
64 open VOC, '<', $voc_file or die "Error opening vocabulary: $!";
72 while (/^(\S+):\s*(.*)\s*$/mg) {
73 my ($key, $value) = ($1, $2);
74 $value =~ s/\377/\n /g;
75 $key =~ tr [A-Z] [a-z];
78 my $voc_key = $data{facet} || $data{tag};
80 warn "No key found in ".Dumper(\%data);
84 warn "Duplicated key found: $voc_key\n";
87 my ($sdesc,$ldesc) = split /\n/, $data{description}, 2;
89 $data{html_description} = [ encode_entities($sdesc), process_desc($ldesc)||"" ];
90 $voc_db{$voc_key} = $sdesc || "";
92 foreach my $lang (@LANGUAGES) {
93 next if $lang eq 'en';
95 my $cat = Packages::I18N::Locale->get_handle($lang)
96 or die "get_handle failed for $lang";
98 my $sdesc_trans = $cat->maketext($sdesc);
99 $voc_db{"$voc_key-$lang"} = $sdesc_trans
100 if $sdesc_trans and $sdesc_trans ne $sdesc;
103 $voc{$voc_key} = \%data;
106 close VOC or warn "Couldn't close vocabulary: $!";
108 #print Dumper(\%voc,\%voc_db);
110 print "Creating tag list...\n";
112 -d $wwwdir || mkpath( $wwwdir );
113 open TAGLST, '>', "$wwwdir/debtags.en.html.new"
114 or die "Error creating tag list: $!";
116 my $template = new Packages::Template( "$TOPDIR/templates", 'html', {} );
117 my @facets = sort( grep { exists $voc{$_}{facet} } keys %voc );
118 my @tags = sort( grep { exists $voc{$_}{tag} } keys %voc );
121 my ($facet, $tag) = split m/::/, $_, 2;
122 warn "No facet data available for $facet\n"
123 unless exists $voc{$facet};
124 $tags_by_facet{$facet} ||= [];
125 push @{$tags_by_facet{$facet}}, $_;
127 my %content = ( vocabulary => \%voc,
128 facets => \@facets, tags => \@tags,
129 tags_by_facet => \%tags_by_facet );
130 print TAGLST $template->page( 'tag_index', \%content );
131 close TAGLST or warn "Couldn't close tag list: $!";
133 rename( "$wwwdir/debtags.en.html.new",
134 "$wwwdir/debtags.en.html" );
137 rename( "$debtagsdir/vocabulary.db.new",
138 "$debtagsdir/vocabulary.db" );