16 use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES @LANGUAGES $LOCALES);
18 use Packages::I18N::Locale;
20 use Packages::Sections;
21 &Packages::Config::init( './' );
23 delete $ENV{'LANGUAGE'};
25 delete $ENV{'LC_ALL'};
26 delete $ENV{'LC_MESSAGES'};
27 bindtextdomain ( 'pdo', $LOCALES );
28 bindtextdomain ( 'sections', $LOCALES );
31 my $wwwdir = "$TOPDIR/www";
33 tie my %packages, 'DB_File', "$DBDIR/packages_small.db",
34 O_RDONLY, 0666, $DB_BTREE
35 or die "couldn't tie DB $DBDIR/packages_small.db: $!";
37 my $sections = retrieve "$DBDIR/sections.info";
38 my $subsections = retrieve "$DBDIR/subsections.info";
39 # work around problems with non-US security updates
40 $subsections->{oldstable}{us}{'non-US'}++;
41 my $priorities = retrieve "$DBDIR/priorities.info";
44 #print STDERR Dumper($sections, $subsections, $priorities);
48 print "write suite index files ...\n";
49 foreach my $s (@SUITES) {
51 mkpath ( "$wwwdir/$key" );
52 foreach my $lang (@LANGUAGES) {
53 my $locale = get_locale( $lang );
54 setlocale ( LC_ALL, $locale ) or do {
55 warn "couldn't set locale ($lang/$locale)\n";
58 open $pages{$key}{$lang}{index}{fh}, '>', "$wwwdir/$key/index.$lang.html.new"
59 or die "can't open index file for output: $!";
60 my $index_title = sprintf( _g( "List of sections in \"%s\"" ),
62 print {$pages{$key}{$lang}{index}{fh}} header( title => $index_title,
63 title_keywords => "debian, $s",
64 desc => encode_entities( $index_title, '"' ),
66 title( $index_title ), '<div id="lefthalfcol"><dl>';
67 my $i = 0; my $num_sections = keys %{$subsections->{$s}};
68 foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) {
70 if ($sections_descs{$ssec}) {
71 print {$pages{$key}{$lang}{index}{fh}} "<dt><a href=\"$ssec/\">".dgettext( 'sections', $sections_descs{$ssec}[0] )."</a></dt><dd>".dgettext( 'sections', $sections_descs{$ssec}[1] )."</dd>\n";
73 if ($i eq ceil($num_sections/2)) {
74 print {$pages{$key}{$lang}{index}{fh}} "</dl>\n</div> <!-- end lefthalfcol -->\n<div id=\"righthalfcol\">\n<dl>\n";
79 print {$pages{$key}{$lang}{index}{fh}} '</dl></div>',
80 "<p class=\"psmallcenter\"><a href=\"allpackages\" title=\""._g( "List of all packages" )."\">".
81 _g( "All packages" ) ."</a><br>(<a href=\"allpackages?format=txt.gz\">".
82 _g( "compact compressed textlist" )."</a>)</p>\n";
83 print {$pages{$key}{$lang}{index}{fh}} trailer( "../", 'index', $lang, @LANGUAGES );
84 close $pages{$key}{$lang}{index}{fh} or
85 warn "can't close index file $wwwdir/$key/index.$lang.html.new: $!";
86 rename( "$wwwdir/$key/index.$lang.html.new",
87 "$wwwdir/$key/index.$lang.html" );
91 setlocale( LC_ALL, 'C' ) or die "couldn't reset locale";
93 print "opening files ...\n";
94 foreach my $s (@SUITES) {
96 mkpath ( "$wwwdir/$key" );
97 open $pages{$key}{fh}, '>', "$wwwdir/$key/allpackages.en.html.new"
98 or die "can't open index file for output: $!";
99 $pages{$key}{textgz} = gzopen("$wwwdir/$key/allpackages.en.txt.gz.new",
101 or die "can't open text index file for output: $!";
103 my $title = sprintf( _g( "Software Packages in \"%s\"" ),
105 print {$pages{$key}{fh}} header( title => $title,
106 title_keywords => "debian, $s",
107 desc => encode_entities( $title, '"' ),
109 title( $title ), '<dl>';
110 my $title_txt = sprintf( _g( "All Debian Packages in \"%s\"" ),
112 $title_txt .= _g( "Last Modified: " ).gmtime()."\n".
113 sprintf(_g( "Copyright (C) 1997-%d SPI;\nSee <URL:http://www.debian.org/license> for the license terms."), (gmtime)[5]+1900 )."\n\n";
114 $pages{$key}{textgz}->gzwrite($title_txt);
116 foreach my $sec (keys %{$sections->{$s}}) {
117 mkpath ( "$wwwdir/$key/$sec" );
118 open $pages{$key}{$sec}{fh}, '>', "$wwwdir/$key/$sec/index.en.html.new"
119 or die "can't open index file for output: $!";
120 $title = sprintf( _g( "Software Packages in \"%s\", section %s" ),
122 print {$pages{$key}{$sec}{fh}} header( title => $title,
123 title_keywords => "debian, $s, $sec",
124 desc => encode_entities( $title, '"' ),
126 title( $title ), '<dl>';
128 foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) {
129 next if $ssec eq '-';
130 mkpath ( "$wwwdir/$key/$ssec" );
131 open $pages{$key}{$ssec}{fh}, '>', "$wwwdir/$key/$ssec/index.en.html.new"
132 or die "can't open index file for output: $!";
133 $title = sprintf( _g( "Software Packages in \"%s\", subsection %s" ),
135 print {$pages{$key}{$ssec}{fh}} header( title => $title,
136 title_keywords => "debian, $s, $ssec",
137 desc => encode_entities( $title, '"' ),
139 title( $title ), '<dl>';
141 foreach my $prio (keys %{$priorities->{$s}}) {
142 next if $prio eq '-';
143 mkpath ( "$wwwdir/$key/$prio" );
144 open $pages{$key}{$prio}{fh}, '>', "$wwwdir/$key/$prio/index.en.html.new"
145 or die "can't open index file for output: $!";
146 $title = sprintf( _g( "Software Packages in \"%s\", priority %s" ),
148 print {$pages{$key}{$prio}{fh}} header( title => $title,
149 title_keywords => "debian, $s, $prio",
150 desc => encode_entities( $title, '"' ),
152 title( $title ), '<dl>';
156 print "writing package info ...\n";
157 while (my ($pkg, $data) = each %packages) {
159 my ($virt, $p_data) = split /\000/o, $data, 2;
160 %virt = split /\01/o, $virt;
161 foreach (split /\000/o, $p_data||'') {
162 my @data = split ( /\s/o, $_, 8 );
163 $pkg{$data[1]} ||= new Packages::Page( $pkg );
164 $pkg{$data[1]}->merge_package( { package => $pkg,
167 architecture => $data[2],
169 subsection => $data[4],
170 priority => $data[5],
172 description => $data[7] } );
174 foreach (keys %virt) {
176 $pkg{$_} ||= new Packages::Page( $pkg );
177 $pkg{$_}->add_provided_by([split /\s+/, $virt{$_}]);
180 while (my ($key, $entry) = each %pkg) {
181 if (my $provided_by = $entry->{provided_by}) {
182 my $str = "<dt><a href=\"$pkg\">$pkg</a> ".
183 "</dt>\n <dd>virtual package provided by ".
184 join( ', ',map { "<a href=\"../$_\">$_</a>" } @$provided_by)."</dd>\n";
185 my $txt_str = "$pkg\tvirtual package provided by ".join(', ', @$provided_by)."\n";
186 print {$pages{$key}{virtual}{fh}} $str
187 or die "couldn't write to output file: $!";
189 next if $entry->is_virtual;
190 my (undef, $v_str) = $entry->get_version_string;
191 my $subsection = $entry->get_newest( 'subsection' );
192 my $section = $entry->get_newest( 'section' );
193 my $archive = $entry->get_newest( 'archive' );
194 my $short_desc_txt = $entry->get_newest( 'description' );
195 my $short_desc = encode_entities( $short_desc_txt, "<>&\"" );
196 my $priority = $entry->get_newest( 'priority' );
198 my $str = "<dt><a href=\"$pkg\">$pkg</a> ($v_str) ";
199 my $txt_str = "$pkg ($v_str)";
200 if ($section ne 'main') {
201 $str .= marker( $section );
202 $txt_str .= " [$section]";
204 if ($archive ne 'us') {
205 $str .= marker( $archive );
206 $txt_str .= " [$archive]";
208 $str .= "</dt>\n <dd>$short_desc</dd>\n";
209 $txt_str .= " $short_desc_txt\n";
210 print {$pages{$key}{fh}} $str
211 or die "couldn't write to output file: $!";
212 $pages{$key}{textgz}->gzwrite($txt_str)
213 or die "couldn't write to output file: ".$pages{$key}{textgz}->gzerror;
214 print {$pages{$key}{$section}{fh}} $str
215 or die "couldn't write to output file: $!";
216 if ($subsection ne '-') {
217 print {$pages{$key}{$subsection}{fh}} $str
218 or die "couldn't write to output file: $!";
220 if ($priority ne '-') {
221 print {$pages{$key}{$priority}{fh}} $str
222 or die "couldn't write to output file: $!";
227 print "closing files ...\n";
228 foreach my $s (@SUITES) {
230 print {$pages{$key}{fh}} '</dl>', trailer( "../" );
231 $pages{$key}{textgz}->gzclose or
232 warn "can't close text index file $wwwdir/$key/allpackages.en.txt.gz.new: ".$pages{$key}{textgz}->gzerror;
233 close $pages{$key}{fh} or
234 warn "can't close index file $wwwdir/$key/allpackages.en.html.new: $!";
235 rename( "$wwwdir/$key/allpackages.en.html.new",
236 "$wwwdir/$key/allpackages.en.html" );
237 rename( "$wwwdir/$key/allpackages.en.txt.gz.new",
238 "$wwwdir/$key/allpackages.en.txt.gz" );
239 foreach my $sec (keys %{$sections->{$s}{'us'}}) {
240 print {$pages{$key}{$sec}{fh}} '</dl>', trailer( "../../" );
241 close $pages{$key}{$sec}{fh} or
242 warn "can't close index file $wwwdir/$key/$sec/index.en.html.new: $!";
243 rename( "$wwwdir/$key/$sec/index.en.html.new",
244 "$wwwdir/$key/$sec/index.en.html" );
246 foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) {
247 next if $ssec eq '-';
248 print {$pages{$key}{$ssec}{fh}} '</dl>', trailer( "../../" );
249 close $pages{$key}{$ssec}{fh} or
250 warn "can't close index file $wwwdir/$key/$ssec/index.en.html.new: $!";
251 rename( "$wwwdir/$key/$ssec/index.en.html.new",
252 "$wwwdir/$key/$ssec/index.en.html" );
254 foreach my $prio (keys %{$priorities->{$s}}) {
255 next if $prio eq '-';
256 print {$pages{$key}{$prio}{fh}} '</dl>', trailer( "../../" );
257 close $pages{$key}{$prio}{fh} or
258 warn "can't close index file $wwwdir/$key/$prio/index.en.html.new: $!";
259 rename( "$wwwdir/$key/$prio/index.en.html.new",
260 "$wwwdir/$key/$prio/index.en.html" );