15 use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES @LANGUAGES $LOCALES);
17 use Packages::I18N::Locale;
19 use Packages::Sections;
20 &Packages::Config::init( './' );
22 delete $ENV{'LANGUAGE'};
24 delete $ENV{'LC_ALL'};
25 delete $ENV{'LC_MESSAGES'};
26 bindtextdomain ( 'pdo', $LOCALES );
27 bindtextdomain ( 'sections', $LOCALES );
30 my $wwwdir = "$TOPDIR/www";
32 tie my %packages, 'DB_File', "$DBDIR/packages_small.db",
33 O_RDONLY, 0666, $DB_BTREE
34 or die "couldn't tie DB $DBDIR/packages_small.db: $!";
36 my $sections = retrieve "$DBDIR/sections.info";
37 my $subsections = retrieve "$DBDIR/subsections.info";
38 # work around problems with non-US security updates
39 $subsections->{oldstable}{us}{'non-US'}++;
40 my $priorities = retrieve "$DBDIR/priorities.info";
43 #print STDERR Dumper($sections, $subsections, $priorities);
47 print "write suite index files ...\n";
48 foreach my $s (@SUITES) {
50 mkpath ( "$wwwdir/$key" );
51 foreach my $lang (@LANGUAGES) {
52 my $locale = get_locale( $lang );
53 setlocale ( LC_ALL, $locale ) or do {
54 warn "couldn't set locale ($lang/$locale)\n";
57 open $pages{$key}{$lang}{index}{fh}, '>', "$wwwdir/$key/index.$lang.html.new"
58 or die "can't open index file for output: $!";
59 my $index_title = sprintf( _g( "List of sections in \"%s\"" ),
61 print {$pages{$key}{$lang}{index}{fh}} header( title => $index_title,
62 title_keywords => "debian, $s",
63 desc => encode_entities( $index_title, '"' ),
65 title( $index_title ), '<div id="lefthalfcol"><dl>';
66 my $i = 0; my $num_sections = keys %{$subsections->{$s}{'us'}};
67 foreach my $ssec ((keys %{$subsections->{$s}{'us'}}, 'virtual')) {
69 if ($sections_descs{$ssec}) {
70 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";
72 if ($i eq ceil($num_sections/2)) {
73 print {$pages{$key}{$lang}{index}{fh}} "</dl>\n</div> <!-- end lefthalfcol -->\n<div id=\"righthalfcol\">\n<dl>\n";
78 print {$pages{$key}{$lang}{index}{fh}} '</dl></div>',
79 "<p class=\"psmallcenter\"><a href=\"allpackages\" title=\""._g( "List of all packages" )."\">".
80 _g( "All packages" ) ."</a><br>(<a href=\"allpackages.en.txt.gz\">".
81 _g( "compact compressed textlist" )."</a>)</p>\n";
82 print {$pages{$key}{$lang}{index}{fh}} trailer( "../", 'index', $lang, @LANGUAGES );
83 close $pages{$key}{$lang}{index}{fh} or
84 warn "can't close index file $wwwdir/$key/index.$lang.html.new: $!";
85 rename( "$wwwdir/$key/index.$lang.html.new",
86 "$wwwdir/$key/index.$lang.html" );
90 setlocale( LC_ALL, 'C' ) or die "couldn't reset locale";
92 print "opening files ...\n";
93 foreach my $s (@SUITES) {
95 mkpath ( "$wwwdir/$key" );
96 open $pages{$key}{fh}, '>', "$wwwdir/$key/allpackages.en.html.new"
97 or die "can't open index file for output: $!";
99 my $title = sprintf( _g( "Software Packages in \"%s\"" ),
101 print {$pages{$key}{fh}} header( title => $title,
102 title_keywords => "debian, $s",
103 desc => encode_entities( $title, '"' ),
105 title( $title ), '<dl>';
107 foreach my $sec (keys %{$sections->{$s}{'us'}}) {
108 mkpath ( "$wwwdir/$key/$sec" );
109 open $pages{$key}{$sec}{fh}, '>', "$wwwdir/$key/$sec/index.en.html.new"
110 or die "can't open index file for output: $!";
111 $title = sprintf( _g( "Software Packages in \"%s\", section %s" ),
113 print {$pages{$key}{$sec}{fh}} header( title => $title,
114 title_keywords => "debian, $s, $sec",
115 desc => encode_entities( $title, '"' ),
117 title( $title ), '<dl>';
119 foreach my $ssec ((keys %{$subsections->{$s}{'us'}}, 'virtual')) {
120 next if $ssec eq '-';
121 mkpath ( "$wwwdir/$key/$ssec" );
122 open $pages{$key}{$ssec}{fh}, '>', "$wwwdir/$key/$ssec/index.en.html.new"
123 or die "can't open index file for output: $!";
124 $title = sprintf( _g( "Software Packages in \"%s\", subsection %s" ),
126 print {$pages{$key}{$ssec}{fh}} header( title => $title,
127 title_keywords => "debian, $s, $ssec",
128 desc => encode_entities( $title, '"' ),
130 title( $title ), '<dl>';
132 foreach my $prio (keys %{$priorities->{$s}{'us'}}) {
133 next if $prio eq '-';
134 mkpath ( "$wwwdir/$key/$prio" );
135 open $pages{$key}{$prio}{fh}, '>', "$wwwdir/$key/$prio/index.en.html.new"
136 or die "can't open index file for output: $!";
137 $title = sprintf( _g( "Software Packages in \"%s\", priority %s" ),
139 print {$pages{$key}{$prio}{fh}} header( title => $title,
140 title_keywords => "debian, $s, $prio",
141 desc => encode_entities( $title, '"' ),
143 title( $title ), '<dl>';
147 print "writing package info ...\n";
148 while (my ($pkg, $data) = each %packages) {
150 my ($virt, $p_data) = split /\000/o, $data, 2;
151 %virt = split /\01/o, $virt;
152 foreach (split /\000/o, $p_data) {
153 my @data = split ( /\s/o, $_, 8 );
154 $pkg{$data[1]} ||= new Packages::Page( $pkg );
155 $pkg{$data[1]}->merge_package( { package => $pkg,
158 architecture => $data[2],
160 subsection => $data[4],
161 priority => $data[5],
163 description => $data[7] } );
165 foreach (keys %virt) {
167 $pkg{$_} ||= new Packages::Page( $pkg );
168 $pkg{$_}->add_provided_by([split /\s+/, $virt{$_}]);
171 while (my ($key, $entry) = each %pkg) {
172 if (my $provided_by = $entry->{provided_by}) {
173 my $str = "<dt><a href=\"$pkg\">$pkg</a> ".
174 "</dt>\n <dd>virtual package provided by ".
175 join( ', ',map { "<a href=\"../$_\">$_</a>" } @$provided_by)."</dd>\n";
176 my $txt_str = "$pkg\tvirtual package provided by ".join(', ', @$provided_by)."\n";
177 print {$pages{$key}{virtual}{fh}} $str
178 or die "couldn't write to output file: $!";
180 next if $entry->is_virtual;
181 my (undef, $v_str) = $entry->get_version_string;
182 my $subsection = $entry->get_newest( 'subsection' );
183 my $section = $entry->get_newest( 'section' );
184 my $archive = $entry->get_newest( 'archive' );
185 my $short_desc_txt = $entry->get_newest( 'description' );
186 my $short_desc = encode_entities( $short_desc_txt, "<>&\"" );
187 my $priority = $entry->get_newest( 'priority' );
189 my $str = "<dt><a href=\"$pkg\">$pkg</a> ($v_str) ";
190 my $txt_str = "$pkg ($v_str)";
191 if ($section ne 'main') {
192 $str .= marker( $section );
193 $txt_str .= " [$section]";
195 if ($archive ne 'us') {
196 $str .= marker( $archive );
197 $txt_str .= " [$archive]";
199 $str .= "</dt>\n <dd>$short_desc</dd>\n";
200 $txt_str .= " $short_desc_txt\n";
201 print {$pages{$key}{fh}} $str
202 or die "couldn't write to output file: $!";
203 print {$pages{$key}{$section}{fh}} $str
204 or die "couldn't write to output file: $!";
205 if ($subsection ne '-') {
206 print STDERR "pages{$key}{$subsection}{fh}\n"
207 unless $pages{$key}{$subsection}{fh};
208 print {$pages{$key}{$subsection}{fh}} $str
209 or die "couldn't write to output file: $!";
211 if ($priority ne '-') {
212 print {$pages{$key}{$priority}{fh}} $str
213 or die "couldn't write to output file: $!";
218 print "closing files ...\n";
219 foreach my $s (@SUITES) {
221 print {$pages{$key}{fh}} '</dl>', trailer( "../" );
222 close $pages{$key}{fh} or
223 warn "can't close index file $wwwdir/$key/allpackages.en.html.new: $!";
224 rename( "$wwwdir/$key/allpackages.en.html.new",
225 "$wwwdir/$key/allpackages.en.html" );
226 foreach my $sec (keys %{$sections->{$s}{'us'}}) {
227 print {$pages{$key}{$sec}{fh}} '</dl>', trailer( "../../" );
228 close $pages{$key}{$sec}{fh} or
229 warn "can't close index file $wwwdir/$key/$sec/index.en.html.new: $!";
230 rename( "$wwwdir/$key/$sec/index.en.html.new",
231 "$wwwdir/$key/$sec/index.en.html" );
233 foreach my $ssec ((keys %{$subsections->{$s}{'us'}}, 'virtual')) {
234 next if $ssec eq '-';
235 print {$pages{$key}{$ssec}{fh}} '</dl>', trailer( "../../" );
236 close $pages{$key}{$ssec}{fh} or
237 warn "can't close index file $wwwdir/$key/$ssec/index.en.html.new: $!";
238 rename( "$wwwdir/$key/$ssec/index.en.html.new",
239 "$wwwdir/$key/$ssec/index.en.html" );
241 foreach my $prio (keys %{$priorities->{$s}{'us'}}) {
242 next if $prio eq '-';
243 print {$pages{$key}{$prio}{fh}} '</dl>', trailer( "../../" );
244 close $pages{$key}{$prio}{fh} or
245 warn "can't close index file $wwwdir/$key/$prio/index.en.html.new: $!";
246 rename( "$wwwdir/$key/$prio/index.en.html.new",
247 "$wwwdir/$key/$prio/index.en.html" );