r11942 - in /scripts/qa/DebianQA: BTS.pm Svn.pm

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

Author: tincho-guest
Date: Thu Jan  3 08:22:49 2008
New Revision: 11942

URL: http://svn.debian.org/wsvn/?sc=1&rev=11942
Log:
Many more changes:
* Svn.pm:
- Added safe_svn_op to be able to use svn without dying on nonexistant files.
- Use that sub to retrieve logs, and mark invalid dirs (fixing pkg-voip
  problem).
- While we're at it, added an extra check if debian/control is missing, to see
  if there is really a debian/ directory.
- Parse::DebControl is starting to get on my nerves, by default it doesn't
  understand comments (and dpkg does), and the stripComments option doesn't
  behave sanely. Fixed with a s///.
- Add provides to the list of binary packages.
* BTS.pm: allow matching on source package too, this API is confusing _and_
  undocumented.

Modified:
    scripts/qa/DebianQA/BTS.pm
    scripts/qa/DebianQA/Svn.pm

Modified: scripts/qa/DebianQA/BTS.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/BTS.pm?rev=11942&op=diff
==============================================================================
--- scripts/qa/DebianQA/BTS.pm (original)
+++ scripts/qa/DebianQA/BTS.pm Thu Jan  3 08:22:49 2008
@@ -90,7 +90,7 @@
         my @binnames = split(/,/, $binname);
         my $found = 0;
         foreach(@binnames) {
-            my $srcname = $binmap{$_} or next;
+            my $srcname = exists $pkginfo->{$_} ? $_ : $binmap{$_} or next;
             $bugs{$srcname}{$bug} = $bugs_st->{$bug};
             $found++;
         }

Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=11942&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Thu Jan  3 08:22:49 2008
@@ -85,16 +85,22 @@
 
         # Now search in the SVN log to see if there's any interesting change
         # Remove from list already updated parts of the cache
+        # Also remove invalid dirs
+        my %invalid;
         foreach my $dir (grep({ $cache_vers{$_}
                     and $cache_vers{$_} < $revision } @dirlist)) {
             $dir =~ s{^/*(.*?)/*$}{$1};
             my $pkghome = "$svnpath/$dir$svnpostpath";
-            $svn->log([ $pkghome ], $cache_vers{$dir}, "HEAD", 1, 1,
-                sub {
+            safe_svn_op($svn, "log", [ $pkghome ], $cache_vers{$dir},
+                "HEAD", 1, 1, sub {
                     foreach (keys %{$_[0]}) {
                         $changed{$dir} = 1 if(m{/debian/(changelog|control|watch)$});
                     }
-                });
+                }) or $invalid{$dir} = 1;
+        }
+        foreach(keys %invalid) {
+            info("Removing invalid $_ directory");
+            $svn{$_} = {};
         }
         # Copy the not-changed dirs that we want to have the stamp bumped
         foreach(grep({ ! $changed{$_} } @dirlist)) {
@@ -112,6 +118,10 @@
 
         unless($control) {
             $svn{$dir}{error} = "MissingControl";
+            # Check if it's an invalid dir
+            safe_svn_op($svn, "ls", $debdir, 'HEAD', 0) and next;
+            info("Removing invalid $dir directory");
+            $svn{$dir} = {};
             next;
         }
 
@@ -129,6 +139,7 @@
         # they to exist, [2] and on for the other binary packages - which 
         # we will wisely ignore)
         my ($ctrl_data, $short, $long);
+        $control =~ s/^#.*\n//gm; # stripComments looks like nonsense to me
         $ctrl_data = Parse::DebControl->new->parse_mem($control, {
                 discardCase => 1 # unreliable if don't
             });
@@ -153,6 +164,11 @@
             };
             delete $svn{$dir}{bindata}[$_-1]{description};
             $bins{$bin->{package}} = 1;
+            if($bin->{provides}) {
+                foreach(split(/\s*,\s*/, $bin->{provides})) {
+                    $bins{$_} = 1;
+                }
+            }
         }
         $svn{$dir}{binaries} = [ sort keys %bins ];
         my $parser = Parse::DebianChangelog->init({
@@ -366,19 +382,24 @@
     my($svn, $target) = @_;
     my $svn_error;
     my $data;
-    {
-        my $fh = IO::Scalar->new(\$data);
-        local $SVN::Error::handler = undef;
-        ($svn_error) = $svn->cat($fh, $target , 'HEAD');
-    }
+    my $fh = IO::Scalar->new(\$data);
+    safe_svn_op($svn, "cat", $fh, $target , 'HEAD');
+    return $data;
+}
+sub safe_svn_op($$@) {
+    my($svn, $op, @opts) = @_;
+    local $SVN::Error::handler = undef;
+    my ($svn_error) = eval "\$svn->$op(\@opts)";
+    die $@ if($@);
     if(SVN::Error::is_error($svn_error)) {
         if($svn_error->apr_err() == $SVN::Error::FS_NOT_FOUND) {
             $svn_error->clear();
+            return 0;
         } else {
             SVN::Error::croak_on_error($svn_error);
         }
     }
-    return $data;
+    return 1;
 }
 
 sub split_description($) {