#!/usr/bin/perl use strict; use warnings; use POSIX; 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 @LANGUAGES ); use Packages::Template; use Packages::I18N::Locale; use Packages::Page; use Packages::SrcPage; use Packages::Sections; &Packages::Config::init( './' ); 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"; my $priorities = retrieve "$DBDIR/priorities.info"; #use Data::Dumper; #print STDERR Dumper($sections, $subsections, $priorities); my (%pages); my $template = new Packages::Template( "$TOPDIR/templates", 'html'); my $txt_template = new Packages::Template( "$TOPDIR/templates", 'txt'); 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, $_, 9 ); $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-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}) { $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; } } 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 $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" ); } } } }