bin/parse-debtags-voc

   1 #!/usr/bin/perl -w
   2 # Convert Debtags vocabulary.gz files into Sleepycat db files
   3 #
   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.
   9
  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.
  14
  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.
  18
  19 use strict;
  20 use warnings;
  21 use lib './lib';
  22
  23 $| = 1;
  24
  25 use POSIX;
  26 use DB_File;
  27 use File::Path;
  28 use Data::Dumper;
  29 use HTML::Entities;
  30 use URI::Escape;
  31 use Locale::gettext;
  32
  33 use Deb::Versions;
  34 use Packages::Template;
  35 use Packages::Config qw( $TOPDIR @LANGUAGES $LOCALES);
  36 use Packages::I18N::Locale;
  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 bindtextdomain ( 'debtags', $LOCALES );
  50 textdomain( 'debtags' );
  51
  52 sub process_desc {
  53     my ($desc) = @_;
  54
  55     if ($desc) {
  56         $desc = encode_entities($desc);
  57
  58         $desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
  59         $desc =~ s/\A //o;
  60         $desc =~ s/\n /\n/sgo;
  61         $desc =~ s/\n.\n/\n<p>\n/go;
  62         $desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
  63     }
  64     return $desc;
  65 }
  66
  67 print "Parsing Vocabulary...\n";
  68 tie %voc_db, "DB_File", "$debtagsdir/vocabulary.db.new",
  69     O_RDWR|O_CREAT, 0666, $DB_BTREE
  70     or die "Error creating DB: $!";
  71 open VOC, '<', $voc_file or die "Error opening vocabulary: $!";
  72
  73 while (<VOC>) {
  74     next if /^\s*$/;
  75     my $data = "";
  76     my %data = ();
  77     chomp;
  78     s/\n /\377/g;
  79     while (/^(\S+):\s*(.*)\s*$/mg) {
  80         my ($key, $value) = ($1, $2);
  81         $value =~ s/\377/\n /g;
  82         $key =~ tr [A-Z] [a-z];
  83         $data{$key} = $value;
  84     }
  85     my $voc_key = $data{facet} || $data{tag};
  86     unless ($voc_key) {
  87         warn "No key found in ".Dumper(\%data);
  88         next;
  89     }
  90     if ($voc{$voc_key}) {
  91         warn "Duplicated key found: $voc_key\n";
  92         next;
  93     }
  94     my ($sdesc,$ldesc) = split /\n/, $data{description}, 2;
  95
  96     $data{html_description} = [ encode_entities($sdesc), process_desc($ldesc)||"" ];
  97     $voc_db{$voc_key} = $sdesc || "";
  98
  99     foreach my $lang (@LANGUAGES) {
 100         my $locale = get_locale( $lang );
 101         setlocale ( LC_ALL, $locale ) or do {
 102             warn "couldn't set locale ($lang/$locale)\n";
 103             next;
 104         };
 105
 106         my $sdesc_trans = dgettext( 'debtags', $sdesc );
 107         $voc_db{"$voc_key-$lang"} = $sdesc_trans
 108             if $sdesc_trans and $sdesc_trans ne $sdesc;
 109     }
 110
 111     $voc{$voc_key} = \%data;
 112 }
 113
 114 close VOC or warn "Couldn't close vocabulary: $!";
 115
 116 #print Dumper(\%voc,\%voc_db);
 117
 118 print "Creating tag list...\n";
 119
 120 -d $wwwdir || mkpath( $wwwdir );
 121 open TAGLST, '>', "$wwwdir/debtags.en.html.new"
 122     or die "Error creating tag list: $!";
 123
 124 my $template = new Packages::Template( "$TOPDIR/templates", 'html', {} );
 125 my @facets = sort( grep { exists $voc{$_}{facet} } keys %voc );
 126 my @tags = sort( grep { exists $voc{$_}{tag} } keys %voc );
 127 my %tags_by_facet;
 128 foreach (@tags) {
 129     my ($facet, $tag) = split /::/, $_, 2;
 130     warn "No facet data available for $facet\n"
 131         unless exists $voc{$facet};
 132     $tags_by_facet{$facet} ||= [];
 133     push @{$tags_by_facet{$facet}}, $_;
 134 }
 135 my %content = ( vocabulary => \%voc,
 136                 facets => \@facets, tags => \@tags,
 137                 tags_by_facet => \%tags_by_facet );
 138 print TAGLST $template->page( 'tag_index', \%content );
 139 close TAGLST or warn "Couldn't close tag list: $!";
 140
 141 rename( "$wwwdir/debtags.en.html.new",
 142         "$wwwdir/debtags.en.html" );
 143
 144 untie %voc_db;
 145 rename( "$debtagsdir/vocabulary.db.new",
 146         "$debtagsdir/vocabulary.db" );