]> git.deb.at Git - deb/packages.git/commitdiff
* Complete pmoreinfo
authorFrank Lichtenheld <frank@lichtenheld.de>
Sun, 5 Feb 2006 03:14:33 +0000 (03:14 +0000)
committerFrank Lichtenheld <frank@lichtenheld.de>
Sun, 5 Feb 2006 03:14:33 +0000 (03:14 +0000)
* Some big speed optimisations

cgi-bin/show_package.pl
lib/Packages/HTML.pm
lib/Packages/Page.pm
lib/Packages/Search.pm

index f6324d6bb0db35638088ce459b8136cce23d54c2..e4e897c970bf4cf2a18dfb79f31fb1ea2b43438e 100755 (executable)
@@ -50,7 +50,8 @@ $Packages::CGI::debug = $debug;
 # read the configuration
 our $config_read_time ||= 0;
 our $db_read_time ||= 0;
-our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES );
+our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES,
+      %FTP_SITES );
 
 # FIXME: move to own module
 my $modtime = (stat( "../config.sh" ))[9];
@@ -71,6 +72,8 @@ if ($modtime > $config_read_time) {
        $Packages::HTML::BUG_URL = $1 if /^\s*bug_url="?([^\"]*)"?\s*$/o;
        $Packages::HTML::SRC_BUG_URL = $1 if /^\s*src_bug_url="?([^\"]*)"?\s*$/o;
        $Packages::HTML::QA_URL = $1 if /^\s*qa_url="?([^\"]*)"?\s*$/o;
+       $FTP_SITES{us} = $1 if /^\s*ftpsite="?([^\"]*)"?\s*$/o;
+       $FTP_SITES{$1} = $2 if /^\s*(\w+)_ftpsite="?([^\"]*)"?\s*$/o;
        @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
        @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
        @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
@@ -280,7 +283,8 @@ unless (@Packages::CGI::fatal_errors) {
            #
            # display dependencies
            #
-           my $dep_list = print_deps( \%packages, \%opts, $pkg,
+           my $dep_list;
+           $dep_list = print_deps( \%packages, \%opts, $pkg,
                                       $page->get_dep_field('depends'),
                                       'depends' );
            $dep_list .= print_deps( \%packages, \%opts, $pkg,
@@ -302,62 +306,63 @@ unless (@Packages::CGI::fatal_errors) {
                                             [ '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 .= "</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 ) {
                $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 ) {
-                   $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 .=  "\">$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 .=  "<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 .= "</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,
-                                           bugreports => 1, sourcedownload => 1,
-                                           changesandcopy => 0, maintainers => 1,
-                                           search => 1 );
+               $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 .= "</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,
+                                       env => \%FTP_SITES,
+                                       bugreports => 1, sourcedownload => 1,
+                                       changesandcopy => 1, maintainers => 1,
+                                       search => 1 );
        }
     }
 }
index 38bfb588eea2c7f1d678771873aa3f08e29bce70..da024339886679c74eca96bbf8df1a1a1bf9f470 100644 (file)
@@ -7,7 +7,7 @@ use URI::Escape;
 use HTML::Entities;
 
 use Packages::CGI;
-use Packages::Search qw( read_entry );
+use Packages::Search qw( read_entry_simple );
 
 #use Packages::Util;
 #use Packages::I18N::Locale;
@@ -82,44 +82,44 @@ sub pdeplegend {
     return $str;
 }
 
-sub pkg_list {
-    my ( $pkgs, $lang, $env ) = @_;
+sub pkg_list {
+    my ( $pkgs, $lang, $env ) = @_;
 
-    my $str = "";
-    foreach my $p ( @$pkgs ) {
-       my $p_pkg = $env->{db}->get_pkg( $p );
+    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";
-    }
+#      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;
-}
+    return $str;
+}
 
 sub pmoreinfo {
     my %info = @_;
     
     my $name = $info{name} or return;
-#    my $env = $info{env} or return;
+    my $env = $info{env} or return;
     my $page = $info{data} or return;
     my $is_source = $info{is_source};
 
@@ -135,6 +135,8 @@ sub pmoreinfo {
     }
        
     my $source = $page->get_src( 'name' );
+    my $source_version = $page->get_src( 'version' );
+    my $src_dir = $page->get_src('directory');
     if ($info{sourcedownload}) {
        my $files = $page->get_src( 'files' );
        $str .= gettext( "Source Package:" );
@@ -146,15 +148,15 @@ sub pmoreinfo {
        } else {
            foreach( @$files ) {
                my ($src_file_md5, $src_file_size, $src_file_name) = @$_;
-#              if ($d->{is_security}) {
-#                  $str .= "<a href=\"$env->{opts}{security_site}/$d->{src_directory}/$src_file_name\">[";
-#              } elsif ($d->{is_volatile}) {
-#                  $str .= "<a href=\"$env->{opts}{volatile_site}/$d->{src_directory}/$src_file_name\">[";
-#              } elsif ($d->{is_nonus}) {
-#                  $str .= "<a href=\"$env->{opts}{nonus_site}/$d->{src_directory}/$src_file_name\">[";
-#              } else {
-#                  $str .= "<a href=\"$env->{opts}{debian_site}/$d->{src_directory}/$src_file_name\">[";
-#              }
+               for ($page->get_newest('archive')) {
+                   /security/o && do {
+                       $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 };
+                   /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\">[";
+               }
                if ($src_file_name =~ /dsc$/) {
                    $str .= "dsc";
                } else {
@@ -167,22 +169,21 @@ sub pmoreinfo {
 #              if ($src_version ne $version) && !$src_version_given_in_control;
     }
 
-#     if ($info{changesandcopy}) {
-#      if ( $d->{src_directory} ) {
-#          my $src_dir = $d->{src_directory};
-#          (my $src_basename = $d->{src_version}) =~ s,^\d+:,,; # strip epoche
-#          $src_basename = "$d->{src_name}_$src_basename";
-#          $src_dir =~ s,pool/updates,pool,o;
-#          $src_dir =~ s,pool/non-US,pool,o;
-#          $str .= "<br>".sprintf( gettext( "View the <a href=\"%s\">Debian changelog</a>" ),
-#                                  "$CHANGELOG_URL/$src_dir/$src_basename/changelog" )."<br>\n";
-#          my $copyright_url = "$CHANGELOG_URL/$src_dir/$src_basename/";
-#          $copyright_url .= ( $is_source ? 'copyright' : "$name.copyright" );
-
-#          $str .= sprintf( gettext( "View the <a href=\"%s\">copyright file</a>" ),
-#                           $copyright_url )."</p>";
-#      }
-#    }
+    if ($info{changesandcopy}) {
+       if ( $src_dir ) {
+           (my $src_basename = $source_version) =~ s,^\d+:,,; # strip epoche
+           $src_basename = "${source}_$src_basename";
+           $src_dir =~ s,pool/updates,pool,o;
+           $src_dir =~ s,pool/non-US,pool,o;
+           $str .= "<br>".sprintf( gettext( "View the <a href=\"%s\">Debian changelog</a>" ),
+                                   "$CHANGELOG_URL/$src_dir/$src_basename/changelog" )."<br>\n";
+           my $copyright_url = "$CHANGELOG_URL/$src_dir/$src_basename/";
+           $copyright_url .= ( $is_source ? 'copyright' : "$name.copyright" );
+
+           $str .= sprintf( gettext( "View the <a href=\"%s\">copyright file</a>" ),
+                            $copyright_url )."</p>";
+       }
+   }
 
     if ($info{maintainers}) {
        my @uploaders = @{$page->get_src( 'uploaders' )};
@@ -284,13 +285,16 @@ sub print_deps {
            $pkg_version = "($pkg_version)" if $pkg_version;
            
            my @results;
-           read_entry( $packages, $p_name, \@results, $opts);
-           if ( @results ) {
+           my %short_descs;
+           my $short_desc = $short_descs{$p_name} ||
+               (read_entry_simple( $packages, $p_name, $opts->{suite}))->[-1];
+           if ( $short_desc ) {
                if ( $is_old_pkgs ) {
                    push @res_pkgs, dep_item( "/$opts->{suite}/$p_name",
                                              $p_name, "$pkg_version$arch_str" );
                } else {
-                   my $short_desc = encode_entities( $results[0][-1], "<>&\"" );
+                   $short_descs{$p_name} ||= $short_desc;
+                   $short_desc = encode_entities( $short_desc, "<>&\"" );
                    push @res_pkgs, dep_item( "/$opts->{suite}/$p_name",
                                              $p_name, "$pkg_version$arch_str", $short_desc );
                }
index bd746880c0397cef259cf485bdbdc9c5928578c5..bc7fdc03f4faf54d4815ae6755ed5201af91818c 100644 (file)
@@ -32,27 +32,17 @@ sub new {
 sub merge_data {
     my ($self, $pkg, $version, $architecture, $data) = @_;
 
-    local $/ = "";
-    my $strio = IO::String->new($data);
-    my $merged = 0;
-    while (<$strio>) {
-        next if /^\s*$/;
-        my %data = ( package => $pkg,
+    my %data = ( package => $pkg,
                     version => $version,
                     architecture => $architecture );
-        chomp;
-        s/\n /\377/g;
-        while (/^(\S+):\s*(.*)\s*$/mg) {
-            my ($key, $value) = ($1, $2);
-            $value =~ s/\377/\n /g;
-            $key =~ tr [A-Z] [a-z];
-            $data{$key} = $value;
-        }
-#      debug( "Merge package:\n".Dumper(\%data), 3 );
-        $merged += $self->merge_package( \%data );
+    chomp($data);
+    while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+       my ($key, $value) = ($1, $2);
+       $key =~ tr [A-Z] [a-z];
+       $data{$key} = $value;
     }
-    close DATA;
-    return $merged;
+#      debug( "Merge package:\n".Dumper(\%data), 3 );
+    return $self->merge_package( \%data );
 }
 
 sub gettext { return $_[0]; }
@@ -76,22 +66,13 @@ sub split_name_mail {
 sub add_src_data {
     my ($self, $src, $version, $data) = @_;
 
-    local $/ = "";
-    my $strio = IO::String->new($data);
-    my %data;
-    while (<$strio>) {
-        next if /^\s*$/;
-        chomp;
-       %data = ();
-        s/\n /\377/g;
-        while (/^(\S+):\s*(.*)\s*$/mg) {
-            my ($key, $value) = ($1, $2);
-            $value =~ s/\377/\n /g;
-            $key =~ tr [A-Z] [a-z];
-            $data{$key} = $value;
-        }
+    chomp($data);
+    my %data = ();
+    while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+       my ($key, $value) = ($1, $2);
+       $key =~ tr [A-Z] [a-z];
+       $data{$key} = $value;
     }
-    close DATA;
 
     $self->{src}{name} = $src;
     $self->{src}{version} = $version;
@@ -103,6 +84,7 @@ sub add_src_data {
             push @{$self->{src}{files}}, [ split( /\s+/, $sf) ];
         }
     }
+    $self->{src}{directory} = $data{directory};
     my @uploaders;
     if ($data{maintainer} ||= '') {
        push @uploaders, [ split_name_mail( $data{maintainer} ) ];
index 000dc602d1b71249f58033352c45a92a8f02fbf3..a7a76d072bc69a9038a5d95db4eb6c9741455ba6 100644 (file)
@@ -56,7 +56,8 @@ our @ISA = qw( Exporter );
 
 our @EXPORT_OK = qw( nextlink prevlink indexline
                      resperpagelink
-                    read_entry read_entry_all read_src_entry find_binaries
+                    read_entry read_entry_all read_entry_simple
+                    read_src_entry find_binaries
                     do_names_search do_fulltext_search
                     printindexline multipageheader );
 our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
@@ -341,8 +342,8 @@ sub multipageheader {
 sub read_entry_all {
     my ($hash, $key, $results, $non_results, $opts) = @_;
     my $result = $hash->{$key} || '';
-    foreach (split /\000/, $result) {
-       my @data = split ( /\s/, $_, 8 );
+    foreach (split /\000/o, $result) {
+       my @data = split ( /\s/o, $_, 8 );
        debug( "Considering entry ".join( ':', @data), 2);
        if ($opts->{h_archives}{$data[0]} && $opts->{h_suites}{$data[1]}
            && ($opts->{h_archs}{$data[2]} || $data[2] eq 'all')
@@ -359,11 +360,23 @@ sub read_entry {
     my @non_results;
     read_entry_all( $hash, $key, $results, \@non_results, $opts );
 }
+sub read_entry_simple {
+    my ($hash, $key, $suite) = @_;
+    my $result = $hash->{$key} || '';
+    foreach (split /\000/o, $result) {
+       my @data = split ( /\s/o, $_, 8 );
+       debug( "Considering entry ".join( ':', @data), 2);
+       if ($data[1] eq $suite) {
+           debug( "Using entry ".join( ':', @data), 2);
+           return \@data;
+       }
+    }
+}
 sub read_src_entry {
     my ($hash, $key, $results, $opts) = @_;
     my $result = $hash->{$key} || '';
-    foreach (split /\000/, $result) {
-       my @data = split ( /\s/, $_, 6 );
+    foreach (split /\000/o, $result) {
+       my @data = split ( /\s/o, $_, 6 );
        debug( "Considering entry ".join( ':', @data), 2);
        if ($opts->{h_archives}{$data[0]}
            && $opts->{h_suites}{$data[1]}