r9026 - in /scripts/qa: DebianQA/Config.pm DebianQA/Svn.pm fetchdata qareport

[tincho-guest at users.alioth.debian.org]

Author: tincho-guest
Date: Thu Nov  8 12:09:53 2007
New Revision: 9026

URL: http://svn.debian.org/wsvn/?sc=1&rev=9026
Log:
- scripts+Config: make them read the conffile even if not using -c (use
  environment or default).
- Svn: sanitise SVN paths to avoid stupid SVN::Client crashes.

Modified:
    scripts/qa/DebianQA/Config.pm
    scripts/qa/DebianQA/Svn.pm
    scripts/qa/fetchdata
    scripts/qa/qareport

Modified: scripts/qa/DebianQA/Config.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Config.pm?rev=9026&op=diff
==============================================================================
--- scripts/qa/DebianQA/Config.pm (original)
+++ scripts/qa/DebianQA/Config.pm Thu Nov  8 12:09:53 2007
@@ -115,8 +115,9 @@
 # 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;
+# If $readconf, will call read_config even if the user didn't say --conf
+sub getopt_common(;$$) {
+    my($passthru, $readconf) = @_;
     my($conffile, $force, $v, $q) = (undef, 0, 0, 0);
     my $p = new Getopt::Long::Parser;
     $p->configure(qw(no_ignore_case bundling),
@@ -125,7 +126,7 @@
         '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);
+    read_config($conffile) if($conffile or $readconf);
     $CFG{common}{verbose} += $v - $q;
     return {
         force => $force     # only one argument for now

Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=9026&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Thu Nov  8 12:09:53 2007
@@ -36,7 +36,17 @@
     $revision ||= 0;
     debug("svn_download($force, $revision, (@dirlist))");
 
-    my $svnpath = $CFG{svn}{repository} . "/". $CFG{svn}{packages_path};
+    die "Missing SVN repository" unless($CFG{svn}{repository});
+    my $svnpath = $CFG{svn}{repository};
+
+    # Sanitise, as SVN::Client is too stupid
+    $svnpath =~ s{/+$}{};
+    $svnpath .= "/";
+    $svnpath .= $CFG{svn}{packages_path} if($CFG{svn}{packages_path});
+    $svnpath =~ s{/+$}{};
+    my $svnpostpath = $CFG{svn}{post_path} || "";
+    $svnpostpath =~ s{^/*(.*?)/*$}{$1};
+
     my $complete = ! @dirlist;
 
     our $svn = SVN::Client->new();
@@ -74,8 +84,8 @@
         # Remove from list already updated parts of the cache
         foreach my $dir (grep({ $cache_vers{$_}
                     and $cache_vers{$_} < $revision } @dirlist)) {
-            my $pkghome = "$svnpath/$dir";
-            $pkghome .= $CFG{svn}{post_path} if($CFG{svn}{post_path});
+            $dir =~ s{^/*(.*?)/*$}{$1};
+            my $pkghome = "$svnpath/$dir/$svnpostpath";
             $svn->log([ $pkghome ], $cache_vers{$dir}, "HEAD", 1, 1,
                 sub {
                     foreach (keys %{$_[0]}) {
@@ -90,12 +100,11 @@
     }
     my @changed = keys %changed;
     foreach my $dir (@changed) {
+        $dir =~ s{^/*(.*?)/*$}{$1};
         $svn{$dir} = {};
         info("Retrieving changelog for $dir");
         my $changelog = get_svn_file($svn,
-            "$svnpath/$dir/" . 
-            ($CFG{svn}{post_path} ? $CFG{svn}{post_path} . "/" : "") .
-            "debian/changelog");
+            "$svnpath/$dir/$svnpostpath/debian/changelog");
 
         unless($changelog) {
             $svn{$dir}{error} = "Missing";
@@ -138,9 +147,7 @@
 
         info("Retrieving watchfile for $dir");
         my $watch = get_svn_file($svn,
-            "$svnpath/$dir/" . 
-            ($CFG{svn}{post_path} ? $CFG{svn}{post_path} . "/" : "") .
-            "debian/watch");
+            "$svnpath/$dir/$svnpostpath/debian/watch");
         unless($watch) {
             if($svn{$dir}{version} and $svn{$dir}{version} !~ /-/) {
                 $svn{$dir}{watch_error} = "Native";

Modified: scripts/qa/fetchdata
URL: http://svn.debian.org/wsvn/scripts/qa/fetchdata?rev=9026&op=diff
==============================================================================
--- scripts/qa/fetchdata (original)
+++ scripts/qa/fetchdata Thu Nov  8 12:09:53 2007
@@ -18,7 +18,7 @@
 use DebianQA::Watch;
 use Getopt::Long;
 
-my $opts = getopt_common(1);
+my $opts = getopt_common(1, 1);
 
 my $p = new Getopt::Long::Parser;
 $p->configure(qw(no_ignore_case bundling));

Modified: scripts/qa/qareport
URL: http://svn.debian.org/wsvn/scripts/qa/qareport?rev=9026&op=diff
==============================================================================
--- scripts/qa/qareport (original)
+++ scripts/qa/qareport Thu Nov  8 12:09:53 2007
@@ -16,7 +16,7 @@
 use DebianQA::Svn;
 use Getopt::Long;
 
-my $opts = getopt_common(1);
+my $opts = getopt_common(1, 1);
 
 my $p = new Getopt::Long::Parser;
 $p->configure(qw(no_ignore_case bundling));