summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorgregor herrmann <gregoa@debian.org>2023-04-21 21:21:44 +0200
committergregor herrmann <gregoa@debian.org>2023-04-21 21:21:44 +0200
commitdf7d87bf2c7ca74d749f85619263135ccf3a2ab7 (patch)
tree185d04f4f1520d20a7751e15e921ced138212d10
parent011928dd9d192dfb674b4e74c8971e916b44b279 (diff)
parentafcd75e2e60669a6998c42cc5c753969d302c32e (diff)
Update upstream source from tag 'upstream/1.31'
Update to upstream version '1.31' with Debian dir 985adee835094498fc324162c9c466f041ecbc49
-rw-r--r--Changes11
-rw-r--r--LICENSE6
-rw-r--r--MANIFEST3
-rw-r--r--META.json11
-rw-r--r--META.yml7
-rw-r--r--Makefile.PL2
-rw-r--r--README4
-rw-r--r--lib/Proc/Background.pm64
-rw-r--r--lib/Proc/Background/Unix.pm19
-rw-r--r--lib/Proc/Background/Win32.pm108
-rw-r--r--t/01proc.t70
-rw-r--r--t/05-timed-process.t58
-rw-r--r--t/10-io-redirect.t12
-rw-r--r--t/11-cwd.t11
14 files changed, 235 insertions, 151 deletions
diff --git a/Changes b/Changes
index f2746b0..7f6f623 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,14 @@
+Mon Apr 17 14:33:00 EDT 2023
+
+ Version 1.31
+
+ * Allow { exe => undef } on Win32 for default OS determination of
+ what to execute.
+ * Avoid potential side effects from signal handlers when preparing
+ to exec on Unix
+ * Better perl 5.6 compatibility
+ * Various documentation improvements
+
Wed Oct 20 15:38:00 JST 2021
Version 1.30
diff --git a/LICENSE b/LICENSE
index d901a88..3666821 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-This software is copyright (c) 2021 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
+This software is copyright (c) 2023 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@ b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2021 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
+This software is Copyright (c) 2023 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
This is free software, licensed under:
@@ -272,7 +272,7 @@ That's all there is to it!
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2021 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
+This software is Copyright (c) 2023 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
This is free software, licensed under:
diff --git a/MANIFEST b/MANIFEST
index 2304b15..8902ddf 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,4 @@
-# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.024.
+# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.029.
Changes
LICENSE
MANIFEST
@@ -13,6 +13,7 @@ lib/Proc/Background.pm
lib/Proc/Background/Unix.pm
lib/Proc/Background/Win32.pm
t/01proc.t
+t/05-timed-process.t
t/10-io-redirect.t
t/11-cwd.t
t/12-autodie.t
diff --git a/META.json b/META.json
index 8106832..8fdeb91 100644
--- a/META.json
+++ b/META.json
@@ -5,7 +5,7 @@
"Michael Conrad <mike@nrdvana.net>"
],
"dynamic_config" : 1,
- "generated_by" : "Dist::Zilla version 6.024, CPAN::Meta::Converter version 2.150010",
+ "generated_by" : "Dist::Zilla version 6.029, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
@@ -32,14 +32,15 @@
"web" : "https://github.com/nrdvana/perl-proc-background"
}
},
- "version" : "1.30",
+ "version" : "1.31",
"x_contributors" : [
"Florian Schlichting <fsfs@debian.org>",
"Kevin Ryde <user42@zip.com.au>",
- "Salvador Fandi\u00f1o <sfandino@yahoo.com>"
+ "Salvador Fandi\u00f1o <sfandino@yahoo.com>",
+ "Sven Kirmess <sven.kirmess@kzone.ch>"
],
- "x_generated_by_perl" : "v5.34.0",
- "x_serialization_backend" : "Cpanel::JSON::XS version 4.27",
+ "x_generated_by_perl" : "v5.36.0",
+ "x_serialization_backend" : "Cpanel::JSON::XS version 4.29",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later"
}
diff --git a/META.yml b/META.yml
index ebe8fde..8d24c2d 100644
--- a/META.yml
+++ b/META.yml
@@ -7,7 +7,7 @@ build_requires: {}
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'Dist::Zilla version 6.024, CPAN::Meta::Converter version 2.150010'
+generated_by: 'Dist::Zilla version 6.029, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -16,11 +16,12 @@ name: Proc-Background
resources:
bugtracker: https://github.com/nrdvana/perl-proc-background/issues
repository: https://github.com/nrdvana/perl-proc-background.git
-version: '1.30'
+version: '1.31'
x_contributors:
- 'Florian Schlichting <fsfs@debian.org>'
- 'Kevin Ryde <user42@zip.com.au>'
- 'Salvador Fandiño <sfandino@yahoo.com>'
-x_generated_by_perl: v5.34.0
+ - 'Sven Kirmess <sven.kirmess@kzone.ch>'
+x_generated_by_perl: v5.36.0
x_serialization_backend: 'YAML::Tiny version 1.73'
x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later'
diff --git a/Makefile.PL b/Makefile.PL
index 9778e8d..cb9c1d8 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -31,7 +31,7 @@ my %WriteMakefileArgs = (
"LICENSE" => "perl",
"NAME" => "Proc::Background",
"PREREQ_PM" => {},
- "VERSION" => "1.30",
+ "VERSION" => "1.31",
"test" => {
"TESTS" => "t/*.t"
}
diff --git a/README b/README
index 5692e6f..9a081ef 100644
--- a/README
+++ b/README
@@ -26,7 +26,7 @@ AVAILABILITY
The latest released version of this package is available for download
from a CPAN (Comprehensive Perl Archive Network) archive near you in
- https://metacpan.org/pod/proc::Background
+ https://metacpan.org/pod/Proc::Background
The package's source code is hosted in a Git repository at
@@ -56,7 +56,7 @@ 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/
+ http://www.perl.com/CPAN/authors/id/G/GS/GSAR/
Once that is completed, you install Proc::Background as you would
install any perl module library, by running these commands:
diff --git a/lib/Proc/Background.pm b/lib/Proc/Background.pm
index 6d8e434..1bc47a4 100644
--- a/lib/Proc/Background.pm
+++ b/lib/Proc/Background.pm
@@ -1,5 +1,5 @@
package Proc::Background;
-$Proc::Background::VERSION = '1.30';
+$Proc::Background::VERSION = '1.31';
# ABSTRACT: Generic interface to Unix and Win32 background process management
require 5.004_04;
@@ -396,7 +396,7 @@ Proc::Background - Generic interface to Unix and Win32 background process manage
=head1 SYNOPSIS
- use Proc::Background;
+ use Proc::Background 'timeout_system';
timeout_system($seconds, $command, $arg1, $arg2);
timeout_system($seconds, "$command $arg1 $arg2");
@@ -469,7 +469,8 @@ If you supply a single-string command line, it derives the executable by
parsing the command line and looking for the first element in the C<PATH>,
appending C<".exe"> if needed. If you supply multiple arguments, the
first is used as the C<exe> and the command line is built using
-L<Win32::ShellQuote>.
+L<Win32::ShellQuote>. To let Windows search for the executable, pass option
+C<< { exe => undef } >>.
=back
@@ -483,19 +484,21 @@ This module traditionally has returned C<undef> if the child could not
be started. Modern Perl recommends the use of exceptions for things
like this. This option, like Perl's L<autodie> pragma, causes all
fatal errors in starting the process to die with exceptions instead of
-returning undef.
+returning undef. (module-usage errors or other problems prior to
+launching the process may still 'croak' regardless of this setting)
=item C<command>
You may specify the command as an option instead of passing the command
as a list. A string value is considered a command line, and an arrayref
-value is considered an argument list. This can resolve the ambiguity
-between a command line vs. single-element argument list.
+value is considered an argument list. Using this option resolves the
+ambiguity in the plain-list constructor between a command line vs.
+a single-element argument list.
=item C<exe>
Specify the executable. This can serve two purposes:
-on Win32 it avoids the parsing of the commandline, and on Unix it can be
+on Win32 it avoids the need to parse the commandline, and on Unix it can be
used to run an executable while passing a different value for C<$ARGV[0]>.
=item C<stdin>, C<stdout>, C<stderr>
@@ -510,7 +513,7 @@ name which this module will attmept to open for reading or appending.
Note that on Win32, none of the parent's handles are inherited by default,
which is the opposite on Unix. When you specify any of these handles on
-Win32 the default will change to inherit them from the parent.
+Win32 the default will change to inherit the rest from the parent.
=item C<cwd>
@@ -681,6 +684,41 @@ scalar context, or nothing in a void context.
=back
+=head1 BUGS
+
+The following behaviors aren't ideal, but are preserved for backward-compatibility.
+
+=over
+
+=item Commandline vs. Single Argv[]
+
+C<< ->new($x) >> is treated as a command line. In C<< ->new({ exe => $y }, $x) >>,
+$x is treated as C<$ARGV[0]>. Use C<< ->new({ command => ... }) >>
+(scalar vs. arrayref) to dis-ambiguate.
+
+=item Win32 Argv Quoting
+
+This is a bug in Windows, not this module. It is not possible to universally
+convert an @ARGV into a commandline, because each Win32 program performs its
+own command line parsing, and cmd.exe and find.exe deviate from the majority
+of other executables. Those things could be improved with hieuristics, which
+this module doesn't have.
+
+=item Win32 exe determination
+
+If you don't specify an absolute path for option C<exe>, this module manually
+searches the %PATH% looking for the executable, and is less thorough than the
+native Windows shell behavior. Use C<< { exe => undef } >> to get the naive
+Windows exe search. (but you need Win32::Process version 0.17 or newer)
+
+=item Win32 SIGTERM
+
+This module only supports TerminateProcess, which is equivalent to SIGKILL, not
+SIGTERM. SIGTERM could be emulated by calling taskkill.exe, or using windows
+messages. Patches welcome.
+
+=back
+
=head1 SEE ALSO
=over
@@ -723,7 +761,7 @@ Michael Conrad <mike@nrdvana.net>
=head1 CONTRIBUTORS
-=for stopwords Florian Schlichting Kevin Ryde Salvador Fandiño
+=for stopwords Florian Schlichting Kevin Ryde Salvador Fandiño Sven Kirmess
=over 4
@@ -739,15 +777,19 @@ Kevin Ryde <user42@zip.com.au>
Salvador Fandiño <sfandino@yahoo.com>
+=item *
+
+Sven Kirmess <sven.kirmess@kzone.ch>
+
=back
=head1 VERSION
-version 1.30
+version 1.31
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2021 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
+This software is copyright (c) 2023 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/lib/Proc/Background/Unix.pm b/lib/Proc/Background/Unix.pm
index e937ee1..4f22334 100644
--- a/lib/Proc/Background/Unix.pm
+++ b/lib/Proc/Background/Unix.pm
@@ -1,5 +1,5 @@
package Proc::Background::Unix;
-$Proc::Background::Unix::VERSION = '1.30';
+$Proc::Background::Unix::VERSION = '1.31';
# ABSTRACT: Unix-specific implementation of process create/wait/kill
require 5.004_04;
@@ -104,17 +104,18 @@ sub _start {
# child
# Make absolutely sure nothing in this block interacts with the rest of the
# process state, and that flow control never skips the _exit().
+ $SIG{$_}= sub{die;} for qw( INT HUP QUIT TERM ); # clear custom signal handlers
+ $SIG{$_}= 'DEFAULT' for qw( __WARN__ __DIE__ );
eval {
- local $SIG{__DIE__}= undef;
eval {
chdir($options->{cwd}) or die "chdir($options->{cwd}): $!\n"
if defined $options->{cwd};
- open STDIN, '<&', $new_stdin or die "Can't redirect STDIN: $!\n"
+ open STDIN, '<&'.fileno($new_stdin) or die "Can't redirect STDIN: $!\n"
if defined $new_stdin;
- open STDOUT, '>&', $new_stdout or die "Can't redirect STDOUT: $!\n"
+ open STDOUT, '>&'.fileno($new_stdout) or die "Can't redirect STDOUT: $!\n"
if defined $new_stdout;
- open STDERR, '>&', $new_stderr or die "Can't redirect STDERR: $!\n"
+ open STDERR, '>&'.fileno($new_stderr) or die "Can't redirect STDERR: $!\n"
if defined $new_stderr;
if (defined $exe) {
@@ -234,10 +235,6 @@ Proc::Background::Unix - Unix-specific implementation of process create/wait/kil
This module does not have a public interface. Use L<Proc::Background>.
-=head1 NAME
-
-Proc::Background::Unix - Implementation of process management for Unix systems
-
=head1 IMPLEMENTATION
=head2 Command vs. Exec
@@ -288,11 +285,11 @@ Michael Conrad <mike@nrdvana.net>
=head1 VERSION
-version 1.30
+version 1.31
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2021 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
+This software is copyright (c) 2023 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/lib/Proc/Background/Win32.pm b/lib/Proc/Background/Win32.pm
index 41b8a00..a43c4f2 100644
--- a/lib/Proc/Background/Win32.pm
+++ b/lib/Proc/Background/Win32.pm
@@ -1,5 +1,5 @@
package Proc::Background::Win32;
-$Proc::Background::Win32::VERSION = '1.30';
+$Proc::Background::Win32::VERSION = '1.31';
# ABSTRACT: Windows-specific implementation of process create/wait/kill
require 5.004_04;
@@ -14,7 +14,7 @@ use Win32::ShellQuote ();
sub _start {
my ($self, $options)= @_;
- my ($exe, $cmd, $cmdline)= ( $self->{_exe}, $self->{_command}, undef );
+ my ($exe, $cmd, $cmdline, $err)= @{$options}{'exe','command'};
# If 'command' is a single string, treat it as system() would and assume
# it should be split into arguments. The first argument is then the
@@ -22,26 +22,33 @@ sub _start {
if (ref $cmd ne 'ARRAY') {
$cmdline= $cmd;
($exe) = Win32::ShellQuote::unquote_native($cmdline)
- unless defined $exe;
+ unless exists $options->{exe};
}
# system() would treat a list of arguments as an un-quoted ARGV
# for the program, so concatenate them into a command line appropriate
# for Win32 CommandLineToArgvW to decode back to what we started with.
- # Preserve the first un-quoted argument for use as lpApplicationName.
+ # Preserve the first un-quoted argument for use as lpApplicationName,
+ # unless user requested some value (including undef).
else {
- $exe = $cmd->[0] unless defined $exe;
+ $exe = $cmd->[0] unless exists $options->{exe};
$cmdline= Win32::ShellQuote::quote_native(@$cmd);
}
- # 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.
- ($exe, my $err) = Proc::Background::_resolve_path($exe);
- return $self->_fatal($err) unless defined $exe;
- $exe = Win32::GetShortPathName($exe);
-
+ if (defined $exe) {
+ # Find the absolute path to the program. If it cannot be found,
+ # then return.
+ ($exe, $err) = Proc::Background::_resolve_path($exe);
+ return $self->_fatal($err) unless defined $exe;
+ # 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.
+ $exe = Win32::GetShortPathName($exe)
+ }
+ else {
+ Win32::Process->VERSION > 0.16
+ or croak "{exe => undef} feature requires Win32::Process 0.17";
+ }
+
my $cwd= '.';
if (defined $options->{cwd}) {
-d $options->{cwd}
@@ -56,30 +63,30 @@ sub _start {
if (exists $options->{stdin}) {
$inherit= 1;
$new_stdin= _resolve_file_handle($options->{stdin}, '<', \*STDIN);
- open $old_stdin, '<&', \*STDIN or croak "Can't save STDIN: $!\n"
+ open $old_stdin, '<&'.fileno(\*STDIN) or croak "Can't save STDIN: $!\n"
if defined $new_stdin;
}
if (exists $options->{stdout}) {
$inherit= 1;
$new_stdout= _resolve_file_handle($options->{stdout}, '>>', \*STDOUT);
- open $old_stdout, '>&', \*STDOUT or croak "Can't save STDOUT: $!\n"
+ open $old_stdout, '>&'.fileno(\*STDOUT) or croak "Can't save STDOUT: $!\n"
if defined $new_stdout;
}
if (exists $options->{stderr}) {
$inherit= 1;
$new_stderr= _resolve_file_handle($options->{stderr}, '>>', \*STDERR);
- open $old_stderr, '>&', \*STDERR or croak "Can't save STDERR: $!\n"
+ open $old_stderr, '>&'.fileno(\*STDERR) or croak "Can't save STDERR: $!\n"
if defined $new_stderr;
}
{
local $@;
eval {
- open STDIN, '<&', $new_stdin or die "Can't redirect STDIN: $!\n"
+ open STDIN, '<&'.fileno($new_stdin) or die "Can't redirect STDIN: $!\n"
if defined $new_stdin;
- open STDOUT, '>&', $new_stdout or die "Can't redirect STDOUT: $!\n"
+ open STDOUT, '>&'.fileno($new_stdout) or die "Can't redirect STDOUT: $!\n"
if defined $new_stdout;
- open STDERR, '>&', $new_stderr or die "Can't redirect STDERR: $!\n"
+ open STDERR, '>&'.fileno($new_stderr) or die "Can't redirect STDERR: $!\n"
if defined $new_stderr;
# Perl 5.004_04 cannot run Win32::Process::Create on a nonexistant
@@ -94,11 +101,11 @@ sub _start {
};
chomp($err= $@);
# Now restore handles before throwing exception
- open STDERR, '>&', $old_stderr or warn "Can't restore STDERR: $!\n"
+ open STDERR, '>&'.fileno($old_stderr) or warn "Can't restore STDERR: $!\n"
if defined $old_stderr;
- open STDOUT, '>&', $old_stdout or warn "Can't restore STDOUT: $!\n"
+ open STDOUT, '>&'.fileno($old_stdout) or warn "Can't restore STDOUT: $!\n"
if defined $old_stdout;
- open STDIN, '<&', $old_stdin or warn "Can't restore STDIN: $!\n"
+ open STDIN, '<&'.fileno($old_stdin) or warn "Can't restore STDIN: $!\n"
if defined $old_stdin;
}
if ($self->{_os_obj}) {
@@ -210,10 +217,6 @@ Proc::Background::Win32 - Windows-specific implementation of process create/wait
This module does not have a public interface. Use L<Proc::Background>.
-=head1 NAME
-
-Proc::Background::Win32 - Implementation of process management for Win32 systems
-
=head1 IMPLEMENTATION
=head2 Perl Fork Limitations
@@ -232,38 +235,51 @@ In short, B<never> call C<fork> or C<exec> on native Win32 Perl.
=head2 Command Line
-This module implements background processes using C<Win32::Process>, which
+This module implements background processes using L<Win32::Process>, which
uses the Windows API's concepts of C<CreateProcess>, C<TerminateProces>,
C<WaitForSingleObject>, C<GetExitCode>, and so on.
Windows CreateProcess expects an executable name and a command line; breaking
the command line into an argument list is left to each individual application,
-most of which use the library function C<CommandLineToArgvW>. This module
-C<Win32::ShellQuote> to parse and format Windows command lines.
+most of which use the library function L<https://docs.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-commandlinetoargvw|CommandLineToArgvW>. This module
+uses L<Win32::ShellQuote> to parse and format Windows command lines.
If you supply a single-string command line, and don't specify the executable
-with the C<'exe'> option, it splits the command line and uses the first
-argument. Then it looks for that argument in the C<PATH>, searching again
-with a suffix of C<".exe"> if the original wasn't found.
-
-If you supply a command of multiple arguments, they are combined into a command
-line using C<Win32::ShellQuote>. The first argument is used as the executable
-(unless you specified the C<'exe'> option), and gets the same path lookup.
+with the C<exe> option, this module parses the first argument from the
+command line to be the 'exe' option. It then looks for the 'exe' in
+C<< $ENV{PATH} >>, and tries again with a suffix of C<< .exe >> if it didn't
+find one. If you specify the option as C<< { exe => undef } >>, this module
+skips that step and passes NULL to Win32 C<CreateProcess>, which causes
+Windows to parse the first argument and find the executable on its own.
+(Letting Windows search for the executable is probably a better idea anyway,
+and this might become the default in the future. It only works with
+Win32::Process 0.17 or later)
+
+If you supply an array of arguments as the command, this module combines them
+into a command line using C<Win32::ShellQuote/quote_native>. The first
+argument is used as the executable (unless you specified the C<'exe'> option,
+like above).
=head2 Initial File Handles
-When no options are specified, the new process does not inherit any file handles
-of the current process. This differs from the Unix implementation, but I'm
-leaving it this way for back-compat. If you specify any of stdin, stdout, or
-stderr, this module delivers them to the new process by temporarily redirecting
-STDIN, STDOUT, and STDERR of the current process, which the child process then
-inherits. Any handle not specified will be inherited as-is. If you wish to
-redirect a handle to NUL, set the option to C<undef>:
+When B<no handle options> are specified, the new process does B<not inherit any file handles>
+of the current process. This differs from the Unix implementation where they are all
+inherited by default, but I'm leaving it this way for backward compatibility.
+In other words, yes, they ought to be inherited by default, but changing that now
+is more likely to break things than fix things.
+
+If you specify B<any> of C<stdin>, C<stdout>, or C<stderr>, any handle not
+specified B<will be inherited> as-is. In other words, by indicating you are
+interested in passing file handles, the default Unix behavior occurs.
+If you wish to redirect a handle to NUL, set the option to C<undef>:
stdin => undef, # stdin will read from NUL device
stdout => $some_fh, # stdout will write to a file handle
stderr => \*STDERR, # stderr will go to the same STDERR of the current process
+You may set a file handle to a pipe, but beware, Windows does not support
+non-blocking reads or writes to pipes.
+
=head1 AUTHORS
=over 4
@@ -280,11 +296,11 @@ Michael Conrad <mike@nrdvana.net>
=head1 VERSION
-version 1.30
+version 1.31
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2021 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
+This software is copyright (c) 2023 by Michael Conrad, (C) 1998-2009 by Blair Zajac.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/t/01proc.t b/t/01proc.t
index 4c49ac8..e4c9636 100644
--- a/t/01proc.t
+++ b/t/01proc.t
@@ -4,7 +4,7 @@
use strict;
use vars qw($loaded);
-BEGIN { $| = 1; print "1..50\n"; }
+BEGIN { $| = 1; print "1..41\n"; }
END {print "not ok 1\n" unless $loaded; }
my $ok_count = 1;
@@ -27,35 +27,19 @@ package main;
$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);
+my $sleep_exit_cmdline= join ' ', map { $_ =~ /\S/? qq{"$_"} : $_ } @sleep_exit;
# Test the alive and wait returns.
my $p1 = EmptySubclass->new(@sleep_exit, 2, 26);
@@ -146,7 +130,7 @@ if ($p4) {
}
# Test a command line entered as a single string.
-my $p5 = EmptySubclass->new("@sleep_exit 2 26");
+my $p5 = EmptySubclass->new("$sleep_exit_cmdline 2 26");
ok($p5); # 29
if ($p5) {
ok($p5->alive); # 30
@@ -159,36 +143,14 @@ if ($p5) {
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
+ok($p6); # 33
if ($p6) {
- ok(($p6->wait >> 8) == 43); # 43
+ ok(($p6->wait >> 8) == 43); # 34
} else {
- ok(0); # 43
+ ok(0); # 34
}
# Test to make sure that the process is killed when the
@@ -196,28 +158,28 @@ if ($p6) {
$options{die_upon_destroy} = 1;
{
my $p7 = EmptySubclass->new(\%options, @sleep_exit, 99999, 98);
- ok($p7); # 44
+ ok($p7); # 35
if ($p7) {
my $pid = $p7->pid;
- ok(defined $pid); # 45
+ ok(defined $pid); # 36
sleep 1;
- ok(kill(0, $pid) == 1); # 46
+ ok(kill(0, $pid) == 1); # 37
$p7 = undef;
# sleep up to 10 seconds waiting for the process id to stop being valid
my $kill= 1;
for (1..10) { sleep 1; last if !($kill=kill(0, $pid)); }
- ok($kill == 0); # 47
+ ok($kill == 0); # 38
} else {
- ok(0); # 45
- ok(0); # 46
- ok(0); # 47
+ ok(0); # 36
+ ok(0); # 37
+ ok(0); # 38
}
}
# Test wait with a timeout on a process that doesn't exit.
my $p8 = EmptySubclass->new(@sleep_exit, 10, 0);
-ok($p8); # 48
-ok($p8 && $p8->alive); # 49
-ok($p8 && !defined $p8->wait(1.5)); # 50
+ok($p8); # 39
+ok($p8 && $p8->alive); # 40
+ok($p8 && !defined $p8->wait(1.5)); # 41
$p8->die;
diff --git a/t/05-timed-process.t b/t/05-timed-process.t
new file mode 100644
index 0000000..795bc4f
--- /dev/null
+++ b/t/05-timed-process.t
@@ -0,0 +1,58 @@
+use strict;
+use Test;
+BEGIN { plan tests => 9; }
+use Proc::Background qw(timeout_system);
+
+# 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);
+my $sleep_exit_cmdline= join ' ', map { $_ =~ /\S/? qq{"$_"} : $_ } @sleep_exit;
+
+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_cmdline 0 237");
+ok($result[0], 237);
+ok($result[1], 0);
+ok($result[2], 0);
+
+@result = System(@t_args, 1, "$sleep_exit_cmdline 10 27");
+ok($result[0], 255);
+ok($result[1], 0);
+ok($result[2], 0);
+
+@result = System(@t_args, '-e', 153, 1, "$sleep_exit_cmdline 10 27");
+ok($result[0], 153);
+ok($result[1], 0);
+ok($result[2], 0);
+
diff --git a/t/10-io-redirect.t b/t/10-io-redirect.t
index 04f1aab..9d527f4 100644
--- a/t/10-io-redirect.t
+++ b/t/10-io-redirect.t
@@ -19,12 +19,12 @@ sub open_or_die {
$fh;
}
sub readfile {
- my $fh= open_or_die('<:raw', $_[0]);
+ my $fh= open_or_die('<', $_[0]);
local $/= undef;
scalar <$fh>;
}
sub writefile {
- my $fh= open_or_die('>:raw', $_[0]);
+ my $fh= open_or_die('>', $_[0]);
print $fh $_[1] or die "print: $!";
close $fh or die "close: $!";
}
@@ -38,7 +38,7 @@ my $stderr_fname= catfile(tmpdir, "$tmp_prefix-stderr-$$.txt");
# Write something to the stdin file. Then run the script which reads it and echoes to both stdout and stderr.
my ($stdin, $stdout, $stderr);
-my $content= "Time = ".time."\r\n";
+my $content= "Time = ".time."\n";
writefile($stdin_fname, $content);
my $proc= Proc::Background->new({
@@ -47,9 +47,6 @@ my $proc= Proc::Background->new({
stderr => open_or_die('>', $stderr_fname),
command => [ $^X, '-we', <<'END' ],
use strict;
-binmode STDIN;
-binmode STDOUT;
-binmode STDERR;
$/= undef;
my $content= <STDIN>;
print STDOUT $content;
@@ -87,9 +84,8 @@ $proc= Proc::Background->new({
stderr => $stderr_fname,
command => [ $^X, '-we', <<'END' ],
use strict;
-binmode STDERR;
print STDERR "appended a line\n";
-print "ok 7\r\n";
+print "ok 7\n";
END
});
$proc->wait;
diff --git a/t/11-cwd.t b/t/11-cwd.t
index 5a6db7b..3be1b9d 100644
--- a/t/11-cwd.t
+++ b/t/11-cwd.t
@@ -17,12 +17,12 @@ sub open_or_die {
$fh;
}
sub readfile {
- my $fh= open_or_die('<:raw', $_[0]);
+ my $fh= open_or_die('<', $_[0]);
local $/= undef;
scalar <$fh>;
}
sub writefile {
- my $fh= open_or_die('>:raw', $_[0]);
+ my $fh= open_or_die('>', $_[0]);
print $fh $_[1] or die "print: $!";
close $fh or die "close: $!";
}
@@ -34,8 +34,7 @@ my $script_fname= catfile(tmpdir, "$tmp_prefix-echodir-$$.pl");
writefile($script_fname, <<'END');
use strict;
use Cwd;
-binmode STDOUT;
-print STDOUT getcwd()."\r\n";
+print STDOUT getcwd()."\n";
END
my $stdout_fname= catfile(tmpdir, "$tmp_prefix-stdout-$$.txt");
@@ -49,7 +48,7 @@ my $proc= Proc::Background->new({
ok( !!$proc, 1, 'started child' ); # 1
$proc->wait;
ok( $proc->exit_code, 0, 'exit_code' ); # 2
-ok( readfile($stdout_fname), getcwd()."\r\n", 'stdout content' ); # 3
+ok( readfile($stdout_fname), getcwd()."\n", 'stdout content' ); # 3
# Now run the script in the tmp directory
$proc= Proc::Background->new({
@@ -60,7 +59,7 @@ $proc= Proc::Background->new({
ok( !!$proc, 1, 'started child' ); # 1
$proc->wait;
ok( $proc->exit_code, 0, 'exit_code' ); # 2
-ok( readfile($stdout_fname), abs_path(tmpdir)."\r\n", 'stdout content' ); # 3
+ok( readfile($stdout_fname), abs_path(tmpdir)."\n", 'stdout content' ); # 3
unlink $stdout_fname;
unlink $script_fname;