X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=bin%2Fcreate_index_pages;h=3e9fc529f63ff74fe27dcc2590370e1e3c0c297c;hp=ff1084aa4b40ce54de52e3417bf3275fbc1c3a71;hb=1c880dbbb5b885dd620120354e735c06280030df;hpb=ef769eaccb9ebf7f49b8c3240c9c4d6980072ee5 diff --git a/bin/create_index_pages b/bin/create_index_pages index ff1084a..3e9fc52 100755 --- a/bin/create_index_pages +++ b/bin/create_index_pages @@ -8,123 +8,235 @@ use File::Path; use DB_File; use Storable; use HTML::Entities; +use URI::Escape; +use Compress::Zlib; use lib './lib'; -use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES ); -use Packages::HTML; +use Packages::CommonCode qw(:all); +use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES @LANGUAGES ); +use Packages::Template; +use Packages::I18N::Locale; use Packages::Page; +use Packages::SrcPage; use Packages::Sections; &Packages::Config::init( './' ); -sub gettext { return $_[0]; } -sub dgettext { return $_[1]; } + +use constant DEBUG => 0; 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: $!"; +tie my %src_packages, 'DB_File', "$DBDIR/sources_small.db", + O_RDONLY, 0666, $DB_BTREE + or die "couldn't tie DB $DBDIR/sources_small.db: $!"; +tie my %src2bin, 'DB_File', "$DBDIR/sources_packages.db", + O_RDONLY, 0666, $DB_BTREE + or die "couldn't open $DBDIR/sources_packages.db: $!"; +tie my %desctrans, 'DB_File', "$DBDIR/descriptions_translated.db", + O_RDONLY, 0666, $DB_BTREE + or die "couldn't tie DB $DBDIR/descriptions_translated.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; +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 @PACKAGES = sort keys %packages; +my @SRC_PACKAGES = sort keys %src_packages; + +print "Found ".scalar(@PACKAGES)." packages\n"; +print "Found ".scalar(@SRC_PACKAGES)." source packages\n"; + +my $template = new Packages::Template( "$TOPDIR/templates", 'html'); +my $txt_template = new Packages::Template( "$TOPDIR/templates", 'txt'); + +my $charset = 'UTF-8'; +my (%cat, %lang_vars, $prov_string, %s, %fh); +foreach my $lang (@LANGUAGES) { + $cat{$lang} = Packages::I18N::Locale->get_handle($lang) + or die "get_handle failed for $lang"; + $lang_vars{$lang} = { po_lang => $lang, ddtp_lang => $lang, + charset => $charset, + cat => $cat{$lang}, used_langs => \@LANGUAGES }; + $s{begin}{$lang} = '['.uc($lang).':'; + $s{end}{$lang} = ':'.uc($lang).']'; + $prov_string .= $s{begin}{$lang}.$cat{$lang}->g('virtual package provided by').$s{end}{$lang}; +} + +sub open_file { + my ($key, $vars, $file) = @_; + + $file ||= 'index'; + + print "opening $key\n"; + mkdirp ( "$wwwdir/$key" ); + open($fh{$key}, '>', + "$wwwdir/$key/$file.slices.new") + or die "Cannot open file $wwwdir/$key/$file.slices.new: $!"; + + foreach my $lang (@LANGUAGES) { + print {$fh{$key}} "$s{begin}{$lang}\n"; + $template->page( 'index_head', + { %{$lang_vars{$lang}}, + %$vars }, + $fh{$key}); + print {$fh{$key}} "\n$s{end}{$lang}\n"; + } +} + +sub close_file { + my ($key, $vars, $file) = @_; + + $file ||= 'index'; + + print "closing $key\n"; + + foreach my $lang (@LANGUAGES) { + print {$fh{$key}} "\n$s{begin}{$lang}\n"; + $template->page( 'index_foot', + { %{$lang_vars{$lang}}, + %$vars }, + $fh{$key}); + print {$fh{$key}} "\n$s{end}{$lang}\n"; + } + close($fh{$key}) + or die "Cannot close file $wwwdir/$key/$file.slices.new: $!"; + + activate("$wwwdir/$key/$file.slices"); +} + + +sub open_txt_file { + my ($key, $vars, $file) = @_; + + $file ||= 'allpackages'; + my $lang = 'en'; + + print "opening $key (txt,lang=$lang)\n"; + mkdirp ( "$wwwdir/$key" ); + $fh{"$key/$lang/txt"} = gzopen("$wwwdir/$key/$file.$lang.txt.gz.new", 'wb9') + or die "Cannot open file $wwwdir/$key/$file.$lang.txt.gz.new: $!"; + + my $gztxt = $txt_template->page( 'index_head', + { %{$lang_vars{$lang}}, + %$vars }); + $fh{"$key/$lang/txt"}->gzwrite($gztxt); +} + +sub close_txt_file { + my ($key, $vars, $file) = @_; + + $file ||= 'allpackages'; + my $lang = 'en'; + + print "closing $key (txt,lang=$lang)\n"; + my $gztxt = $txt_template->page( 'index_foot', + { %{$lang_vars{$lang}}, + %$vars }); + $fh{"$key/$lang/txt"}->gzwrite($gztxt); + ($fh{"$key/$lang/txt"}->gzclose == Z_OK) or + warn("can't close text index file $wwwdir/$key/$file.$lang.txt.gz.new: " + . $fh{"$key/$lang/txt"}->gzerror); + activate("$wwwdir/$key/$file.$lang.txt.gz"); +} + + +foreach my $source (("", "source/")) { + print "write headers ...\n"; + foreach my $s (@SUITES) { + mkdirp ( "$wwwdir/$source$s" ); + my %common_vars = ( suite => $s, + is_source => $source ); + + open_file("$source$s", \%common_vars, 'allpackages'); + open_txt_file("$source$s", \%common_vars, 'allpackages'); + + foreach my $sec (keys %{$sections->{$s}}) { + open_file("$source$s/$sec", + { %common_vars, + category => { id => N_('Section'), + name => $sec }}); } - my $i = 0; my $num_sections = keys %{$subsections->{$s}{$a}}; - foreach my $ssec ((keys %{$subsections->{$s}{$a}}, 'virtual')) { + foreach my $ssec ((keys %{$subsections->{$s}}, '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"; - } - } + open_file("$source$s/$ssec", + { %common_vars, + category => { id => N_('Subsection'), + name => $ssec }}); } - foreach my $prio (keys %{$priorities->{$s}{$a}}) { + foreach my $prio (keys %{$priorities->{$s}}) { 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 ), '
'; + open_file("$source$s/$prio", + { %common_vars, + category => { id => N_('Priority'), + name => $prio }}); } } -} -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]"; + if ($source) { + process_source_packages(); + } else { + process_packages(); + } + + print "write footers ...\n"; + foreach my $s (@SUITES) { + my %common_vars = ( suite => $s, + is_source => $source ); + my $page_base = "$source$s/"; + close_file("$source$s", { %common_vars, + page_name => "${page_base}allpackages" }, + 'allpackages'); + close_txt_file("$source$s", { %common_vars, + page_name => "{$page_base}allpackages" }, + 'allpackages'); + + foreach my $sec (keys %{$sections->{$s}}) { + close_file("$source$s/$sec", + { %common_vars, + page_name => "$page_base$sec/", + category => { id => N_('Section'), + name => $sec }}); + } + foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) { + next if $ssec eq '-'; + close_file("$source$s/$ssec", + { %common_vars, + page_name => "$page_base$ssec/", + category => { id => N_('Subsection'), + name => $ssec }}); + } + foreach my $prio (keys %{$priorities->{$s}}) { + next if $prio eq '-'; + close_file("$source$s/$prio", + { %common_vars, + page_name => "$page_base$prio/", + category => { id => N_('Priority'), + name => $prio }}); } - $pkg{$key} ||= new Packages::Page( $pkg ); - if ($data[2] ne 'virtual') { - $pkg{$key}->merge_package( { package => $pkg, + } +} + +sub process_packages { + +print "processing package info ...\n"; +my $count = 0; +foreach my $pkg (@PACKAGES) { + warn "pkg=$pkg\n" if DEBUG; + print "$count\n" unless ++$count % 1000; + + my (%pkg,%virt); + my ($virt, $p_data) = split /\000/o, $packages{$pkg}, 2; + %virt = split /\01/o, $virt; + foreach (split /\000/o, $p_data||'') { + my @data = split ( /\s/o, $_, 9 ); + $pkg{$data[1]} ||= new Packages::Page( $pkg ); + $pkg{$data[1]}->merge_package( { package => $pkg, archive => $data[0], suite => $data[1], architecture => $data[2], @@ -132,99 +244,178 @@ while (my ($pkg, $data) = each %packages) { subsection => $data[4], priority => $data[5], version => $data[6], - description => $data[7] } ); - } else { - $pkg{$key}->add_provided_by([split /\s+/, $data[7]]); - } + 'description-md5' => $data[7], + description => $data[8] } ); + } + foreach (keys %virt) { + next if $_ eq '-'; + $pkg{$_} ||= new Packages::Page( $pkg ); + $pkg{$_}->add_provided_by([split /\s+/, $virt{$_}]); } - while (my ($key, $entry) = each %pkg) { + + while (my ($suite, $entry) = each %pkg) { + + warn "\tsuite=$suite\n" if DEBUG; + my %p = ( name => $pkg, providers => [], versions => '' ); 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: $!"; + $p{providers} = $provided_by; } - 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]"; + $p{subsection} = $p{section} = $p{archive} = + $p{desc} = $p{priority} = ''; + unless ($entry->is_virtual) { + (undef, $p{versions}) = $entry->get_version_string; + $p{subsection} = $entry->get_newest( 'subsection' ); + $p{section} = $entry->get_newest( 'section' ); + $p{archive} = $entry->get_newest( 'archive' ); + $p{desc} = $entry->get_newest( 'description' ); + my $desc_md5 = $entry->get_newest( 'description-md5' ); + my $trans_desc = $desctrans{$desc_md5}; + if ($trans_desc) { + my %sdescs; + my %trans_desc = split /\000|\001/, $trans_desc; + while (my ($l, $d) = each %trans_desc) { + # filter out non-po languages + next unless exists $lang_vars{$l}; + + $d =~ s/\n.*//os; + $sdescs{$l} = $d; + } + $p{trans_desc} = \%sdescs if %sdescs; + } + $p{priority} = $entry->get_newest( 'priority' ); } - if ($archive ne 'us') { - $str .= marker( $archive ); - $txt_str .= " [$archive]"; + + my $html = my $txt = ""; + my $id = " id='$p{name}'"; + if ($p{versions}) { + warn "\tversions=$p{versions}\n" if DEBUG; + + $html .= "\n
$p{name} ($p{versions})"; + $id = ""; + $html .= " [$p{section}]" + if $p{section} ne 'main'; + $html .= " [$p{archive}]" + if $p{archive} ne 'us'; + $html .= "
\n&"\''), + 'en'); + if ($p{trans_desc}{$lang}) { + $sdesc = $p{trans_desc}{$lang}; + $sdesc_html = encode_entities($sdesc, '<>&"\''); + $desclang = $lang; + } + + $html .= $s{begin}{$lang}; + $html .= " lang='$desclang'" if $desclang ne $lang; + $html .= ">$sdesc_html$s{end}{$lang}"; + } + } else { + $html .= " lang='en'>".encode_entities($p{desc}, '<>&"\''); + } + $html .= ""; + $txt .= $p{desc}; } - $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 (@{$p{providers}}) { + warn "\tproviders=@{$p{providers}}\n" if DEBUG; + $html .= "\n
$p{name}
$prov_string "; + my @prov; + foreach my $prov (@{$p{providers}}) { + my $prov_uri = uri_escape($prov); + push @prov, "$prov"; + } + $html .= join(', ', @prov)."
"; + $txt .= "\n$p{name} virtual package provided by ". + join(', ', @{$p{providers}}); } - if ($priority ne '-') { - print {$pages{$key}{$priority}{fh}} $str - or die "couldn't write to output file: $!"; + warn "HTML=$html\n" if DEBUG > 1; + warn "TXT=$txt\n" if DEBUG > 1; + + print {$fh{$suite}} $html; + $fh{"$suite/en/txt"}->gzwrite($txt); + foreach my $key (qw(section subsection priority)) { + next unless $fh{"$suite/$p{$key}"}; + warn "\t\t$suite/$p{$key}\n" if DEBUG; + print {$fh{"$suite/$p{$key}"}} $html; } } } -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" ); +} + +sub process_source_packages { + +print "collecting source package info ...\n"; +my $count = 0; +foreach my $pkg (@SRC_PACKAGES) { + warn "pkg=$pkg\n" if DEBUG; + print "$count\n" unless ++$count % 1000; + + my %pkg; + foreach (split /\000/o, $src_packages{$pkg}||'') { + my @data = split ( /\s/o, $_ ); + $pkg{$data[1]} ||= new Packages::SrcPage( $pkg ); + $pkg{$data[1]}->merge_package( { package => $pkg, + archive => $data[0], + suite => $data[1], + section => $data[2], + subsection => $data[3], + priority => $data[4], + version => $data[5], + } ); + } + + while (my ($suite, $entry) = each %pkg) { + my %p = ( name => $pkg, providers => [], versions => '' ); + $p{versions} = $entry->{version}; + $p{subsection} = $entry->get_newest( 'subsection' ); + $p{section} = $entry->get_newest( 'section' ); + $p{archive} = $entry->get_newest( 'archive' ); + $p{priority} = $entry->get_newest( 'priority' ); + + $p{desc} = ''; + $p{binaries} = []; +# my $binaries = find_binaries( $pkg, $p{archive}, $p{suite}, \%src2bin ); +# if ($binaries && @$binaries) { +# pkg_list( \%packages, $opts, $binaries, 'en', $contents{binaries} ); +# } + + my $html = my $txt = ""; + warn "\tversions=$p{versions}\n" if DEBUG; + + $html .= "\n
$p{name} ($p{versions})"; + $html .= " [$p{section}]" + if $p{section} ne 'main'; + $html .= " [$p{archive}]" + if $p{archive} ne 'us'; + $html .= "
"; + + $txt .= "\n$p{name} ($p{versions})"; + $txt .= " [$p{section}]" if $p{section} ne 'main'; + $txt .= " [$p{archive}]" if $p{archive} ne 'us'; + + warn "HTML=$html\n" if DEBUG > 1; + warn "TXT=$txt\n" if DEBUG > 1; + + print {$fh{"source/$suite"}} $html; + $fh{"source/$suite/en/txt"}->gzwrite($txt); + foreach my $key (qw(section subsection priority)) { + next unless $fh{"source/$suite/$p{$key}"}; + warn "\t\tsource/$suite/$p{$key}\n" if DEBUG; + print {$fh{"source/$suite/$p{$key}"}} $html; } } } + +} + +__END__