X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=bin%2Fcreate_index_pages;h=7f35b31a4ffe57f0dcdb8d8388d24f75b37de86b;hp=4161a7654761acd9bce6d932948eaf455f5e6079;hb=1bae1b743532d7d100015b751fe1f7be52198b8b;hpb=bcfcaa38f5df98ccff82e7ec1b9473b92b850c17 diff --git a/bin/create_index_pages b/bin/create_index_pages index 4161a76..7f35b31 100755 --- a/bin/create_index_pages +++ b/bin/create_index_pages @@ -8,281 +8,265 @@ use File::Path; use DB_File; use Storable; use HTML::Entities; +use URI::Escape; +use Locale::gettext; +use Compress::Zlib; use lib './lib'; -use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES ); -use Packages::HTML; +use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES @LANGUAGES $LOCALES); +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]; } + +delete $ENV{'LANGUAGE'}; +delete $ENV{'LANG'}; +delete $ENV{'LC_ALL'}; +delete $ENV{'LC_MESSAGES'}; +bindtextdomain ( 'pdo', $LOCALES ); +bindtextdomain ( 'sections', $LOCALES ); +bindtextdomain ( 'templates', $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: $!"; 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 %sections_descs = ( - 'admin' => [ "Administration Utilities", - "Utilities to administer system resources, manage user accounts, etc." ], - 'base' => [ "Base Utilities", - "Basic needed utilities of every Debian system." ], - 'comm' => [ "Communication Programs", - "Software to use your modem in the old fashioned style." ], - 'devel' => [ "Development", - "Development utilities, compilers, development environments, libraries, etc." ], - 'doc' => [ "Documentation", - "FAQs, HOWTOs and other documents trying to explain everything related to Debian, and software needed to browse documentation (man, info, etc)." ], - 'editors' => [ "Editors", - "Software to edit files. Programming environments." ], - 'electronics' => [ "Electronics", - "Electronics utilities." ], - 'embedded' => [ "Embedded software", - "Software suitable for use in embedded applications." ], - 'games' => [ "Games", - "Programs to spend a nice time with after all this setting up." ], - 'gnome' => [ "GNOME", - "The GNOME desktop environment, a powerful, easy to use set of integrated applications." ], - 'graphics' => [ "Graphics", - "Editors, viewers, converters... Everything to become an artist." ], - 'hamradio' => [ "Ham Radio", - "Software for ham radio." ], - 'interpreters' => [ "Interpreters", - "All kind of interpreters for interpreted languages. Macro processors." ], - 'kde' => [ "KDE", - "The K Desktop Environment, a powerful, easy to use set of integrated applications." ], - 'libs' => [ "Libraries", - "Libraries to make other programs work. They provide special features to developers." ], - 'libdevel' => [ "Library development", - "Libraries necessary for developers to write programs that use them." ], - 'mail' => [ "Mail", - "Programs to route, read, and compose E-mail messages." ], - 'math' => [ "Mathematics", - "Math software." ], - 'misc' => [ "Miscellaneous", - "Miscellaneous utilities that didn\'t fit well anywhere else." ], - 'net' => [ "Network", - "Daemons and clients to connect your Debian GNU/Linux system to the world." ], - 'news' => [ "Newsgroups", - "Software to access Usenet, to set up news servers, etc." ], - 'non-US' => [ "Software restricted in the U.S.", - "These packages probably may not be used in or distributed from the U.S. due to software patents. You should check the regulations in your country before using this software." ], - 'oldlibs' => [ "Old Libraries", - "Old versions of libraries, kept for backward compatibility with old applications." ], - 'otherosfs' => [ "Other OS\'s and file systems", - "Software to run programs compiled for other operating system, and to use their filesystems." ], - 'perl' => [ "Perl", - "Everything about Perl, an interpreted scripting language." ], - 'python' => [ "Python", - "Everything about Python, an interpreted, interactive object oriented language." ], - 'science' => [ "Science", - "Basic tools for scientific work" ], - 'shells' => [ "Shells", - "Command shells. Friendly user interfaces for beginners." ], - 'sound' => [ "Sound", - "Utilities to deal with sound: mixers, players, recorders, CD players, etc." ], - 'tex' => [ "TeX", - "The famous typesetting software and related programs." ], - 'text' => [ "Text Processing", - "Utilities to format and print text documents." ], - 'utils' => [ "Utilities", - "Utilities for file/disk manipulation, backup and archive tools, system monitoring, input systems, etc." ], - 'virtual' => [ "Virtual packages", - "Virtual packages." ], - 'web' => [ "Web Software", - "Web servers, browsers, proxies, download tools etc." ], - 'x11' => [ "X Window System software", - "X servers, libraries, fonts, window managers, terminal emulators and many related applications." ], - 'debian-installer' => [ "debian-installer udeb packages", - "Special packages for building customized debian-installer variants. Do not install them on a normal system!" ], - ); - - -my (%pages); +my (%pages, %tt_vars); + +$tt_vars{make_search_url} = sub { return &Packages::CGI::make_search_url(@_) }; +$tt_vars{make_url} = sub { return &Packages::CGI::make_url(@_) }; +$tt_vars{g} = sub { return &Packages::I18N::Locale::tt_gettext(@_) }; +# needed to work around the limitations of the the FILTER syntax +$tt_vars{html_encode} = sub { return HTML::Entities::encode_entities(@_,'<>&"') }; +$tt_vars{uri_escape} = sub { return URI::Escape::uri_escape(@_) }; +$tt_vars{quotemeta} = sub { return quotemeta($_[0]) }; + +my $template = new Packages::Template( "$TOPDIR/templates", 'html', \%tt_vars ); +my $txt_template = new Packages::Template( "$TOPDIR/templates", 'txt', \%tt_vars ); + +print "write suite index 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}}) { - 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 ), '
'; + my $key = $s; + mkpath ( "$wwwdir/$key" ); + mkpath ( "$wwwdir/source/$key" ); + foreach my $lang (@LANGUAGES) { + my $locale = get_locale( $lang ); + my $charset = get_charset( $lang ); + setlocale ( LC_ALL, $locale ) or do { + warn "couldn't set locale ($lang/$locale)\n"; + next; + }; + print "writing $key/index (lang=$lang)...\n"; + my %content = ( subsections => [], suite => $s, + lang => $lang, charset => $charset, + used_langs => \@LANGUAGES, suites => \@SUITES ); + foreach my $ssec ((keys %{$subsections->{$s}}, 'virtual')) { + next if $ssec eq '-'; 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"; - } + push @{$content{subsections}}, { + id => $ssec, + name => dgettext( 'sections', $sections_descs{$ssec}[0] ), + desc => dgettext( 'sections', $sections_descs{$ssec}[1] ), + }; } } - 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 ), '
'; - } + + $template->page( 'suite_index', \%content, + "$wwwdir/$key/index.$lang.html.new"); + rename( "$wwwdir/$key/index.$lang.html.new", + "$wwwdir/$key/index.$lang.html" ); + + $content{source} = 'source'; + $template->page( 'suite_index', \%content, + "$wwwdir/source/$key/index.$lang.html.new"); + rename( "$wwwdir/source/$key/index.$lang.html.new", + "$wwwdir/source/$key/index.$lang.html" ); + } } +setlocale( LC_ALL, 'C' ) or die "couldn't reset locale"; +print "collecting package info ...\n"; +my %allpkgs; while (my ($pkg, $data) = each %packages) { - my %pkg; - foreach (split /\000/o, $data) { + 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 $key = $data[1]; - if ($data[0] !~ /^(?:us|security|non-US)$/o) { - $key = "$data[1]/$data[0]"; - } - $pkg{$key} ||= new Packages::Page( $pkg ); - $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] } ); + $pkg{$data[1]} ||= new Packages::Page( $pkg ); + $pkg{$data[1]}->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] } ); } + foreach (keys %virt) { + next if $_ eq '-'; + $pkg{$_} ||= new Packages::Page( $pkg ); + $pkg{$_}->add_provided_by([split /\s+/, $virt{$_}]); + } + while (my ($key, $entry) = each %pkg) { - 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: $!"; + $allpkgs{$key} ||= []; + + my %p = ( name => $pkg, providers => [], versions => '' ); + if (my $provided_by = $entry->{provided_by}) { + $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' ); + $p{priority} = $entry->get_newest( 'priority' ); } + push @{$allpkgs{$key}}, \%p; } } -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}}) { - 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" ); +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], + } ); + } + + 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; + } +} + +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 $locale = get_locale( $lang ); + my $charset = get_charset( $lang ); + setlocale ( LC_ALL, $locale ) or do { + warn "couldn't set locale ($lang/$locale)\n"; + next; + }; + + my %lang_vars = ( lang => $lang, charset => $charset, + 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 => _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 => _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 => _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" ); + } } } }