Proc-Background-1.10/0000755000076600000000000000000011224230557013364 5ustar blairwheelProc-Background-1.10/bin/0000755000076600000000000000000011224230557014134 5ustar blairwheelProc-Background-1.10/bin/timed-process.PL0000644000076600000000000000437711224227556017167 0ustar blairwheeluse Config; use File::Basename qw(basename dirname); chdir(dirname($0)); ($file = basename($0)) =~ s/\.PL$//; $file =~ s/\.pl$// if ($Config{'osname'} eq 'VMS' or $Config{'osname'} eq 'OS2'); # "case-forgiving" open OUT,">$file" or die "Can't create $file: $!"; chmod(0755, $file); print "Extracting $file (with variable substitutions)\n"; print OUT <<"!GROK!THIS!"; $Config{'startperl'} -w !GROK!THIS! print OUT <<'!NO!SUBS!'; =head1 NAME timed-process - Run background process for limited amount of time =head1 SYNOPSIS timed-process [-e exit_status] timeout command [ [ ...]] =head1 DESCRIPTION This script runs I for a specified amount of time and if it doesn't finish, it kills the process. If I runs and exits before the given timeout, B returns the exit value of I. If I did not exit before I seconds, then B will kill the process and returns an exit value of 255, unless the -e command line option is set, which instructs B to return a different exit value. This allows the user of B to determine if the process ended normally or was killed. =cut use strict; use Proc::Background 1.04 qw(timeout_system); use Getopt::Long; $0 =~ s:.*/::; sub usage { print < [ ...]] This script runs command for a specified amount of time and if it doesn't finish, it kills the process. If command runs and exits before the given timeout, timed-process returns the exit value of command. If command did not exit before timeout seconds, then timed-process will kill the process and returns an exit value of 255, unless the -e command line option is set, which instructs timed-process to return a different exit value. This allows the user of timed-process to determine if the process ended normally or was killed. END exit 1; } my $exit_status = 255; Getopt::Long::Configure('require_order'); GetOptions('exit-status=i', => \$exit_status) or usage; if ($exit_status < 0) { die "$0: exit status value `$exit_status' cannot be negative.\n"; } @ARGV > 1 or usage; my @result = timeout_system(@ARGV); if ($result[1]) { exit $exit_status; } else { exit $result[0] >> 8; } !NO!SUBS! Proc-Background-1.10/Changes0000644000076600000000000002444511224227556014675 0ustar blairwheelSun Jul 5 15:40:32 PDT 2009 * Release version 1.10. Sun Jul 5 15:15:12 PDT 2009 * Makefile.PL: Resolve https://rt.cpan.org/Ticket/Display.html?id=47100 by passing PREREQ_PM to WriteMakefile(). Patch by: Tomas Doran Wed Jul 1 22:58:13 PDT 2009 * README: Correct the URL to the Subversion repository for this project. Wed Jul 1 22:46:11 PDT 2009 * Release version 1.09. Wed Jul 1 22:36:06 PDT 2009 * Makefile.PL: Switch from die() to warn() if Win32::Process isn't installed into a warning. When running under CPAN.pm, the die causes the install to fail before processing dependencies. Reducing this to a warning means that CPAN will cleanly install Proc::Background and Win32::Process with no user intervention needed in strawberry perl or even ActiveState if you have a working make. Patch by: Tomas Doran Sat Dec 7 09:41:58 PST 2002 * Release version 1.08. Sat Dec 7 09:33:53 PST 2002 Blair Zajac * lib/Proc/Background/Win32.pm (_new): When more than one argument is passed to _new in @_, each array element may be quoted to protect whitespace so that the final assembly of the individual arguments into one string, using "@_", that is passed to Win32::Process::Create works. An empty string was not being protected and was lost from the command line arguments. Bug fix by Jim Hahn . * README: Note that this package is hosted in a Subversion repository and give its URL. * Changes: Renamed from CHANGES. Sat Apr 20 19:27:53 PDT 2002 Blair Zajac * Release version 1.07. Sat Apr 20 18:55:46 PDT 2002 Blair Zajac * lib/Proc/Background/Win32.pm: Fix a bug spotted by John Kingsley on Windows platforms where if Proc::Background->new is passed an absolute pathname to a program containing whitespace, then Win32::Process::Create will not be able to create the new process. The solution is use Win32::GetShortPathName to convert the long pathname into a short pathname with no spaces. Also eval "use Win32' to load Win32::GetShortPathName. Sat Apr 20 18:35:57 PDT 2002 Blair Zajac * lib/Proc/Background.pm: Fix a bug spotted by Ruben Diez in _resolve_path where if one of the directories in the PATH had a directory with the same name as the program being searched for, the directory would be used because they typically have execute permissions. Now check for a file and the execute permissions before using the file. Sat Apr 20 18:19:27 PDT 2002 Blair Zajac * lib/Proc/Background.pm: Fix all cases where a string containing '0' would fail a test even though it should pass. * lib/Proc/Background/Unix.pm: Ditto. * lib/Proc/Background/Win32.pm: Ditto. Sat Sep 8 12:20:01 PDT 2001 Blair Zajac * Release version 1.06. Sat Sep 8 12:19:39 PDT 2001 Blair Zajac * t/01proc.t: On Cygwin test 46 fails intermittently when it tries to see if the spawned process is running by using kill(0, $pid). It's not clear why this would happen, but sometimes kill returns 0, even though the process should be running. Maybe it's the Cygwin layer that is causing the problem. Adding a one second sleep before calling kill seems to cause the test to pass. * t/sleep_exit.t: The sleep argument was being set to 1 even if the command line argument was 0 because $sleep was checked for trueness, not if it was defined. Now check $sleep and $exit_status for being defined before setting them. * README: Update the instructions for checking and installing Win32::Process for Perl on Windows. Tue Aug 28 12:54:44 PDT 2001 Blair Zajac * Release version 1.05. Tue Aug 28 12:34:15 PDT 2001 Blair Zajac * lib/Proc/Background.pm: The $VERSION variable was being set using $VERSION = substr q$Revision: 1.05 $, 10;' which did not properly set $VERSION to a numeric value in Perl 5.6.1 probably due to the trailing ' ' character after the number. This resulted in 'use Proc::Background 1.04' failing to force Perl to use version 1.04 or newer of Proc::Background even if 1.03 or older was installed because $VERSION was set using substr and Perl would not consider $VERSION to be set. Now use the longer but effective: $VERSION = sprintf '%d.%02d', '$Revision: 1.05 $' =~ /(\d+)\.(\d+)/; * lib/Proc/Background/Unix.pm: Ditto. * lib/Proc/Background/Win32.pm: Ditto. Thu Aug 16 14:36:39 PDT 2001 Blair Zajac * Release version 1.04. Thu Aug 16 14:29:14 PDT 2001 Blair Zajac * lib/Proc/Background.pm: When new is passed an incorrect number of arguments, do confess using the class passed to new, rather use the hardwired Proc::Background class which will make error messages easier to understand since module complaining about the error will be the correct one. * lib/Proc/Background/Unix.pm: Ditto, except for _new, not new. * lib/Proc/Background/Win32.pm: Ditto, except for _new, not new. Thu Aug 16 14:00:41 PDT 2001 Blair Zajac * lib/Proc/Background.pm: Proc::Background::new can accept a reference to a hash as its first argument which contains key/value pairs to modify Proc::Background's behavior. Currently the only key understood is `die_upon_destroy' which has the process killed via die() when the Proc::Background object is being DESTROY'ed. * t/01proc.t: Add tests to test the new options behavior. Thu Aug 16 13:30:23 PDT 2001 Blair Zajac * lib/Proc/Background.pm: No longer use cluck and return undef to warn about invalid arguments to function calls. Instead just call confess to print the call stack and quit the script. * lib/Proc/Background/Unix.pm: Ditto. * lib/Proc/Background/Win32.pm: Ditto. Tue Aug 14 22:50:14 PDT 2001 Blair Zajac * lib/Proc/Background/Win32.pm: Remove an unnecessary loop label in _die. * lib/Proc/Background.pm: Update the documentation to be clearer. * README: Remove the reference to my FTP site, as it is no longer being used. * README: Update all references to Blair Zajac's email addresses to blair@orcaware.com. * CHANGES: Ditto. * lib/Proc/Background/Unix.pm: Ditto. * lib/Proc/Background/Win32.pm: Ditto. * lib/Proc/Background.pm: Ditto. Sun Feb 4 13:54:37 PST 2001 Blair Zajac * Release version 1.03. Sun Feb 4 11:50:15 PST 2001 Blair Zajac * Add a new command line option to timed-process, -e, that takes an integer argument. This value sets the exit value timed-process uses for its exit call when it has to kill the given program because the timeout elapsed. This value is not used if the process exits before the timeout expires. * t/01proc.t: Add tests for for the timed-process script. Sat Feb 3 14:21:32 PST 2001 Blair Zajac * Change all occurrences of Proc::Generic, which was the original name of this module, with Proc::Background in every file in the module. This includes fixing the timed-process script which used Proc::Generic instead of Proc::Background. Mon Jan 15 16:05:04 PST 2001 Blair Zajac * Release version 1.02. Mon Jan 15 10:32:59 PST 2001 Blair Zajac * Make Proc::Background::new flexible enough to behave in the same manner as exec() or system() do when passed either a single or multiple arguments. When the command to put in the background run is passed as an array with two or more elements, run the command directly without passing the command through the shell. When a single argument is passed to Proc::Background::new, pass the command through the shell. Add a new test to the test suite to check a command passed as a single argument to Proc::Background::new. * Remove 'Unrecognized escape \w passed through at Background.pm line 30' warning when using Perl 5.6.0. Wed Jun 21 09:51:37 PDT 2000 Blair Zajac * Release version 1.01. Wed Jun 21 09:47:33 PDT 2000 Blair Zajac * Proc::Background::Win32 used to only protect arguments that contained he space character by placing "'s around the argument. Now, make sure that each individual argument to Proc::Backgrond ends up going to the Windows shell in such a way that the shell sees the argument as a single argument. This means escaping "'s that are not already escaped and placing "'s around the argument if it matches \s. This will protect the string if it finds a \s in it and not just a space. Thu Apr 20 14:46:31 PDT 2000 Blair Zajac * Release version 1.00. Thu Apr 20 14:40:11 PDT 2000 Blair Zajac * In certain circumstances on older Perls, Proc::Background would complain that @_ could not be modified since it is a read only variable. Make a copy of @_ and modify that. Wed Apr 19 19:50:51 PDT 2000 Blair Zajac * Release version 0.03. Wed Apr 19 14:47:58 PDT 2000 Blair Zajac * Relax the requirement that the path to the program has to be absolute. If it is not absolute, then look for the absolute location of the program. * Add a new method named pid that returns the process ID of the new process. Sun Jun 28 12:43:39 PDT 1998 Blair Zajac * Release version 0.02. Tue Jun 23 15:13:13 PDT 1998 Blair Zajac * Restructure the die method. Keep the OS independent code for killing a process in Proc::Background and the OS dependent killing code in Proc::Background::*. * Update the POD for Proc::Background to be more explicit about what start_time and end_time return. * Fix bugs in Proc::Background::Win32. * Update Makefile.PL to check for Win32::Process installed on Win32 systems. Thu Jun 18 14:52:01 PDT 1998 Blair Zajac * Update the README to indicate that libwin32 is only needed on Win32 systems. * Remove calls to croak or die. Call cluck instead. * Fix the implementation documentation. * Remove Proc::Background::Win32::alive since Proc::Background::alive works. Thu Apr 24 12:00:00 PDT 1998 Blair Zajac * Version 0.01 Proc-Background-1.10/lib/0000755000076600000000000000000011224230556014131 5ustar blairwheelProc-Background-1.10/lib/Proc/0000755000076600000000000000000011224230556015034 5ustar blairwheelProc-Background-1.10/lib/Proc/Background/0000755000076600000000000000000011224230556017113 5ustar blairwheelProc-Background-1.10/lib/Proc/Background/Unix.pm0000644000076600000000000000637211224227556020412 0ustar blairwheel# Proc::Background::Unix: Unix interface to background process management. # # Copyright (C) 1998-2005 Blair Zajac. All rights reserved. package Proc::Background::Unix; require 5.004_04; use strict; use Exporter; use Carp; use POSIX qw(:errno_h :sys_wait_h); use vars qw(@ISA $VERSION); @ISA = qw(Exporter); $VERSION = sprintf '%d.%02d', '$Revision: 1.10 $' =~ /(\d+)\.(\d+)/; # Start the background process. If it is started sucessfully, then record # the process id in $self->{_os_obj}. sub _new { my $class = shift; unless (@_ > 0) { confess "Proc::Background::Unix::_new called with insufficient number of arguments"; } return unless defined $_[0]; # If there is only one element in the @_ array, then it may be a # command to be passed to the shell and should not be checked, in # case the command sets environmental variables in the beginning, # i.e. 'VAR=arg ls -l'. If there is more than one element in the # array, then check that the first element is a valid executable # that can be found through the PATH and find the absolute path to # the executable. If the executable is found, then replace the # first element it with the absolute path. my @args = @_; if (@_ > 1) { $args[0] = Proc::Background::_resolve_path($args[0]) or return; } my $self = bless {}, $class; # Fork a child process. my $pid; { if ($pid = fork()) { # parent $self->{_os_obj} = $pid; $self->{_pid} = $pid; last; } elsif (defined $pid) { # child exec @_ or croak "$0: exec failed: $!\n"; } elsif ($! == EAGAIN) { sleep 5; redo; } else { return; } } $self; } # Wait for the child. sub _waitpid { my $self = shift; my $timeout = shift; { # Try to wait on the process. my $result = waitpid($self->{_os_obj}, $timeout ? 0 : WNOHANG); # Process finished. Grab the exit value. if ($result == $self->{_os_obj}) { return (0, $?); } # Process already reaped. We don't know the exist status. elsif ($result == -1 and $! == ECHILD) { return (1, 0); } # Process still running. elsif ($result == 0) { return (2, 0); } # If we reach here, then waitpid caught a signal, so let's retry it. redo; } return 0; } sub _die { my $self = shift; # Try to kill the process with different signals. Calling alive() will # collect the exit status of the program. SIGNAL: { foreach my $signal (qw(HUP QUIT INT KILL)) { my $count = 5; while ($count and $self->alive) { --$count; kill($signal, $self->{_os_obj}); last SIGNAL unless $self->alive; sleep 1; } } } } 1; __END__ =head1 NAME Proc::Background::Unix - Unix interface to process mangement =head1 SYNOPSIS Do not use this module directly. =head1 DESCRIPTION This is a process management class designed specifically for Unix operating systems. It is not meant used except through the I class. See L for more information. =head1 AUTHOR Blair Zajac =head1 COPYRIGHT Copyright (C) 1998-2005 Blair Zajac. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Proc-Background-1.10/lib/Proc/Background/Win32.pm0000644000076600000000000001006511224227556020363 0ustar blairwheel# Proc::Background::Win32 Windows interface to background process management. # # Copyright (C) 1998-2005 Blair Zajac. All rights reserved. package Proc::Background::Win32; require 5.004_04; use strict; use Exporter; use Carp; use vars qw(@ISA $VERSION); @ISA = qw(Exporter); $VERSION = sprintf '%d.%02d', '$Revision: 1.10 $' =~ /(\d+)\.(\d+)/; BEGIN { eval "use Win32"; $@ and die "Proc::Background::Win32 needs Win32 from libwin32-?.??.zip to run.\n"; eval "use Win32::Process"; $@ and die "Proc::Background::Win32 needs Win32::Process from libwin32-?.??.zip to run.\n"; } sub _new { my $class = shift; unless (@_ > 0) { confess "Proc::Background::Win32::_new called with insufficient number of arguments"; } return unless defined $_[0]; # If there is only one element in the @_ array, then just split the # argument by whitespace. If there is more than one element in @_, # then assume that each argument should be properly protected from # the shell so that whitespace and special characters are passed # properly to the program, just as it would be in a Unix # environment. This will ensure that a single argument with # whitespace will not be split into multiple arguments by the time # the program is run. Make sure that any arguments that are already # protected stay protected. Then convert unquoted "'s into \"'s. # Finally, check for whitespace and protect it. my @args; if (@_ == 1) { @args = split(' ', $_[0]); } else { @args = @_; for (my $i=1; $i<@args; ++$i) { my $arg = $args[$i]; $arg =~ s#\\\\#\200#g; $arg =~ s#\\"#\201#g; $arg =~ s#"#\\"#g; $arg =~ s#\200#\\\\#g; $arg =~ s#\201#\\"#g; if (length($arg) == 0 or $arg =~ /\s/) { $arg = "\"$arg\""; } $args[$i] = $arg; } } # Find the absolute path to the program. If it cannot be found, # then return. To work around a problem where # Win32::Process::Create cannot start a process when the full # pathname has a space in it, convert the full pathname to the # Windows short 8.3 format which contains no spaces. $args[0] = Proc::Background::_resolve_path($args[0]) or return; $args[0] = Win32::GetShortPathName($args[0]); my $self = bless {}, $class; # Perl 5.004_04 cannot run Win32::Process::Create on a nonexistant # hash key. my $os_obj = 0; # Create the process. if (Win32::Process::Create($os_obj, $args[0], "@args", 0, NORMAL_PRIORITY_CLASS, '.')) { $self->{_pid} = $os_obj->GetProcessID; $self->{_os_obj} = $os_obj; return $self; } else { return; } } # Reap the child. sub _waitpid { my ($self, $timeout) = @_; # Try to wait on the process. my $result = $self->{_os_obj}->Wait($timeout ? INFINITE : 0); # Process finished. Grab the exit value. if ($result == 1) { my $_exit_status; $self->{_os_obj}->GetExitCode($_exit_status); return (0, $_exit_status<<8); } # Process still running. elsif ($result == 0) { return (2, 0); } # If we reach here, then something odd happened. return (0, 1<<8); } sub _die { my $self = shift; # Try the kill the process several times. Calling alive() will # collect the exit status of the program. my $count = 5; while ($count and $self->alive) { --$count; $self->{_os_obj}->Kill(1<<8); last unless $self->alive; sleep 1; } } 1; __END__ =head1 NAME Proc::Background::Win32 - Interface to process mangement on Win32 systems =head1 SYNOPSIS Do not use this module directly. =head1 DESCRIPTION This is a process management class designed specifically for Win32 operating systems. It is not meant used except through the I class. See L for more information. =head1 IMPLEMENTATION This package uses the Win32::Process class to manage the objects. =head1 AUTHOR Blair Zajac =head1 COPYRIGHT Copyright (C) 1998-2005 Blair Zajac. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Proc-Background-1.10/lib/Proc/Background.pm0000644000076600000000000003513111224227556017462 0ustar blairwheel# Proc::Background: Generic interface to background process management. # # Copyright (C) 1998-2005 Blair Zajac. All rights reserved. package Proc::Background; require 5.004_04; use strict; use Exporter; use Carp; use Cwd; use vars qw(@ISA $VERSION @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw(timeout_system); $VERSION = sprintf '%d.%02d', '$Revision: 1.10 $' =~ /(\d+)\.(\d+)/; # Determine if the operating system is Windows. my $is_windows = $^O eq 'MSWin32'; # Set up a regular expression that tests if the path is absolute and # if it has a directory separator in it. Also create a list of file # extensions of append to the programs name to look for the real # executable. my $is_absolute_re; my $has_dir_element_re; my @extensions = (''); if ($is_windows) { $is_absolute_re = '^(?:(?:[a-zA-Z]:[\\\\/])|(?:[\\\\/]{2}\w+[\\\\/]))'; $has_dir_element_re = "[\\\\/]"; push(@extensions, '.exe'); } else { $is_absolute_re = "^/"; $has_dir_element_re = "/"; } # Make this class a subclass of Proc::Win32 or Proc::Unix. Any # unresolved method calls will go to either of these classes. if ($is_windows) { require Proc::Background::Win32; unshift(@ISA, 'Proc::Background::Win32'); } else { require Proc::Background::Unix; unshift(@ISA, 'Proc::Background::Unix'); } # Take either a relative or absolute path to a command and make it an # absolute path. sub _resolve_path { my $command = shift; return unless length $command; # Make the path to the progam absolute if it isn't already. If the # path is not absolute and if the path contains a directory element # separator, then only prepend the current working to it. If the # path is not absolute, then look through the PATH environment to # find the executable. In all cases, look for the programs with any # extensions added to the original path name. my $path; if ($command =~ /$is_absolute_re/o) { foreach my $ext (@extensions) { my $p = "$command$ext"; if (-f $p and -x _) { $path = $p; last; } } unless (defined $path) { warn "$0: no executable program located at $command\n"; } } else { my $cwd = cwd; if ($command =~ /$has_dir_element_re/o) { my $p1 = "$cwd/$command"; foreach my $ext (@extensions) { my $p2 = "$p1$ext"; if (-f $p2 and -x _) { $path = $p2; last; } } } else { foreach my $dir (split($is_windows ? ';' : ':', $ENV{PATH})) { next unless length $dir; $dir = "$cwd/$dir" unless $dir =~ /$is_absolute_re/o; my $p1 = "$dir/$command"; foreach my $ext (@extensions) { my $p2 = "$p1$ext"; if (-f $p2 and -x _) { $path = $p2; last; } } last if defined $path; } } unless (defined $path) { warn "$0: cannot find absolute location of $command\n"; } } $path; } # We want the created object to live in Proc::Background instead of # the OS specific class so that generic method calls can be used. sub new { my $class = shift; my $options; if (@_ and defined $_[0] and UNIVERSAL::isa($_[0], 'HASH')) { $options = shift; } unless (@_ > 0) { confess "Proc::Background::new called with insufficient number of arguments"; } return unless defined $_[0]; my $self = $class->SUPER::_new(@_) or return; # Save the start time of the class. $self->{_start_time} = time; # Handle the specific options. if ($options) { $self->{_die_upon_destroy} = $options->{die_upon_destroy}; } bless $self, $class; } sub DESTROY { my $self = shift; if ($self->{_die_upon_destroy}) { $self->die; } } # Reap the child. If the first argument is 0 the wait should return # immediately, 1 if it should wait forever. If this number is # non-zero, then wait. If the wait was sucessful, then delete # $self->{_os_obj} and set $self->{_exit_value} to the OS specific # class return of _reap. Return 1 if we sucessfully waited, 0 # otherwise. sub _reap { my $self = shift; my $timeout = shift || 0; return 0 unless exists($self->{_os_obj}); # Try to wait on the process. Use the OS dependent wait call using # the Proc::Background::*::waitpid call, which returns one of three # values. # (0, exit_value) : sucessfully waited on. # (1, undef) : process already reaped and exist value lost. # (2, undef) : process still running. my ($result, $exit_value) = $self->_waitpid($timeout); if ($result == 0 or $result == 1) { $self->{_exit_value} = defined($exit_value) ? $exit_value : 0; delete $self->{_os_obj}; # Save the end time of the class. $self->{_end_time} = time; return 1; } return 0; } sub alive { my $self = shift; # If $self->{_os_obj} is not set, then the process is definitely # not running. return 0 unless exists($self->{_os_obj}); # If $self->{_exit_value} is set, then the process has already finished. return 0 if exists($self->{_exit_value}); # Try to reap the child. If it doesn't reap, then it's alive. !$self->_reap(0); } sub wait { my $self = shift; # If neither _os_obj or _exit_value are set, then something is wrong. if (!exists($self->{_exit_value}) and !exists($self->{_os_obj})) { return; } # If $self->{_exit_value} exists, then we already waited. return $self->{_exit_value} if exists($self->{_exit_value}); # Otherwise, wait forever for the process to finish. $self->_reap(1); return $self->{_exit_value}; } sub die { my $self = shift; # See if the process has already died. return 1 unless $self->alive; # Kill the process using the OS specific method. $self->_die; # See if the process is still alive. !$self->alive; } sub start_time { $_[0]->{_start_time}; } sub end_time { $_[0]->{_end_time}; } sub pid { $_[0]->{_pid}; } sub timeout_system { unless (@_ > 1) { confess "$0: timeout_system passed too few arguments.\n"; } my $timeout = shift; unless ($timeout =~ /^\d+(?:\.\d*)?$/ or $timeout =~ /^\.\d+$/) { confess "$0: timeout_system passed a non-positive number first argument.\n"; } my $proc = Proc::Background->new(@_) or return; my $end_time = $proc->start_time + $timeout; while ($proc->alive and time < $end_time) { sleep(1); } my $alive = $proc->alive; if ($alive) { $proc->die; } if (wantarray) { return ($proc->wait, $alive); } else { return $proc->wait; } } 1; __END__ =pod =head1 NAME Proc::Background - Generic interface to Unix and Win32 background process management =head1 SYNOPSIS use Proc::Background; timeout_system($seconds, $command, $arg1); timeout_system($seconds, "$command $arg1"); my $proc1 = Proc::Background->new($command, $arg1, $arg2); my $proc2 = Proc::Background->new("$command $arg1 1>&2"); $proc1->alive; $proc1->die; $proc1->wait; my $time1 = $proc1->start_time; my $time2 = $proc1->end_time; # Add an option to kill the process with die when the variable is # DETROYed. my $opts = {'die_upon_destroy' => 1}; my $proc3 = Proc::Background->new($opts, $command, $arg1, $arg2); $proc3 = undef; =head1 DESCRIPTION This is a generic interface for placing processes in the background on both Unix and Win32 platforms. This module lets you start, kill, wait on, retrieve exit values, and see if background processes still exist. =head1 METHODS =over 4 =item B [options] I, [I, [I, ...]] =item B [options] 'I [I [I ...]]' This creates a new background process. As exec() or system() may be passed an array with a single single string element containing a command to be passed to the shell or an array with more than one element to be run without calling the shell, B has the same behavior. In certain cases B will attempt to find I on the system and fail if it cannot be found. For Win32 operating systems: The Win32::Process module is always used to spawn background processes on the Win32 platform. This module always takes a single string argument containing the executable's name and any option arguments. In addition, it requires that the absolute path to the executable is also passed to it. If only a single argument is passed to new, then it is split on whitespace into an array and the first element of the split array is used at the executable's name. If multiple arguments are passed to new, then the first element is used as the executable's name. If the executable's name is an absolute path, then new checks to see if the executable exists in the given location or fails otherwise. If the executable's name is not absolute, then the executable is searched for using the PATH environmental variable. The input executable name is always replaced with the absolute path determined by this process. In addition, when searching for the executable, the executable is searched for using the unchanged executable name and if that is not found, then it is checked by appending `.exe' to the name in case the name was passed without the `.exe' suffix. Finally, the argument array is placed back into a single string and passed to Win32::Process::Create. For non-Win32 operating systems, such as Unix: If more than one argument is passed to new, then new assumes that the command will not be passed through the shell and the first argument is the executable's relative or absolute path. If the first argument is an absolute path, then it is checked to see if it exists and can be run, otherwise new fails. If the path is not absolute, then the PATH environmental variable is checked to see if the executable can be found. If the executable cannot be found, then new fails. These steps are taking to prevent exec() from failing after an fork() without the caller of new knowing that something failed. The first argument to B I may be a reference to a hash which contains key/value pairs to modify Proc::Background's behavior. Currently the only key understood by B is I. When this value is set to true, then when the Proc::Background object is being DESTROY'ed for any reason (i.e. the variable goes out of scope) the process is killed via the die() method. If anything fails, then new returns an empty list in a list context, an undefined value in a scalar context, or nothing in a void context. =item B Returns the process ID of the created process. This value is saved even if the process has already finished. =item B Return 1 if the process is still active, 0 otherwise. =item B Reliably try to kill the process. Returns 1 if the process no longer exists once B has completed, 0 otherwise. This will also return 1 if the process has already died. On Unix, the following signals are sent to the process in one second intervals until the process dies: HUP, QUIT, INT, KILL. =item B Wait for the process to exit. Return the exit status of the command as returned by wait() on the system. To get the actual exit value, divide by 256 or right bit shift by 8, regardless of the operating system being used. If the process never existed, then return an empty list in a list context, an undefined value in a scalar context, or nothing in a void context. This function may be called multiple times even after the process has exited and it will return the same exit status. =item B Return the value that the Perl function time() returned when the process was started. =item B Return the value that the Perl function time() returned when the exit status was obtained from the process. =back =head1 FUNCTIONS =over 4 =item B I, I, [I, [I...]] =item B 'I I [I [I...]]' Run a command for I seconds and if the process did not exit, then kill it. While the timeout is implemented using sleep(), this function makes sure that the full I is reached before killing the process. B does not wait for the complete I number of seconds before checking if the process has exited. Rather, it sleeps repeatidly for 1 second and checks to see if the process still exists. In a scalar context, B returns the exit status from the process. In an array context, B returns a two element array, where the first element is the exist status from the process and the second is set to 1 if the process was killed by B or 0 if the process exited by itself. The exit status is the value returned from the wait() call. If the process was killed, then the return value will include the killing of it. To get the actual exit value, divide by 256. If something failed in the creation of the process, the subroutine returns an empty list in a list context, an undefined value in a scalar context, or nothing in a void context. =back =head1 IMPLEMENTATION I comes with two modules, I and I. Currently, on Unix platforms I uses the I class and on Win32 platforms it uses I, which makes use of I. The I assigns to @ISA either I or I, which does the OS dependent work. The OS independent work is done in I. Proc::Background uses two variables to keep track of the process. $self->{_os_obj} contains the operating system object to reference the process. On a Unix systems this is the process id (pid). On Win32, it is an object returned from the I class. When $self->{_os_obj} exists, then the process is running. When the process dies, this is recorded by deleting $self->{_os_obj} and saving the exit value $self->{_exit_value}. Anytime I is called, a waitpid() is called on the process and the return status, if any, is gathered and saved for a call to I. This module does not install a signal handler for SIGCHLD. If for some reason, the user has installed a signal handler for SIGCHLD, then, then when this module calls waitpid(), the failure will be noticed and taken as the exited child, but it won't be able to gather the exit status. In this case, the exit status will be set to 0. =head1 SEE ALSO See also L and L. =head1 AUTHOR Blair Zajac =head1 COPYRIGHT Copyright (C) 1998-2005 Blair Zajac. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Proc-Background-1.10/Makefile.PL0000644000076600000000000000334111224227556015344 0ustar blairwheel# This -*- perl -*- script writes the Makefile for this package. require 5.004_04; use strict; my %requires; # Subroutine to check for installed modules. sub check_version { my ($pkg, $wanted, $msg) = @_; local($|) = 1; print "Checking for $pkg..."; eval { my $p; ($p = $pkg . ".pm") =~ s#::#/#g; require $p; }; no strict 'refs'; my $vstr = ${"${pkg}::VERSION"} ? "found v" . ${"${pkg}::VERSION"} : "not found"; my $vnum = ${"${pkg}::VERSION"} || 0; my $ok = $vnum >= $wanted; print $ok ? "ok\n" : " " . $vstr . "\n"; $requires{$pkg} = $wanted if !$ok; return $ok; } # Check for needed modules. if ($^O eq 'MSWin32') { check_version('Win32::Process' => '0.04') or warn "\n" . "*** For Proc:Background you require version 0.04, or later, of\n" . " Win32::Process from CPAN/authors/id/GSAR/libwin32-x.x.tar.gz\n\n"; } #--- Configuration section --- my @programs_to_install = qw(timed-process); #--- End Configuration - You should not have to change anything below this line # Allow us to suppress all program installation with the -n (library only) # option. This is for those that don't want to mess with the configuration # section of this file. use Getopt::Std; use vars qw($opt_n); unless (getopts('n')) { die "Usage: $0 [-n]\n"; } @programs_to_install = () if $opt_n; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Proc::Background', VERSION_FROM => 'lib/Proc/Background.pm', PL_FILES => { map {("bin/$_.PL" => "bin/$_")} @programs_to_install }, EXE_FILES => [map {"bin/$_"} @programs_to_install ], 'clean' => {FILES => '$(EXE_FILES)' }, 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => 'gz' }, PREREQ_PM => \%requires, ); Proc-Background-1.10/MANIFEST0000644000076600000000000000024411224227556014522 0ustar blairwheelChanges MANIFEST README Makefile.PL lib/Proc/Background.pm lib/Proc/Background/Unix.pm lib/Proc/Background/Win32.pm bin/timed-process.PL t/01proc.t t/sleep_exit.pl Proc-Background-1.10/README0000644000076600000000000000722611224227556014260 0ustar blairwheelPackage Proc::Background Version 1.10 This is the Proc::Background package. It provides a generic interface to running background processes. Through this interface, users can run background processes on different operating systems without concerning themselves about the specifics of doing this. Users of this package create new Proc::Background objects that provide an object oriented interface to process management. The following methods are provided to users of the Proc::Background package: new: start a new background process. alive: test to see if the process is still alive. die: reliably try to kill the process. wait: wait for the process to exit and return the exit status. start_time: return the time that the process started. end_time: return the time when the exit status was retrieved. A generic function, timed-system, is also included that lets a background process run for a specified amount of time, and if the process did not exit, then the process is killed. AVAILABILITY The latest released version of this package is available for download from a CPAN (Comprehensive Perl Archive Network) archive near you in http://www.perl.com/CPAN/authors/id/B/BZ/BZAJAC/ The latest beta version of this package is hosted in a Subversion repository located at http://www.orcaware.com/svn/repos/perl_proc_background/trunk/ Subversion is an open-source source code management system designed to replace CVS. To get Subversion, see http://subversion.tigris.org/ and for an overview of Subversion, see http://www.orcaware.com/svn/Subversion-Blair_Zajac.ppt INSTALLATION In order to use this package you will need Perl version 5.004_04 or better. On Win32 systems Proc::Background requires the Win32::Process module. To check if your Perl has Win32::Process installed on it, run perl Makefile.PL If this command does not complain about missing Win32::Process, then you have the module installed. If you receive an error message, you can do two things to resolve this. If you have not performed extensive customization and installation of modules into your Perl, the easier path is to upgrade to the latest version of ActiveState Perl at http://aspn.activestate.com/ASPN/Downloads/ActivePerl/ which includes Win32::Process. If you want to use your current Perl installation, then download the latest version of the libwin32 package by Gurusamy Sarathy available at: http://www.perl.com/CPAN/authors/id/GSAR/ Once that is completed, you install Proc::Background as you would install any perl module library, by running these commands: perl Makefile.PL make make test make install You can edit the configuration section of Makefile.PL to select which programs to install in addition to the library itself. If you don't want to install any programs (only the library files) and don't want to mess with the Makefile.PL then pass the '-n' option to Makefile.PL: perl Makefile.PL -n If you want to install a private copy of this package in some other directory, then you should try to produce the initial Makefile with something like this command: perl Makefile.PL LIB=~/perl DOCUMENTATION See the CHANGES file for a list of recent changes. POD style documentation is included in all modules and scripts. These are normally converted to manual pages end installed as part of the "make install" process. You should also be able to use the 'perldoc' utility to extract documentation from the module files directly. COPYRIGHT Copyright (C) 1998-2005 Blair Zajac. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Proc-Background-1.10/t/0000755000076600000000000000000011224230556013626 5ustar blairwheelProc-Background-1.10/t/01proc.t0000644000076600000000000001274311224227556015134 0ustar blairwheel# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..47\n"; } END {print "not ok 1\n" unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use Proc::Background qw(timeout_system); package EmptySubclass; use Proc::Background; use vars qw(@ISA); @ISA = qw(Proc::Background); package main; # If we got here, then the package being tested was loaded. $loaded = 1; ok(1); # 1 # Find the lib directory. my $lib; foreach my $l (qw(lib ../lib)) { if (-d $l) { $lib = $l; last; } } $lib or die "Cannot find lib directory.\n"; # Find the sleep_exit.pl and timed-process scripts. The sleep_exit.pl # script takes a sleep time and an exit value. timed-process takes a # sleep time and a command to run. my $sleep_exit; my $timed_process; foreach my $dir (qw(. ./bin ./t ../bin ../t Proc-Background/t)) { unless ($sleep_exit) { my $s = "$dir/sleep_exit.pl"; $sleep_exit = $s if -r $s; } unless ($timed_process) { my $t = "$dir/timed-process"; $timed_process = $t if -r $t; } } $sleep_exit or die "Cannot find sleep_exit.pl.\n"; $timed_process or die "Cannot find timed-process.\n"; my @sleep_exit = ($^X, '-w', $sleep_exit); my @timed_process = ($^X, '-w', "-I$lib", $timed_process); # Test the alive and wait returns. my $p1 = EmptySubclass->new(@sleep_exit, 2, 26); ok($p1); # 2 if ($p1) { ok($p1->alive); # 3 sleep 3; ok(!$p1->alive); # 4 ok(($p1->wait >> 8) == 26); # 5 } else { ok(0); # 3 ok(0); # 4 ok(0); # 5 } # Test alive, wait, and die on already dead process. Also pass some # bogus command line options to the program to make sure that the # argument protecting code for Windows does not cause the shell any # confusion. my $p2 = EmptySubclass->new(@sleep_exit, 2, 5, "\t", '"', '\" 10 \\" \\\\"'); ok($p2); # 6 if ($p2) { ok($p2->alive); # 7 ok(($p2->wait >> 8) == 5); # 8 ok($p2->die); # 9 ok(($p2->wait >> 8) == 5); # 10 } else { ok(0); # 7 ok(0); # 8 ok(0); # 9 ok(0); # 10 } # Test die on a live process and collect the exit value. The exit # value should not be 0. my $p3 = EmptySubclass->new(@sleep_exit, 10, 0); ok($p3); # 11 if ($p3) { ok($p3->alive); # 12 sleep 1; ok($p3->die); # 13 ok(!$p3->alive); # 14 ok($p3->wait); # 15 ok($p3->end_time > $p3->start_time); # 16 } else { ok(0); # 12 ok(0); # 13 ok(0); # 14 ok(0); # 15 ok(0); # 16 } # Test the timeout_system function. In the first case, sleep_exit.pl # should exit with 26 before the timeout, and in the other case, it # should be killed and exit with a non-zero status. Do not check the # wait return value when the process is killed, since the return value # is different on Unix and Win32 platforms. my $a = timeout_system(2, @sleep_exit, 0, 26); my @a = timeout_system(2, @sleep_exit, 0, 26); ok($a>>8 == 26); # 17 ok(@a == 2); # 18 ok($a[0]>>8 == 26); # 19 ok($a[1] == 0); # 20 $a = timeout_system(1, @sleep_exit, 4, 0); @a = timeout_system(1, @sleep_exit, 4, 0); ok($a); # 21 ok(@a == 2); # 22 ok($a[0]); # 23 ok($a[1] == 1); # 24 # Test the code to find a program if the path to it is not absolute. my $p4 = EmptySubclass->new(@sleep_exit, 0, 0); ok($p4); # 25 if ($p4) { ok($p4->pid); # 26 sleep 2; ok(!$p4->alive); # 27 ok(($p4->wait >> 8) == 0); # 28 } else { ok(0); # 26 ok(0); # 27 ok(0); # 28 } # Test a command line entered as a single string. my $p5 = EmptySubclass->new("@sleep_exit 2 26"); ok($p5); # 29 if ($p5) { ok($p5->alive); # 30 sleep 3; ok(!$p5->alive); # 31 ok(($p5->wait >> 8) == 26); # 32 } else { ok(0); # 30 ok(0); # 31 ok(0); # 32 } sub System { my $result = system(@_); return ($? >> 8, $? & 127, $? & 128); } # Test the timed-process script. First test a normal exit. my @t_args = ($^X, '-w', "-I$lib", $timed_process); my @result = System(@t_args, '-e', 153, 3, "@sleep_exit 0 237"); ok($result[0] == 237); # 33 ok($result[1] == 0); # 34 ok($result[2] == 0); # 35 @result = System(@t_args, 1, "@sleep_exit 10 27"); ok($result[0] == 255); # 36 ok($result[1] == 0); # 37 ok($result[2] == 0); # 38 @result = System(@t_args, '-e', 153, 1, "@sleep_exit 10 27"); ok($result[0] == 153); # 39 ok($result[1] == 0); # 40 ok($result[2] == 0); # 41 # Test the ability to pass options to Proc::Background::new. my %options; my $p6 = EmptySubclass->new(\%options, @sleep_exit, 0, 43); ok($p6); # 42 if ($p6) { ok(($p6->wait >> 8) == 43); # 43 } else { ok(0); # 43 } # Test to make sure that the process is killed when the # Proc::Background object goes out of scope. $options{die_upon_destroy} = 1; { my $p7 = EmptySubclass->new(\%options, @sleep_exit, 99999, 98); ok($p7); # 44 if ($p7) { my $pid = $p7->pid; ok(defined $pid); # 45 sleep 1; ok(kill(0, $pid) == 1); # 46 $p7 = undef; sleep 1; ok(kill(0, $pid) == 0); # 47 } else { ok(0); # 45 ok(0); # 46 ok(0); # 47 } } Proc-Background-1.10/t/sleep_exit.pl0000755000076600000000000000050211224230105016312 0ustar blairwheeluse strict; $| = 1; my ($sleep, $exit_status) = @ARGV; $sleep = 1 unless defined $sleep; $exit_status = 0 unless defined $exit_status; if ($ENV{VERBOSE}) { print STDERR "$0: sleep $sleep and exit $exit_status.\n"; } sleep $sleep; if ($ENV{VERBOSE}) { print STDERR "$0 now exiting.\n"; } exit $exit_status;