r44075 - in /scripts/KGB: Makefile script/kgb-client
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Sun Sep 13 20:43:25 UTC 2009
Author: dmn
Date: Sun Sep 13 20:43:21 2009
New Revision: 44075
URL: http://svn.debian.org/wsvn/?sc=1&rev=44075
Log:
convert kgb-client to modular implementation
Modified:
scripts/KGB/Makefile
scripts/KGB/script/kgb-client
Modified: scripts/KGB/Makefile
URL: http://svn.debian.org/wsvn/scripts/KGB/Makefile?rev=44075&op=diff
==============================================================================
--- scripts/KGB/Makefile (original)
+++ scripts/KGB/Makefile Sun Sep 13 20:43:21 2009
@@ -20,5 +20,5 @@
test:
$(PERL) -c script/kgb-bot
- $(PERL) -c script/kgb-client
+ $(PERL) -Ilib -c script/kgb-client
sh -n script/post-commit
Modified: scripts/KGB/script/kgb-client
URL: http://svn.debian.org/wsvn/scripts/KGB/script/kgb-client?rev=44075&op=diff
==============================================================================
--- scripts/KGB/script/kgb-client (original)
+++ scripts/KGB/script/kgb-client Sun Sep 13 20:43:21 2009
@@ -48,7 +48,7 @@
B<kgb-client> is the client counterpart of L<kgb-bot(1)>. Intented usage is as
a post-commit hook in your version control system. It analyzes the commit(s)
and then relays the information about the repository, branch, author, modified
-filed and change log to the KGB server, who will show it on IRC.
+files and change log to the KGB server, whch will show it on IRC.
=head1 CONFIGURATION
@@ -161,11 +161,9 @@
=cut
-use Digest::SHA1 qw(sha1_hex);
-use SOAP::Lite;
+use App::KGB::Client::ServerRef;
use Getopt::Long;
use YAML ();
-use List::Util ();
my( $conf_file, $uri, $proxy, $repo_id, $password, $timeout,
$repo_type, @br_mod_re, $br_mod_re_swap, $ignore_branch, @servers,
@@ -185,10 +183,6 @@
'repository'=> \$repo_type,
) or exit 1;
-$repo_type||= 'svn';
-
-my($path, $rev) = @ARGV;
-
if( $conf_file )
{
my $conf = YAML::LoadFile($conf_file)
@@ -197,198 +191,63 @@
$uri ||= $conf->{uri};
$proxy ||= $conf->{proxy};
$repo_id ||= $conf->{'repo-id'};
- $password ||= $conf->{'password'};
- $timeout ||= $conf->{'timeout'};
+ $password ||= $conf->{password};
+ $timeout ||= $conf->{timeout};
@br_mod_re = @{ $conf->{'branch-and-module-re'} }
if !@br_mod_re and $conf->{'branch-and-module-re'};
$br_mod_re_swap //= $conf->{'branch-and-module-re-swap'};
$ignore_branch //= $conf->{'ignore-branch'};
- @servers = @{ $conf->{servers} } if $conf->{servers};
+ @servers = map {
+ App::KGB::Client::ServerRef->new(
+ { password => $password,
+ timeout => $timeout,
+ %$_
+ }
+ )
+ } @{ $conf->{servers} }
+ if $conf->{servers};
}
-push @servers, {
- uri => $uri,
- password => $password,
- timeout => $timeout,
-} if $uri;
+push @servers,
+ App::KGB::Client::ServerRef->new(
+ { uri => $uri,
+ password => $password,
+ timeout => $timeout,
+ }
+ ) if $uri;
die "no servers difined. use 'uri' or 'servers' configuration options\n"
-unless @servers;
-
-for(@servers) {
- $_->{password} = $password unless defined $_->{password};
- $_->{timeout} ||= $timeout || 15;
- $_->{proxy} ||= $_->{uri}."?session=KGB";
+ unless @servers;
+
+die "repo-id not given\n" unless $repo_id;
+
+my @client_args = (
+ repo_id => $repo_id,
+ servers => \@servers,
+ br_mod_re => \@br_mod_re,
+ br_mod_re_swap => $br_mod_re_swap,
+ ignore_branch => $ignore_branch,
+);
+
+$repo_type||= 'svn';
+
+if ( $repo_type eq 'svn' ) {
+ my($path, $rev) = @ARGV;
+ die "Repository path and revision must be given as arguments\n"
+ unless $path and $rev;
+
+ require App::KGB::Client::Subversion;
+ my $client = App::KGB::Client::Subversion->new(
+ { @client_args,
+ repo_path => $path,
+ revision => $rev,
+ }
+ );
+
+ $client->process();
}
-die "repo-id not given\n" unless $repo_id;
-
-die "Repository path and revision must be given as arguments\n"
- unless $path and $rev;
-
-my( $author, $log, @changed );
-if( $repo_type eq 'svn' ) {
- require SVN::Fs;
- require SVN::Repos;
- require SVN::Core;
-
- # Shut up the perl compiler warnings
- if($SVN::Fs::PathChange::modify and $SVN::Fs::PathChange::add and
- $SVN::Fs::PathChange::delete) {
- }
-
- my $repo = SVN::Repos::open($path);
- my $fs = $repo->fs or die $!;
-
- $rev ||= $fs->youngest_rev;
- $log = $fs->revision_prop($rev, "svn:log");
- $author = $fs->revision_prop($rev, "svn:author");
-
- my $root = $fs->revision_root($rev);
- my $changed = $root->paths_changed();
- foreach(keys %$changed) {
- my $k = $changed->{$_}->change_kind();
- if($k == $SVN::Fs::PathChange::modify) {
- $k = "M";
- } elsif($k == $SVN::Fs::PathChange::add) {
- $k = "A";
- } elsif($k == $SVN::Fs::PathChange::delete) {
- $k = "D";
- }
- my $pm = $changed->{$_}->prop_mod() ? "+" : "";
- push @changed, {
- action => $k,
- prop_change => $pm,
- path => $_,
- };
- }
-} else {
- die "Repository type '$repo_type' not supported\n";
+else {
+ die "Repository type '$repo_type' not supported\n";
}
-my ( $branch, $module, $matched_re );
-if (@br_mod_re) {
- require Safe;
- my $safe = Safe->new;
- $safe->permit_only(qw(padany lineseq match const leaveeval
- rv2sv pushmark list warn));
-
- # for a successful branch/module extraction, we require that all the
- # changes share the same branch/module
- for my $c(@changed) {
- my ( $change_branch, $change_module );
-
- for my $re (@br_mod_re) {
- $re =~ s{,}{\\,}g; # escape commas
- my $matching = "m,$re,; "
- . ( $br_mod_re_swap ? '($2,$1)' : '($1,$2)' );
-
- $_ = $c->{path};
- ( $change_branch, $change_module ) = $safe->reval($matching);
- die "Error while evaluating `$re': $@" if $@;
-
- if ( defined($change_branch) and defined($change_module) ) {
- $matched_re = $re;
- last;
- }
- }
-
- # some change cannot be tied to a branch and a module?
- if ( !defined( $change_branch // $change_module ) ) {
- $branch = $module = $matched_re = undef;
- last;
- }
-
- if ( defined($branch) ) {
- # this change is for a different branch/module?
- if ( $branch ne $change_branch or $module ne $change_module ) {
- $branch = $module = undef;
- last;
- }
- }
- else {
- # first change, store branch and module
- $branch = $change_branch;
- $module = $change_module;
- }
- }
-
- # remove the part that have matched as it contains information about the
- # branch and module that we provide otherwise
- if ($matched_re) {
- #warn "Branch: ".($branch||"NONE");
- #warn "Module: ".($module||"NONE");
- $safe->permit(qw(subst));
- for my $c(@changed) {
- #warn "FROM ".$c->{path};
- $_ = $c->{path};
- $safe->reval("s,.*$matched_re,,");
- die "Eror while evaluating s/.*$matched_re//: $@" if $@;
- $c->{path} = $_;
- #warn " TO $_";
- }
- }
-
- $branch = undef
- if $branch and $ignore_branch and $branch eq $ignore_branch;
-}
-#utf8::encode($author);
-#utf8::encode($log);
-#utf8::encode($_) foreach(@changed);
-
-sub change2text {
- my $c = shift;
- my $a = $c->{action};
- my $pc = $c->{prop_change};
- my $p = $c->{path};
-
- my $text = '';
- # ignore flags for modifications (unlless there is also a property change)
- $text = "($a$pc)" if $a ne 'M' or $pc;
- $p =~ s,^/,,; # strip leading slash from paths
- $text .= $p;
- return $text;
-}
-
-#warn( change2text($_), "\n" ) for @changed;
-
- at servers = List::Util::shuffle(@servers);
-
-# try all servers in turn until someone succeeds
-for my $srv (@servers) {
-
- my $failure = 0;
- my $s = SOAP::Lite->new(uri => $srv->{uri}, proxy => $srv->{proxy});
- $s->transport->proxy->timeout($srv->{timeout}) if $srv->{timeout};
-
- # v1 protocol
- my $checksum = sha1_hex($repo_id, $rev, map( change2text($_), @changed ),
- $log, $author, $branch // (), $module // (), $srv->{password});
-
- my $res = $s->commit([1,
- $repo_id, $checksum, SOAP::Data->type(int => $rev),
- [ map( SOAP::Data->type( string => change2text($_) ),
- @changed ) ],
- SOAP::Data->type(string => $log),
- SOAP::Data->type(string => $author),
- SOAP::Data->type( string => $branch),
- SOAP::Data->type( string => $module),
- ]);
-
- if( $res->fault ) {
- warn 'SOAP FAULT while talking to '.$srv->{uri}."\n";
- warn 'FAULT MESSAGE: ', $res->fault->{faultstring}, "\n";
- warn 'FAULT DETAILS: ', $res->fault->{detail}, "\n" if $res->fault->{detail};
- $failure = 1;
- }
-
- #my $res = $s->commit([
- # $repo_id, $password, SOAP::Data->type(int => $rev),
- # [ map({SOAP::Data->type(string => $_)} @changed) ],
- # SOAP::Data->type(string => $log),
- # SOAP::Data->type(string => $author)]);
-
- #print $res->result(), "\n";
-
- last unless $failure;
-}
More information about the Pkg-perl-cvs-commits
mailing list