r14252 - in /scripts/qa: DebianQA/Config.pm DebianQA/Svn.pm debianqa.conf-sample
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Thu Feb 7 18:40:29 UTC 2008
Author: tincho-guest
Date: Thu Feb 7 18:40:29 2008
New Revision: 14252
URL: http://svn.debian.org/wsvn/?sc=1&rev=14252
Log:
Added tags tracking in svn, three new configuration options (all optional):
track_tags => 0
tags_path => "tags"
tags_post_path => ""
Also splitted the big svn_download function in three chunks.
Modified:
scripts/qa/DebianQA/Config.pm
scripts/qa/DebianQA/Svn.pm
scripts/qa/debianqa.conf-sample
Modified: scripts/qa/DebianQA/Config.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Config.pm?rev=14252&op=diff
==============================================================================
--- scripts/qa/DebianQA/Config.pm (original)
+++ scripts/qa/DebianQA/Config.pm Thu Feb 7 18:40:29 2008
@@ -29,7 +29,10 @@
svn => {
repository => undef,
packages_path => "trunk",
- post_path => ""
+ post_path => "",
+ track_tags => 0,
+ tags_path => "tags",
+ tags_post_path => ""
},
archive => {
mirror => "ftp://ftp.debian.org/debian",
Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=14252&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Thu Feb 7 18:40:29 2008
@@ -30,6 +30,9 @@
use Parse::DebControl;
use SVN::Client;
+# shared
+our $svn = SVN::Client->new();
+
# Returns the list of changed directories
sub svn_download {
my($force, $revision, @dirlist) = @_;
@@ -39,44 +42,109 @@
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} || "";
+
+ my $svnpkgpath = "$svnpath/";
+ $svnpkgpath .= $CFG{svn}{packages_path} if($CFG{svn}{packages_path});
+ $svnpkgpath =~ s{/+$}{};
+
+ my $svnpkgpostpath = $CFG{svn}{post_path} || "";
# Always has a slash if not empty
- $svnpostpath =~ s{^/*(.*?)/*$}{/$1} if($svnpostpath);
-
- my $complete = ! @dirlist;
-
- our $svn = SVN::Client->new();
+ $svnpkgpostpath =~ s{^/*(.*?)/*$}{/$1} if($svnpkgpostpath);
+
+ unless(@dirlist) {
+ info("Retrieving list of directories in SVN");
+ my %dirlist = %{$svn->ls($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 {
$revision = $_[1]->rev();
}, 0);
}
-
- if($complete) {
- info("Retrieving list of directories in SVN");
- my %dirlist = %{$svn->ls($svnpath, 'HEAD', 0)};
- @dirlist = grep({ $dirlist{$_}->kind() == $SVN::Node::dir }
- keys(%dirlist));
- info(scalar @dirlist, " directories to process");
- }
+ 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($CFG{svn}{track_tags}) {
+ my $svntagpath = "$svnpath/";
+ $svntagpath .= $CFG{svn}{tags_path} if($CFG{svn}{tags_path});
+ $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, @dirlist);
+ foreach(keys %$pkgdata) {
+ $pkgdata->{$_}{tags} = $tagdata->{$_} if($tagdata->{$_});
+ }
+ }
+ # Retain lock
+ my $complete = ! @dirlist;
+ $cdata = update_cache("svn", $pkgdata, "", $complete, 1, $revision);
+
+ my @pkglist = grep({ ref $cdata->{$_} and $cdata->{$_}{pkgname} }
+ keys(%$cdata));
+ my %pkglist;
+ foreach(@pkglist) {
+ $pkglist{$cdata->{$_}{pkgname}} = {
+ svndir => $_,
+ binaries => $cdata->{$_}{binaries}
+ };
+ }
+ update_cache("consolidated", \%pkglist, "pkglist", 1, 1);
+ my %svn;
+ foreach(keys(%$cdata)) {
+ next unless ref($cdata->{$_});
+ my $pkgname = $cdata->{$_}{pkgname} or next;
+ # Shallow copy, it's enough here, but can't be used for anything else
+ $svn{$pkgname} = { %{$cdata->{$_}} };
+ $svn{$pkgname}{dir} = $_;
+ delete $svn{$pkgname}{$_} foreach(
+ qw(watch pkgname text un_text long_descr bindata)
+ );
+ }
+ update_cache("consolidated", \%svn, "svn", 1, 0);
+ unlock_cache("svn");
+ return @changed;
+}
+sub svn_scantags {
+ my($force, $revision, $prepath, $postpath, @dirlist) = @_;
+
+ info("Scanning tags from SVN");
+ my $cdata = read_cache("svn", "", 0);
+ my %tags;
+ foreach my $dir (@dirlist) {
+ if(find_stamp($cdata, $dir) < $revision) {
+ debug("Retrieving tags for $dir");
+ my $pkghome = "$prepath/$dir$postpath";
+ my %tagdirs = %{$svn->ls($pkghome, 'HEAD', 0)};
+ my @tagdirs = sort( { deb_compare_nofail($a, $b) }
+ grep({ $tagdirs{$_}->kind() == $SVN::Node::dir } keys(%tagdirs))
+ );
+ $tags{$dir} = \@tagdirs;
+ }
+ }
+ return \%tags;
+}
+sub svn_scanpackages {
+ my($force, $revision, $prepath, $postpath, @dirlist) = @_;
+
my(%changed, %svn);
-
if($force) {
%changed = map({ $_ => 1 } @dirlist);
} else {
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
- }
-
# Stamps from cache
my %cache_vers = map({ $_ => find_stamp($cdata, $_) }
grep({ $cdata->{$_} } @dirlist));
@@ -90,11 +158,12 @@
foreach my $dir (grep({ $cache_vers{$_}
and $cache_vers{$_} < $revision } @dirlist)) {
$dir =~ s{^/*(.*?)/*$}{$1};
- my $pkghome = "$svnpath/$dir$svnpostpath";
+ my $pkghome = "$prepath/$dir$postpath";
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)$});
+ $changed{$dir} = 1 if(
+ m{/debian/(changelog|control|watch)$});
}
}) or $invalid{$dir} = 1;
}
@@ -110,7 +179,7 @@
my @changed = keys %changed;
foreach my $dir (@changed) {
$dir =~ s{^/*(.*?)/*$}{$1};
- my $debdir = "$svnpath/$dir$svnpostpath/debian";
+ my $debdir = "$prepath/$dir$postpath/debian";
$svn{$dir} = {};
info("Retrieving control information for $dir");
@@ -255,33 +324,7 @@
$svn{$dir}{mangled_un_ver} = $versions[-1];
}
}
- # Retain lock
- my $cdata = update_cache("svn", \%svn, "", $complete, 1, $revision);
-
- my @pkglist = grep({ ref $cdata->{$_} and $cdata->{$_}{pkgname} }
- keys(%$cdata));
- my %pkglist;
- foreach(@pkglist) {
- $pkglist{$cdata->{$_}{pkgname}} = {
- svndir => $_,
- binaries => $cdata->{$_}{binaries}
- };
- }
- update_cache("consolidated", \%pkglist, "pkglist", 1, 1);
- my %svn2;
- foreach(keys(%$cdata)) {
- next unless ref($cdata->{$_});
- my $pkgname = $cdata->{$_}{pkgname} or next;
- # Shallow copy, it's enough here, but can't be used for anything else
- $svn2{$pkgname} = { %{$cdata->{$_}} };
- $svn2{$pkgname}{dir} = $_;
- delete $svn2{$pkgname}{$_} foreach(
- qw(watch pkgname text un_text long_descr bindata)
- );
- }
- update_cache("consolidated", \%svn2, "svn", 1, 0);
- unlock_cache("svn");
- return @changed;
+ return(\%svn, @changed);
}
# Returns the hash of svn info. Doesn't download anything.
sub svn_get {
Modified: scripts/qa/debianqa.conf-sample
URL: http://svn.debian.org/wsvn/scripts/qa/debianqa.conf-sample?rev=14252&op=diff
==============================================================================
--- scripts/qa/debianqa.conf-sample (original)
+++ scripts/qa/debianqa.conf-sample Thu Feb 7 18:40:29 2008
@@ -17,7 +17,12 @@
repository = svn://svn.debian.org/svn/pkg-foo
packages_path = trunk
; path after the package name, should be the parent of the "debian/" directory
-; post_path = trunk
+;post_path = trunk
+track_tags = 1
+; path to the directory containing the tags
+tags_path = tags
+; same as post_path, for tags
+; tags_post_path = tags
[archive]
mirror = ftp://ftp.debian.org/debian
More information about the Pkg-perl-cvs-commits
mailing list