r14304 - /scripts/qa/DebianQA/Svn.pm
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Thu Feb 7 23:34:28 UTC 2008
Author: tincho-guest
Date: Thu Feb 7 23:34:16 2008
New Revision: 14304
URL: http://svn.debian.org/wsvn/?sc=1&rev=14304
Log:
- Better SVN path sanitisation.
- Fix $complete.
- Lots of extra debugging.
- Optimise tags retrieval.
Modified:
scripts/qa/DebianQA/Svn.pm
Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=14304&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Thu Feb 7 23:34:16 2008
@@ -29,6 +29,7 @@
use DebianQA::DebVersions;
use Parse::DebControl;
use SVN::Client;
+use List::Util 'min';
# shared
our $svn = SVN::Client->new();
@@ -42,57 +43,70 @@
die "Missing SVN repository" unless($CFG{svn}{repository});
my $svnpath = $CFG{svn}{repository};
- # Sanitise, as SVN::Client is too stupid
- $svnpath =~ s{/+$}{};
-
- my $svnpkgpath = "$svnpath/";
- $svnpkgpath .= $CFG{svn}{packages_path} if($CFG{svn}{packages_path});
- $svnpkgpath =~ s{/+$}{};
+ $svnpath =~ m{^([^/:]+)://([^/]*)/(.*)$}
+ or die "Invalid SVN repository: $svnpath";
+ my($repoproto, $repohost, $repopath) = ($1, $2, $3);
+ $repopath =~ s#/+#/#g;
+ $repopath =~ s{/$}{};
+ $repopath =~ s{^/}{};
+ $svnpath = "$repoproto://$repohost/$repopath";
+
+ # Starts with a slash
+ my $svnpkgpath = "/".$CFG{svn}{packages_path} if($CFG{svn}{packages_path});
+ $svnpkgpath =~ s#/+#/#g;
+ $svnpkgpath =~ s{/$}{};
my $svnpkgpostpath = $CFG{svn}{post_path} || "";
# Always has a slash if not empty
$svnpkgpostpath =~ s{^/*(.*?)/*$}{/$1} if($svnpkgpostpath);
-
+ $svnpkgpostpath =~ s#/+#/#g;
+
+ my $complete = ! @dirlist;
unless(@dirlist) {
info("Retrieving list of directories in SVN");
- my %dirlist = %{$svn->ls($svnpkgpath, 'HEAD', 0)};
+ my %dirlist = %{$svn->ls("$svnpath$svnpkgpath", 'HEAD', 0)};
@dirlist = grep({ $dirlist{$_}->kind() == $SVN::Node::dir }
keys(%dirlist));
info(scalar @dirlist, " directories to process");
}
unless($revision) {
info("Retrieving last revision number from SVN");
- $svn->info($svnpath, undef, "HEAD", sub {
+ $svn->info("$svnpath$svnpkgpath", undef, "HEAD", sub {
$revision = $_[1]->rev();
}, 0);
}
unless($force) {
my $cdata = read_cache("svn", "", 0);
- my @new = grep({! $cdata->{$_}} @dirlist);
- if(find_stamp($cdata, "") == $revision and not @new) {
- return (); # Cache is up-to-date
- }
- }
-
- my($pkgdata, @changed) = svn_scanpackages($force, $revision, $svnpkgpath,
- $svnpkgpostpath, @dirlist);
+ if(find_stamp($cdata, "")) {
+ my @new = grep({! $cdata->{$_}} @dirlist);
+ if(find_stamp($cdata, "") == $revision and not @new) {
+ return (); # Cache is up-to-date
+ }
+ } else {
+ $force = 1;
+ }
+ }
+
+ my($pkgdata, @changed) = svn_scanpackages($force, $revision,
+ "$svnpath$svnpkgpath", $svnpkgpostpath, @dirlist);
if($CFG{svn}{track_tags}) {
- my $svntagpath = "$svnpath/";
- $svntagpath .= $CFG{svn}{tags_path} if($CFG{svn}{tags_path});
- $svntagpath =~ s{/+$}{};
+ # Starts with a slash
+ my $svntagpath = "/" . $CFG{svn}{tags_path} if($CFG{svn}{tags_path});
+ $svntagpath =~ s#/+#/#g;
+ $svntagpath =~ s{/$}{};
my $svntagpostpath = $CFG{svn}{tags_post_path} || "";
# Always has a slash if not empty
$svntagpostpath =~ s{^/*(.*?)/*$}{/$1} if($svntagpostpath);
-
- my $tagdata = svn_scantags($force, $revision, $svntagpath,
+ $svntagpostpath =~ s#/+#/#g;
+
+ my $tagdata = svn_scantags($force, $revision, $svnpath, $svntagpath,
$svntagpostpath, @dirlist);
foreach(keys %$pkgdata) {
$pkgdata->{$_}{tags} = $tagdata->{$_} if($tagdata->{$_});
}
}
# Retain lock
- my $complete = ! @dirlist;
my $cdata = update_cache("svn", $pkgdata, "", $complete, 1, $revision);
my @pkglist = grep({ ref $cdata->{$_} and $cdata->{$_}{pkgname} }
@@ -121,24 +135,45 @@
return @changed;
}
sub svn_scantags {
- my($force, $revision, $prepath, $postpath, @dirlist) = @_;
+ my($force, $revision, $svnpath, $prepath, $postpath, @dirlist) = @_;
info("Scanning tags from SVN");
my $cdata;
- $cdata = read_cache("svn", "", 0) unless($force);
+ my %dirs = map({ ( $_ => 1 ) } @dirlist);
+ my %changed;
+ if($force) {
+ %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 %tags;
foreach my $dir (@dirlist) {
- if($force or not $cdata->{$dir}{tags}
- or find_stamp($cdata, $dir) < $revision) {
- debug("Retrieving tags for $dir");
- my $pkghome = "$prepath/$dir$postpath";
- my $tagdirs = safe_svn_op($svn, ls => $pkghome, 'HEAD', 0);
- my @tagdirs = sort( { deb_compare_nofail($a, $b) }
- grep({ $tagdirs->{$_}->kind() == $SVN::Node::dir }
- keys(%{$tagdirs || {}}))
- );
- $tags{$dir} = \@tagdirs;
- }
+ unless($changed{$dir}) {
+ $tags{$dir} = $cdata->{$dir}{tags};
+ next;
+ }
+ debug("Retrieving tags for $dir");
+ my $pkghome = "$svnpath$prepath/$dir$postpath";
+ my $tagdirs = safe_svn_op($svn, ls => $pkghome, 'HEAD', 0);
+ my @tagdirs = sort( { deb_compare_nofail($a, $b) }
+ grep({ $tagdirs->{$_}->kind() == $SVN::Node::dir }
+ keys(%{$tagdirs || {}}))
+ );
+ debug("Tags for $dir: @tagdirs");
+ $tags{$dir} = \@tagdirs;
}
return \%tags;
}
@@ -164,9 +199,11 @@
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},
"HEAD", 1, 1, sub {
foreach (keys %{$_[0]}) {
+ debug("Changed path: $_");
$changed{$dir} = 1 if(
m{/debian/(changelog|control|watch)$});
}
More information about the Pkg-perl-cvs-commits
mailing list