r27332 - /trunk/dh-make-perl/dh-make-perl

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Thu Nov 27 08:34:45 UTC 2008


Author: dmn
Date: Thu Nov 27 08:34:42 2008
New Revision: 27332

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27332
Log:
AptContents: add verbose member and warning method

warnings are emitted only if above the verbosity threshold

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=27332&op=diff
==============================================================================
--- trunk/dh-make-perl/dh-make-perl (original)
+++ trunk/dh-make-perl/dh-make-perl Thu Nov 27 08:34:42 2008
@@ -93,7 +93,9 @@
 package AptContents;
 
 use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw(cache homedir cache_file contents_dir contents_files ));
+__PACKAGE__->mk_accessors(
+    qw(cache homedir cache_file contents_dir contents_files verbose )
+);
 
 use Storable;
 use File::Spec::Functions qw( catfile catdir splitpath );
@@ -115,11 +117,19 @@
         unless $self->contents_files;
     $self->cache_file( catfile( $self->homedir, 'Contents.cache' ) )
         unless $self->cache_file;
+    $self->verbose(1) unless defined( $self->verbose );
 
     $self->read_cache();
     $self->cache or return undef;
 
     return $self;
+}
+
+sub warning
+{
+    my( $self, $level, $msg ) = @_;
+
+    warn "$msg\n" if $self->verbose >= $level;
 }
 
 sub get_contents_file_list {
@@ -180,7 +190,7 @@
                 next;
             }
 
-            warn "Parsing $_ ...\n";
+            $self->warning( 1, "Parsing $_ ..." );
             my $capturing = 0;
             my $line;
             while ( defined( $line = $f->getline ) ) {
@@ -212,8 +222,10 @@
         }
     }
     else {
-        warn "Using cached Contents from "
-        . localtime( $cache->{stamp} ) . "\n";
+        $self->warning( 1,
+            "Using cached Contents from "
+            . localtime( $cache->{stamp} )
+        );
 
         $self->cache($cache);
     }




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