r8815 - in /scripts/qa/QA: Cache.pm Common.pm Config.pm DebianArchive.pm
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Sun Nov 4 08:03:03 UTC 2007
Author: tincho-guest
Date: Sun Nov 4 08:03:03 2007
New Revision: 8815
URL: http://svn.debian.org/wsvn/?sc=1&rev=8815
Log:
Proper logging routines.
Added:
scripts/qa/QA/Common.pm
Modified:
scripts/qa/QA/Cache.pm
scripts/qa/QA/Config.pm
scripts/qa/QA/DebianArchive.pm
Modified: scripts/qa/QA/Cache.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/Cache.pm?rev=8815&op=diff
==============================================================================
--- scripts/qa/QA/Cache.pm (original)
+++ scripts/qa/QA/Cache.pm Sun Nov 4 08:03:03 2007
@@ -14,7 +14,8 @@
our @EXPORT = (qw(
dump_cache unlock_cache read_cache update_cache find_timestamp ));
-use QA::Config;
+use QA::Config '$CACHEDIR';
+use QA::Common;
use Storable qw(store_fd fd_retrieve);
use Fcntl qw(:seek :flock);
use File::Path;
@@ -47,7 +48,7 @@
sub unlock_cache {
my $cache = shift;
return 0 unless($fd{$cache});
- warn("Closing $CACHEDIR/$cache\n") if($DEBUG);
+ debug("Closing $CACHEDIR/$cache");
close($fd{$cache});
$fd{$cache} = undef;
1;
@@ -66,7 +67,7 @@
$root ||= "";
$cache ||= "";
$keep_lock ||= 0;
- warn("read_cache($cache, $root, $keep_lock) invoked\n") if($DEBUG);
+ debug("read_cache($cache, $root, $keep_lock) invoked");
$root = "/$root";
$root =~ s{/+$}{};
@@ -78,12 +79,12 @@
if(! defined($fd{$cache})) {
mkpath $CACHEDIR;
if($keep_lock) {
- warn("Opening $CACHEDIR/$cache in RW mode\n") if($DEBUG);
+ debug("Opening $CACHEDIR/$cache in RW mode");
open $fd{$cache}, "+<", "$CACHEDIR/$cache"
or die "Error opening cache: $!\n";
flock($fd{$cache}, LOCK_EX) or die "Error locking cache: $!\n";
} else {
- warn("Opening $CACHEDIR/$cache in R mode\n") if($DEBUG);
+ debug("Opening $CACHEDIR/$cache in R mode");
open $fd{$cache}, "<", "$CACHEDIR/$cache"
or die "Error opening cache: $!\n";
flock($fd{$cache}, LOCK_SH) or die "Error locking cache: $!\n";
@@ -116,15 +117,14 @@
$root ||= "";
$replace ||= 0;
$keep_lock ||= 0;
- warn("update_cache($cache, $data, $root, $replace, $keep_lock) invoked\n")
- if($DEBUG);
+ debug("update_cache($cache, $data, $root, $replace, $keep_lock) invoked");
$root = "/$root";
$root =~ s{/+$}{};
my $tsmp = time;
if(! defined($fd{$cache})) {
- warn("Opening $CACHEDIR/$cache in RW mode\n") if($DEBUG);
+ debug("Opening $CACHEDIR/$cache in RW mode");
mkpath $CACHEDIR;
open($fd{$cache}, "+<", "$CACHEDIR/$cache")
or die "Error opening cache: $!\n";
@@ -162,7 +162,7 @@
# Creates or replaces any component that is not a hashref
sub dive_hash($$) {
my($hash, $path) = @_;
- warn("dive_hash($hash, $path) invoked\n") if($DEBUG);
+ debug("dive_hash($hash, $path) invoked");
die "Invalid hashref" unless($hash and ref $hash and ref $hash eq "HASH");
my @path = split(m#/+#, $path);
my $ref = $hash;
@@ -180,7 +180,7 @@
# root
sub find_timestamp {
my($hash, $path) = @_;
- warn("find_timestamp($hash, $path) invoked\n") if($DEBUG);
+ debug("find_timestamp($hash, $path) invoked");
die "Invalid hashref" unless($hash and ref $hash and ref $hash eq "HASH");
my $ctsmp = 0;
if($path =~ s{^/*([^/]+)}{}) {
Added: scripts/qa/QA/Common.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/Common.pm?rev=8815&op=file
==============================================================================
--- scripts/qa/QA/Common.pm (added)
+++ scripts/qa/QA/Common.pm Sun Nov 4 08:03:03 2007
@@ -1,0 +1,50 @@
+# vim:ts=4:sw=4:et:ai:sts=4
+# $Id: Common.pm 6650 2007-08-15 10:17:36Z tincho-guest $
+#
+# Commong helper routines
+#
+# Copyright MartÃn Ferrari <martin.ferrari at gmail.com>, 2007
+# Released under the terms of the GNU GPL 2
+
+package QA::Common;
+use strict;
+use warnings;
+
+our @ISA = "Exporter";
+our @EXPORT = qw(debug info warn error);
+
+use QA::Config;
+use POSIX;
+
+my $basename = $0;
+$basename =~ s{.*/+}{};
+
+sub print_msg {
+ my($logfmt, @msg) = @_;
+ foreach(0..$#msg-1) {
+ $msg[$_] .= " " unless ($msg[$_] =~ /\n$/s);
+ }
+ my $msg = join("", @msg);
+ @msg = split(/\n+/, $msg);
+ foreach(@msg) {
+ if($logfmt) {
+ printf(STDERR "%s %s[%d]: %s\n",
+ strftime("%b %e %H:%M:%S", localtime), $basename, $$, $_);
+ } else {
+ printf(STDERR $_);
+ }
+ }
+}
+sub error {
+ print_msg($LOGFMT, @_) if($VERBOSITY >= 0);
+}
+sub warn {
+ print_msg($LOGFMT, @_) if($VERBOSITY >= 1);
+}
+sub info {
+ print_msg($LOGFMT, @_) if($VERBOSITY >= 2);
+}
+sub debug {
+ print_msg($LOGFMT, @_) if($VERBOSITY >= 3);
+}
+1;
Modified: scripts/qa/QA/Config.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/Config.pm?rev=8815&op=diff
==============================================================================
--- scripts/qa/QA/Config.pm (original)
+++ scripts/qa/QA/Config.pm Sun Nov 4 08:03:03 2007
@@ -14,7 +14,8 @@
$MIRROR
$CPAN_MIRROR
$CACHEDIR
- $DEBUG
+ $VERBOSITY
+ $LOGFMT
);
our @ISA = "Exporter";
@@ -22,7 +23,11 @@
our $MIRROR = "MIRROR=ftp://ftp.debian.org";
our $CPAN_MIRROR = "ftp://cpan.org/pub/CPAN";
our $CACHEDIR = "$ENV{HOME}/.dpg/versioncheck";
-our $DEBUG = 1;
+# verbosity level: error => 0, warn => 1, info => 2, debug => 3
+# Should be 1 by default, 0 for quiet mode
+our $VERBOSITY = 3;
+# Prepend syslog-style format?
+our $LOGFMT = 1;
# special hosts
for( hostname )
Modified: scripts/qa/QA/DebianArchive.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/DebianArchive.pm?rev=8815&op=diff
==============================================================================
--- scripts/qa/QA/DebianArchive.pm (original)
+++ scripts/qa/QA/DebianArchive.pm Sun Nov 4 08:03:03 2007
@@ -17,8 +17,9 @@
our @ISA = "Exporter";
our @EXPORT = qw(deb_download deb_get);
-use QA::Config;
use QA::Cache;
+use QA::Common;
+use QA::Config '$MIRROR';
use QA::VerComp;
use LWP::UserAgent;
use IO::Uncompress::Gunzip;
@@ -64,7 +65,7 @@
my $modified;
foreach my $src (@list) {
if($force or $ttl{$src} * 60 < time - find_timestamp($data, $src)) {
- warn("$src is stale, getting new version\n") if($DEBUG);
+ info("$src is stale, getting new version");
my $d;
if($src eq "new") {
$d = get_new();
@@ -81,7 +82,7 @@
}
return $data->{global} unless($modified);
# retain lock, we need consistency
- warn("Re-generating consolidated hash\n") if($DEBUG);
+ info("Re-generating consolidated hash");
my $pkgs = read_cache("consolidated", "svn", 0);
$data = read_cache("archive", "", 1);
my $g = {};
@@ -110,7 +111,7 @@
my %vers;
foreach my $section qw(main contrib non-free) {
my $url = "$MIRROR/debian/dists/$suite/$section/source/Sources.gz";
- warn("Downloading $url\n") if($DEBUG);
+ info("Downloading $url");
my $res = $ua->get($url);
unless($res->is_success()) {
warn "Can't download $url: " . $res->message();
@@ -135,7 +136,7 @@
}
sub get_incoming {
my $url = 'http://incoming.debian.org';
- warn("Downloading $url\n") if($DEBUG);
+ info("Downloading $url");
my $res = $ua->get($url);
unless($res->is_success()) {
warn "Can't download $url: " . $res->message();
@@ -144,11 +145,9 @@
my $data = $res->decoded_content();
my %vers;
while($data =~ /<a href="([^_]+)_(.+)\.dsc">/g) {
- # debug
- warn "existing $1: $vers{$1} / $2\n" if($DEBUG and defined($vers{$1}));
+ debug("existing $1: $vers{$1} / $2") if(defined($vers{$1}));
if(!defined $vers{$1} or deb_compare($2, $vers{$1}) > 0) {
- warn "replaced $1: $vers{$1} -> $2\n" if($DEBUG and
- defined($vers{$1}));
+ debug("replaced $1: $vers{$1} -> $2") if(defined($vers{$1}));
$vers{$1} = $2;
}
}
@@ -156,7 +155,7 @@
}
sub get_new {
my $url = 'http://ftp-master.debian.org/new.html';
- warn("Downloading $url\n") if($DEBUG);
+ info("Downloading $url");
my $res = $ua->get($url);
unless($res->is_success()) {
warn "Can't download $url: " . $res->message();
@@ -174,11 +173,10 @@
my $pkg = $row->[0];
foreach(split(/\s+/, $row->[1])) {
next unless($_);
- # debug
- warn "existing $pkg: $vers{$pkg} / $_\n" if($DEBUG and
+ debug("existing $pkg: $vers{$pkg} / $_") if(
defined($vers{$pkg}));
if(!defined $vers{$pkg} or deb_compare($_, $vers{$pkg}) > 0) {
- warn "replaced $pkg: $vers{$pkg} -> $_\n" if($DEBUG and
+ debug("replaced $pkg: $vers{$pkg} -> $_") if(
defined($vers{$pkg}));
$vers{$pkg} = $_;
}
More information about the Pkg-perl-cvs-commits
mailing list