r77806 - in /branches/upstream/libproc-simple-perl/current: Changes MANIFEST MANIFEST.SKIP META.yml README Simple.pm t/bin/ 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
carnil at users.alioth.debian.org
carnil at users.alioth.debian.org
Sun Jul 24 19:16:40 UTC 2011
Author: carnil
Date: Sun Jul 24 19:16:38 2011
New Revision: 77806
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=77806
Log:
[svn-upgrade] new version libproc-simple-perl (1.29)
Added:
branches/upstream/libproc-simple-perl/current/t/bin/
branches/upstream/libproc-simple-perl/current/t/bin/test-prog (with props)
branches/upstream/libproc-simple-perl/current/t/sh-c.t (with props)
Modified:
branches/upstream/libproc-simple-perl/current/Changes
branches/upstream/libproc-simple-perl/current/MANIFEST
branches/upstream/libproc-simple-perl/current/MANIFEST.SKIP
branches/upstream/libproc-simple-perl/current/META.yml
branches/upstream/libproc-simple-perl/current/README
branches/upstream/libproc-simple-perl/current/Simple.pm
branches/upstream/libproc-simple-perl/current/t/destroy.t
branches/upstream/libproc-simple-perl/current/t/esub.t
branches/upstream/libproc-simple-perl/current/t/exit.t
branches/upstream/libproc-simple-perl/current/t/muarg.t
branches/upstream/libproc-simple-perl/current/t/mult.t
branches/upstream/libproc-simple-perl/current/t/simple.t
branches/upstream/libproc-simple-perl/current/t/stdouterr.t
Modified: branches/upstream/libproc-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/Changes?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/Changes (original)
+++ branches/upstream/libproc-simple-perl/current/Changes Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/MANIFEST?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/MANIFEST (original)
+++ branches/upstream/libproc-simple-perl/current/MANIFEST Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/MANIFEST.SKIP?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libproc-simple-perl/current/MANIFEST.SKIP Sun Jul 24 19:16:38 2011
@@ -1,3 +1,4 @@
+.gz
.git
blib
^Makefile$
Modified: branches/upstream/libproc-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/META.yml?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/META.yml (original)
+++ branches/upstream/libproc-simple-perl/current/META.yml Sun Jul 24 19:16:38 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Proc-Simple
-version: 1.28
+version: 1.29
abstract: ~
author: []
license: unknown
Modified: branches/upstream/libproc-simple-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/README?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/README (original)
+++ branches/upstream/libproc-simple-perl/current/README Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/Simple.pm?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/Simple.pm (original)
+++ branches/upstream/libproc-simple-perl/current/Simple.pm Sun Jul 24 19:16:38 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>
Added: branches/upstream/libproc-simple-perl/current/t/bin/test-prog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/bin/test-prog?rev=77806&op=file
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/bin/test-prog (added)
+++ branches/upstream/libproc-simple-perl/current/t/bin/test-prog Sun Jul 24 19:16:38 2011
@@ -1,0 +1,13 @@
+
+# test perl program
+
+use FindBin qw($Bin);
+
+my $testfile = "$Bin/../test-prog-running";
+
+open FILE, ">$testfile" or die "Can't open $testfile: $!";
+close FILE;
+
+$SIG{ TERM } = sub { unlink $testfile; };
+
+sleep 30;
Propchange: branches/upstream/libproc-simple-perl/current/t/bin/test-prog
------------------------------------------------------------------------------
svn:executable = *
Modified: branches/upstream/libproc-simple-perl/current/t/destroy.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/destroy.t?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/destroy.t (original)
+++ branches/upstream/libproc-simple-perl/current/t/destroy.t Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/t/esub.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/esub.t?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/esub.t (original)
+++ branches/upstream/libproc-simple-perl/current/t/esub.t Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/t/exit.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/exit.t?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/exit.t (original)
+++ branches/upstream/libproc-simple-perl/current/t/exit.t Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/t/muarg.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/muarg.t?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/muarg.t (original)
+++ branches/upstream/libproc-simple-perl/current/t/muarg.t Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/t/mult.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/mult.t?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/mult.t (original)
+++ branches/upstream/libproc-simple-perl/current/t/mult.t Sun Jul 24 19:16:38 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();
Added: branches/upstream/libproc-simple-perl/current/t/sh-c.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/sh-c.t?rev=77806&op=file
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/sh-c.t (added)
+++ branches/upstream/libproc-simple-perl/current/t/sh-c.t Sun Jul 24 19:16:38 2011
@@ -1,0 +1,43 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Proc::Simple;
+use Test::More;
+use FindBin qw($Bin);
+
+my $runfile = "$Bin/test-prog-running";
+
+plan tests => 3;
+
+unlink $runfile; # cleanup leftover from previous runs
+
+my $psh = Proc::Simple->new();
+
+ # contains a wildcard, so will be launched via sh -c
+$psh->start("$^X $Bin/bin/test-prog *");
+
+while( ! $psh->poll() ) {
+ # diag "waiting for process to start";
+ sleep 1;
+}
+
+ok 1, "process is up";
+
+ # wait for shell to spawn perl process
+while( !-f $runfile ) {
+ # diag "waiting for process to create runfile $runfile";
+ sleep 1;
+}
+
+$psh->kill();
+
+while( $psh->poll() ) {
+ # diag "waiting for process to shut down";
+ sleep 1;
+}
+
+ok 1, "process is down";
+
+ok !-f "$Bin/test-prog-running", "running file unlinked";
+
+1;
Propchange: branches/upstream/libproc-simple-perl/current/t/sh-c.t
------------------------------------------------------------------------------
svn:executable = *
Modified: branches/upstream/libproc-simple-perl/current/t/simple.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/simple.t?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/simple.t (original)
+++ branches/upstream/libproc-simple-perl/current/t/simple.t Sun Jul 24 19:16:38 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: branches/upstream/libproc-simple-perl/current/t/stdouterr.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libproc-simple-perl/current/t/stdouterr.t?rev=77806&op=diff
==============================================================================
--- branches/upstream/libproc-simple-perl/current/t/stdouterr.t (original)
+++ branches/upstream/libproc-simple-perl/current/t/stdouterr.t Sun Jul 24 19:16:38 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