[svk-commit] r2638 - in trunk: lib/SVK lib/SVK/Command lib/SVK/Help

[nobody at bestpractical.com]

Author: jesse
Date: Sun Dec 16 20:28:13 2007
New Revision: 2638

Modified:
   trunk/   (props changed)
   trunk/lib/SVK/Command.pm
   trunk/lib/SVK/Command/Copy.pm
   trunk/lib/SVK/Help/Environment.pod
   trunk/lib/SVK/Util.pm

Log:
 r73235 at pinglin:  jesse | 2007-12-16 20:28:02 -0500
 * First implementation of an SVKBATCHMODE environemt variable


Modified: trunk/lib/SVK/Command.pm
==============================================================================
--- trunk/lib/SVK/Command.pm	(original)
+++ trunk/lib/SVK/Command.pm	Sun Dec 16 20:28:13 2007
@@ -1033,6 +1033,10 @@
 		      );
     }
     else {
+        if ($ENV{'SVKBATCHMODE'}) {
+            die(loc("This command needs to be run interactively\n"));
+        }
+
 	$prompt = loc ("Enter a depot path to %1 into (under // if no leading '/'): ",
 		       loc($action));
     }

Modified: trunk/lib/SVK/Command/Copy.pm
==============================================================================
--- trunk/lib/SVK/Command/Copy.pm	(original)
+++ trunk/lib/SVK/Command/Copy.pm	Sun Dec 16 20:28:13 2007
@@ -52,7 +52,7 @@
 use strict;
 use SVK::Version;  our $VERSION = $SVK::VERSION;
 use base qw( SVK::Command::Mkdir );
-use SVK::Util qw( get_anchor get_prompt abs2rel splitdir is_uri make_path is_path_inside);
+use SVK::Util qw( get_anchor abs2rel splitdir is_uri make_path is_path_inside);
 use SVK::I18N;
 use SVK::Logger;
 

Modified: trunk/lib/SVK/Help/Environment.pod
==============================================================================
--- trunk/lib/SVK/Help/Environment.pod	(original)
+++ trunk/lib/SVK/Help/Environment.pod	Sun Dec 16 20:28:13 2007
@@ -140,6 +140,12 @@
 C<svk log> command.  The value of this variable can be anything that you can
 pass to C<svk log>'s C<--output> option.
 
+=item SVKBATCHMODE
+
+When you set this variable to a true value, SVK should never prompt the user for an 
+interactive response. 
+
+
 =item $SVKPGP
 
 svk supports signing and verifying changesets using the Gnu Privacy Guard.

Modified: trunk/lib/SVK/Util.pm
==============================================================================
--- trunk/lib/SVK/Util.pm	(original)
+++ trunk/lib/SVK/Util.pm	Sun Dec 16 20:28:13 2007
@@ -173,6 +173,8 @@
 sub get_prompt { {
     my ($prompt, $pattern) = @_;
 
+    return '' if ($ENV{'SVKBATCHMODE'});
+
     local $| = 1;
     print $prompt;
 
@@ -266,70 +268,76 @@
 =cut
 
 sub get_buffer_from_editor {
-    my ($what, $sep, $content, $file, $anchor, $targets_ref) = @_;
+    my ( $what, $sep, $content, $file, $anchor, $targets_ref ) = @_;
     my $fh;
-    if (defined $content) {
-	($fh, $file) = tmpfile ($file, TEXT => 1, UNLINK => 0);
-	print $fh $content;
-	close $fh;
-    }
-    else {
-	open $fh, $file or die $!;
-	local $/;
-	$content = <$fh>;
-    close $fh;
+    if ( defined $content ) {
+        ( $fh, $file ) = tmpfile( $file, TEXT => 1, UNLINK => 0 );
+        print $fh $content;
+        close $fh;
+    } else {
+        open $fh, $file or die $!;
+        local $/;
+        $content = <$fh>;
+        close $fh;
     }
 
     my $time = time;
 
-    while (1) {
+    while (!$ENV{'SVKBATCHMODE'} && 1) {
         open my $fh, '<', $file or die $!;
         my $md5 = md5_fh($fh);
         close $fh;
 
-	edit_file ($file);
+        edit_file($file);
 
         open $fh, '<', $file or die $!;
-        last if ($md5 ne md5_fh($fh));
+        last if ( $md5 ne md5_fh($fh) );
         close $fh;
 
-	my $ans = get_prompt(
-	    loc("%1 not modified: a)bort, e)dit, c)ommit?", ucfirst($what)),
-	    qr/^[aec]/,
-	);
-	last if $ans =~ /^c/;
-	# XXX: save the file somewhere
-	unlink ($file), die loc("Aborted.\n") if $ans =~ /^a/;
+        my $ans = get_prompt(
+            loc( "%1 not modified: a)bort, e)dit, c)ommit?", ucfirst($what) ),
+            qr/^[aec]/,
+        );
+        last if $ans =~ /^c/;
+
+        # XXX: save the file somewhere
+        unlink($file), die loc("Aborted.\n") if $ans =~ /^a/;
     }
 
     open $fh, $file or die $!;
     local $/;
-    my @ret = defined $sep ? split (/\n\Q$sep\E\n/, <$fh>, 2) : (<$fh>);
+    my @ret = defined $sep ? split( /\n\Q$sep\E\n/, <$fh>, 2 ) : (<$fh>);
     close $fh;
     unlink $file;
 
     die loc("Cannot find separator; aborted.\n")
-        if defined($sep) and !defined($ret[1]);
+        if defined($sep)
+            and !defined( $ret[1] );
 
     return $ret[0] unless wantarray;
 
     # Compare targets in commit message
-    my $old_targets = (split (/\n\Q$sep\E\n/, $content, 2))[1];
-    $old_targets =~ s/^\?.*//mg; # remove unversioned files
+    my $old_targets = ( split( /\n\Q$sep\E\n/, $content, 2 ) )[1];
+    $old_targets =~ s/^\?.*//mg;    # remove unversioned files
 
-    my @new_targets =
-               map {
-                   s/^\s+//; # proponly change will have leading spacs
-			       [split(/[\s\+]+/, $_, 2)]}
-               grep {!/^\?/m} # remove unversioned fils
-               grep {/\S/}
-               split(/\n+/, $ret[1]);
-
-    if ($old_targets ne $ret[1]) {
-        # Assign new targets 
-	@$targets_ref = map abs2rel($_->[1], $anchor, undef, '/'), @new_targets;
+    my @new_targets
+        = map {
+        s/^\s+//;                   # proponly change will have leading spacs
+        [ split( /[\s\+]+/, $_, 2 ) ]
+        }
+        grep {
+        !/^\?/m
+        }    # remove unversioned fils
+        grep {/\S/}
+        split( /\n+/, $ret[1] );
+
+    if ( $old_targets ne $ret[1] ) {
+
+        # Assign new targets
+        @$targets_ref = map abs2rel( $_->[1], $anchor, undef, '/' ),
+            @new_targets;
     }
-    return ($ret[0], \@new_targets);
+    return ( $ret[0], \@new_targets );
 }
 
 =head3 get_encoding