Move common functions for template use to Packages::Template
[deb/packages.git] / 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 DB_File;
26 use File::Path;
27 use Data::Dumper;
28 use HTML::Entities;
29 use URI::Escape;
30
31 use Deb::Versions;
32 use Packages::Template;
33 use Packages::Config qw( $TOPDIR );
34 use Packages::CGI;
35 &Packages::Config::init( './' );
36 my $debtagsdir = "$TOPDIR/files/debtags";
37 my $wwwdir = "$TOPDIR/www/about";
38 my $voc_file = "$debtagsdir/vocabulary";
39 my (%voc, %voc_db);
40
41 $/ = "";
42
43 delete $ENV{'LANGUAGE'};
44 delete $ENV{'LANG'};
45 delete $ENV{'LC_ALL'};
46 delete $ENV{'LC_MESSAGES'};
47
48 print "Parsing Vocabulary...\n";
49 tie %voc_db, "DB_File", "$debtagsdir/vocabulary.db.new",
50     O_RDWR|O_CREAT, 0666, $DB_BTREE
51     or die "Error creating DB: $!";
52 open VOC, '<', $voc_file or die "Error opening vocabulary: $!";
53
54 while (<VOC>) {
55     next if /^\s*$/;
56     my $data = "";
57     my %data = ();
58     chomp;
59     s/\n /\377/g;
60     while (/^(\S+):\s*(.*)\s*$/mg) {
61         my ($key, $value) = ($1, $2);
62         $value =~ s/\377/\n /g;
63         $key =~ tr [A-Z] [a-z];
64         $data{$key} = $value;
65     }
66     my $voc_key = $data{facet} || $data{tag};
67     unless ($voc_key) {
68         warn "No key found in ".Dumper(\%data);
69         next;
70     }
71     if ($voc{$voc_key}) {
72         warn "Duplicated key found: $voc_key\n";
73         next;
74     }
75     my ($sdesc,$ldesc) = split /\n/, encode_entities($data{description}), 2;
76
77     if ($ldesc) {
78         $ldesc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
79         $ldesc =~ s/\A //o;
80         $ldesc =~ s/\n /\n/sgo;
81         $ldesc =~ s/\n.\n/\n<p>\n/go;
82         $ldesc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
83     }
84     $data{html_description} = [ $sdesc, $ldesc||"" ];
85
86     $voc_db{$voc_key} = $sdesc || "";
87     $voc{$voc_key} = \%data;
88 }
89
90 close VOC or warn "Couldn't close vocabulary: $!";
91
92 #print Dumper(\%voc,\%voc_db);
93
94 print "Creating tag list...\n";
95
96 -d $wwwdir || mkpath( $wwwdir );
97 open TAGLST, '>', "$wwwdir/debtags.en.html.new"
98     or die "Error creating tag list: $!";
99
100 my $template = new Packages::Template( "$TOPDIR/templates", 'html', {} );
101 my @facets = sort( grep { exists $voc{$_}{facet} } keys %voc );
102 my @tags = sort( grep { exists $voc{$_}{tag} } keys %voc );
103 my %tags_by_facet;
104 foreach (@tags) {
105     my ($facet, $tag) = split /::/, $_, 2;
106     warn "No facet data available for $facet\n"
107         unless exists $voc{$facet};
108     $tags_by_facet{$facet} ||= [];
109     push @{$tags_by_facet{$facet}}, $_;
110 }
111 my %content = ( vocabulary => \%voc,
112                 facets => \@facets, tags => \@tags,
113                 tags_by_facet => \%tags_by_facet );
114 print TAGLST $template->page( 'tag_index', \%content );
115 close TAGLST or warn "Couldn't close tag list: $!";
116
117 rename( "$wwwdir/debtags.en.html.new",
118         "$wwwdir/debtags.en.html" );
119
120 untie %voc_db;
121 rename( "$debtagsdir/vocabulary.db.new",
122         "$debtagsdir/vocabulary.db" );