[Bps-public-commit] r9032 - in SVN-Hook: lib/SVN/Hook t

[clkao at bestpractical.com]

Author: clkao
Date: Thu Sep 13 09:05:00 2007
New Revision: 9032

Added:
   SVN-Hook/lib/SVN/Hook/Redispatch.pm
   SVN-Hook/t/02partial.t
Modified:
   SVN-Hook/lib/SVN/Hook.pm

Log:
library and tests for a redispatch hook.

Modified: SVN-Hook/lib/SVN/Hook.pm
==============================================================================
--- SVN-Hook/lib/SVN/Hook.pm	(original)
+++ SVN-Hook/lib/SVN/Hook.pm	Thu Sep 13 09:05:00 2007
@@ -59,20 +59,25 @@
 sub init {
     my ($self, $hook) = @_;
     my $path = $self->hook_path($hook);
-    die if -e $path;
-    open my $fh, '>', $path or die $!;
-    my $perl = _this_perl();
-    print $fh <<"EOF";
-#!$perl
+    die "There is already $hook file.\n" if -e $path;
+
+    $self->_install_perl_hook( $path, <<"EOF");
 # DO NOT EDIT. generated by svnhook version $VERSION.
 use SVN::Hook::CLI; SVN::Hook::CLI->_run("$hook", \@ARGV);
 EOF
 
-    close $fh;
-    chmod 0755, $path or die $!;
     mkdir catfile($self->repospath, 'hooks', "_$hook") or die $!;
 }
 
+sub _install_perl_hook {
+    my ($self, $hook_file, $perl_code) = @_;
+    my $perl = _this_perl();
+    open my $fh, '>', $hook_file or die "$hook_file: $!";
+    print $fh "#!$perl\n$perl_code";
+    close $fh;
+    chmod 0755, $hook_file or die $!;
+}
+
 sub scripts {
     my ( $self, $hook ) = @_;
     SVN::Hook::Script->load_from_dir($self->hook_path("_$hook"));

Added: SVN-Hook/lib/SVN/Hook/Redispatch.pm
==============================================================================
--- (empty file)
+++ SVN-Hook/lib/SVN/Hook/Redispatch.pm	Thu Sep 13 09:05:00 2007
@@ -0,0 +1,62 @@
+package SVN::Hook::Redispatch;
+use strict;
+use Data::Dumper;
+use Path::Class;
+use SVN::Hook;
+
+sub import {
+    my $class = shift;
+    my $spec  = shift;
+
+    my $hook_base = Path::Class::File->new($0)->parent;
+
+    my $type;
+    my $svnlook_arg;
+    if ($hook_base =~ m/pre-commit$/) {
+	$type = 'pre-commit';
+	$svnlook_arg = "-t $_[1]";
+    }
+    elsif ($hook_base =~ m/post-commit$/) {
+	$type = 'post-commit';
+	$svnlook_arg = "-r $_[1]";
+    }
+    else {
+	die "not yet";
+    }
+
+    my $toplevel = $class->find_toplevel_change($_[0], $svnlook_arg);
+
+    for (map { Path::Class::Dir->new_foreign('Unix', $_) } sort keys %$spec) {
+	next unless $_ eq $toplevel || $_->subsumes($toplevel);
+	my @scripts = SVN::Hook::Script->load_from_dir
+	    ( $hook_base.'/'.$spec->{$_} );
+	SVN::Hook->run_scripts( \@scripts );
+    }
+
+};
+
+sub find_toplevel_change {
+    my $class = shift;
+    my $repos = shift;
+    my $arg   = shift;
+
+    my $svnlook = '/usr/local/bin/svnlook';
+    open my $fh, '-|', "$svnlook dirs-changed $arg $repos"
+	or die "Unable to run svnlook: $!";
+    my $toplevel;
+    while (<$fh>) {
+	chomp;
+	if (!$toplevel) {
+	    $toplevel = Path::Class::Dir->new_foreign('Unix', $_);
+	}
+	else {
+	    while (!$toplevel->subsumes($_)) {
+		$toplevel = $toplevel->parent;
+	    }
+
+	}
+    }
+    return $toplevel;
+}
+
+1;

Added: SVN-Hook/t/02partial.t
==============================================================================
--- (empty file)
+++ SVN-Hook/t/02partial.t	Thu Sep 13 09:05:00 2007
@@ -0,0 +1,50 @@
+#!/usr/bin/perl -w
+
+use Test::More; 
+eval { use SVK::Test; 1 }
+    or plan skip_all => 'requires SVK for testing.';
+
+plan tests => 4;
+use_ok('SVN::Hook');
+use File::Temp 'tempdir';
+use File::Path 'mkpath';
+
+my ($xd, $svk) = build_test();
+our $output;
+my ($repospath, $path, $repos) = $xd->find_repos ('//', 1);
+
+my $hook = SVN::Hook->new({repospath => $repospath});
+
+$hook->init($_) for SVN::Hook->ALL_HOOKS;
+
+my $tmpdir = tempdir( CLEANUP => 1 );
+
+SVN::Hook->_install_perl_hook($hook->hook_path('_pre-commit/partial'), <<"EOF");
+use SVN::Hook::Redispatch {
+  foo => 'foo_scripts',
+  'foo/bar' => 'foobar_scripts',
+  bar => 'bar_scripts',
+}, \@ARGV;
+exit 0;
+EOF
+
+SVN::Hook->_install_perl_hook($hook->hook_path('_pre-commit/00worky_log'), <<"EOF");
+open my \$fh, '>>', "$tmpdir/worky";
+print \$fh "this is worky \$ARGV[1]\\n";
+EOF
+
+mkpath [$hook->hook_path('_pre-commit/foo_scripts')];
+SVN::Hook->_install_perl_hook($hook->hook_path('_pre-commit/foo_scripts/die'), <<"EOF");
+die "this is foo die";
+EOF
+
+is_output($svk, 'mkdir', [-m => 'foo', '//foo'],
+	  [qr'Committed']);
+
+is_output($svk, 'mkdir', [-m => 'foo', '//foo/shouldtrigger'],
+	  [qr'A repository hook failed.*',
+	   qr'this is foo die', '']);
+
+is_file_content("$tmpdir/worky", 'this is worky 0-1
+this is worky 1-1
+');