[svk-commit] r2265 - in branches/2.0-releng: lib/SVK t

[nobody at bestpractical.com]

Author: clkao
Date: Sun Dec 24 11:16:02 2006
New Revision: 2265

Modified:
   branches/2.0-releng/lib/SVK/Test.pm
   branches/2.0-releng/t/75hook.t
   branches/2.0-releng/t/mirror/sync-failed-hook.t

Log:
Install and test hooks portablity.

Modified: branches/2.0-releng/lib/SVK/Test.pm
==============================================================================
--- branches/2.0-releng/lib/SVK/Test.pm	(original)
+++ branches/2.0-releng/lib/SVK/Test.pm	Sun Dec 24 11:16:02 2006
@@ -71,7 +71,7 @@
 		 not_l uri set_editor replace_file glob_mime_samples
 		 create_mime_samples chmod_probably_useless
 
-		 catdir HAS_SVN_MIRROR IS_WIN32
+		 catdir HAS_SVN_MIRROR IS_WIN32 install_perl_hook
 
 		 rmtree mkpath @TOCLEAN $output $answer $show_prompt);
 
@@ -608,6 +608,22 @@
     return $^O eq 'MSWin32' || Cwd::cwd() =~ m!^/afs/!;
 }
 
+sub install_perl_hook {
+    my ($repospath, $hook, $content) = @_;
+    $hook = "$repospath/hooks/$hook".(IS_WIN32 ? '.bat' : '');
+    open my $fh, '>', $hook or die $!;
+    if (IS_WIN32) {
+        print $fh "\@rem = '--*-Perl-*--\n";
+        print $fh '@echo off'."\n$^X".' -x -S %0 %*'."\n";
+        print $fh 'if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul'."\n";
+	print $fh "goto endofperl\n\@rem ';\n";
+    }
+    print $fh "#!$^X\n" . $content;
+    print $fh "\n__END__\n:endofperl\n" if IS_WIN32;
+    chmod(0755, $hook);
+    warn $hook;
+}
+
 END {
     return unless $$ == $pid;
     unlink $_ for @unlink;

Modified: branches/2.0-releng/t/75hook.t
==============================================================================
--- branches/2.0-releng/t/75hook.t	(original)
+++ branches/2.0-releng/t/75hook.t	Sun Dec 24 11:16:02 2006
@@ -17,11 +17,7 @@
 
 # install pre-commit hook
 
-my $hook = "$srepospath/hooks/pre-commit".($^O eq 'MSWin32' ? '.bat' : '');
-open FH, '>', $hook or die "$hook: $!";
-print FH ($^O eq 'MSWin32' ? '@echo off' : "#!$^X") . "\nwarn \"foo\\n\";\nexit 1\n";
-close FH;
-chmod (0755, $hook);
+my $hook = install_perl_hook($srepospath, 'pre-commit', "warn \"foo\\n\";\nexit 1\n");
 
 my ($repospath, undef, $repos) = $xd->find_repos ('//', 1);
 
@@ -41,5 +37,4 @@
 	    qr"A repository hook failed: 'pre-commit' hook failed .* error output.*:",
 	    'foo', ''
 	   ]);
-
 1;

Modified: branches/2.0-releng/t/mirror/sync-failed-hook.t
==============================================================================
--- branches/2.0-releng/t/mirror/sync-failed-hook.t	(original)
+++ branches/2.0-releng/t/mirror/sync-failed-hook.t	Sun Dec 24 11:16:02 2006
@@ -29,16 +29,13 @@
 is_output($svk, 'sync', ['//m'],
 	  ["Syncing $uri"]);
 
+my $hook;
 {
-    open my $fh, '>', "$repospath/hooks/pre-commit" or die $!;
     local $/;
-    my $buf = <DATA>;
-    $buf =~ s|PERL|$^X|;
-    print $fh $buf;
+    $hook = install_perl_hook($repospath, 'pre-commit', <DATA>);
 }
-chmod 0755, "$repospath/hooks/pre-commit";
-
-skip "Can't run hooks", 1 unless -x "$repospath/hooks/pre-commit";
+SKIP: {
+skip "Can't run hooks", 1 unless -x $hook;
 
 $svk->mkdir('-m', 'A/X', '/test/A/X');
 is_output($svk, 'sync', ['//m'],
@@ -46,8 +43,7 @@
 	   'Retrieving log information from 2 to 2',
 	   qr"A repository hook failed: 'pre-commit' hook failed .* error output.*:",
 	   'hate']);
-
+}
 __DATA__
-#!PERL
 print STDERR "hate";
-exit -1;
+exit 1;