r8886 - in /scripts/qa: DebianQA.conf-sample DebianQA/Archive.pm DebianQA/BTS.pm DebianQA/Cache.pm DebianQA/Common.pm DebianQA/Config.pm DebianQA/Svn.pm DebianQA/Watch.pm fetchdata
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Tue Nov 6 01:51:30 UTC 2007
Author: tincho-guest
Date: Tue Nov 6 01:51:29 2007
New Revision: 8886
URL: http://svn.debian.org/wsvn/?sc=1&rev=8886
Log:
Some real configuration support, including sample conffile.
First working script: fetchdata (it even has --help!!!)
Added:
scripts/qa/DebianQA.conf-sample
scripts/qa/fetchdata (with props)
Modified:
scripts/qa/DebianQA/Archive.pm
scripts/qa/DebianQA/BTS.pm
scripts/qa/DebianQA/Cache.pm
scripts/qa/DebianQA/Common.pm
scripts/qa/DebianQA/Config.pm
scripts/qa/DebianQA/Svn.pm
scripts/qa/DebianQA/Watch.pm
Added: scripts/qa/DebianQA.conf-sample
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA.conf-sample?rev=8886&op=file
==============================================================================
--- scripts/qa/DebianQA.conf-sample (added)
+++ scripts/qa/DebianQA.conf-sample Tue Nov 6 01:51:29 2007
@@ -1,0 +1,36 @@
+# vim:syntax=dosini
+#
+# Sample config for DebianQA scripts
+#
+# A "~/" appearing at the beginning of a string will be replaced for the user's
+# home directory
+[svn]
+repository = svn://svn.debian.org/svn/pkg-perl
+packages_path = trunk
+
+[archive]
+mirror = ftp://ftp.debian.org/debian
+suites = unstable, testing, stable, oldstable, experimental
+sections = main, contrib, non-free
+suites_ttl = 360, 360, 10080, 10080, 360
+new_url = http://ftp-master.debian.org/new.html
+new_ttl = 60
+incoming_url = http://incoming.debian.org
+incoming_ttl = 60
+
+[watch] # Not implemented yet
+use_cpan = 1
+cpan_mirror = ftp://cpan.org/pub/CPAN
+
+[bts]
+ttl = 360 # 6 hours
+soap_proxy = http://bugs.debian.org/cgi-bin/soap.cgi
+soap_uri = Debbugs/SOAP
+
+# Parameters before any section header go into the [common] section
+[common]
+cache_dir = ~/.debianqa
+# verbosity level: error => 0, warn => 1, info => 2 debug => 3
+verbose = 1
+# Prepend syslog-style format?
+formatted_log => 1
Modified: scripts/qa/DebianQA/Archive.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Archive.pm?rev=8886&op=diff
==============================================================================
--- scripts/qa/DebianQA/Archive.pm (original)
+++ scripts/qa/DebianQA/Archive.pm Tue Nov 6 01:51:29 2007
@@ -18,7 +18,7 @@
use DebianQA::Cache;
use DebianQA::Common;
-use DebianQA::Config '$MIRROR';
+use DebianQA::Config '%CFG';
use DebianQA::Svn;
use DebianQA::DebVersions;
use LWP::UserAgent;
@@ -27,24 +27,11 @@
use Compress::Zlib;
use HTML::TableExtract;
-# Table of cache validity, also used as index of valid "suites"
-my %ttl = (
- new => 60, # 1 hour
- incoming => 60, # 1 hour
- experimental => 360, # 6 hours
- unstable => 360, # 6 hours
- testing => 360, # 6 hours
- stable => 10080, # 1 week
- oldstable => 10080, # 1 week
-);
-
my $ua = new LWP::UserAgent;
$ua->timeout(10);
$ua->env_proxy;
-# Main routine.
-# * For each named suite in @LIST, checks cache validity and updates it if
-# necessary. If @list is empty, checks all seven suites.
+# Module for extracting source package listings from the Debian archive.
# * If $force, current cache is ignored.
#
# Re-generates and returns the cache of consolidated versions (key "archive"),
@@ -55,11 +42,19 @@
# ....
# }
sub deb_download {
- my($force, @list) = @_;
- foreach(@list) {
- die "Invalid suite: $_\n" unless(defined $ttl{$_});
+ my $force = shift;
+ my @list = split(/\s*,\s*/, $CFG{archive}{suites});
+ my @ttls = split(/\s*,\s*/, $CFG{archive}{suites_ttl});
+ my %ttl = map({ $list[$_] => $ttls[$_] } (0..$#list));
+
+ if($CFG{archive}{new_url}) {
+ push @list, "new";
+ $ttl{new} = $CFG{archive}{new_ttl} || 60;
}
- @list = keys(%ttl) unless(@list);
+ if($CFG{archive}{incoming_url}) {
+ push @list, "incoming";
+ $ttl{incoming} = $CFG{archive}{incoming_ttl} || 60;
+ }
my $data = {};
unless($force) {
$data = read_cache("archive", "", 0);
@@ -116,9 +111,10 @@
}
sub get_sources {
my($suite) = shift;
+ my @sections = split(/\s*,\s*/, $CFG{archive}{sections});
my %vers;
- foreach my $section qw(main contrib non-free) {
- my $url = "$MIRROR/dists/$suite/$section/source/Sources.gz";
+ foreach my $section(@sections) {
+ my $url = $CFG{archive}{mirror} . "/dists/$suite/$section/source/Sources.gz";
info("Downloading $url");
my $res = $ua->get($url);
unless($res->is_success()) {
@@ -129,7 +125,7 @@
# interact with gunzip
my $gzdata = $res->decoded_content();
my $data;
- if(substr($gzdata, 0, 2) eq "\037\0213") {
+ if(substr($gzdata, 0, 2) eq "\037\0213") { # gzip magic number
#my $z = new IO::Uncompress::Gunzip(\$data);
my $uncdata = Compress::Zlib::memGunzip(\$gzdata);
$data = IO::Scalar->new(\$uncdata);
@@ -150,7 +146,7 @@
return \%vers;
}
sub get_incoming {
- my $url = 'http://incoming.debian.org';
+ my $url = $CFG{archive}{incoming_url};
info("Downloading $url");
my $res = $ua->get($url);
unless($res->is_success()) {
@@ -169,7 +165,7 @@
return \%vers;
}
sub get_new {
- my $url = 'http://ftp-master.debian.org/new.html';
+ my $url = $CFG{archive}{new_url};
info("Downloading $url");
my $res = $ua->get($url);
unless($res->is_success()) {
@@ -200,5 +196,4 @@
}
return \%vers;
}
-
1;
Modified: scripts/qa/DebianQA/BTS.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/BTS.pm?rev=8886&op=diff
==============================================================================
--- scripts/qa/DebianQA/BTS.pm (original)
+++ scripts/qa/DebianQA/BTS.pm Tue Nov 6 01:51:29 2007
@@ -16,13 +16,12 @@
our @EXPORT = qw(bts_download bts_get bts_get_consolidated);
use DebianQA::Common;
+use DebianQA::Config '%CFG';
use DebianQA::Cache;
use DebianQA::Svn;
use SOAP::Lite;
-my $ttl = 360; # 6 hours
-my $btsproxy = 'http://bugs.debian.org/cgi-bin/soap.cgi';
-my $maint = 'pkg-perl-maintainers at lists.alioth.debian.org';
+#my $maint = 'pkg-perl-maintainers at lists.alioth.debian.org';
sub bts_download {
my($force, @pkglist) = @_;
@@ -33,7 +32,8 @@
my $cdata = {};
my $replace = 0;
- my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy($btsproxy);
+ my $soap = SOAP::Lite->uri($CFG{bts}{soap_uri})->proxy(
+ $CFG{bts}{soap_proxy});
unless($force) {
$cdata = read_cache("bts", "", 0);
}
@@ -41,14 +41,14 @@
# A list of packages to update has been received
unless($force) {
@pkglist = grep( {
- $ttl * 60 < time - find_stamp($cdata, $_)
+ $CFG{bts}{ttl} * 60 < time - find_stamp($cdata, $_)
} @pkglist);
info("BTS info for @pkglist is stale");
}
info("Downloading list of bugs of (", join(", ", @pkglist),
")");
@list = @{$soap->get_bugs( package => [ @pkglist ] )->result()};
- } elsif($force or $ttl * 60 < time - find_stamp($cdata, "")) {
+ } elsif($force or $CFG{bts}{ttl} * 60 < time - find_stamp($cdata, "")) {
# No list of packages; forced operation or stale cache
info("BTS info is stale") unless($force);
$replace = 1;
@@ -59,8 +59,11 @@
info("Downloading list of bugs of packages in the repo");
@list = @{$soap->get_bugs( src => [ @pkglist ] )->result()};
} else {
- info("Downloading list of bugs assigned to $maint");
- @list = @{$soap->get_bugs( maint => $maint )->result()};
+ # Doesn't make sense to search bugs if we don't have the list
+ # of packages.
+ return {};
+# info("Downloading list of bugs assigned to $maint");
+# @list = @{$soap->get_bugs( maint => $maint )->result()};
}
} else {
# Cache is up to date
Modified: scripts/qa/DebianQA/Cache.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Cache.pm?rev=8886&op=diff
==============================================================================
--- scripts/qa/DebianQA/Cache.pm (original)
+++ scripts/qa/DebianQA/Cache.pm Tue Nov 6 01:51:29 2007
@@ -14,7 +14,7 @@
our @EXPORT = (qw(
dump_cache unlock_cache read_cache update_cache find_stamp ));
-use DebianQA::Config '$CACHEDIR';
+use DebianQA::Config '%CFG';
use DebianQA::Common;
use Storable qw(store_fd fd_retrieve);
use Fcntl qw(:seek :flock);
@@ -29,8 +29,8 @@
$root =~ s{/+$}{};
if(! defined($fd{$cache})) {
- mkpath $CACHEDIR;
- open $fd{$cache}, "<", "$CACHEDIR/$cache"
+ mkpath $CFG{common}{cache_dir};
+ open $fd{$cache}, "<", "$CFG{common}{cache_dir}/$cache"
or die "Error opening cache: $!\n";
flock($fd{$cache}, LOCK_SH) or die "Error locking cache: $!\n";
}
@@ -49,7 +49,7 @@
sub unlock_cache($) {
my $cache = shift;
return 0 unless($fd{$cache});
- debug("Closing $CACHEDIR/$cache");
+ debug("Closing $CFG{common}{cache_dir}/$cache");
close($fd{$cache});
$fd{$cache} = undef;
1;
@@ -72,14 +72,14 @@
$root = "/$root";
$root =~ s{/+$}{};
- my $file = "$CACHEDIR/$cache";
+ my $file = "$CFG{common}{cache_dir}/$cache";
unless(-e $file) {
return({}, 0) if(wantarray);
return {};
}
my $use_memcache = 0;
if(! defined($fd{$cache})) {
- mkpath $CACHEDIR;
+ mkpath $CFG{common}{cache_dir};
if($keep_lock) {
debug("Opening $file in RW mode");
open $fd{$cache}, "+<", $file or die "Error opening cache: $!\n";
@@ -136,13 +136,13 @@
debug("update_cache($cache, $data, $root, $replace, $keep_lock, $stamp) ",
"invoked");
- my $file = "$CACHEDIR/$cache";
+ my $file = "$CFG{common}{cache_dir}/$cache";
if(! defined($fd{$cache})) {
debug("Opening $file in RW mode");
if(-e $file) {
open($fd{$cache}, "+<", $file) or die "Error opening cache: $!\n";
} else {
- mkpath $CACHEDIR;
+ mkpath $CFG{common}{cache_dir};
open($fd{$cache}, "+>", $file) or die "Error opening cache: $!\n";
}
flock($fd{$cache}, LOCK_EX) or die "Error locking cache: $!\n";
Modified: scripts/qa/DebianQA/Common.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Common.pm?rev=8886&op=diff
==============================================================================
--- scripts/qa/DebianQA/Common.pm (original)
+++ scripts/qa/DebianQA/Common.pm Tue Nov 6 01:51:29 2007
@@ -13,17 +13,21 @@
our @ISA = "Exporter";
our @EXPORT = qw(debug info warn error);
-use DebianQA::Config;
+use DebianQA::Config '%CFG';
use POSIX;
-my $basename = $0;
-$basename =~ s{.*/+}{};
+my $basename;
sub print_msg {
- my($logfmt, @msg) = @_;
+ my($level, @msg) = @_;
+ return if($level > $CFG{common}{verbose});
+ unless($basename) {
+ $basename = $0;
+ $basename =~ s{.*/+}{};
+ }
@msg = split(/\n+/, join("", @msg));
foreach(@msg) {
- if($logfmt) {
+ if($CFG{common}{formatted_log}) {
printf(STDERR "%s %s[%d]: %s\n",
strftime("%b %e %H:%M:%S", localtime), $basename, $$, $_);
} else {
@@ -32,15 +36,15 @@
}
}
sub error {
- print_msg($LOGFMT, @_) if($VERBOSITY >= 0);
+ print_msg(0, @_);
}
sub warn {
- print_msg($LOGFMT, @_) if($VERBOSITY >= 1);
+ print_msg(1, @_);
}
sub info {
- print_msg($LOGFMT, @_) if($VERBOSITY >= 2);
+ print_msg(2, @_);
}
sub debug {
- print_msg($LOGFMT, @_) if($VERBOSITY >= 3);
+ print_msg(3, @_);
}
1;
Modified: scripts/qa/DebianQA/Config.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Config.pm?rev=8886&op=diff
==============================================================================
--- scripts/qa/DebianQA/Config.pm (original)
+++ scripts/qa/DebianQA/Config.pm Tue Nov 6 01:51:29 2007
@@ -1,122 +1,122 @@
+# vim:ts=4:sw=4:et:ai:sts=4
# $Id$
+#
+# Module that holds configuration variables. Also has subroutines for parsing
+# command line options and the configuration file.
+#
+# Copyright MartÃn Ferrari <martin.ferrari at gmail.com>, 2007
+# Released under the terms of the GNU GPL 2
package DebianQA::Config;
use strict;
use warnings;
-use Sys::Hostname;
-# This doesn't seem to be used, and also, use CPAN modifies @INC -- looks like
-# a bug to me
-#use CPAN;
+use FindBin;
+use Getopt::Long;
-our @EXPORT = qw(
- $SVN_REPO
- $SVN_PKG_PATH
- $MIRROR
- $CPAN_MIRROR
- $CACHEDIR
- $VERBOSITY
- $LOGFMT
-);
+our @EXPORT = qw(%CFG read_config getopt_common);
our @ISA = "Exporter";
-our $SVN_REPO = "svn://svn.debian.org/svn/pkg-perl";
-our $SVN_PKG_PATH = "trunk";
-our $MIRROR = "ftp://ftp.debian.org/debian";
-our $CPAN_MIRROR = "ftp://cpan.org/pub/CPAN";
-our $CACHEDIR = "$ENV{HOME}/.dpg/newversioncheck";
-# 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 )
-{
- # alioth
- /alioth/ && do {
- $SVN_REPO = "file:///svn/pkg-perl";
- $MIRROR = "ftp://ftp.nl.debian.org/debian";
- $CPAN_MIRROR = "ftp://cpan.wanadoo.nl/pub/CPAN";
- last;
- };
-
- # Gregor
- /belanna|nerys/ && do {
- $MIRROR = "ftp://ftp.at.debian.org/debian";
- $CPAN_MIRROR = "ftp://gd.tuwien.ac.at/pub/CPAN";
- last;
- };
-
- # dam
- /pc1/ && do {
- $MIRROR = "http://proxy:9999/debian";
- $CPAN_MIRROR = "ftp://ftp.uni-sofia.bg/cpan";
- last;
- };
- /beetle/ && do {
- $MIRROR = "http://localhost:9999/debian";
- $CPAN_MIRROR = "ftp://ftp.uni-sofia.bg/cpan";
- last;
- };
-
- # Tincho
- /abraxas/ && do {
- $MIRROR = "file:///media/IOMega/mirror/debian/";
- $CPAN_MIRROR = "ftp://cpan.ip.pt/pub/cpan/";
- last;
- };
-
- die "Unknown host $_";
+# Default values
+my %defaults = (
+ svn => {
+ repository => "svn://svn.debian.org/svn/pkg-perl",
+ packages_path => "trunk"
+ },
+ archive => {
+ mirror => "ftp://ftp.debian.org/debian",
+ suites => "unstable, testing, stable, oldstable, experimental",
+ sections => "main, contrib, non-free",
+ suites_ttl => "360, 360, 10080, 10080, 360",
+ new_url => 'http://ftp-master.debian.org/new.html',
+ new_ttl => 60,
+ incoming_url => 'http://incoming.debian.org',
+ incoming_ttl => 60,
+ },
+ watch => { # Not implemented yet
+ use_cpan => 1,
+ cpan_mirror => "ftp://cpan.org/pub/CPAN",
+ },
+ bts => {
+ ttl => 360, # 6 hours
+ soap_proxy => 'http://bugs.debian.org/cgi-bin/soap.cgi',
+ soap_uri => 'Debbugs/SOAP'
+ },
+ common => {
+ cache_dir => "$ENV{HOME}/.dpg/newversioncheck",
+ # verbosity level: error => 0, warn => 1, info => 2, debug => 3
+ # Should be 1 by default, 0 for quiet mode
+ verbose => 1,
+ # Prepend syslog-style format?
+ formatted_log => 1
+ }
+);
+our %CFG = %defaults; # Global configuration
+my %valid_cfg;
+foreach my $section (keys %defaults) {
+ $valid_cfg{$section} = { map({ $_ => 1 } keys(%{$defaults{$section}})) };
}
-# This mirror is near alioth. From #alioth:
-# <ard> ard at c32791:~$ sudo /usr/sbin/traceroute -A cpan.wanadoo.nl|grep AS1200
-# <ard> traceroute to ftp.wanadoo.nl (194.134.17.10), 64 hops max, 40 byte packets
-# <ard> 5 ams-ix.euro.net (195.69.144.70) [AS1200] 1 ms 1 ms 1 ms
-# <ard> jups
-# <ard> 10G going to as1200
-# <ard> As long as it passes as1200 it's ok... Everything else is $$ :-(
-# CPAN=ftp://cpan.wanadoo.nl/pub/CPAN
+sub read_config(;$) {
+ my $file = shift;
+ unless($file) {
+ if(-e "/etc/DebianQA.conf") {
+ $file = "/etc/DebianQA.conf";
+ } elsif(-e "DebianQA.conf") {
+ $file = "DebianQA.conf";
+ } elsif(-e "$FindBin::Bin/DebianQA.conf") {
+ $file = "$FindBin::Bin/DebianQA.conf";
+ } else {
+ die "Can't find any configuration file!\n";
+ }
+ }
+ die "Can't read configuration file: $file\n" unless(-r $file);
-my $home = $ENV{HOME};
-$CPAN::Config = {
- 'build_cache' => q[10],
- 'build_dir' => "$home/.cpan/build",
- 'cache_metadata' => q[1],
- 'cpan_home' => "$home/.cpan",
- 'cpan_version_check' => q[0],
- 'dontload_hash' => { },
- 'ftp' => q[],
- 'ftp_proxy' => q[],
- 'getcwd' => q[cwd],
- 'gpg' => q[/usr/bin/gpg],
- 'gzip' => q[/bin/gzip],
- 'histfile' => "/dev/null",
- 'histsize' => q[100],
- 'http_proxy' => q[],
- 'inactivity_timeout' => q[0],
- 'index_expire' => q[1],
- 'inhibit_startup_message' => q[1],
- 'keep_source_where' => "$home/.cpan/sources",
- 'lynx' => q[/usr/bin/lynx],
- 'make' => q[/usr/bin/make],
- 'make_arg' => q[],
- 'make_install_arg' => q[],
- 'makepl_arg' => q[INSTALLDIRS=site],
- 'ncftp' => q[],
- 'ncftpget' => q[],
- 'no_proxy' => q[],
- 'pager' => q[/usr/bin/less],
- 'prerequisites_policy' => q[ignore],
- 'scan_cache' => q[never],
- 'shell' => q[/bin/bash],
- 'tar' => q[/bin/tar],
- 'term_is_latin' => q[0],
- 'unzip' => q[],
- 'urllist' => [ $CPAN_MIRROR ],
- 'wget' => q[/usr/bin/wget],
-};
-
+ my $section = "common";
+ open(CFG, "<", $file) or die "Can't open $file: $!\n";
+ while(<CFG>) {
+ chomp;
+ s/(?<!\S)#.*//;
+ s/\s+$//;
+ next unless($_);
+ if(/^\s*\[\s*(\w+)\s*\]\s*$/) {
+ $section = lc($1);
+ die "Invalid section in configuration file: $section\n" unless(
+ exists($valid_cfg{$section}));
+ next;
+ }
+ unless(/^\s*([^=]+?)\s*=\s*(.+)/) {
+ die "Unrecognised line in configuration file: $_\n";
+ }
+ my($key, $val) = ($1, $2);
+ unless(exists($valid_cfg{$section}{$key})) {
+ die("Unrecognised configuration parameter $key in section " .
+ "$section\n");
+ }
+ if($val =~ s/^~\///) { # UGLY!
+ $val = $ENV{HOME} . "/$val";
+ }
+ $CFG{$section}{$key} = $val;
+ }
+ close CFG;
+}
+# Parses command line options, loads configuration file if specified, removes
+# arguments from @ARGV and returns a hash with the parsed options.
+# If $passthru, ignores unknown parameters and keeps them in @ARGV.
+sub getopt_common {
+ my $passthru = shift;
+ my($conffile, $force, $v, $q) = (undef, 0, 0, 0);
+ my $p = new Getopt::Long::Parser;
+ $p->configure(qw(no_ignore_case bundling),
+ $passthru ? ("pass_through") : ());
+ $p->getoptions(
+ 'conf|c=s' => \$conffile, 'force|f!' => \$force,
+ 'verbose|v:+' => \$v, 'quiet|q:+' => \$q
+ ) or die("Error parsing command-line arguments\n");
+ read_config($conffile) if($conffile);
+ $CFG{common}{verbose} += $v - $q;
+ return {
+ force => $force # only one argument for now
+ };
+}
1;
Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=8886&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Tue Nov 6 01:51:29 2007
@@ -25,7 +25,7 @@
use Parse::DebianChangelog;
use DebianQA::Cache;
use DebianQA::Common;
-use DebianQA::Config qw($SVN_REPO $SVN_PKG_PATH);
+use DebianQA::Config '%CFG';
use SVN::Client;
sub svn_download {
@@ -34,7 +34,7 @@
$revision ||= 0;
debug("svn_download($force, $revision, (@dirlist))");
- my $svnpath = "$SVN_REPO/$SVN_PKG_PATH";
+ my $svnpath = $CFG{svn}{repository} . "/". $CFG{svn}{packages_path};
my $complete = ! @dirlist;
our $svn = SVN::Client->new();
Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=8886&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Tue Nov 6 01:51:29 2007
@@ -17,9 +17,9 @@
use DebianQA::Cache;
use DebianQA::Common;
+use DebianQA::Config '%CFG';
use DebianQA::Svn;
use DebianQA::DebVersions;;
-use IO::Scalar;
use LWP::UserAgent;
my $ttl = 6;
Added: scripts/qa/fetchdata
URL: http://svn.debian.org/wsvn/scripts/qa/fetchdata?rev=8886&op=file
==============================================================================
--- scripts/qa/fetchdata (added)
+++ scripts/qa/fetchdata Tue Nov 6 01:51:29 2007
@@ -1,0 +1,89 @@
+#!/usr/bin/perl
+# vim:ts=4:sw=4:et:ai:sts=4
+# $Id: Watch.pm 8885 2007-11-05 20:43:22Z tincho-guest $
+#
+# Program for invoking the different data-fetching routines. To use from a
+# cronjob, interactively or on post-commit hooks.
+#
+# Copyright MartÃn Ferrari <martin.ferrari at gmail.com>, 2007
+# Released under the terms of the GNU GPL 2
+use strict;
+use warnings;
+
+use DebianQA::Archive;
+use DebianQA::BTS;
+use DebianQA::Common;
+use DebianQA::Config;
+use DebianQA::Svn;
+use DebianQA::Watch;
+use Getopt::Long;
+
+my $opts = getopt_common(1);
+
+my $p = new Getopt::Long::Parser;
+$p->configure(qw(no_ignore_case bundling));
+
+my $list_is_packages = 0;
+my $svn_rev;
+my $parallel = 0;
+$p->getoptions('help|h|?' => \&help, 'packages!' => \$list_is_packages,
+ 'svn-revision|r=i' => \$svn_rev, 'parallel|j!' => \$parallel)
+ or die "Error parsing command-line arguments!\n";
+
+my @dirs = @ARGV;
+
+if($list_is_packages) {
+ foreach my $dir (@dirs) {
+ $dir = svndir2pkgname($dir) || $dir; # Fallback
+ }
+}
+# We need this first
+svn_download($opts->{force}, $svn_rev, @dirs);
+if($parallel) {
+ local $SIG{CHLD} = "IGNORE";
+ my @pids;
+ my $pid;
+ foreach(0..2) {
+ unless(defined($pid = fork())) {
+ die "Can't fork: $!";
+ }
+ last unless($pid);
+ push @pids, $pid;
+ }
+ if(@pids == 2) {
+ deb_download($opts->{force}); exit 0;
+ } elsif(@pids == 1) {
+ bts_download($opts->{force}, @dirs); exit 0;
+ } elsif(@pids == 0) {
+ watch_download($opts->{force}, @dirs); exit 0;
+ } else {
+ waitpid($_, 0) foreach(@pids);
+ }
+} else {
+ deb_download($opts->{force});
+ bts_download($opts->{force}, @dirs);
+ watch_download($opts->{force}, @dirs);
+}
+
+sub help {
+ print <<END;
+Usage:
+ $0 [options] [dirname [dirname ...]]
+
+ For each named directory, updates the databases with information retrieved
+ from the Debian archive, BTS, watchfiles and the Subversion repository.
+
+Options:
+ --help, -h This help.
+ --conf, -c FILE Specifies a configuration file, uses defaults if not
+ present.
+ --force, -f Force operation: ignore caches.
+ --packages Treat the parameters as source package names, instead of
+ directories.
+ --svn-revision,
+ -r REV Current revision for scanning the Subversion repository.
+ --parallel, -j Process in parallel (it will fork three processes).
+
+END
+ exit 0;
+}
Propchange: scripts/qa/fetchdata
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list