r77808 - in /trunk/libproc-simple-perl: Changes MANIFEST MANIFEST.SKIP META.yml README Simple.pm debian/changelog t/bin/ t/destroy.t t/esub.t t/exit.t t/muarg.t t/mult.t t/sh-c.t t/simple.t t/stdouterr.t

carnil at users.alioth.debian.org carnil at users.alioth.debian.org
Sun Jul 24 19:17:16 UTC 2011


Author: carnil
Date: Sun Jul 24 19:17:14 2011
New Revision: 77808

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=77808
Log:
New upstream release

Added:
    trunk/libproc-simple-perl/t/bin/
      - copied from r77807, branches/upstream/libproc-simple-perl/current/t/bin/
    trunk/libproc-simple-perl/t/sh-c.t
      - copied unchanged from r77807, branches/upstream/libproc-simple-perl/current/t/sh-c.t
Modified:
    trunk/libproc-simple-perl/Changes
    trunk/libproc-simple-perl/MANIFEST
    trunk/libproc-simple-perl/MANIFEST.SKIP
    trunk/libproc-simple-perl/META.yml
    trunk/libproc-simple-perl/README
    trunk/libproc-simple-perl/Simple.pm
    trunk/libproc-simple-perl/debian/changelog
    trunk/libproc-simple-perl/t/destroy.t
    trunk/libproc-simple-perl/t/esub.t
    trunk/libproc-simple-perl/t/exit.t
    trunk/libproc-simple-perl/t/muarg.t
    trunk/libproc-simple-perl/t/mult.t
    trunk/libproc-simple-perl/t/simple.t
    trunk/libproc-simple-perl/t/stdouterr.t

Modified: trunk/libproc-simple-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/Changes?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/Changes (original)
+++ trunk/libproc-simple-perl/Changes Sun Jul 24 19:17:14 2011
@@ -2,6 +2,10 @@
     Proc::Simple CHANGES
 ######################################################################
 
+          From 1.28:
+                     [RT 69103] Typo fix by Salvatore Bonaccorso
+                     Added support for processes called via 'sh -c' by
+                     system() (see "Shell Processes" note in the manpage).
           From 1.27:
                      [RT 62802] Pod fix by Salvatore Bonaccorso
                      [RT 63833] Applied patch to stop reaping PIDs of 

Modified: trunk/libproc-simple-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/MANIFEST?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/MANIFEST (original)
+++ trunk/libproc-simple-perl/MANIFEST Sun Jul 24 19:17:14 2011
@@ -7,11 +7,13 @@
 META.yml			Module meta-data (added by MakeMaker)
 README
 Simple.pm
+t/bin/test-prog
 t/destroy.t
 t/esub.t
 t/exit.t
 t/muarg.t
 t/mult.t
+t/sh-c.t
 t/simple.t
 t/stdouterr.t
 t/time.t

Modified: trunk/libproc-simple-perl/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/MANIFEST.SKIP?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/MANIFEST.SKIP (original)
+++ trunk/libproc-simple-perl/MANIFEST.SKIP Sun Jul 24 19:17:14 2011
@@ -1,3 +1,4 @@
+.gz
 .git
 blib
 ^Makefile$

Modified: trunk/libproc-simple-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/META.yml?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/META.yml (original)
+++ trunk/libproc-simple-perl/META.yml Sun Jul 24 19:17:14 2011
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Proc-Simple
-version:            1.28
+version:            1.29
 abstract:           ~
 author:  []
 license:            unknown

Modified: trunk/libproc-simple-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/README?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/README (original)
+++ trunk/libproc-simple-perl/README Sun Jul 24 19:17:14 2011
@@ -1,5 +1,5 @@
 ######################################################################
-    Proc::Simple 1.28
+    Proc::Simple 1.29
 ######################################################################
 
 NAME
@@ -196,9 +196,8 @@
           $proc->signal_on_destroy("KILL");
 
     redirect_output
-        This allows to redirect the stdout and/or stderr output to a file.
-        Specify undef to leave the stderr/stdout handles of the process
-        alone.
+        Redirects stdout and/or stderr output to a file. Specify undef to
+        leave the stderr/stdout handles of the process alone.
 
           # stdout to a file, left stderr unchanged
           $proc->redirect_output ("/tmp/someapp.stdout", undef);
@@ -260,6 +259,26 @@
     that avoid the shutdown. If in doubt, whether a process still exists,
     check it repeatedly with the *poll* routine after sending the signal.
 
+Shell Processes
+    If you pass a shell program to Proc::Simple, it'll use "exec()" to
+    launch it. As noted in Perl's "exec()" manpage, simple commands for the
+    one-argument version of "exec()" will be passed to "execvp()" directly,
+    while commands containing characters like ";" or "*" will be passed to a
+    shell to make sure those get the shell expansion treatment.
+
+    This has the interesting side effect that if you launch something like
+
+        $p->start("./womper *");
+
+    then you'll see two processes in your process list:
+
+        $ ps auxww | grep womper
+        mschilli  9126 11:21 0:00 sh -c ./womper *
+        mschilli  9127 11:21 0:00 /usr/local/bin/perl -w ./womper ...
+
+    and Proc::Simple's "kill()" method will only kill the first one (pid
+    9126).
+
 Contributors
     Tim Jenness <t.jenness at jach.hawaii.edu> did
     kill_on_destroy/signal_on_destroy/pid

Modified: trunk/libproc-simple-perl/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/Simple.pm?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/Simple.pm (original)
+++ trunk/libproc-simple-perl/Simple.pm Sun Jul 24 19:17:14 2011
@@ -112,12 +112,13 @@
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXIT_STATUS %INTERVAL
             %DESTROYED);
 
+use POSIX;
 use IO::Handle;
 require Exporter;
 
 @ISA     = qw(Exporter AutoLoader);
 @EXPORT  = qw( );
-$VERSION = '1.28';
+$VERSION = '1.29';
 
 ######################################################################
 # Globals: Debug and the mysterious waitpid nohang constant.
@@ -254,6 +255,10 @@
         open(STDOUT, ">$self->{'redirect_stdout'}") ;
         autoflush STDOUT 1 ;
       }
+
+        # Mark it as process group leader, so that we can kill
+        # the process group later.
+      POSIX::setsid();
 
       if(ref($func) eq "CODE") {
         $func->(@params); exit 0;            # Start perl subroutine
@@ -339,16 +344,27 @@
   my $sig  = shift;
 
   # If no signal specified => SIGTERM-Signal
-  $sig = "SIGTERM" unless defined $sig;
+  $sig = POSIX::SIGTERM() unless defined $sig;
+
+  # Use numeric signal if we get a string 
+  if( $sig !~ /^[-\d]+$/ ) {
+      $sig =~ s/^SIG//g;
+      $sig = eval "POSIX::SIG${sig}()";
+  }
 
   # Process initialized at all?
   return 0 if !defined $self->{'pid'};
 
+  # kill process group instead of process to make sure that shell
+  # processes containing shell characters, which get launched via
+  # "sh -c" are killed along with their launching shells.
+  $sig = -$sig;
+
   # Send signal
   if(kill($sig, $self->{'pid'})) {
-      $self->dprt("KILL($self->{'pid'}) OK");
+      $self->dprt("KILL($sig, $self->{'pid'}) OK");
   } else {
-      $self->dprt("KILL($self->{'pid'}) failed");
+      $self->dprt("KILL($sig, $self->{'pid'}) failed");
       return 0;
   }
 
@@ -406,7 +422,7 @@
 
 =item redirect_output
 
-This allows to redirect the stdout and/or stderr output to a file.
+Redirects stdout and/or stderr output to a file.
 Specify undef to leave the stderr/stdout handles of the process alone.
 
   # stdout to a file, left stderr unchanged
@@ -748,6 +764,28 @@
 If in doubt, whether a process still exists, check it
 repeatedly with the I<poll> routine after sending the signal.
 
+=head1 Shell Processes
+
+If you pass a shell program to Proc::Simple, it'll use C<exec()> to 
+launch it. As noted in Perl's C<exec()> manpage, simple commands for
+the one-argument version of C<exec()> will be passed to 
+C<execvp()> directly, while commands containing characters
+like C<;> or C<*> will be passed to a shell to make sure those get
+the shell expansion treatment.
+
+This has the interesting side effect that if you launch something like
+
+    $p->start("./womper *");
+
+then you'll see two processes in your process list:
+
+    $ ps auxww | grep womper
+    mschilli  9126 11:21 0:00 sh -c ./womper *
+    mschilli  9127 11:21 0:00 /usr/local/bin/perl -w ./womper ...
+
+and Proc::Simple's C<kill()> method will only kill the first one
+(pid 9126).
+
 =head1 Contributors
 
 Tim Jenness  <t.jenness at jach.hawaii.edu>

Modified: trunk/libproc-simple-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/debian/changelog?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/debian/changelog (original)
+++ trunk/libproc-simple-perl/debian/changelog Sun Jul 24 19:17:14 2011
@@ -1,3 +1,9 @@
+libproc-simple-perl (1.29-1) UNRELEASED; urgency=low
+
+  * New upstream release
+
+ -- Salvatore Bonaccorso <carnil at debian.org>  Sun, 24 Jul 2011 21:16:47 +0200
+
 libproc-simple-perl (1.28-1) unstable; urgency=low
 
   * New upstream release

Modified: trunk/libproc-simple-perl/t/destroy.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/t/destroy.t?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/t/destroy.t (original)
+++ trunk/libproc-simple-perl/t/destroy.t Sun Jul 24 19:17:14 2011
@@ -23,23 +23,9 @@
 
 
 use Proc::Simple;
-#Proc::Simple::debug(1);
+use Test::More;
 
-###
-### check(1) -> print #testno ok
-### check(O) -> print #testno not ok
-###
-sub check {
-    my ($yesno) = @_;
-
-    $nu = 1 unless defined $nu;
-    print($yesno ? "ok $nu\n" : "not ok $nu\n");
-    $nu++;
-}
-
-$| = 1;
-
-print "1..4\n";
+plan tests => 5;
 
 ###
 ### Simple Test of destroy
@@ -51,7 +37,7 @@
 
 $psh  = Proc::Simple->new();
 
-check($psh->start($coderef));         # 1
+ok($psh->start($coderef));         # 1
 
 # Retrieve the process id (so that we can look for it later)
 
@@ -64,15 +50,16 @@
 # The sleep is here to make the test fair with the 
 # ond_destroy test later
 sleep 2;
-check($result = kill "SIGTERM", $pid);      # 2
+ok($result = kill "SIGTERM", $pid);      # 2
 
-print "Result should equal 1 if process was killed by us: $result\n";
+ok($result == 1, "check result");        # 3
+# print "Result should equal 1 if process was killed by us: $result\n";
 
 # Now try the same thing with the kill_on_destroy flag set
 
 $psh  = Proc::Simple->new();
 
-check($psh->start($coderef));         # 3
+ok($psh->start($coderef));         # 4
 
 # Retrieve the process id (so that we can look for it later)
 
@@ -94,4 +81,4 @@
 }
 
 # Okay if we returned before the 10 secs expired
-check($i<10);
+ok($i<10);

Modified: trunk/libproc-simple-perl/t/esub.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/t/esub.t?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/t/esub.t (original)
+++ trunk/libproc-simple-perl/t/esub.t Sun Jul 24 19:17:14 2011
@@ -8,34 +8,20 @@
 
 
 package Main;
-
-###
-### check(1) -> print #testno ok
-### check(O) -> print #testno not ok
-###
-sub check {
-    my ($yesno) = @_;
-
-    $nu = 1 unless defined $nu;
-    print($yesno ? "ok $nu\n" : "not ok $nu\n");
-    $nu++;
-}
-
-$| = 1;
-
-print "1..2\n";
+use Test::More;
+plan tests => 2;
 
 ###
 ### Empty Subclass test
 ###
 $psh  = EmptySubclass->new();
 
-check($psh->start("sleep 10"));        # 1
+ok($psh->start("sleep 10"));        # 1
 
 while(!$psh->poll) { 
     sleep 1; }
 
-check($psh->kill());                   # 2
+ok($psh->kill());                   # 2
 
 while($psh->poll) { 
     sleep 1; }

Modified: trunk/libproc-simple-perl/t/exit.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/t/exit.t?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/t/exit.t (original)
+++ trunk/libproc-simple-perl/t/exit.t Sun Jul 24 19:17:14 2011
@@ -4,12 +4,12 @@
 ##################################################
 
 use Proc::Simple;
+use Test::More;
+plan tests => 1;
 
 #Proc::Simple::debug(1);
 
 $proc = Proc::Simple->new();
-
-print "1..1\n";
 
 $proc->start("ls . >/dev/null");
 while($proc->poll()) {
@@ -34,8 +34,4 @@
 }
 Proc::Simple->dprt("EXIT: '$stat'");
 
-if($stat eq 0) {
-    print "ok 1\n";
-} else {
-    print "not ok 1\n";
-}
+is $stat, 0, "stat 0";

Modified: trunk/libproc-simple-perl/t/muarg.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/t/muarg.t?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/t/muarg.t (original)
+++ trunk/libproc-simple-perl/t/muarg.t Sun Jul 24 19:17:14 2011
@@ -1,36 +1,20 @@
 #!/usr/bin/perl -w
 
 use Proc::Simple;
+use Test::More;
 
-### Test the new multi arg methods
-$| = 1;
-
-print "1..4\n";
+plan tests => 4;
 
 $psh  = Proc::Simple->new();
 
-check($psh->start("sleep", "1"));      # 1
+ok($psh->start("sleep", "1"));      # 1
 while($psh->poll) { 
     sleep 1; }
-check(!$psh->poll());                  # 2 Must be dead
+ok(!$psh->poll());                  # 2 Must be dead
 
 sub mysleep { sleep(@_); }
 
-check($psh->start(\&mysleep, 1));      # 3
+ok($psh->start(\&mysleep, 1));      # 3
 while($psh->poll) {
     sleep 1; }
-check(!$psh->poll());                  # 4 Must have been terminated
-
-###
-### check(1) -> print #testno ok
-### check(O) -> print #testno not ok
-###
-sub check {
-    my ($yesno) = @_;
-
-    $nu = 1 unless defined $nu;
-    print($yesno ? "ok $nu\n" : "not ok $nu\n");
-    $nu++;
-}
-
-1;
+ok(!$psh->poll());                  # 4 Must have been terminated

Modified: trunk/libproc-simple-perl/t/mult.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/t/mult.t?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/t/mult.t (original)
+++ trunk/libproc-simple-perl/t/mult.t Sun Jul 24 19:17:14 2011
@@ -1,22 +1,8 @@
 #!/usr/bin/perl -w
 
 use Proc::Simple;
-
-###
-### check(1) -> print #testno ok
-### check(O) -> print #testno not ok
-###
-sub check {
-    my ($yesno) = @_;
-
-    $nu = 1 unless defined $nu;
-    print($yesno ? "ok $nu\n" : "not ok $nu\n");
-    $nu++;
-}
-
-$| = 1;
-
-print "1..80\n";
+use Test::More;
+plan tests => 80;
 
 ###
 ### Multiple Processes Test
@@ -28,17 +14,17 @@
 }
 
 foreach $i (@psh) {
-    check($i->start("sleep 60"));        # 1-20
+    ok($i->start("sleep 60"));        # 1-20
 }
 
 foreach $i (@psh) {
     while(!$i->poll) { 
         sleep 1; }
-    check($i->poll());                   # Check each process, kill it
-    check($i->kill());                   # and check again: 21-80
+    ok($i->poll());                   # Check each process, kill it
+    ok($i->kill());                   # and check again: 21-80
     while($i->poll) { 
         sleep 1; }
-    check(!$i->poll());                  
+    ok(!$i->poll());                  
 }
 
 Proc::Simple->cleanup();

Modified: trunk/libproc-simple-perl/t/simple.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/t/simple.t?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/t/simple.t (original)
+++ trunk/libproc-simple-perl/t/simple.t Sun Jul 24 19:17:14 2011
@@ -6,24 +6,10 @@
 @ISA = qw(Proc::Simple);
 1;
 
+package Main;
+use Test::More;
 
-package Main;
-
-###
-### check(1) -> print #testno ok
-### check(O) -> print #testno not ok
-###
-sub check {
-    my ($yesno) = @_;
-
-    $nu = 1 unless defined $nu;
-    print($yesno ? "ok $nu\n" : "not ok $nu\n");
-    $nu++;
-}
-
-$| = 1;
-
-print "1..10\n";
+plan tests => 10;
 
 ###
 ### Simple Test
@@ -33,35 +19,35 @@
 
 $psh  = Proc::Simple->new();
 
-check($psh->start("sleep 1"));         # 1
+ok($psh->start("sleep 1"));         # 1
 while($psh->poll) { 
     sleep 1; }
-check(!$psh->poll());                  # 2 Must have been terminated
+ok(!$psh->poll());                  # 2 Must have been terminated
 
-check($psh->start("sleep 10"));        # 3
+ok($psh->start("sleep 10"));        # 3
 while(!$psh->poll) { 
     sleep 1; }
-check($psh->kill());                   # 4
+ok($psh->kill());                   # 4
 while($psh->poll) { 
     sleep 1; }
-check(!$psh->poll());                  # 5 Must have been terminated
+ok(!$psh->poll());                  # 5 Must have been terminated
 
 
 ### Perl subroutines
 $psub  = Proc::Simple->new();
 
-check($psub->start(sub { sleep 1 }));  # 6
+ok($psub->start(sub { sleep 1 }));  # 6
 while($psub->poll) { 
     sleep 1; }
-check(!$psub->poll());                 # 7 Must have been terminated
+ok(!$psub->poll());                 # 7 Must have been terminated
 
-check($psub->start(sub { sleep 10 })); # 8
+ok($psub->start(sub { sleep 10 })); # 8
 while(!$psub->poll) { 
     sleep 1; }
 
-check($psub->kill("SIGTERM"));         # 9
+ok($psub->kill("SIGTERM"));         # 9
 while($psub->poll) { 
     sleep 1; }
-check(!$psub->poll());                 # 10 Must have been terminated
+ok(!$psub->poll());                 # 10 Must have been terminated
 
 1;

Modified: trunk/libproc-simple-perl/t/stdouterr.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libproc-simple-perl/t/stdouterr.t?rev=77808&op=diff
==============================================================================
--- trunk/libproc-simple-perl/t/stdouterr.t (original)
+++ trunk/libproc-simple-perl/t/stdouterr.t Sun Jul 24 19:17:14 2011
@@ -1,9 +1,9 @@
 #!/usr/bin/perl -w
 
 use Proc::Simple;
+use Test::More;
 
-$| = 1;
-print "1..2\n";
+plan tests => 2;
 
 sub test_output {
     print "hello stdout\n";
@@ -24,16 +24,7 @@
 my $stderr = join '', <FILE>;
 close FILE;
 
-if($stderr eq "hello stderr\n") {
-    print "ok 1\n";
-} else {
-    print "not ok 1 ($stderr)\n";
-}
-
-if($stdout eq "hello stdout\n") {
-    print "ok 2\n";
-} else {
-    print "not ok 2\n";
-}
+is $stderr, "hello stderr\n", "hello stderr";
+is $stdout, "hello stdout\n", "hello stdout";
 
 unlink("stdout.txt", "stderr.txt");




More information about the Pkg-perl-cvs-commits mailing list