X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=bin%2Fcreate_index_pages;h=53443bc08bb1d1f666064629590089cc2d9c3ebe;hp=aa40f3c0702f49f9719c8c6b7f9f4b783a63a664;hb=2442b6d4d053bc955fcfa96db3c74d52416303bc;hpb=01393b020237bbfa4571d41cc98899b4d25acd8b diff --git a/bin/create_index_pages b/bin/create_index_pages index aa40f3c..53443bc 100755 --- a/bin/create_index_pages +++ b/bin/create_index_pages @@ -8,36 +8,36 @@ use File::Path; use DB_File; use Storable; use HTML::Entities; -use Locale::gettext; +use URI::Escape; use Compress::Zlib; use lib './lib'; -use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES @LANGUAGES $LOCALES); -use Packages::HTML; +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( './' ); -delete $ENV{'LANGUAGE'}; -delete $ENV{'LANG'}; -delete $ENV{'LC_ALL'}; -delete $ENV{'LC_MESSAGES'}; -bindtextdomain ( 'pdo', $LOCALES ); -bindtextdomain ( 'sections', $LOCALES ); -textdomain( 'pdo' ); - 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; @@ -45,121 +45,17 @@ my $priorities = retrieve "$DBDIR/priorities.info"; my (%pages); -print "write suite index files ...\n"; -foreach my $s (@SUITES) { - my $key = $s; - mkpath ( "$wwwdir/$key" ); - foreach my $lang (@LANGUAGES) { - my $locale = get_locale( $lang ); - setlocale ( LC_ALL, $locale ) or do { - warn "couldn't set locale ($lang/$locale)\n"; - next; - }; - open $pages{$key}{$lang}{index}{fh}, '>', "$wwwdir/$key/index.$lang.html.new" - or die "can't open index file for output: $!"; - my $index_title = sprintf( _g( "List of sections in \"%s\"" ), - $key ); - print {$pages{$key}{$lang}{index}{fh}} header( title => $index_title, - title_keywords => "debian, $s", - desc => encode_entities( $index_title, '"' ), - lang => $lang ), - title( $index_title ), '
'; - my $i = 0; my $num_sections = keys %{$subsections->{$s}}; - foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) { - next if $ssec eq '-'; - if ($sections_descs{$ssec}) { - print {$pages{$key}{$lang}{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}{$lang}{index}{fh}} "
\n
\n
\n
\n"; - } - } - } - - print {$pages{$key}{$lang}{index}{fh}} '
', - "

". - _g( "All packages" ) ."
(". - _g( "compact compressed textlist" ).")

\n"; - print {$pages{$key}{$lang}{index}{fh}} trailer( "../", 'index', $lang, @LANGUAGES ); - close $pages{$key}{$lang}{index}{fh} or - warn "can't close index file $wwwdir/$key/index.$lang.html.new: $!"; - rename( "$wwwdir/$key/index.$lang.html.new", - "$wwwdir/$key/index.$lang.html" ); - - } -} -setlocale( LC_ALL, 'C' ) or die "couldn't reset locale"; - -print "opening files ...\n"; -foreach my $s (@SUITES) { - my $key = $s; - mkpath ( "$wwwdir/$key" ); - open $pages{$key}{fh}, '>', "$wwwdir/$key/allpackages.en.html.new" - or die "can't open index file for output: $!"; - $pages{$key}{textgz} = gzopen("$wwwdir/$key/allpackages.en.txt.gz.new", - 'wb9') - or die "can't open text index file for output: $!"; - - my $title = sprintf( _g( "Software Packages in \"%s\"" ), - $key ); - print {$pages{$key}{fh}} header( title => $title, - title_keywords => "debian, $s", - desc => encode_entities( $title, '"' ), - lang => 'en' ), - title( $title ), '
'; - my $title_txt = sprintf( _g( "All Debian Packages in \"%s\"" ), - $key )."\n\n"; - $title_txt .= _g( "Last Modified: " ).gmtime()."\n". - sprintf(_g( "Copyright (C) 1997-%d SPI;\nSee for the license terms."), (gmtime)[5]+1900 )."\n\n"; - $pages{$key}{textgz}->gzwrite($title_txt); - - foreach my $sec (keys %{$sections->{$s}}) { - 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( _g( "Software Packages in \"%s\", section %s" ), - $key, $sec ); - print {$pages{$key}{$sec}{fh}} header( title => $title, - title_keywords => "debian, $s, $sec", - desc => encode_entities( $title, '"' ), - lang => 'en' ), - title( $title ), '
'; - } - 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( _g( "Software Packages in \"%s\", subsection %s" ), - $key, $ssec ); - print {$pages{$key}{$ssec}{fh}} header( title => $title, - title_keywords => "debian, $s, $ssec", - desc => encode_entities( $title, '"' ), - lang => 'en' ), - title( $title ), '
'; - } - 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( _g( "Software Packages in \"%s\", priority %s" ), - $key, $prio ); - print {$pages{$key}{$prio}{fh}} header( title => $title, - title_keywords => "debian, $s, $prio", - desc => encode_entities( $title, '"' ), - lang => 'en' ), - title( $title ), '
'; - } -} +my $template = new Packages::Template( "$TOPDIR/templates", 'html'); +my $txt_template = new Packages::Template( "$TOPDIR/templates", 'txt'); -print "writing package info ...\n"; +print "collecting package info ...\n"; +my %allpkgs; while (my ($pkg, $data) = each %packages) { my (%pkg,%virt); my ($virt, $p_data) = split /\000/o, $data, 2; %virt = split /\01/o, $virt; foreach (split /\000/o, $p_data||'') { - my @data = split ( /\s/o, $_, 8 ); + my @data = split ( /\s/o, $_, 9 ); $pkg{$data[1]} ||= new Packages::Page( $pkg ); $pkg{$data[1]}->merge_package( { package => $pkg, archive => $data[0], @@ -169,94 +65,161 @@ while (my ($pkg, $data) = each %packages) { subsection => $data[4], priority => $data[5], version => $data[6], - description => $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) { + $allpkgs{$key} ||= []; + + 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: $!"; - } - 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: $!"; - $pages{$key}{textgz}->gzwrite($txt_str) - or die "couldn't write to output file: ".$pages{$key}{textgz}->gzerror; - 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: $!"; + $p{providers} = $provided_by; + } + $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) { + $d =~ s/\n.*//os; + + $sdescs{$l} = $d; + } + $p{trans_desc} = \%sdescs; + } + $p{priority} = $entry->get_newest( 'priority' ); } + push @{$allpkgs{$key}}, \%p; } } -print "closing files ...\n"; -foreach my $s (@SUITES) { - my $key = $s; - print {$pages{$key}{fh}} '
', trailer( "../" ); - $pages{$key}{textgz}->gzclose or - warn "can't close text index file $wwwdir/$key/allpackages.en.txt.gz.new: ".$pages{$key}{textgz}->gzerror; - 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" ); - rename( "$wwwdir/$key/allpackages.en.txt.gz.new", - "$wwwdir/$key/allpackages.en.txt.gz" ); - foreach my $sec (keys %{$sections->{$s}{'us'}}) { - print {$pages{$key}{$sec}{fh}} '
', trailer( "../../" ); - 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" ); +write_files(\%allpkgs); + +print "collecting source package info ...\n"; +my %allsrcpkgs; +while (my ($pkg, $data) = each %src_packages) { + my %pkg; + foreach (split /\000/o, $data||'') { + 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], + } ); } - foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) { - next if $ssec eq '-'; - print {$pages{$key}{$ssec}{fh}} '
', trailer( "../../" ); - 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" ); + + while (my ($key, $entry) = each %pkg) { + $allsrcpkgs{$key} ||= []; + + 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} ); +# } + + push @{$allsrcpkgs{$key}}, \%p; } - foreach my $prio (keys %{$priorities->{$s}}) { - next if $prio eq '-'; - print {$pages{$key}{$prio}{fh}} '
', trailer( "../../" ); - 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" ); +} + +write_files(\%allsrcpkgs, 1); + +sub write_files { + my ($pkgs, $source) = @_; + + $source = $source ? 'source/' : ''; + print "writing files ...\n"; + foreach my $s (@SUITES) { + my $key = $s; + mkpath ( "$wwwdir/$source$key" ); + foreach my $lang (@LANGUAGES) { + my $charset = 'UTF-8'; + my $cat = Packages::I18N::Locale->get_handle($lang) + or die "get_handle failed for $lang"; + + my %lang_vars = ( po_lang => $lang, ddtp_lang => $lang, + charset => $charset, + cat => $cat, used_langs => \@LANGUAGES ); + print "writing $source$s/allpackages (lang=$lang)...\n"; + $template->page( 'index', { %lang_vars, packages => $pkgs->{$key}, + suite => $s, is_source => $source }, + "$wwwdir/$source$key/allpackages.$lang.html.new" ); + print "writing $source$s/allpackages (txt,lang=$lang)...\n"; + my $gzfh = gzopen("$wwwdir/$source$key/allpackages.$lang.txt.gz.new", + 'wb9') + or die "can't open text index file for output: $!"; + my $gztxt; + $gztxt = $txt_template->page( 'index', { %lang_vars, packages => $pkgs->{$key}, + suite => $s, is_source => $source }, + ); + $gzfh->gzwrite($gztxt); + ($gzfh->gzclose == Z_OK) or + warn "can't close text index file $wwwdir/$source$key/allpackages.$lang.txt.gz.new: ".$gzfh->gzerror; + + rename( "$wwwdir/$source$key/allpackages.$lang.html.new", + "$wwwdir/$source$key/allpackages.$lang.html" ); + rename( "$wwwdir/$source$key/allpackages.$lang.txt.gz.new", + "$wwwdir/$source$key/allpackages.$lang.txt.gz" ); + + foreach my $sec (keys %{$sections->{$s}}) { + mkpath ( "$wwwdir/$source$key/$sec" ); + + print "writing $source$s/$sec/index (lang=$lang)...\n"; + $template->page( 'index', { packages => [ grep { $_->{section} eq $sec } @{$pkgs->{$key}} ], + %lang_vars, suite => $s, is_source => $source, + category => { id => $cat->g('Section'), name => $sec } }, + "$wwwdir/$source$key/$sec/index.$lang.html.new" ); + rename( "$wwwdir/$source$key/$sec/index.$lang.html.new", + "$wwwdir/$source$key/$sec/index.$lang.html" ); + } + foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) { + next if $ssec eq '-'; + mkpath ( "$wwwdir/$source$key/$ssec" ); + + print "writing $source$s/$ssec/index (lang=$lang)...\n"; + $template->page( 'index', { packages => [ grep { $_->{subsection} eq $ssec } @{$pkgs->{$key}} ], + %lang_vars, suite => $s, is_source => $source, + category => { id => $cat->g('Subsection'), name => $ssec } }, + "$wwwdir/$source$key/$ssec/index.$lang.html.new" ); + rename( "$wwwdir/$source$key/$ssec/index.$lang.html.new", + "$wwwdir/$source$key/$ssec/index.$lang.html" ); + } + foreach my $prio (keys %{$priorities->{$s}}) { + next if $prio eq '-'; + mkpath ( "$wwwdir/$source$key/$prio" ); + + print "writing $source$s/$prio/index (lang=$lang)...\n"; + $template->page( 'index', { packages => [ grep { $_->{priority} eq $prio } @{$pkgs->{$key}} ], + %lang_vars, suite => $s, is_source => $source, + category => { id => $cat->g('Priority'), name => $prio } }, + "$wwwdir/$source$key/$prio/index.$lang.html.new" ); + rename( "$wwwdir/$source$key/$prio/index.$lang.html.new", + "$wwwdir/$source$key/$prio/index.$lang.html" ); + } + } } }