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