]> git.deb.at Git - deb/packages.git/commitdiff
* Add source package display
authorFrank Lichtenheld <frank@lichtenheld.de>
Tue, 7 Feb 2006 01:01:00 +0000 (01:01 +0000)
committerFrank Lichtenheld <frank@lichtenheld.de>
Tue, 7 Feb 2006 01:01:00 +0000 (01:01 +0000)
* Move most of the DB init code to own module

bin/parse-sources
cgi-bin/search_packages.pl
cgi-bin/show_package.pl
lib/Packages/DB.pm [new file with mode: 0644]
lib/Packages/HTML.pm
lib/Packages/Page.pm
lib/Packages/Search.pm
lib/Packages/SrcPage.pm [new file with mode: 0644]

index 9c97e2f315750f5849a1c2eef5d76cdacd9b906c..e640b9d3dfae2581421f77cd6ba75caaa567fb7c 100755 (executable)
@@ -57,20 +57,29 @@ for my $archive (@ARCHIVES) {
                        $key =~ tr [A-Z] [a-z];
                        $data{$key} = $value;
                }
-               $data .= "Archive: $archive\n";
-               $sources_all_db{"$data{'package'} $data{'version'}"}
-                       = $data;
-
                $source_names{$data{'package'}} = 1;
 
                my $section = 'main';
                my $subsection = $data{section} || '-';
                if ($data{section} && ($data{section} =~ m=/=o)) {
                    ($section, $subsection) = split m=/=o, $data{section}, 2;
+                   ($subsection, $section) = split m=/=o, $data{section}, 2
+                       if $section eq 'non-US';
                }
-               $data{'priority'} = "-" if not exists($data{'priority'});
+               $data{'section'} = $section;
+               $data{'subsection'} = $subsection;
+               $data{'priority'} ||= "-";
                $sources_small{$data{'package'}} .=
                        "$archive $suite $section $subsection $data{'priority'} $data{'version'}\000";
+
+               $data{archive} = $archive;
+               while (my ($key, $value) = each (%data)) {
+                   next if $key eq 'package' or $key eq 'version';
+                   print STDERR "WARN: $key ($suite/$archive/$data{package}/$data{architecture}\n" unless defined $value;
+                   $data .= "$key: $value\n";
+               }
+               $sources_all_db{"$data{'package'} $data{'version'}"}
+                       = $data;
        }
 
        untie %sources_all_db;
index 5a31a1c961e82075a9b192d158560b5871372426..516d36d522adee913399ca1e91e43086bb5373e5 100755 (executable)
@@ -25,6 +25,7 @@ use Deb::Versions;
 use Packages::Config qw( $DBDIR $ROOT $SEARCH_CGI $SEARCH_PAGE
                         @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES );
 use Packages::CGI;
+use Packages::DB;
 use Packages::Search qw( :all );
 use Packages::HTML ();
 
@@ -48,10 +49,8 @@ my $debug = $debug_allowed && $input->param("debug");
 $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
 $Packages::CGI::debug = $debug;
 
-# read the configuration
-our $db_read_time ||= 0;
-
 &Packages::Config::init( '../' );
+&Packages::DB::init();
 
 if (my $path = $input->param('path')) {
     my @components = map { lc $_ } split /\//, $path;
@@ -148,36 +147,8 @@ debug( "Parameter evaluation took ".timestr($petd) );
 my $st0 = new Benchmark;
 my @results;
 
-our ($obj, $s_obj, $p_obj, $sp_obj,
-     %packages, %sources, %postf, %spostf, %src2bin, %did2pkg );
-
 unless (@Packages::CGI::fatal_errors) {
 
-    my $dbmodtime = (stat("$DBDIR/packages_small.db"))[9];
-    if ($dbmodtime > $db_read_time) {
-       $obj = tie %packages, 'DB_File', "$DBDIR/packages_small.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't tie DB $DBDIR/packages_small.db: $!";
-       $s_obj = tie %sources, 'DB_File', "$DBDIR/sources_small.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't tie DB $DBDIR/sources_small.db: $!";
-       $p_obj = tie %postf, 'DB_File', "$DBDIR/package_postfixes.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't tie postfix db $DBDIR/package_postfixes.db: $!";
-       $sp_obj = tie %spostf, 'DB_File', "$DBDIR/source_postfixes.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't tie postfix db $DBDIR/source_postfixes.db: $!";
-       tie %src2bin, 'DB_File', "$DBDIR/sources_packages.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't open $DBDIR/sources_packages.db: $!";
-       tie %did2pkg, 'DB_File', "$DBDIR/descriptions_packages.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't tie DB $DBDIR/descriptions_packages.db: $!";
-       
-       debug( "tied databases ($dbmodtime > $db_read_time)" );
-       $db_read_time = $dbmodtime;
-    }
-
     if ($searchon eq 'names') {
        push @results, @{ do_names_search( $keyword, \%packages,
                                           $p_obj,
index 1a29b39c284e405466634016f86d9c0117f0ab9a..0f3c48f6663b5592095320d2a672f124266ff516 100755 (executable)
@@ -26,9 +26,11 @@ use Deb::Versions;
 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
                         @ARCHITECTURES %FTP_SITES );
 use Packages::CGI;
+use Packages::DB;
 use Packages::Search qw( :all );
 use Packages::HTML;
 use Packages::Page ();
+use Packages::SrcPage ();
 
 &Packages::CGI::reset;
 
@@ -50,10 +52,8 @@ my $debug = $debug_allowed && $input->param("debug");
 $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
 $Packages::CGI::debug = $debug;
 
-# read the configuration
-our $db_read_time ||= 0;
-
 &Packages::Config::init( '../' );
+&Packages::DB::init();
 
 if (my $path = $input->param('path')) {
     my @components = map { lc $_ } split /\//, $path;
@@ -72,6 +72,8 @@ if (my $path = $input->param('path')) {
            $input->param('archive', $_);
        } elsif ($ARCHITECTURES{$_}) {
            $input->param('arch', $_);
+       } elsif ($_ eq 'source') {
+           $input->param('source', 1);
        }
     }
 }
@@ -91,7 +93,8 @@ my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
                             array => ',', var => \@archs,
                             replace => { any => \@ARCHITECTURES } },
                   format => { default => 'html', match => '^(\w+)$',
-                               var => \$format }
+                               var => \$format },
+                  source => { default => 0, match => '^(\d+)$' },
                   );
 my %opts;
 my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
@@ -119,9 +122,11 @@ $opts{h_archives} = { map { $_ => 1 } @archives };;
 my $DL_URL = "$pkg/download";
 my $FILELIST_URL = "$pkg/files";
 
-our (%packages, %packages_all, %sources_all, %descriptions);
+our (%packages_all, %sources_all);
 my (@results, @non_results);
-my $page = new Packages::Page( $pkg );
+my $page = $opts{source} ?
+    new Packages::SrcPage( $pkg ) :
+    new Packages::Page( $pkg );
 my $package_page = "";
 my ($short_desc, $version, $archive, $section, $subsection) = ("")x5;
 
@@ -129,243 +134,402 @@ sub gettext { return $_[0]; };
 
 my $st0 = new Benchmark;
 unless (@Packages::CGI::fatal_errors) {
-    my $dbmodtime = (stat("$DBDIR/packages_small.db"))[9];
     tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
     O_RDONLY, 0666, $DB_BTREE
        or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
     tie %sources_all, 'DB_File', "$DBDIR/sources_all_$suite.db",
     O_RDONLY, 0666, $DB_BTREE
        or die "couldn't tie DB $DBDIR/sources_all_$suite.db: $!";
-    if ($dbmodtime > $db_read_time) {
-       tie %packages, 'DB_File', "$DBDIR/packages_small.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't tie DB $DBDIR/packages_small.db: $!";
-       tie %descriptions, 'DB_File', "$DBDIR/descriptions.db",
-       O_RDONLY, 0666, $DB_BTREE
-           or die "couldn't tie DB $DBDIR/descriptions.db: $!";
-
-       debug( "tied databases ($dbmodtime > $db_read_time)" );
-       $db_read_time = $dbmodtime;
-    }
 
-    read_entry_all( \%packages, $pkg, \@results, \@non_results, \%opts );
+    unless ($opts{source}) {
+       read_entry_all( \%packages, $pkg, \@results, \@non_results, \%opts );
 
-    unless (@results || @non_results ) {
-       fatal_error( "No such package".
-                    "{insert link to search page with substring search}" );
-    } else {
-       unless (@results) {
-           fatal_error( "Package not available in this suite" );
+       unless (@results || @non_results ) {
+           fatal_error( "No such package".
+                        "{insert link to search page with substring search}" );
        } else {
-           for my $entry (@results) {
-               debug( join(":", @$entry), 1 );
-               my (undef, $archive, undef, $arch, $section, $subsection,
-                   $priority, $version) = @$entry;
-               
-               my $data = $packages_all{"$pkg $arch $version"};
-               $page->merge_data($pkg, $version, $arch, $data) or debug( "Merging $pkg $arch $version FAILED", 2 );
-           }
+           unless (@results) {
+               fatal_error( "Package not available in this suite" );
+           } else {
+               for my $entry (@results) {
+                   debug( join(":", @$entry), 1 );
+                   my (undef, $archive, undef, $arch, $section, $subsection,
+                       $priority, $version) = @$entry;
+                   
+                   my $data = $packages_all{"$pkg $arch $version"};
+                   $page->merge_data($pkg, $version, $arch, $data) or debug( "Merging $pkg $arch $version FAILED", 2 );
+               }
 
-           $version = $page->{newest};
-           my $source = $page->get_newest( 'source' );
-           my $source_version = $page->get_newest( 'source-version' )
-               || $version;
-           debug( "find source package: source=$source (=$source_version)", 1);
-           my $src_data = $sources_all{"$source $source_version"};
-           unless ($src_data) { #fucking binNMUs
-               my $versions = $page->get_versions;
-               my $sources = $page->get_arch_field( 'source' );
-               my $source_versions = $page->get_arch_field( 'source-version' );
-               foreach (version_sort keys %$versions) {
-                   $source = $sources->{$versions->{$_}[0]};
-                   $source = $source_versions->{$versions->{$_}[0]}
+               $version = $page->{newest};
+               my $source = $page->get_newest( 'source' );
+               my $source_version = $page->get_newest( 'source-version' )
                    || $version;
-                   $src_data = $sources_all{"$source $source_version"};
-                   last if $src_data;
+               debug( "find source package: source=$source (=$source_version)", 1);
+               my $src_data = $sources_all{"$source $source_version"};
+               unless ($src_data) { #fucking binNMUs
+                   my $versions = $page->get_versions;
+                   my $sources = $page->get_arch_field( 'source' );
+                   my $source_versions = $page->get_arch_field( 'source-version' );
+                   foreach (version_sort keys %$versions) {
+                       $source = $sources->{$versions->{$_}[0]};
+                       $source = $source_versions->{$versions->{$_}[0]}
+                       || $version;
+                       $src_data = $sources_all{"$source $source_version"};
+                       last if $src_data;
+                   }
+                   error( "couldn't find source package" ) unless $src_data;
                }
-               error( "couldn't find source package" ) unless $src_data;
-           }
-           $page->add_src_data( $source, $source_version, $src_data )
-               if $src_data;
-
-           my $st1 = new Benchmark;
-           my $std = timediff($st1, $st0);
-           debug( "Data search and merging took ".timestr($std) );
-
-           my $encodedpkg = uri_escape( $pkg );
-           my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
-           my $did = $page->get_newest( 'description' );
-           $archive = $page->get_newest( 'archive' );
-           $section = $page->get_newest( 'section' );
-           $subsection = $page->get_newest( 'subsection' );
-           my $filenames = $page->get_arch_field( 'filename' );
-           my $file_md5sums = $page->get_arch_field( 'md5sum' );
-           my $archives = $page->get_arch_field( 'archive' );
-           my $sizes_inst = $page->get_arch_field( 'installed-size' );
-           my $sizes_deb = $page->get_arch_field( 'size' );
-           my @archs = sort $page->get_architectures;
-
-           # process description
-           #
-           my $desc = $descriptions{$did};
-           $short_desc = encode_entities( $1, "<>&\"" )
-               if $desc =~ s/^(.*)$//m;
-           my $long_desc = encode_entities( $desc, "<>&\"" );
-           
-           $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
-           $long_desc =~ s/\A //o;
-           $long_desc =~ s/\n /\n/sgo;
-           $long_desc =~ s/\n.\n/\n<p>\n/go;
-           $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
+               $page->add_src_data( $source, $source_version, $src_data )
+                   if $src_data;
+
+               my $st1 = new Benchmark;
+               my $std = timediff($st1, $st0);
+               debug( "Data search and merging took ".timestr($std) );
+
+               my $encodedpkg = uri_escape( $pkg );
+               my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
+               my $did = $page->get_newest( 'description' );
+               $archive = $page->get_newest( 'archive' );
+               $section = $page->get_newest( 'section' );
+               $subsection = $page->get_newest( 'subsection' );
+               my $filenames = $page->get_arch_field( 'filename' );
+               my $file_md5sums = $page->get_arch_field( 'md5sum' );
+               my $archives = $page->get_arch_field( 'archive' );
+               my $sizes_inst = $page->get_arch_field( 'installed-size' );
+               my $sizes_deb = $page->get_arch_field( 'size' );
+               my @archs = sort $page->get_architectures;
+
+               # process description
+               #
+               my $desc = $descriptions{$did};
+               $short_desc = encode_entities( $1, "<>&\"" )
+                   if $desc =~ s/^(.*)$//m;
+               my $long_desc = encode_entities( $desc, "<>&\"" );
+               
+               $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
+               $long_desc =~ s/\A //o;
+               $long_desc =~ s/\n /\n/sgo;
+               $long_desc =~ s/\n.\n/\n<p>\n/go;
+               $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
 #          $long_desc = conv_desc( $lang, $long_desc );
 #          $short_desc = conv_desc( $lang, $short_desc );
 
-           my %all_suites;
-           foreach (@results, @non_results) {
-               my $a = $_->[1];
-               my $s = $_->[2];
-               if ($a =~ /^(?:us|security|non-US)$/o) {
-                   $all_suites{$s}++;
-               } else {
-                   $all_suites{"$s/$a"}++;
+               my %all_suites;
+               foreach (@results, @non_results) {
+                   my $a = $_->[1];
+                   my $s = $_->[2];
+                   if ($a =~ /^(?:us|security|non-US)$/o) {
+                       $all_suites{$s}++;
+                   } else {
+                       $all_suites{"$s/$a"}++;
+                   }
                }
-           }
-           foreach (suites_sort(keys %all_suites)) {
-               if (("$suite/$archive" eq $_)
-                   || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
-                   $package_page .= "[ <strong>$_</strong> ] ";
-               } else {
-                   $package_page .=
-                       "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
+               foreach (suites_sort(keys %all_suites)) {
+                   if (("$suite/$archive" eq $_)
+                       || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
+                       $package_page .= "[ <strong>$_</strong> ] ";
+                   } else {
+                       $package_page .=
+                           "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
+                   }
                }
-           }
-           $package_page .= '<br>';
-
-           $package_page .= simple_menu( [ gettext( "Distribution:" ),
-                                           gettext( "Overview over this suite" ),
-                                           "/$suite/",
-                                           $suite ],
-                                         [ gettext( "Section:" ),
-                                           gettext( "All packages in this section" ),
-                                           "/$suite/$subsection/",
-                                           $subsection ],
-                                         );
-
-           my $title .= sprintf( gettext( "Package: %s (%s)" ), $pkg, $v_str );
-           $title .=  " ".marker( $archive ) if $archive ne 'us';
-           $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
-               and $archive ne 'non-US'; # non-US/security
-           $title .=  " ".marker( $section ) if $section ne 'main';
-           $package_page .= title( $title );
-           
-           $package_page .= "<h2>".gettext( "Versions:" )." $v_str_arch</h2>\n" 
-               unless $version eq $v_str;
-           
-           if ($suite eq "experimental") {
-               $package_page .= note( gettext( "Experimental package"),
-                                      gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."</p><p>".
-                                      gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
-                                      );
-           }
-           if ($subsection eq "debian-installer") {
-               note( gettext( "debian-installer udeb package"),
-                     gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
-                     );
-           }
-           $package_page .= pdesc( $short_desc, $long_desc );
-
-           #
-           # display dependencies
-           #
-           my $dep_list;
-           $dep_list = print_deps( \%packages, \%opts, $pkg,
-                                      $page->get_dep_field('depends'),
-                                      'depends' );
-           $dep_list .= print_deps( \%packages, \%opts, $pkg,
-                                      $page->get_dep_field('recommends'),
-                                      'recommends' );
-           $dep_list .= print_deps( \%packages, \%opts, $pkg,
-                                      $page->get_dep_field('suggests'),
-                                      'suggests' );
-
-           if ( $dep_list ) {
-               $package_page .= "<div id=\"pdeps\">\n";
-               $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
-               if ($suite eq "experimental") {
-                   note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
-               }
+               $package_page .= '<br>';
+
+               $package_page .= simple_menu( [ gettext( "Distribution:" ),
+                                               gettext( "Overview over this suite" ),
+                                               "/$suite/",
+                                               $suite ],
+                                             [ gettext( "Section:" ),
+                                               gettext( "All packages in this section" ),
+                                               "/$suite/$subsection/",
+                                               $subsection ],
+                                             );
+
+               my $title .= sprintf( gettext( "Package: %s (%s)" ), $pkg, $v_str );
+               $title .=  " ".marker( $archive ) if $archive ne 'us';
+               $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
+                   and $archive ne 'non-US'; # non-US/security
+               $title .=  " ".marker( $section ) if $section ne 'main';
+               $package_page .= title( $title );
                
-               $package_page .= pdeplegend( [ 'dep',  gettext( 'depends' ) ],
-                                            [ 'rec',  gettext( 'recommends' ) ],
-                                            [ 'sug',  gettext( 'suggests' ) ], );
+               $package_page .= "<h2>".gettext( "Versions:" )." $v_str_arch</h2>\n" 
+                   unless $version eq $v_str;
                
-               $package_page .= $dep_list;
-               $package_page .= "</div> <!-- end pdeps -->\n";
-           }
+               if ($suite eq "experimental") {
+                   $package_page .= note( gettext( "Experimental package"),
+                                          gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."</p><p>".
+                                          gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
+                                          );
+               }
+               if ($subsection eq "debian-installer") {
+                   note( gettext( "debian-installer udeb package"),
+                         gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
+                         );
+               }
+               $package_page .= pdesc( $short_desc, $long_desc );
+
+               #
+               # display dependencies
+               #
+               my $dep_list;
+               $dep_list = print_deps( \%packages, \%opts, $pkg,
+                                       $page->get_dep_field('depends'),
+                                       'depends' );
+               $dep_list .= print_deps( \%packages, \%opts, $pkg,
+                                        $page->get_dep_field('recommends'),
+                                        'recommends' );
+               $dep_list .= print_deps( \%packages, \%opts, $pkg,
+                                        $page->get_dep_field('suggests'),
+                                        'suggests' );
+
+               if ( $dep_list ) {
+                   $package_page .= "<div id=\"pdeps\">\n";
+                   $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
+                   if ($suite eq "experimental") {
+                       note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
+                   }
+                   
+                   $package_page .= pdeplegend( [ 'dep',  gettext( 'depends' ) ],
+                                                [ 'rec',  gettext( 'recommends' ) ],
+                                                [ 'sug',  gettext( 'suggests' ) ], );
+                   
+                   $package_page .= $dep_list;
+                   $package_page .= "</div> <!-- end pdeps -->\n";
+               }
 
-           #
-           # Download package
-           #
-           my $encodedpack = uri_escape( $pkg );
-           $package_page .= "<div id=\"pdownload\">";
-           $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
-                                     $pkg ) ;
-           $package_page .= "<table border=\"1\" summary=\"".gettext("The download table links to the download of the package and a file overview. In addition it gives information about the package size and the installed size.")."\">\n";
-           $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
-           $package_page .= "<tr>\n";
-           $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
-           foreach my $a ( @archs ) {
+               #
+               # Download package
+               #
+               my $encodedpack = uri_escape( $pkg );
+               $package_page .= "<div id=\"pdownload\">";
+               $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
+                                         $pkg ) ;
+               $package_page .= "<table border=\"1\" summary=\"".gettext("The download table links to the download of the package and a file overview. In addition it gives information about the package size and the installed size.")."\">\n";
+               $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
                $package_page .= "<tr>\n";
-               $package_page .=  "<th><a href=\"$DL_URL?arch=$a";
-               $package_page .=  "&amp;file=".uri_escape($filenames->{$a});
-               $package_page .=  "&amp;md5sum=$file_md5sums->{$a}";
-               $package_page .=  "&amp;arch=$a";
-               # there was at least one package with two
-               # different source packages on different
-               # archs where one had a security update
-               # and the other one not
-               for ($archives->{$a}) {
-                   /security/o &&  do {
-                       $package_page .=  "&amp;type=security"; last };
-                   /volatile/o &&  do {
-                       $package_page .=  "&amp;type=volatile"; last };
-                   /non-us/io  &&  do {
-                       $package_page .=  "&amp;type=nonus"; last };
-                   $package_page .=  "&amp;type=main";
+               $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
+               foreach my $a ( @archs ) {
+                   $package_page .= "<tr>\n";
+                   $package_page .=  "<th><a href=\"$DL_URL?arch=$a";
+                   $package_page .=  "&amp;file=".uri_escape($filenames->{$a});
+                   $package_page .=  "&amp;md5sum=$file_md5sums->{$a}";
+                   $package_page .=  "&amp;arch=$a";
+                   for ($archives->{$a}) {
+                       /security/o &&  do {
+                           $package_page .=  "&amp;type=security"; last };
+                       /volatile/o &&  do {
+                           $package_page .=  "&amp;type=volatile"; last };
+                       /backports/o &&  do {
+                           $package_page .=  "&amp;type=backports"; last };
+                       /non-us/io  &&  do {
+                           $package_page .=  "&amp;type=nonus"; last };
+                       $package_page .=  "&amp;type=main";
+                   }
+                   $package_page .=  "\">$a</a></th>\n";
+                   $package_page .= "<td>";
+                   if ( $suite ne "experimental" ) {
+                       $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n", "$FILELIST_URL$encodedpkg&amp;version=$suite&amp;arch=$a", $pkg );
+                   } else {
+                       $package_page .= gettext( "no current information" );
+                   }
+                   $package_page .= "</td>\n<td>";
+                   $package_page .=  floor(($sizes_deb->{$a}/102.4)+0.5)/10;
+                   $package_page .= "</td>\n<td>";
+                   $package_page .=  $sizes_inst->{$a};
+                   $package_page .= "</td>\n</tr>";
                }
-               $package_page .=  "\">$a</a></th>\n";
-               $package_page .= "<td>";
-               if ( $suite ne "experimental" ) {
-                   $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n", "$FILELIST_URL$encodedpkg&amp;version=$suite&amp;arch=$a", $pkg );
-               } else {
-                   $package_page .= gettext( "no current information" );
+               $package_page .= "</table><p>".gettext ( "Size is measured in kBytes." )."</p>\n";
+               $package_page .= "</div> <!-- end pdownload -->\n";
+               
+               #
+               # more information
+               #
+               $package_page .= pmoreinfo( name => $pkg, data => $page,
+                                           opts => \%opts,
+                                           env => \%FTP_SITES,
+                                           bugreports => 1, sourcedownload => 1,
+                                           changesandcopy => 1, maintainers => 1,
+                                           search => 1 );
+           }
+       }
+    } else {
+       read_src_entry_all( \%sources, $pkg, \@results, \@non_results, \%opts );
+
+       unless (@results || @non_results ) {
+           fatal_error( "No such package".
+                        "{insert link to search page with substring search}" );
+       } else {
+           unless (@results) {
+               fatal_error( "Package not available in this suite" );
+           } else {
+               for my $entry (@results) {
+                   debug( join(":", @$entry), 1 );
+                   my (undef, $archive, undef, $section, $subsection,
+                       $priority, $version) = @$entry;
+                   
+                   my $data = $sources_all{"$pkg $version"};
+                   $page->merge_data($pkg, $version, $data) or debug( "Merging $pkg $version FAILED", 2 );
+               }
+               $version = $page->{version};
+
+               my $st1 = new Benchmark;
+               my $std = timediff($st1, $st0);
+               debug( "Data search and merging took ".timestr($std) );
+
+               my $encodedpkg = uri_escape( $pkg );
+               my ($v_str, $v_str_arr) = $page->get_version_string();
+               $archive = $page->get_newest( 'archive' );
+               $section = $page->get_newest( 'section' );
+               $subsection = $page->get_newest( 'subsection' );
+
+               my %all_suites;
+               foreach (@results, @non_results) {
+                   my $a = $_->[1];
+                   my $s = $_->[2];
+                   if ($a =~ /^(?:us|security|non-US)$/o) {
+                       $all_suites{$s}++;
+                   } else {
+                       $all_suites{"$s/$a"}++;
+                   }
+               }
+               foreach (suites_sort(keys %all_suites)) {
+                   if (("$suite/$archive" eq $_)
+                       || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
+                       $package_page .= "[ <strong>$_</strong> ] ";
+                   } else {
+                       $package_page .=
+                           "[ <a href=\"$ROOT/$_/source/".uri_escape($pkg)."\">$_</a> ] ";
+                   }
+               }
+               $package_page .= '<br>';
+
+               $package_page .= simple_menu( [ gettext( "Distribution:" ),
+                                               gettext( "Overview over this suite" ),
+                                               "/$suite/",
+                                               $suite ],
+                                             [ gettext( "Section:" ),
+                                               gettext( "All packages in this section" ),
+                                               "/$suite/$subsection/",
+                                               $subsection ],
+                                             );
+
+               my $title .= sprintf( gettext( "Source Package: %s (%s)" ),
+                                     $pkg, $v_str );
+               $title .=  " ".marker( $archive ) if $archive ne 'us';
+               $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
+                   and $archive ne 'non-US'; # non-US/security
+               $title .=  " ".marker( $section ) if $section ne 'main';
+               $package_page .= title( $title );
+               
+               if ($suite eq "experimental") {
+                   $package_page .= note( gettext( "Experimental package"),
+                                          gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."</p><p>".
+                                          gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
+                                          );
+               }
+               if ($subsection eq "debian-installer") {
+                   note( gettext( "debian-installer udeb package"),
+                         gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
+                         );
+               }
+
+               my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
+               if ($binaries && @$binaries) {
+                   $package_page .= '<div class="pdesc">';
+                   $package_page .= gettext( "The following binary packages are built from this source package:" );
+                   $package_page .= pkg_list( \%packages, \%opts, $binaries, 'en' );
+                   $package_page .= '</div> <!-- end pdesc -->';
+               }
+               
+               #
+               # display dependencies
+               #
+               my $dep_list;
+               $dep_list = print_src_deps( \%packages, \%opts, $pkg,
+                                           $page->get_dep_field('build-depends'),
+                                           'build-depends' );
+               $dep_list .= print_src_deps( \%packages, \%opts, $pkg,
+                                            $page->get_dep_field('build-depends-indep'),
+                                            'build-depends-indep' );
+
+               if ( $dep_list ) {
+                   $package_page .= "<div id=\"pdeps\">\n";
+                   $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
+                   if ($suite eq "experimental") {
+                       note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
+                   }
+                   
+                   $package_page .= pdeplegend( [ 'adep',  gettext( 'build-depends' ) ],
+                                                [ 'idep',  gettext( 'build-depends-indep' ) ],
+                                                );
+                   
+                   $package_page .= $dep_list;
+                   $package_page .= "</div> <!-- end pdeps -->\n";
+               }
+
+               #
+               # Source package download
+               #
+               $package_page .= "<div id=\"pdownload\">\n";
+               my $encodedpack = uri_escape( $pkg );
+               $package_page .= sprintf( "<h2>".gettext( "Download %s" )."</h2>\n",
+                                         $pkg ) ;
+
+               my $source_files = $page->get_src( 'files' );
+               my $source_dir = $page->get_src( 'directory' );
+
+               $package_page .= sprintf( "<table cellspacing=\"0\" cellpadding=\"2\" summary=\"Download information for the files of this source package\">\n"
+                                         ."<tr><th>%s</th><th>%s</th><th>%s</th>",
+                                         gettext("File"),
+                                         gettext("Size (in kB)"),
+                                         gettext("md5sum") );
+               foreach( @$source_files ) {
+                   my ($src_file_md5, $src_file_size, $src_file_name) = @$_;
+                   my $src_url;
+                   for ($archive) {
+                       /security/o &&  do {
+                           $src_url = $FTP_SITES{security}; last };
+                       /volatile/o &&  do {
+                           $src_url = $FTP_SITES{volatile}; last };
+                       /backports/o &&  do {
+                           $src_url = $FTP_SITES{backports}; last };
+                       /non-us/io  &&  do {
+                           $src_url = $FTP_SITES{'non-US'}; last };
+                       $src_url = $FTP_SITES{us};
+                   }
+                   $src_url .= "/$source_dir/$src_file_name";
+                   
+                   $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
+                       ."<td class=\"dotalign\">".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
+                       ."<td>$src_file_md5</td></tr>";
                }
-               $package_page .= "</td>\n<td>";
-               $package_page .=  floor(($sizes_deb->{$a}/102.4)+0.5)/10;
-               $package_page .= "</td>\n<td>";
-               $package_page .=  $sizes_inst->{$a};
-               $package_page .= "</td>\n</tr>";
+               $package_page .= "</table>\n";
+               $package_page .= "</div> <!-- end pdownload -->\n";
+
+               #
+               # more information
+               #
+               $package_page .= pmoreinfo( name => $pkg, data => $page,
+                                           opts => \%opts,
+                                           env => \%FTP_SITES,
+                                           bugreports => 1,
+                                           changesandcopy => 1, maintainers => 1,
+                                           search => 1, is_source => 1 );
            }
-           $package_page .= "</table><p>".gettext ( "Size is measured in kBytes." )."</p>\n";
-           $package_page .= "</div> <!-- end pdownload -->\n";
-           
-           #
-           # more information
-           #
-           $package_page .= pmoreinfo( name => $pkg, data => $page,
-                                       opts => \%opts,
-                                       env => \%FTP_SITES,
-                                       bugreports => 1, sourcedownload => 1,
-                                       changesandcopy => 1, maintainers => 1,
-                                       search => 1 );
        }
     }
 }
 
-use Data::Dumper;
-debug( "Final page object:\n".Dumper($page), 3 );
+#use Data::Dumper;
+#debug( "Final page object:\n".Dumper($page), 3 );
 
-print Packages::HTML::header( title => "Details of package <em>$pkg</em> in $suite" ,
+my $title = $opts{source} ?
+    "Details of source package <em>$pkg</em> in $suite"  :
+    "Details of package <em>$pkg</em> in $suite" ;
+my $title_tag = $opts{source} ?
+    "Details of source package $pkg in $suite"  :
+    "Details of package $pkg in $suite" ;
+print Packages::HTML::header( title => $title ,
                              lang => 'en',
                              desc => $short_desc,
                              keywords => "$suite, $archive, $section, $subsection, $version",
diff --git a/lib/Packages/DB.pm b/lib/Packages/DB.pm
new file mode 100644 (file)
index 0000000..e959f60
--- /dev/null
@@ -0,0 +1,51 @@
+package Packages::DB;
+
+use strict;
+use warnings;
+
+use Exporter;
+use DB_File;
+use Packages::CGI;
+use Packages::Config qw( $DBDIR );
+
+our @ISA = qw( Exporter );
+our ( %packages, %sources, %src2bin, %did2pkg, %descriptions,
+      %postf, %spostf,
+      $obj, $s_obj, $p_obj, $sp_obj );
+our @EXPORT = qw( %packages %sources %src2bin %did2pkg %descriptions
+                 %postf %spostf
+                 $obj $s_obj $p_obj $sp_obj );
+our $db_read_time ||= 0;
+
+sub init {
+    my $dbmodtime = (stat("$DBDIR/packages_small.db"))[9];
+    if ($dbmodtime > $db_read_time) {
+       $obj = tie %packages, 'DB_File', "$DBDIR/packages_small.db",
+       O_RDONLY, 0666, $DB_BTREE
+           or die "couldn't tie DB $DBDIR/packages_small.db: $!";
+       $s_obj = tie %sources, 'DB_File', "$DBDIR/sources_small.db",
+       O_RDONLY, 0666, $DB_BTREE
+           or die "couldn't tie DB $DBDIR/sources_small.db: $!";
+       tie %src2bin, 'DB_File', "$DBDIR/sources_packages.db",
+       O_RDONLY, 0666, $DB_BTREE
+           or die "couldn't open $DBDIR/sources_packages.db: $!";
+       tie %descriptions, 'DB_File', "$DBDIR/descriptions.db",
+       O_RDONLY, 0666, $DB_BTREE
+           or die "couldn't tie DB $DBDIR/descriptions.db: $!";
+       tie %did2pkg, 'DB_File', "$DBDIR/descriptions_packages.db",
+       O_RDONLY, 0666, $DB_BTREE
+           or die "couldn't tie DB $DBDIR/descriptions_packages.db: $!";
+       $p_obj = tie %postf, 'DB_File', "$DBDIR/package_postfixes.db",
+       O_RDONLY, 0666, $DB_BTREE
+           or die "couldn't tie postfix db $DBDIR/package_postfixes.db: $!";
+       $sp_obj = tie %spostf, 'DB_File', "$DBDIR/source_postfixes.db",
+       O_RDONLY, 0666, $DB_BTREE
+           or die "couldn't tie postfix db $DBDIR/source_postfixes.db: $!";
+
+       debug( "tied databases ($dbmodtime > $db_read_time)" );
+       $db_read_time = $dbmodtime;
+    }
+}
+
+1;
+
index 90c95691805b873655feeafca185a9cb08d1ad48..a291a0028b6285d15e76880f35c9e1dfead4af1b 100644 (file)
@@ -24,7 +24,7 @@ our @ISA = qw( Exporter );
 our @EXPORT = qw( header title trailer file_changed time_stamp
                  read_md5_hash write_md5_hash simple_menu
                  ds_begin ds_item ds_end note title marker pdesc
-                 pdeplegend pkg_list pmoreinfo print_deps );
+                 pdeplegend pkg_list pmoreinfo print_deps print_src_deps );
 
 our $CHANGELOG_URL = '/changelogs';
 
@@ -79,38 +79,27 @@ sub pdeplegend {
     return $str;
 }
 
-# sub pkg_list {
-#     my ( $pkgs, $lang, $env ) = @_;
-
-#     my $str = "";
-#     foreach my $p ( @$pkgs ) {
-#      my $p_pkg = $env->{db}->get_pkg( $p );
-
-#      if ( $p_pkg ) {
-#          if ($p_pkg->is_virtual) {
-#              $str .= "<dt><a href=\"../virtual/$p\">$p</a></dt>\n".
-#                  "\t<dd>".gettext("Virtual package")."</dd>\n";
-#          } else {
-#              my %subsections = $p_pkg->get_arch_fields( 'section',
-#                                                         $env->{archs} );
-#              my $subsection = $subsections{max_unique};
-#              my %desc_md5s = $p_pkg->get_arch_fields( 'description-md5', 
-#                                                       $env->{archs} );
-#              my $short_desc = conv_desc( $lang,
-#                                          encode_entities( $env->{db}->get_short_desc( $desc_md5s{max_unique}, $lang ), "<>&\"" ) );
-#              $str .= "<dt><a href=\"../$subsection/$p\">$p</a></dt>\n".
-#                  "\t<dd>$short_desc</dd>\n";
-#          }
-#      } else {
-#          $str .= "<dt>$p</dt>\n\t<dd>".gettext("Not available")."</dd>\n";
-#      }
-#     }
-#     if ($str) {
-#      $str = "<dl>$str</dl>\n";
-#     }
-
-#     return $str;
-# }
+sub pkg_list {
+    my ( $packages, $opts, $pkgs, $lang ) = @_;
+
+    my $str = "";
+    foreach my $p ( @$pkgs ) {
+
+       my $short_desc = (read_entry_simple( $packages, $p, $opts->{h_archives}, $opts->{suite}))->[-1];
+
+       if ( $short_desc ) {
+           $str .= "<dt><a href=\"$ROOT/$opts->{suite}/$p\">$p</a></dt>\n".
+                   "\t<dd>$short_desc</dd>\n";
+       } else {
+           $str .= "<dt>$p</dt>\n\t<dd>".gettext("Not available")."</dd>\n";
+       }
+    }
+    if ($str) {
+       $str = "<dl>$str</dl>\n";
+    }
+
+    return $str;
+}
 
 sub pmoreinfo {
     my %info = @_;
@@ -124,7 +113,6 @@ sub pmoreinfo {
     my $str = "<div id=\"pmoreinfo\">";
     $str .= sprintf( "<h2>".gettext( "More Information on %s" )."</h2>",
                     $name );
-       
     
     if ($info{bugreports}) {
        my $bug_url = $is_source ? $SRC_BUG_URL : $BUG_URL; 
@@ -132,7 +120,7 @@ sub pmoreinfo {
                         $bug_url.$name, $name );
     }
        
-    my $source = $page->get_src( 'name' );
+    my $source = $page->get_src( 'package' );
     my $source_version = $page->get_src( 'version' );
     my $src_dir = $page->get_src('directory');
     if ($info{sourcedownload}) {
@@ -154,6 +142,8 @@ sub pmoreinfo {
                        $str .= "<a href=\"$env->{security}/$src_dir/$src_file_name\">["; last };
                    /volatile/o && do {
                        $str .= "<a href=\"$env->{volatile}/$src_dir/$src_file_name\">["; last };
+                   /backports/o && do {
+                       $str .= "<a href=\"$env->{backports}/$src_dir/$src_file_name\">["; last };
                    /non-us/io && do {
                        $str .= "<a href=\"$env->{nonus_site}/$src_dir/$src_file_name\">["; last };
                    $str .= "<a href=\"$env->{us}/$src_dir/$src_file_name\">[";
@@ -270,7 +260,7 @@ sub print_deps {
            } else {
                $res .= "</dl></li>\n<li>";
            }
-           $res .= "<dl><dt><img class=\"hidecss\" src=\"../../Pics/$dep_type{$type}.gif\" alt=\"[$dep_type{$type}]\"> ";
+           $res .= "<dl><dt><img class=\"hidecss\" src=\"$ROOT/Pics/$dep_type{$type}.gif\" alt=\"[$dep_type{$type}]\"> ";
        }
 
        foreach my $rel_alt ( @$rel ) {
@@ -321,56 +311,48 @@ sub print_deps {
     return $res;
 } # end print_deps
 
-# sub print_src_deps {
-#     my ( $env, $lang, $pkg, $version, $type) = @_;
-#     my %dep_type = ('build-depends' => 'adep', 'build-depends-indep' => 'idep' );
-#     my $found = 0;
-#     my $res = "<ul class=\"ul$dep_type{$type}\">\n";
-#     foreach my $dep ( @{$pkg->{versions}{$version}{$type}} ) {
-#         $found = 1;
-#      my @res_pkgs;
-#      $res .= "<li><dl><dt><img class=\"hidecss\" src=\"../../Pics/$dep_type{$type}.gif\" alt=\"[$dep_type{$type}]\"> ";
-#      foreach my $or_dep ( @$dep ) {
-#          my $p_name = $or_dep->[0];
-#          my $p = $env->{db}->get_pkg( $p_name );
-#          my $p_version = $or_dep->[1] ? "(".encode_entities( $or_dep->[1] ).
-#              " $or_dep->[2]) " : "";
-#          my $not = gettext( "not" );
-#          if ($or_dep->[3]) {
-#              $or_dep->[3] =~ s/\s+/, /go;
-#              # as either all or no archs have to be prepended with
-#              # exlamation marks, convert the first and delete the others
-#              $or_dep->[3] =~ s/!\s*/$not /o;
-#              $or_dep->[3] =~ s/!\s*//go;
-#          }
-#          my $arch_str = $or_dep->[3] ? " [$or_dep->[3]]" : "";
-#          if ( $p ) {
-#              if ( $p->is_virtual ) {
-#                  my $short_desc = gettext( "Virtual package" );
-#                  push @res_pkgs, dep_item( "../virtual/$p_name", $p_name, "$p_version$arch_str", $short_desc );
-#              } else {
-#                  my %sections = $p->get_arch_fields( 'section',
-#                                                      $env->{archs} );
-#                  my $section = $sections{max_unique};
-#                  my %desc_md5s = $p->get_arch_fields( 'description-md5', 
-#                                                       $env->{archs} );
-#                  my $short_desc = conv_desc( $lang, encode_entities( $env->{db}->get_short_desc( $desc_md5s{max_unique}, $lang ), "<>&\"" ) );
-#                  push @res_pkgs, dep_item( "../$section/$p_name", $p_name, "$p_version$arch_str", $short_desc );
-#              }
-#          } else {
-#              my $short_desc = gettext( "Package not available" );
-#              push @res_pkgs, dep_item( undef, $p_name, "$p_version$arch_str", $short_desc );
-#          }
-#      }
-#      $res .= "\n".join( "<dt>\n".gettext( "or" )." ", @res_pkgs )."</dl></li>\n";
-#     }
-#     if ($found) {
-#         $res .= "\n</ul>";
-#     } else {
-#         $res = "";
-#     }
-#     return $res;
-# } # end print_src_deps
+sub print_src_deps {
+    my ( $packages, $opts, $pkg, $relations, $type) = @_;
+    my %dep_type = ('build-depends' => 'adep', 'build-depends-indep' => 'idep' );
+    my $res = "<ul class=\"ul$dep_type{$type}\">\n";
+    foreach my $dep (@$relations) {
+       my @res_pkgs;
+       $res .= "<li><dl><dt><img class=\"hidecss\" src=\"$ROOT/Pics/$dep_type{$type}.gif\" alt=\"[$dep_type{$type}]\"> ";
+       foreach my $or_dep ( @$dep ) {
+           my $p_name = $or_dep->[0];
+           my $p_version = $or_dep->[1] ? "(".encode_entities( $or_dep->[1] ).
+               " $or_dep->[2]) " : "";
+           my $not = gettext( "not" );
+           my $arch_str = '';
+           if ($or_dep->[3] && @{$or_dep->[3]}) {
+               # as either all or no archs have to be prepended with
+               # exlamation marks, convert the first and delete the others
+               if ($or_dep->[3][0] =~ /^!/) {
+                   $arch_str = "$not ";
+                   foreach (@{$or_dep->[3]}) {
+                       $_ =~ s/^!//go;
+                   }
+               }
+               $arch_str = " [${arch_str}@{$or_dep->[3]}]";
+           }
+           my $short_desc = (read_entry_simple( $packages, $p_name, $opts->{h_archives}, $opts->{suite}))->[-1];
+           if ( $short_desc ) {
+               $short_desc = encode_entities( $short_desc, "<>&\"" );
+               push @res_pkgs, dep_item( "/$opts->{suite}/$p_name", $p_name, "$p_version$arch_str", $short_desc );
+           } else {
+               $short_desc = gettext( "Package not available" );
+               push @res_pkgs, dep_item( undef, $p_name, "$p_version$arch_str", $short_desc );
+           }
+       }
+       $res .= "\n".join( "<dt>\n".gettext( "or" )." ", @res_pkgs )."</dl></li>\n";
+    }
+    if (@$relations) {
+        $res .= "\n</ul>";
+    } else {
+        $res = "";
+    }
+       return $res;
+} # end print_src_deps
 
 
 my $ds_begin = '<dl>';
index b00eefbab921974b68df2784be42faaeb5df93e6..d57126ea4825674aba5c432f667fa90a0773f9e0 100644 (file)
@@ -4,9 +4,14 @@ use strict;
 use warnings;
 
 use Data::Dumper;
+use Exporter;
 use Deb::Versions;
 use Packages::CGI;
 
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw( split_name_mail parse_deps );
+our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
+
 our $ARCHIVE_DEFAULT = '';
 our $SECTION_DEFAULT = 'main';
 our $SUBSECTION_DEFAULT = 'unknown';
@@ -74,7 +79,7 @@ sub add_src_data {
        $data{$key} = $value;
     }
 
-    $self->{src}{name} = $src;
+    $self->{src}{package} = $src;
     $self->{src}{version} = $version;
     if ($data{files}) {
        $self->{src}{files} = [];
index b545dbc5fa544c77bb07a59e1a247903c29e3fa6..694528434f5b99083ba028c3c18c27ee0e32fcdb 100644 (file)
@@ -57,7 +57,7 @@ our @ISA = qw( Exporter );
 our @EXPORT_OK = qw( nextlink prevlink indexline
                      resperpagelink
                     read_entry read_entry_all read_entry_simple
-                    read_src_entry find_binaries
+                    read_src_entry read_src_entry_all find_binaries
                     do_names_search do_fulltext_search
                     printindexline multipageheader );
 our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
@@ -379,8 +379,8 @@ sub read_entry_simple {
     }
     return \@data_fuzzy;
 }
-sub read_src_entry {
-    my ($hash, $key, $results, $opts) = @_;
+sub read_src_entry_all {
+    my ($hash, $key, $results, $non_results, $opts) = @_;
     my $result = $hash->{$key} || '';
     foreach (split /\000/o, $result) {
        my @data = split ( /\s/o, $_, 6 );
@@ -390,9 +390,16 @@ sub read_src_entry {
            && $opts->{h_sections}{$data[2]}) {
            debug( "Using entry ".join( ':', @data), 2);
            push @$results, [ $key, @data ];
+       } else {
+           push @$non_results, [ $key, @data ];
        }
     }
 }
+sub read_src_entry {
+    my ($hash, $key, $results, $opts) = @_;
+    my @non_results;
+    read_src_entry_all( $hash, $key, $results, \@non_results, $opts );
+}
 sub do_names_search {
     my ($keyword, $packages, $postfixes, $read_entry, $opts) = @_;
     my @results;
diff --git a/lib/Packages/SrcPage.pm b/lib/Packages/SrcPage.pm
new file mode 100644 (file)
index 0000000..aaee2a9
--- /dev/null
@@ -0,0 +1,127 @@
+package Packages::SrcPage;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use Deb::Versions;
+use Packages::CGI;
+use Packages::Page qw( :all );
+
+our @ISA = qw( Packages::Page );
+
+#FIXME: change parameters so that we can use the version from Packages::Page
+sub merge_data {
+    my ($self, $pkg, $version, $data) = @_;
+
+    my %data = ( package => $pkg,
+                version => $version,
+                );
+    chomp($data);
+    $data =~ s/\n\s+/\377/g;
+    while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+       my ($key, $value) = ($1, $2);
+       $key =~ tr [A-Z] [a-z];
+       $data{$key} = $value;
+    }
+#      debug( "Merge package:\n".Dumper(\%data), 3 );
+    return $self->merge_package( \%data );
+}
+
+sub gettext { return $_[0]; }
+
+our @DEP_FIELDS = qw( build-depends build-depends-indep
+                     build-conflicts build-conflicts-indep);
+sub merge_package {
+    my ($self, $data) = @_;
+
+    ($data->{package} && $data->{version}) || return;
+    $self->{package} ||= $data->{package};
+    ($self->{package} eq $data->{package}) || return;
+    debug( "merge package $data->{package}/$data->{version} into $self (".($self->{version}||'').")", 2 );
+
+    if (!$self->{version}
+       || (version_cmp( $data->{version}, $self->{version} ) > 0)) {
+       debug( "added package is newer, replacing old information" );
+
+       $self->{data} = $data;
+
+       my @uploaders;
+       if ($data->{maintainer} ||= '') {
+           push @uploaders, [ split_name_mail( $data->{maintainer} ) ];
+       }
+       if ($data->{uploaders}) {
+           my @up_tmp = split( /\s*,\s*/,
+                               $data->{uploaders} );
+           foreach my $up (@up_tmp) {
+               if ($up ne $data->{maintainer}) { # weed out duplicates
+                   push @uploaders, [ split_name_mail( $up ) ];
+               }
+           }
+       }
+       $self->{uploaders} = \@uploaders;
+
+       if ($data->{files}) {
+           $self->{files} = [];
+           foreach my $sf ( split( /\377/, $data->{files} ) ) {
+               next unless $sf;
+               # md5, size, name
+               push @{$self->{files}}, [ split( /\s+/, $sf) ];
+           }
+       }
+
+       foreach (@DEP_FIELDS) {
+           $self->normalize_dependencies( $_, $data );
+       }
+
+       $self->{version} = $data->{version};
+    }
+}
+
+#FIXME: should be mergable with the Packages::Page version
+sub normalize_dependencies {
+    my ($self, $dep_field, $data) = @_;
+
+    my ($deps_norm, $deps) = parse_deps( $data->{$dep_field}||'' );
+    $self->{dep_fields}{$dep_field} =
+       [ $deps_norm, $deps ];
+}
+
+sub get_src {
+    my ($self, $field) = @_;
+    
+    return $self->{$field} if exists $self->{$field};
+    return $self->{data}{$field};
+}
+
+sub get_architectures {
+    die "NOT SUPPORTED";
+}
+
+sub get_arch_field {
+    my ($self, $field) = @_;
+
+    return $self->{data}{$field};
+}
+
+sub get_versions {
+    my ($self) = @_;
+
+    return [ $self->{version} ];
+}
+
+sub get_version_string {
+    my ($self) = @_;
+
+    my $versions = $self->get_versions;
+
+    return ($self->{version}, $versions);
+}
+
+sub get_dep_field {
+    my ($self, $dep_field) = @_;
+
+    return $self->{dep_fields}{$dep_field}[1];
+}
+
+1;