[dh-make-perl] 02/05: /usr/lib/apt/apt-helper cat-file can take multiple files as arguments

gregor herrmann gregoa at debian.org
Wed Mar 23 23:14:57 UTC 2016


This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to branch gregoa/apt-file-3
in repository dh-make-perl.

commit 885b31c44b4a61d6f6ca44d3335c20506ab41ee9
Author: gregor herrmann <gregoa at debian.org>
Date:   Wed Mar 23 23:31:28 2016 +0100

    /usr/lib/apt/apt-helper cat-file can take multiple files as arguments
    
    this saves the loop over the Contents files
    
    thanks, nthykier
    
    Gbp-Dch: Ignore
---
 lib/Debian/AptContents.pm | 64 ++++++++++++++++++++++-------------------------
 1 file changed, 30 insertions(+), 34 deletions(-)

diff --git a/lib/Debian/AptContents.pm b/lib/Debian/AptContents.pm
index ddbd02b..982778f 100644
--- a/lib/Debian/AptContents.pm
+++ b/lib/Debian/AptContents.pm
@@ -214,42 +214,38 @@ sub read_cache {
         $cache->{stamp}          = time;
         $cache->{contents_files} = [];
         $cache->{apt_contents}   = {};
-        for ( @{ $self->contents_files } ) {
-            push @{ $cache->{contents_files} }, $_;
-            my @cat_cmd = ( '/usr/lib/apt/apt-helper', 'cat-file', $_ );
-            open( my $f, "-|", @cat_cmd );
-            unless ($f) {
-                warn "Error reading '$_': $!\n";
-                next;
-            }
 
-            $self->warning( 1, "Parsing $_ ..." );
-            my $capturing = 0;
-            my $line;
-            while ( defined( $line = $f->getline ) ) {
-                if ($capturing) {
-                    my ( $file, $packages ) = split( /\s+/, $line );
-                    next unless $file =~ s{
-                        ^usr/
-                        (?:share|lib)/
-                        (?:perl\d+/             # perl5/
-                        | perl/(?:\d[\d.]+)/   # or perl/5.10/
-                        )
-                    }{}x;
-                    $cache->{apt_contents}{$file} = exists $cache->{apt_contents}{$file}
-                        ? $cache->{apt_contents}{$file}.','.$packages
-                        : $packages;
-
-                    # $packages is a comma-separated list of
-                    # section/package items. We'll parse it when a file
-                    # matches. Otherwise we'd parse thousands of entries,
-                    # while checking only a couple
-                }
-                else {
-                    $capturing = 1 if $line =~ /^FILE\s+LOCATION/;
-                }
-            }
+        push @{ $cache->{contents_files} }, @{ $self->contents_files };
+        my @cat_cmd = (
+            '/usr/lib/apt/apt-helper', 'cat-file', @{ $self->contents_files }
+        );
+        open( my $f, "-|", @cat_cmd )
+            or die
+            "Can't run '/usr/lib/apt/apt-helper cat-file' on Contents files: $!\n";
+
+        $self->warning( 1,
+            "Parsing Contents files:\n\t"
+                . join( "\n\t", @{ $self->contents_files } ) );
+        my $line;
+        while ( defined( $line = $f->getline ) ) {
+            my ( $file, $packages ) = split( /\s+/, $line );
+            next unless $file =~ s{
+                ^usr/
+                (?:share|lib)/
+                (?:perl\d+/            # perl5/
+                | perl/(?:\d[\d.]+)/   # or perl/5.10/
+                )
+            }{}x;
+            $cache->{apt_contents}{$file} = exists $cache->{apt_contents}{$file}
+                ? $cache->{apt_contents}{$file}.','.$packages
+                : $packages;
+
+            # $packages is a comma-separated list of
+            # section/package items. We'll parse it when a file
+            # matches. Otherwise we'd parse thousands of entries,
+            # while checking only a couple
         }
+        close($f);
 
         if ( %{ $cache->{apt_contents} } ) {
             $self->cache($cache);

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/dh-make-perl.git



More information about the Pkg-perl-cvs-commits mailing list