IPC::Cmd Udpate to 0.98

rurban · rurban · commit fb9f0ac87839 · 2017-05-17T02:11:12.000+02:00
Enhancements:
  Added wait_loop_callback for run_forked()

Bug fixes:
  Only search in curdir in can_run() when on Win32 RT#105601
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
@@ -869,7 +869,7 @@ package Maintainers;
     },
 
     'IPC::Cmd' => {
-        'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.96.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.98.tar.gz',
         'FILES'        => q[cpan/IPC-Cmd],
     },
 
diff --git a/cpan/IPC-Cmd/lib/IPC/Cmd.pm b/cpan/IPC-Cmd/lib/IPC/Cmd.pm
@@ -18,7 +18,7 @@ BEGIN {
                         $HAVE_MONOTONIC
                     ];
 
-    $VERSION        = '0.96';
+    $VERSION        = '0.98';
     $VERBOSE        = 0;
     $DEBUG          = 0;
     $WARN           = 1;
@@ -242,7 +242,7 @@ sub can_run {
     } else {
         for my $dir (
             File::Spec->path,
-            File::Spec->curdir
+            ( IS_WIN32 ? File::Spec->curdir : () )
         ) {
             next if ! $dir || ! -d $dir;
             my $abs = File::Spec->catfile( IS_WIN32 ? Win32::GetShortPathName( $dir ) : $dir, $command);
@@ -742,6 +742,29 @@ STDOUT from the executing program.
 Coderef of a subroutine to call when a portion of data is received on
 STDERR from the executing program.
 
+=item C<wait_loop_callback>
+
+Coderef of a subroutine to call inside of the main waiting loop
+(while C<run_forked> waits for the external to finish or fail).
+It is useful to stop running external process before it ends
+by itself, e.g.
+
+  my $r = run_forked("some external command", {
+	  'wait_loop_callback' => sub {
+          if (condition) {
+              kill(1, $$);
+          }
+	  },
+	  'terminate_on_signal' => 'HUP',
+	  });
+
+Combined with C<stdout_handler> and C<stderr_handler> allows terminating
+external command based on its output. Could also be used as a timer
+without engaging with L<alarm> (signals).
+
+Remember that this code could be called every millisecond (depending
+on the output which external command generates), so try to make it
+as lightweight as possible.
 
 =item C<discard_output>
 
@@ -1075,6 +1098,10 @@ sub run_forked {
           push @{$ready_fds}, $select->can_read(1/100) if $child_finished;
         }
 
+        if ($opts->{'wait_loop_callback'} && ref($opts->{'wait_loop_callback'}) eq 'CODE') {
+          $opts->{'wait_loop_callback'}->();
+        }
+
         Time::HiRes::usleep(1);
       }
 
diff --git a/cpan/IPC-Cmd/t/01_IPC-Cmd.t b/cpan/IPC-Cmd/t/01_IPC-Cmd.t
@@ -32,15 +32,15 @@ local $IPC::Cmd::DEBUG   = $Verbose;
 
 ### run tests in various configurations, based on what modules we have
 my @Prefs = ( );
-push @Prefs, [ $Have_IPC_Run, $Have_IPC_Open3 ] if $Have_IPC_Run;
+push @Prefs, [ $Have_IPC_Run, $Have_IPC_Open3 ] if $Have_IPC_Run; 
 
 ### run this config twice to ensure FD restores work properly
-push @Prefs, [ 0,             $Have_IPC_Open3 ],
+push @Prefs, [ 0,             $Have_IPC_Open3 ],     
              [ 0,             $Have_IPC_Open3 ] if $Have_IPC_Open3;
 
 ### run this config twice to ensure FD restores work properly
 ### these are the system() tests;
-push @Prefs, [ 0,             0 ],  [ 0,             0 ];
+push @Prefs, [ 0,             0 ],  [ 0,             0 ];     
 
 
 ### can_run tests
@@ -49,7 +49,7 @@ push @Prefs, [ 0,             0 ],  [ 0,             0 ];
     ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existent binary] );
 }
 
-{   ### list of commands and regexes matching output
+{   ### list of commands and regexes matching output 
     ### XXX use " everywhere when using literal strings as commands for
     ### portability, especially on win32
     my $map = [
@@ -61,7 +61,7 @@ push @Prefs, [ 0,             0 ],  [ 0,             0 ];
 
         ### pipes
         [ "$^X -eprint+424 | $^X -neprint+split+2",  qr/44/,            3, ],
-        [ [$^X,qw[-eprint+424 |], $^X, qw|-neprint+split+2|],
+        [ [$^X,qw[-eprint+424 |], $^X, qw|-neprint+split+2|], 
                                                      qr/44/,            3, ],
         ### whitespace
         [ [$^X, '-eprint+shift', q|a b a|],          qr/a b a/,         3, ],
@@ -80,16 +80,16 @@ push @Prefs, [ 0,             0 ],  [ 0,             0 ];
 
     ### extended test in developer mode
     ### test if gzip | tar works
-    if( $Verbose ) {
+    if( $Verbose ) {   
         my $gzip = can_run('gzip');
         my $tar  = can_run('tar');
-
+        
         if( $gzip and $tar ) {
             push @$map,
-                [ [$gzip, qw[-cdf src/x.tgz |], $tar, qw[-tf -]],
+                [ [$gzip, qw[-cdf src/x.tgz |], $tar, qw[-tf -]],     
                                                        qr/a/,           3, ];
         }
-    }
+    }        
 
     ### for each configuration
     for my $pref ( @Prefs ) {
@@ -109,27 +109,23 @@ push @Prefs, [ 0,             0 ],  [ 0,             0 ];
             $pp_cmd .= " (IPC::Run: $pref->[0] IPC::Open3: $pref->[1])";
 
             diag( "Running '$pp_cmd'") if $Verbose;
-            sleep(0.3) if $^O eq 'MSWin32';
-            sleep(2) if $ENV{APPVEYOR};
 
             ### in scalar mode
             {   my $buffer;
                 my $ok = run( command => $cmd, buffer => \$buffer );
 
                 ok( $ok,        "Ran '$pp_cmd' command successfully" );
-
+                
                 SKIP: {
-                    skip "No buffers available", 1
-                      unless $Class->can_capture_buffer;
-                    skip "Appveyor failure", 1
-                      if $^O eq 'MSWin32' and $ENV{APPVEYOR} and $buffer !~ $regex;
-
-                    like( $buffer, $regex,
+                    skip "No buffers available", 1 
+                                unless $Class->can_capture_buffer;
+                    
+                    like( $buffer, $regex,  
                                 "   Buffer matches $regex -- ($pp_cmd)" );
                 }
             }
-
-            ### in list mode
+                
+            ### in list mode                
             {   diag( "Running list mode" ) if $Verbose;
                 my @list = run( command => $cmd );
 
@@ -141,22 +137,17 @@ push @Prefs, [ 0,             0 ],  [ 0,             0 ];
                                 "   Output list has $list_length entries -- ($pp_cmd)" );
 
                 SKIP: {
-                    skip "No buffers available", 6
+                    skip "No buffers available", 6 
                                 unless $Class->can_capture_buffer;
-
+                    
                     ### the last 3 entries from the RV, are they array refs?
                     isa_ok( $list[$_], 'ARRAY' ) for 2..4;
-                    # flapping tests on Appveyor CI (~20%)
-                    if ($ENV{APPVEYOR} and "@{$list[2]}" !~ $regex) {
-                        ok(1, "SKIP empty pp_cmd APPVEYOR (too short sleep)");
-                        ok(1, "SKIP empty pp_cmd APPVEYOR");
-                    } else {
-                        like( "@{$list[2]}", $regex,
+
+                    like( "@{$list[2]}", $regex,
                                 "   Combined buffer matches $regex -- ($pp_cmd)" );
 
-                        like( "@{$list[$index]}", qr/$regex/,
-                          "   Proper buffer($index) matches $regex -- ($pp_cmd)" );
-                    }
+                    like( "@{$list[$index]}", qr/$regex/,
+                            "   Proper buffer($index) matches $regex -- ($pp_cmd)" );
                     is( scalar( @{$list[ $index==3 ? 4 : 3 ]} ), 0,
                                     "   Other buffer empty -- ($pp_cmd)" );
                 }
@@ -199,6 +190,7 @@ unless ( IPC::Cmd->can_use_run_forked ) {
   ok($out =~ m/err/, "stderr handled");
 }
 
+    
 __END__
 ### special call to check that output is interleaved properly
 {   my $cmd     = [$^X, File::Spec->catfile( qw[src output.pl] ) ];
@@ -223,10 +215,10 @@ __END__
                 is( "@{$list[2]}",'1 2 3 4',"   Combined output as expected" );
                 is( "@{$list[3]}", '1 3',   "   STDOUT as expected" );
                 is( "@{$list[4]}", '2 4',   "   STDERR as expected" );
-
+            
             }
         }
-    }
+    }        
 }
 
 
@@ -244,7 +236,7 @@ __END__
         ok( !$ok,               "Non-zero exit caught" );
         ok( $err,               "   Error '$err'" );
     }
-}
+}   
 
 ### timeout tests
 {   my $timeout = 1;
@@ -262,5 +254,5 @@ __END__
         ok( not(ref($err)),     "   Error string is not a reference" );
         like( $err,qr/^$AClass/,"   Error '$err' mentions $AClass" );
     }
-}
+}    
 
diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm
@@ -14909,6 +14909,7 @@ our %delta = (
             'Devel::PPPort'         => '3.35_03',
             'Encode'                => '2.89',
             'ExtUtils::Install'     => '2.08',
+            'IPC::Cmd'              => '0.98',
             'File::Spec'            => '4.68c',
             'File::Spec::Unix'      => '4.68c',
             'File::Spec::Win32'     => '4.68c',
diff --git a/pod/perlcdelta.pod b/pod/perlcdelta.pod
@@ -136,6 +136,14 @@ Optimisations:
 
 Keep our make -s support  
 
+=item L<IPC::Cmd> 0.98
+
+Enhancements:
+  Added wait_loop_callback for run_forked()
+
+Bug fixes:
+  Only search in curdir in can_run() when on Win32 RT#105601
+
 =item PathTools 4.68c
 
 getcwd, getdcwd and abs_path have now long path support.
diff --git a/t/porting/customized.dat b/t/porting/customized.dat
@@ -92,7 +92,7 @@ Math::BigInt cpan/Math-BigInt/t/sub_mif.t e87738bd15116665c38d9f41b310cfe7fbf6da
 Math::BigInt cpan/Math-BigInt/t/upgrade.t 7c15cac7f321ca396648ec45da6389a1283e1546
 Math::BigInt cpan/Math-BigInt/t/upgradef.t 06610e9883ce805bcd6543ab959a9826f598eb40
 Math::BigInt cpan/Math-BigInt/t/with_sub.t c040328e223df6f56250f5d67dcb2c9a2f23c110
-Module::CoreList dist/Module-CoreList/lib/Module/CoreList.pm a29fba440c06e6458a8148447261a841db974849
+Module::CoreList dist/Module-CoreList/lib/Module/CoreList.pm 36b3825354d771b949bb764f9ee94c8b04e6d896
 Module::CoreList dist/Module-CoreList/lib/Module/CoreList/Utils.pm 988e528336a48333ff9a28fe1197a56a640e3792
 Module::Metadata cpan/Module-Metadata/t/lib/GeneratePackage.pm 502ffbe2609947430e6aa1a3df8064b3fef3e086
 Net::Domain cpan/libnet/lib/Net/Cmd.pm 70a007c38833667ad47ea8059c37c1b7d1c77b6c
