r31142 - in /trunk/dh-make-perl: dh-make-perl lib/Debian/AptContents.pm

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Fri Feb 27 20:23:35 UTC 2009


Author: dmn
Date: Fri Feb 27 20:23:32 2009
New Revision: 31142

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=31142
Log:
better matching of sources.list lines to Contents

Previously, files in contents_dir/ were matched against regular
expressions derived from sources.list entries.

Now sources.list entries are converted to file names and these are
looked up in contents_dir/

--dist is no longer a glob, but plain string

Modified:
    trunk/dh-make-perl/dh-make-perl
    trunk/dh-make-perl/lib/Debian/AptContents.pm

Modified: trunk/dh-make-perl/dh-make-perl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/dh-make-perl?rev=31142&op=diff
==============================================================================
--- trunk/dh-make-perl/dh-make-perl (original)
+++ trunk/dh-make-perl/dh-make-perl Fri Feb 27 20:23:32 2009
@@ -221,11 +221,11 @@
 documentation and examples are listed in additional files under debian/, instead
 of being listed in debian/rules
 
-=item B<--dist pattern>
-
-Limit the distributions whose C<Contents> files are parsed. The argument is a shell pattern.
-
-Default: C<{sid,unstable}>.
+=item B<--dist distribution>
+
+Limit the distributions whose C<Contents> files are parsed. The argument is a distribution name.
+
+Default: empty, meaning no filtering.
 
 Example:
     dh-make-perl --dist etch

Modified: trunk/dh-make-perl/lib/Debian/AptContents.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/lib/Debian/AptContents.pm?rev=31142&op=diff
==============================================================================
--- trunk/dh-make-perl/lib/Debian/AptContents.pm (original)
+++ trunk/dh-make-perl/lib/Debian/AptContents.pm Fri Feb 27 20:23:32 2009
@@ -63,8 +63,8 @@
 
 =item dist
 
-A regular expression, used for filtering on the C<distributon> part of the
-repository paths listed in L<sources.list>. Default is C<{sid,unstable}>
+Used for filtering on the C<distributon> part of the repository paths listed in
+L<sources.list>. Default is empty, meaning no filtering.
 
 =item contents_files
 
@@ -105,7 +105,7 @@
     $self->sources_file('/etc/apt/sources.list')
         unless defined( $self->sources_file );
     $self->dist('{sid,unstable}') unless $self->dist;
-    $self->contents_files( $self->get_contents_file_list )
+    $self->contents_files( $self->get_contents_files )
         unless $self->contents_files;
     $self->cache_file( catfile( $self->homedir, 'Contents.cache' ) )
         unless $self->cache_file;
@@ -176,6 +176,8 @@
 
     return undef unless $schema eq 'deb';
 
+    next if $self->dist and $dist ne $self->dist;
+
     $dir ||= '';    # deb http://there sid main
 
         s{/$}{} for( $host, $dir, $dist );  # remove trailing /
@@ -184,22 +186,25 @@
     return join( "_", $host, $dir||(), "dists", $dist );
 }
 
-=item get_contents_filename_filters
+=item get_contents_files
 
 Reads F<sources.list>, gives the repository paths to
-C<repo_source_to_contents_path> and returns a list of regular expressions that
-can be used to match against the files in C<contents_dir>.
-
-=cut
-
-sub get_contents_filename_filters
+C<repo_source_to_contents_path> and returns an arrayref of file names of
+Contents files.
+
+=cut
+
+sub get_contents_files
 {
     my $self = shift;
 
     my $sources = IO::File->new( $self->sources_file, 'r' )
         or die "Unable to open '" . $self->sources_file . "': $!\n";
 
-    my @re;
+    my $archspec = `dpkg --print-architecture`;
+    chomp($archspec);
+
+    my @res;
 
     while( <$sources> ) {
         chomp;
@@ -209,43 +214,23 @@
         next unless $_;
 
         my $path = $self->repo_source_to_contents_path($_);
-        push @re, qr{\Q$path\E} if $path;
-    }
-
-    return @re;
-}
-
-=item get_contents_file_list
-
-Returns a list of F<Contents> files. Uses the information from F<sources.list>
-and C<contents_dir>.
-
-=cut
-
-sub get_contents_file_list {
-    my $self = shift;
-
-    my $archspec = `dpkg --print-architecture`;
-    chomp($archspec);
-
-    my @re = $self->get_contents_filename_filters;
-
-    my $pattern = catfile(
-        $self->contents_dir,
-        "*_". $self->dist . "_Contents{,-$archspec}{,.gz}"
-    );
-
-    my @list = glob $pattern;
-
-    my @filtered;
-    for my $path (@list) {
-        my( $vol, $dirs, $file ) = splitpath( $path );
-
-        for (@re) {
-            push @filtered, $path if $file =~ $_;
+
+        next unless $path;
+
+        # try all of with/out architecture and
+        # un/compressed
+        for my $a ( '', "-$archspec" ) {
+            for my $c ( '', '.gz' ) {
+                my $f = catfile(
+                    $self->contents_dir,
+                    "${path}_Contents$a$c",
+                );
+                push @res, $f if -e $f;
+            }
         }
     }
-    return [ sort @filtered ];
+
+    return [ sort @res ];
 }
 
 =item read_cache




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