r27064 - in /trunk/dh-make-perl: debian/changelog dh-make-perl
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Sat Nov 22 11:11:26 UTC 2008
Author: dmn
Date: Sat Nov 22 11:11:23 2008
New Revision: 27064
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27064
Log:
files in /var/cache/apt/apt-file and cache the result.
Closes: #506075 -- optimize apt-file invocations
Modified:
trunk/dh-make-perl/debian/changelog
trunk/dh-make-perl/dh-make-perl
Modified: trunk/dh-make-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/debian/changelog?rev=27064&op=diff
==============================================================================
--- trunk/dh-make-perl/debian/changelog (original)
+++ trunk/dh-make-perl/debian/changelog Sat Nov 22 11:11:23 2008
@@ -1,9 +1,4 @@
dh-make-perl (0.50) UNRELEASED; urgency=low
-
- WORK IN PRPOGRESS
- the replacement of apt-file invocation with parsing Contents
- needs to be sped up by using a cache of the parsed content
- -- dam
[ gregor herrmann ]
* Replace 'This module' with the real module name in the created long
@@ -11,7 +6,8 @@
[ Damyan Ivanov ]
* replace parsing of 'apt-file search' output with parsing the Contents
- files in /var/cache/apt/apt-file
+ files in /var/cache/apt/apt-file and cache the result.
+ Closes: #506075 -- optimize apt-file invocations
-- gregor herrmann <gregoa at debian.org> Wed, 19 Nov 2008 18:52:03 +0100
Modified: trunk/dh-make-perl/dh-make-perl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/dh-make-perl?rev=27064&op=diff
==============================================================================
--- trunk/dh-make-perl/dh-make-perl (original)
+++ trunk/dh-make-perl/dh-make-perl Sat Nov 22 11:11:23 2008
@@ -728,7 +728,7 @@
sub extract_examples {
my ($dir) = shift;
- $dir .= '/' unless $dir =~ m(/$);
+ $dir .= '/' unless $dir =~ m{/$};
find(sub {
push (@examples, substr($File::Find::name, length($dir)) . '/*')
if (/^(examples?|eg|samples?)$/i and (! $opts{exclude} or $File::Find::name !~ /$opts{exclude}/)) ;
@@ -751,6 +751,29 @@
my $error = $mod_dep->error();
die "Error: $error\n" if $error;
return %dep_hash;
+}
+
+use Storable;
+sub read_cache()
+{
+ my $cache;
+ if( -r "$homedir/Contents.cache" )
+ {
+ $cache = eval{ Storable::retrieve("$homedir/Contents.cache") };
+ undef($cache) unless ref($cache) and ref($cache) eq 'HASH';
+ }
+
+ return $cache;
+}
+
+sub store_cache($)
+{
+ my $cache = shift;
+ mkdir $homedir or die "Error creating '$homedir': $!\n"
+ unless -d $homedir;
+
+ Storable::store( $cache, "$homedir/Contents.cache.new" );
+ rename( "$homedir/Contents.cache.new", "$homedir/Contents.cache" );
}
sub extract_depends {
@@ -800,55 +823,88 @@
}
if (`which apt-file`) {
- my %apt_contents;
my $archspec = `dpkg --print-architecture`; chomp($archspec);
- warn "Parsing apt-file Contents...\n";
- for( glob "/var/cache/apt/apt-file/*_Contents-$archspec.gz" )
+
+ my $cache = read_cache();
+ if( $cache->{stamp} )
{
- my $f = IO::Uncompress::Gunzip->new($_);
- my $capturing = 0;
- while( defined($_ = $f->getline) )
+ my @contents_files;
+ for( glob "/var/cache/apt/apt-file/*_Contents-$archspec.gz" )
{
- if( $capturing )
+ push @contents_files, $_;
+ if( (stat($_))[9] > $cache->{stamp} )
{
- my($file, $packages) = split(/\s+/);
- next unless $file =~ s{
- ^usr/
- (?:share|lib)/
- (?:perl\d+/ # perl5/
- | perl/(?:\d[\d.]+)/ # or perl.5.10/
- )
- }{}x;
- $apt_contents{$file} = $packages;
- # $packages is a comma-separated list of
- # section/package items. We'll parse it when a file
- # matches
+ undef($cache->{stamp});
+ last;
}
- else
+ }
+
+ @contents_files = sort @contents_files;
+
+ undef($cache->{stamp})
+ unless join('><', @contents_files) eq join('><', @{$cache->{contents_files}});
+ }
+
+ unless( $cache->{stamp} )
+ {
+ warn "Parsing apt-file Contents...\n";
+ $cache->{stamp} = time;
+ $cache->{contents_files} = [];
+ $cache->{apt_contents} = {};
+ for( glob "/var/cache/apt/apt-file/*_Contents-$archspec.gz" )
+ {
+ push @{ $cache->{contents_files} }, $_;
+ my $f = IO::Uncompress::Gunzip->new($_);
+ my $capturing = 0;
+ while( defined($_ = $f->getline) )
{
- $capturing = 1 if /^FILE\s+LOCATION/;
+ if( $capturing )
+ {
+ my($file, $packages) = split(/\s+/);
+ next unless $file =~ s{
+ ^usr/
+ (?:share|lib)/
+ (?:perl\d+/ # perl5/
+ | perl/(?:\d[\d.]+)/ # or perl.5.10/
+ )
+ }{}x;
+ $cache->{apt_contents}{$file} = $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 /^FILE\s+LOCATION/;
+ }
}
}
}
- $has_apt_file = scalar(keys(%apt_contents));
+ else
+ {
+ warn "Using cached Contents from ".localtime($cache->{stamp})."\n";
+ }
+
+ $has_apt_file = scalar(keys(%{$cache->{apt_contents}}));
+ store_cache($cache) if $has_apt_file;
+
foreach my $module (@uses) {
- my (@rawsearch, @search, $ls, $ver, $re, $mod);
-
if ($module eq 'perl') {
substitute_perl_dependency($dep_hash{perl});
next;
}
- $mod = $module;
+ my $mod = $module;
$module =~ s|::|/|g;
- my $matches = $apt_contents{"$module.pm"};
+ my $matches = $cache->{apt_contents}{"$module.pm"};
# rank non -perl packages lower
my @matches = sort {
if ($a !~ /-perl: /) { return 1; }
elsif ($b !~ /-perl: /) { return -1; }
else { return $a cmp $b; } # or 0?
- } map { s{.+/}{}; $_ } split(/,/, $matches);
+ } map { s{.+/}{}; $_ } split(/,/, $matches) if $matches;
# use the first package that is not already in @deps
# or @stdmodules
@@ -868,8 +924,7 @@
}
unless (@matches) {
- $module =~ s|/|::|g;
- push @not_debs, $module;
+ push @not_debs, $mod;
}
}
} elsif ( $opts{requiredeps} ) {
@@ -1692,3 +1747,4 @@
=cut
+# vim: set ts=8 sw=4 et :
More information about the Pkg-perl-cvs-commits
mailing list