r27325 - /trunk/dh-make-perl/dh-make-perl
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Thu Nov 27 08:33:52 UTC 2008
Author: dmn
Date: Thu Nov 27 08:33:50 2008
New Revision: 27325
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27325
Log:
AptContents: allow overriding of cache file, contents files directory and contents file list
Modified:
trunk/dh-make-perl/dh-make-perl
Modified: trunk/dh-make-perl/dh-make-perl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/dh-make-perl?rev=27325&op=diff
==============================================================================
--- trunk/dh-make-perl/dh-make-perl (original)
+++ trunk/dh-make-perl/dh-make-perl Thu Nov 27 08:33:50 2008
@@ -93,10 +93,11 @@
package AptContents;
use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw(cache homedir));
+__PACKAGE__->mk_accessors(qw(cache homedir cache_file contents_dir contents_files ));
use Storable;
-use File::Which;
+use File::Which qw(which);
+use File::Spec::Functions qw( catfile catpath splitpath );
sub new
{
@@ -104,8 +105,17 @@
$class = ref($class) if ref($class);
my $self = $class->SUPER::new(@_);
+ # required options
$self->homedir
or die "No homedir given";
+
+ # some defaults
+ $self->contents_dir( '/var/cache/apt/apt-file' )
+ unless $self->contents_dir;
+ $self->contents_files( $self->get_contents_file_list )
+ unless $self->contents_files;
+ $self->cache_file( catfile( $self->homedir, 'Contents.cache' ) )
+ unless $self->cache_file;
if ( which('apt-file') ) {
$self->read_cache();
@@ -124,36 +134,32 @@
my $archspec = `dpkg --print-architecture`;
chomp($archspec);
- return( sort glob
- "/var/cache/apt/apt-file/*_debian_dists_{unstable,sid}_Contents-$archspec.gz"
- );
+ my $pattern = catfile( $self->contents_dir, "*_debian_dists_{unstable,sid}_Contents-$archspec.gz" );
+
+ return [ sort glob $pattern ];
}
sub read_cache() {
my $self = shift;
- my $homedir = $self->homedir;
-
my $cache;
- if ( -r "$homedir/Contents.cache" ) {
- $cache = eval { Storable::retrieve("$homedir/Contents.cache") };
+ if ( -r $self->cache_file ) {
+ $cache = eval { Storable::retrieve( $self->cache_file ) };
undef($cache) unless ref($cache) and ref($cache) eq 'HASH';
}
-
- my @contents_files = $self->get_contents_file_list();
# see if the cache is stale
if ( $cache and $cache->{stamp} and $cache->{contents_files} ) {
undef($cache)
- unless join( '><', @contents_files ) eq
+ unless join( '><', @{ $self->contents_files } ) eq
join( '><', @{ $cache->{contents_files} } );
# file lists are the same?
# see if any of the files has changed since we
# last read it
if ( $cache ) {
- for ( @contents_files ) {
+ for ( @{ $self->contents_files } ) {
if ( ( stat($_) )[9] > $cache->{stamp} ) {
undef($cache);
last;
@@ -169,10 +175,16 @@
$cache->{stamp} = time;
$cache->{contents_files} = [];
$cache->{apt_contents} = {};
- for ( @contents_files ) {
+ for ( @{ $self->contents_files } ) {
push @{ $cache->{contents_files} }, $_;
warn "Parsing $_ ...\n";
my $f = IO::Uncompress::Gunzip->new($_);
+
+ unless ($f) {
+ warn "Error reading '$_': $!\n";
+ next;
+ }
+
my $capturing = 0;
while ( defined( $_ = $f->getline ) ) {
if ($capturing) {
@@ -213,15 +225,16 @@
sub store_cache {
my $self = shift;
- my $homedir = $self->homedir;
-
- unless ( -d $homedir ) {
- mkdir $homedir
- or die "Error creating '$homedir': $!\n"
- }
-
- Storable::store( $self->cache, "$homedir/Contents.cache.new" );
- rename( "$homedir/Contents.cache.new", "$homedir/Contents.cache" );
+ my ( $vol, $dir, $file ) = splitpath( $self->cache_file );
+
+ $dir = catpath( $vol, $dir );
+ unless ( -d $dir ) {
+ mkdir $dir
+ or die "Error creating directory '$dir': $!\n"
+ }
+
+ Storable::store( $self->cache, $self->cache_file . '-new' );
+ rename( $self->cache_file . '-new', $self->cache_file );
}
sub find_file_packages {
More information about the Pkg-perl-cvs-commits
mailing list