r14305 - /scripts/qa/DebianQA/Svn.pm

tincho-guest at users.alioth.debian.org tincho-guest at users.alioth.debian.org
Fri Feb 8 00:15:34 UTC 2008


Author: tincho-guest
Date: Fri Feb  8 00:15:33 2008
New Revision: 14305

URL: http://svn.debian.org/wsvn/?sc=1&rev=14305
Log:
Fixed some corner cases, and optimised old svn code

Modified:
    scripts/qa/DebianQA/Svn.pm

Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=14305&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Fri Feb  8 00:15:33 2008
@@ -87,8 +87,8 @@
         }
     }
 
-    my($pkgdata, @changed) = svn_scanpackages($force, $revision,
-        "$svnpath$svnpkgpath", $svnpkgpostpath, @dirlist);
+    my($pkgdata, @changed) = svn_scanpackages($force, $revision, $svnpath,
+        $svnpkgpath, $svnpkgpostpath, @dirlist);
     if($CFG{svn}{track_tags}) {
         # Starts with a slash
         my $svntagpath = "/" . $CFG{svn}{tags_path} if($CFG{svn}{tags_path});
@@ -145,18 +145,32 @@
         %changed = %dirs;
     } else {
         $cdata = read_cache("svn", "", 0);
-        my $old_rev = min(map({ find_stamp($cdata, $_) || 0 } @dirlist));
-
-        info("Retrieving SVN log since $old_rev");
-        safe_svn_op($svn, log => [ "$svnpath$prepath" ], $old_rev, "HEAD",
-            1, 1, sub {
-                foreach (keys %{$_[0]}) {
-                    debug("Changed path: $_");
-                    $changed{$1} = 1 if(m{^\Q$prepath\E/(.*?)/});
-                }
-            }) or %changed = %dirs; # fallback
-        foreach(grep({ not $cdata->{$_}{tags} } @dirlist)) {
-            $changed{$_} = 1;
+        my @candidates;
+        # Find oldest non-zero stamp, and force changed for new dirs
+        foreach(@dirlist) {
+            my $stamp = find_stamp($cdata, $_);
+            if($stamp and $cdata->{$_}{tags}) {
+                push @candidates, $stamp;
+            } else {
+                $changed{$_} = 1;
+            }
+        }
+        my $old_rev = min(@candidates);
+        if($old_rev) {
+            info("Retrieving SVN log since $old_rev");
+            my $ret = safe_svn_op($svn, log => [ "$svnpath$prepath" ], $old_rev,
+                "HEAD", 1, 1, sub {
+                    foreach (keys %{$_[0]}) {
+                        debug("Changed path: $_");
+                        $changed{$1} = 1 if(m{^\Q$prepath\E/(.*?)/});
+                    }
+                });
+            unless($ret) {
+                warn("svn log had problems!");
+                %changed = %dirs; # fallback
+            }
+        } else {
+            %changed = %dirs;
         }
     }
     my %tags;
@@ -178,50 +192,53 @@
     return \%tags;
 }
 sub svn_scanpackages {
-    my($force, $revision, $prepath, $postpath, @dirlist) = @_;
-
-    my(%changed, %svn);
+    my($force, $revision, $svnpath, $prepath, $postpath, @dirlist) = @_;
+
+    info("Scanning packages from SVN");
+    my(%svn, %changed);
+    my %dirs = map({ ( $_ => 1 ) } @dirlist);
     if($force) {
-        %changed = map({ $_ => 1 } @dirlist);
+        %changed = %dirs;
     } else {
         my $cdata = read_cache("svn", "", 0);
-        # Stamps from cache
-        my %cache_vers = map({ $_ => find_stamp($cdata, $_) }
-            grep({ $cdata->{$_} } @dirlist));
-        # Never updated
-        %changed = map({ $_ => 1 } grep( { not $cache_vers{$_} } @dirlist));
-
-        # 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 = "$prepath/$dir$postpath";
-            info("Retrieving SVN log for $dir since $cache_vers{$dir}");
-            safe_svn_op($svn, "log", [ $pkghome ], $cache_vers{$dir},
+        my @candidates;
+        # Find oldest non-zero stamp, and force changed for new dirs
+        foreach(@dirlist) {
+            my $stamp = find_stamp($cdata, $_);
+            if($stamp and $cdata->{$_}) {
+                push @candidates, $stamp;
+            } else {
+                $changed{$_} = 1;
+            }
+        }
+        my $old_rev = min(@candidates);
+        if($old_rev) {
+            # Now search in the SVN log to see if there's any interesting change
+            # Remove from list already updated parts of the cache
+            info("Retrieving SVN log since $old_rev");
+            my $ret = safe_svn_op($svn, log => [ "$svnpath$prepath" ], $old_rev,
                 "HEAD", 1, 1, sub {
                     foreach (keys %{$_[0]}) {
                         debug("Changed path: $_");
-                        $changed{$dir} = 1 if(
-                            m{/debian/(changelog|control|watch)$});
+                        $changed{$1} = 1 if(m{^\Q$prepath\E/(.*?)\Q$postpath\E/debian/(changelog|control|watch)$});
                     }
-                }) or $invalid{$dir} = 1;
-        }
-        foreach(keys %invalid) {
-            info("Removing invalid $_ directory");
-            $svn{$_} = {};
+                });
+            unless($ret) {
+                warn("svn log had problems!");
+                %changed = %dirs; # fallback
+            }
+        } else {
+            %changed = %dirs;
         }
         # Copy the not-changed dirs that we want to have the stamp bumped
         foreach(grep({ ! $changed{$_} } @dirlist)) {
-            $svn{$_} = $cdata->{$_} if($cdata->{$_});
+            $svn{$_} = $cdata->{$_};
         }
     }
     my @changed = keys %changed;
     foreach my $dir (@changed) {
         $dir =~ s{^/*(.*?)/*$}{$1};
-        my $debdir = "$prepath/$dir$postpath/debian";
+        my $debdir = "$svnpath$prepath/$dir$postpath/debian";
         $svn{$dir} = {};
 
         info("Retrieving control information for $dir");




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