#!/usr/bin/perl use strict; use warnings; use POSIX; use File::Path; use DB_File; use Storable; use HTML::Entities; use lib './lib'; use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES ); use Packages::HTML; use Packages::Page; use Packages::Sections; &Packages::Config::init( './' ); sub gettext { return $_[0]; } sub dgettext { return $_[1]; } my $wwwdir = "$TOPDIR/www"; tie my %packages, 'DB_File', "$DBDIR/packages_small.db", O_RDONLY, 0666, $DB_BTREE or die "couldn't tie DB $DBDIR/packages_small.db: $!"; my $sections = retrieve "$DBDIR/sections.info"; my $subsections = retrieve "$DBDIR/subsections.info"; # work around problems with non-US security updates $subsections->{oldstable}{us}{'non-US'}++; my $priorities = retrieve "$DBDIR/priorities.info"; #use Data::Dumper; #print STDERR Dumper($sections, $subsections, $priorities); my (%pages); print "opening files ...\n"; foreach my $s (@SUITES) { foreach my $a (@ARCHIVES) { next if $a eq 'security'; next if $a eq 'non-US'; my $key = ($a eq 'us') ? $s : "$s/$a"; mkpath ( "$wwwdir/$key" ); open $pages{$key}{index}{fh}, '>', "$wwwdir/$key/index.en.html.new" or die "can't open index file for output: $!"; open $pages{$key}{fh}, '>', "$wwwdir/$key/allpackages.en.html.new" or die "can't open index file for output: $!"; my $title = sprintf( gettext ( "Software Packages in \"%s\"" ), $s ); my $index_title = sprintf( gettext ( "List of sections in \"%s\"" ), $s ); print {$pages{$key}{fh}} header( title => $title, title_keywords => "debian, $s", desc => encode_entities( $title, '"' ), lang => 'en' ), title( $title ), '
'; print {$pages{$key}{index}{fh}} header( title => $index_title, title_keywords => "debian, $s", desc => encode_entities( $index_title, '"' ), lang => 'en' ), title( $index_title ), '
'; foreach my $sec (keys %{$sections->{$s}{$a}}) { mkpath ( "$wwwdir/$key/$sec" ); open $pages{$key}{$sec}{fh}, '>', "$wwwdir/$key/$sec/index.en.html.new" or die "can't open index file for output: $!"; $title = sprintf( gettext ( "Software Packages in \"%s\", section %s" ), $s, $sec ); print {$pages{$key}{$sec}{fh}} header( title => $title, title_keywords => "debian, $s, $sec", desc => encode_entities( $title, '"' ), lang => 'en' ), title( $title ), '
'; } my $i = 0; my $num_sections = keys %{$subsections->{$s}{$a}}; foreach my $ssec ((keys %{$subsections->{$s}{$a}}, 'virtual')) { next if $ssec eq '-'; mkpath ( "$wwwdir/$key/$ssec" ); open $pages{$key}{$ssec}{fh}, '>', "$wwwdir/$key/$ssec/index.en.html.new" or die "can't open index file for output: $!"; $title = sprintf( gettext ( "Software Packages in \"%s\", subsection %s" ), $s, $ssec ); print {$pages{$key}{$ssec}{fh}} header( title => $title, title_keywords => "debian, $s, $ssec", desc => encode_entities( $title, '"' ), lang => 'en' ), title( $title ), '
'; if ($sections_descs{$ssec}) { print {$pages{$key}{index}{fh}} "
".dgettext( 'sections', $sections_descs{$ssec}[0] )."
".dgettext( 'sections', $sections_descs{$ssec}[1] )."
\n"; $i++; if ($i eq ceil($num_sections/2)) { print {$pages{$key}{index}{fh}} "
\n
\n
\n
\n"; } } } foreach my $prio (keys %{$priorities->{$s}{$a}}) { next if $prio eq '-'; mkpath ( "$wwwdir/$key/$prio" ); open $pages{$key}{$prio}{fh}, '>', "$wwwdir/$key/$prio/index.en.html.new" or die "can't open index file for output: $!"; $title = sprintf( gettext ( "Software Packages in \"%s\", priority %s" ), $s, $prio ); print {$pages{$key}{$prio}{fh}} header( title => $title, title_keywords => "debian, $s, $prio", desc => encode_entities( $title, '"' ), lang => 'en' ), title( $title ), '
'; } } } print "writing package info ...\n"; while (my ($pkg, $data) = each %packages) { my %pkg; foreach (split /\000/o, $data) { my @data = split ( /\s/o, $_, 8 ); my $key = $data[1]; if ($data[0] !~ /^(?:us|security|non-US)$/o) { $key = "$data[1]/$data[0]"; } $pkg{$key} ||= new Packages::Page( $pkg ); if ($data[2] ne 'virtual') { $pkg{$key}->merge_package( { package => $pkg, archive => $data[0], suite => $data[1], architecture => $data[2], section => $data[3], subsection => $data[4], priority => $data[5], version => $data[6], description => $data[7] } ); } else { $pkg{$key}->add_provided_by([split /\s+/, $data[7]]); } } while (my ($key, $entry) = each %pkg) { if (my $provided_by = $entry->{provided_by}) { my $str = "
$pkg ". "
\n
virtual package provided by ". join( ', ',map { "$_" } @$provided_by)."
\n"; my $txt_str = "$pkg\tvirtual package provided by ".join(', ', @$provided_by)."\n"; print {$pages{$key}{virtual}{fh}} $str or die "couldn't write to output file: $!"; } next if $entry->is_virtual; my (undef, $v_str) = $entry->get_version_string; my $subsection = $entry->get_newest( 'subsection' ); my $section = $entry->get_newest( 'section' ); my $archive = $entry->get_newest( 'archive' ); my $short_desc_txt = $entry->get_newest( 'description' ); my $short_desc = encode_entities( $short_desc_txt, "<>&\"" ); my $priority = $entry->get_newest( 'priority' ); my $str = "
$pkg ($v_str) "; my $txt_str = "$pkg ($v_str)"; if ($section ne 'main') { $str .= marker( $section ); $txt_str .= " [$section]"; } if ($archive ne 'us') { $str .= marker( $archive ); $txt_str .= " [$archive]"; } $str .= "
\n
$short_desc
\n"; $txt_str .= " $short_desc_txt\n"; print {$pages{$key}{fh}} $str or die "couldn't write to output file: $!"; print {$pages{$key}{$section}{fh}} $str or die "couldn't write to output file: $!"; if ($subsection ne '-') { print {$pages{$key}{$subsection}{fh}} $str or die "couldn't write to output file: $!"; } if ($priority ne '-') { print {$pages{$key}{$priority}{fh}} $str or die "couldn't write to output file: $!"; } } } print "closing files ...\n"; foreach my $s (@SUITES) { foreach my $a (@ARCHIVES) { next if $a eq 'security'; next if $a eq 'non-US'; my $key = ($a eq 'us') ? $s : "$s/$a"; my $root = ($a eq 'us') ? '' : '../'; print {$pages{$key}{index}{fh}} '
', "

". gettext( "All packages" ) ."
(". gettext( "compact compressed textlist" ).")

\n"; print {$pages{$key}{index}{fh}} trailer( "$root../" ); close $pages{$key}{index}{fh} or warn "can't open index file for output $wwwdir/$key/index.en.html.new: $!"; rename( "$wwwdir/$key/index.en.html.new", "$wwwdir/$key/index.en.html" ); print {$pages{$key}{fh}} '
', trailer( "$root../" ); close $pages{$key}{fh} or warn "can't close index file $wwwdir/$key/allpackages.en.html.new: $!"; rename( "$wwwdir/$key/allpackages.en.html.new", "$wwwdir/$key/allpackages.en.html" ); foreach my $sec (keys %{$sections->{$s}{$a}}) { print {$pages{$key}{$sec}{fh}} '', trailer( "$root../../" ); close $pages{$key}{$sec}{fh} or warn "can't close index file $wwwdir/$key/$sec/index.en.html.new: $!"; rename( "$wwwdir/$key/$sec/index.en.html.new", "$wwwdir/$key/$sec/index.en.html" ); } foreach my $ssec ((keys %{$subsections->{$s}{$a}}, 'virtual')) { next if $ssec eq '-'; print {$pages{$key}{$ssec}{fh}} '', trailer( "$root../../" ); close $pages{$key}{$ssec}{fh} or warn "can't close index file $wwwdir/$key/$ssec/index.en.html.new: $!"; rename( "$wwwdir/$key/$ssec/index.en.html.new", "$wwwdir/$key/$ssec/index.en.html" ); } foreach my $prio (keys %{$priorities->{$s}{$a}}) { next if $prio eq '-'; print {$pages{$key}{$prio}{fh}} '', trailer( "$root../../" ); close $pages{$key}{$prio}{fh} or warn "can't close index file $wwwdir/$key/$prio/index.en.html.new: $!"; rename( "$wwwdir/$key/$prio/index.en.html.new", "$wwwdir/$key/$prio/index.en.html" ); } } }