Proc-Background-1.30000755001750001750 014134163660 13540 5ustar00useruser000000000000README100644001750001750 675314134163660 14514 0ustar00useruser000000000000Proc-Background-1.30Package Proc::Background Version 1.30 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. suspend: pause the process resume: resume a paused process terminate: 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 https://metacpan.org/pod/proc::Background The package's source code is hosted in a Git repository at https://github.com/nrdvana/perl-Proc-Background 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 and Win32::ShellQuote modules. 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, 2019-2021 Michael Conrad. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Changes100644001750001750 3111314134163660 15133 0ustar00useruser000000000000Proc-Background-1.30Wed Oct 20 15:38:00 JST 2021 Version 1.30 * New options 'command','exe' dis-ambiguate the problems around determining how to parse the command line and determine the executable name. It also allows faking argv[0]. They can be inspected after program launch via same-named attributes. * New options 'stdin','stdout','stderr' allow initializing handles of the child process. * New option 'cwd' sets initial current directory of the child * Renamed '->die' to '->terminate' and options 'die_upon_destroy' to 'autoterminate' (but preserved back-compat) * Option 'autoterminate' now has an attribute accessor and can be toggled on the fly. * New option 'autodie' throws exceptions from constructor instead of returning undef. * On Unix, use a pipe to capture error messages all the way through to the exec() call. Reap exec() failures without exposing the forked process to the user. * Add methods ->suspend and ->resume * Mitigate bug in timeout_system where a system clock change could increase the wait-time indefinitely. Fri Jul 9 07:33:00 JST 2021 Version 1.22 * Fix bug in timeout of $p->wait on Unix perl earlier than 5.12 where Time::HiRes::alarm was failing to set the alarm. * Fix test case 47 (which was failing on about 5% of systems) by waiting longer for the process to exit Tue Nov 5 17:39:00 EST 2019 Version 1.21 * Fix bug in timeout_system that caused it to wait the maximum duration on every call. Sun Nov 3 19:34:00 EST 2019 Version 1.20 * More correct parsing of Win32 arguments to determine executable name, and more correct quoting when building command line when starting from an argv. * More correct use of Unix signals during ->die, but also give user the ability to specify a custom sequence of signals. * Emulate Unix exit status of SIGKILL on Win32 when process was ended using $proc->Kill * New attributes ->exit_code and ->exit_signal help inspect the wstat value returned by ->wait. * Fix Win32 path separator used when searching %PATH% for exe * Don't leak changes to $? when calling ->die() during DESTROY * Make sure all die_upon_destroy happens before global destruction * Re-tooled with Dist::Zilla for modern generation of MYMETA and automatic version, license, etc. Sun 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 LICENSE100644001750001750 4401014134163660 14645 0ustar00useruser000000000000Proc-Background-1.30This software is copyright (c) 2021 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. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or 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 is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice 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 is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644001750001750 237414134163660 15273 0ustar00useruser000000000000Proc-Background-1.30name = Proc-Background abstract = Run asynchronous child processes under Unix or Windows main_module = lib/Proc/Background.pm author = Blair Zajac author = Michael Conrad license = Perl_5 copyright_holder = Michael Conrad, (C) 1998-2009 by Blair Zajac [MetaResources] bugtracker.web = https://github.com/nrdvana/perl-proc-background/issues repository.web = https://github.com/nrdvana/perl-proc-background repository.url = https://github.com/nrdvana/perl-proc-background.git repository.type = git [@Git] [Git::Contributors] [Git::GatherDir] exclude_match = ^t/tmp include_untracked = 0 [Encoding] encoding = bytes match = ^t/data/ [Git::NextVersion] [PkgVersion] [MakeMaker::Awesome] header_file = Makefile.header WriteMakefile_arg = PL_FILES => { %{$WriteMakefileArgs{PL_FILES}||{}}, %optional_PL_FILES } WriteMakefile_arg = EXE_FILES => [ @{$WriteMakefileArgs{EXE_FILES}||[]}, @optional_EXE_FILES ] [OSPrereqs / MSWin32] Win32::Process = 0.04 Win32::ShellQuote = 0.003001 [PodWeaver] ; authordep Pod::Weaver::Section::Contributors ; authordep Pod::Elemental::Transformer::List ;[ExtraTests] ;[PodSyntaxTests] [Manifest] [License] [MetaYAML] [MetaJSON] [UploadToCPAN] MANIFEST100644001750001750 54114134163660 14732 0ustar00useruser000000000000Proc-Background-1.30# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.024. Changes LICENSE MANIFEST META.json META.yml Makefile.PL Makefile.header README bin/timed-process.PL dist.ini lib/Proc/Background.pm lib/Proc/Background/Unix.pm lib/Proc/Background/Win32.pm t/01proc.t t/10-io-redirect.t t/11-cwd.t t/12-autodie.t t/sleep_exit.pl weaver.ini META.yml100644001750001750 157614134163660 15103 0ustar00useruser000000000000Proc-Background-1.30--- abstract: 'Run asynchronous child processes under Unix or Windows' author: - 'Blair Zajac ' - 'Michael Conrad ' build_requires: {} configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.024, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' 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' x_contributors: - 'Florian Schlichting ' - 'Kevin Ryde ' - 'Salvador Fandiño ' x_generated_by_perl: v5.34.0 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' META.json100644001750001750 245214134163660 15245 0ustar00useruser000000000000Proc-Background-1.30{ "abstract" : "Run asynchronous child processes under Unix or Windows", "author" : [ "Blair Zajac ", "Michael Conrad " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.024, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Proc-Background", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/nrdvana/perl-proc-background/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/nrdvana/perl-proc-background.git", "web" : "https://github.com/nrdvana/perl-proc-background" } }, "version" : "1.30", "x_contributors" : [ "Florian Schlichting ", "Kevin Ryde ", "Salvador Fandi\u00f1o " ], "x_generated_by_perl" : "v5.34.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.27", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } t000755001750001750 014134163660 13724 5ustar00useruser000000000000Proc-Background-1.3001proc.t100644001750001750 1353614134163660 15405 0ustar00useruser000000000000Proc-Background-1.30/t# 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..50\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 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 } else { ok(0); # 45 ok(0); # 46 ok(0); # 47 } } # 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 $p8->die; 11-cwd.t100644001750001750 314014134163660 15243 0ustar00useruser000000000000Proc-Background-1.30/tuse strict; use Test; BEGIN { plan tests => 6; } use FindBin; use File::Spec::Functions qw( catfile tmpdir ); use Cwd qw( abs_path getcwd ); use Proc::Background; =head1 DESCRIPTION This tests the option 'cwd' that runs the child in a different directory. =cut sub open_or_die { open my $fh, $_[0], $_[1] or die "open($_[2]): $!"; $fh; } sub readfile { my $fh= open_or_die('<:raw', $_[0]); local $/= undef; scalar <$fh>; } sub writefile { my $fh= open_or_die('>:raw', $_[0]); print $fh $_[1] or die "print: $!"; close $fh or die "close: $!"; } my $tmp_prefix= $FindBin::Script; $tmp_prefix =~ s/-.*//; my $script_fname= catfile(tmpdir, "$tmp_prefix-echodir-$$.pl"); writefile($script_fname, <<'END'); use strict; use Cwd; binmode STDOUT; print STDOUT getcwd()."\r\n"; END my $stdout_fname= catfile(tmpdir, "$tmp_prefix-stdout-$$.txt"); # Run the script in the current directory my $proc= Proc::Background->new({ stdout => open_or_die('>', $stdout_fname), cwd => '.', command => [ $^X, '-w', $script_fname ], }); 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 # Now run the script in the tmp directory $proc= Proc::Background->new({ stdout => open_or_die('>', $stdout_fname), cwd => abs_path(tmpdir), command => [ $^X, '-w', $script_fname ], }); 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 unlink $stdout_fname; unlink $script_fname; weaver.ini100644001750001750 57014134163660 15575 0ustar00useruser000000000000Proc-Background-1.30[@CorePrep] [-SingleEncoding] [Name] [Region / prelude] [Generic / SYNOPSIS] [Generic / DESCRIPTION] [Generic / OVERVIEW] [Collect / ATTRIBUTES] command = attr [Collect / METHODS] command = method [Collect / FUNCTIONS] command = func [Leftovers] [Region / postlude] [Generic / Thanks] [Authors] [-Transformer] transformer = List [Contributors] [Version] [Legal] Makefile.PL100644001750001750 364014134163660 15576 0ustar00useruser000000000000Proc-Background-1.30# This Makefile.PL for Proc-Background was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.49. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; use ExtUtils::MakeMaker; my @programs_to_install = qw(timed-process); # 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; my %optional_PL_FILES= map {("bin/$_.PL" => "bin/$_")} @programs_to_install; my @optional_EXE_FILES= map {"bin/$_"} @programs_to_install; my %WriteMakefileArgs = ( "ABSTRACT" => "Run asynchronous child processes under Unix or Windows", "AUTHOR" => "Blair Zajac , Michael Conrad ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Proc-Background", "LICENSE" => "perl", "NAME" => "Proc::Background", "PREREQ_PM" => {}, "VERSION" => "1.30", "test" => { "TESTS" => "t/*.t" } ); %WriteMakefileArgs = ( %WriteMakefileArgs, PL_FILES => { %{$WriteMakefileArgs{PL_FILES}||{}}, %optional_PL_FILES }, EXE_FILES => [ @{$WriteMakefileArgs{EXE_FILES}||[]}, @optional_EXE_FILES ], ); my %FallbackPrereqs = (); unless ( eval { ExtUtils::MakeMaker->VERSION('6.63_03') } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; if ( $^O eq 'MSWin32' ) { $WriteMakefileArgs{PREREQ_PM}{'Win32::Process'} = $FallbackPrereqs{'Win32::Process'} = '0.04'; $WriteMakefileArgs{PREREQ_PM}{'Win32::ShellQuote'} = $FallbackPrereqs{'Win32::ShellQuote'} = '0.003001'; } WriteMakefile(%WriteMakefileArgs); 12-autodie.t100644001750001750 175414134163660 16132 0ustar00useruser000000000000Proc-Background-1.30/tuse strict; use Test; BEGIN { plan tests => 7; } use FindBin; use Cwd qw( abs_path getcwd ); use Proc::Background; =head1 DESCRIPTION This tests the option 'cwd' that runs the child in a different directory. =cut sub new_and_catch { my @args= @_; local $@; my ($proc, $err); unless (eval { $proc= Proc::Background->new(@args); 1; }) { $err= $@; } #use DDP; &p([$proc, $err, $@]); return ($proc, $err); } my ($proc, $err)= new_and_catch('command_that_does_not_exist', ''); ok( $proc, undef ); # 1 ok( $err, undef ); # 2 ($proc, $err)= new_and_catch({ autodie => 1 }, 'command_that_does_not_exist', ''); $proc->wait if defined $proc; ok( $err ); # 3 ($proc, $err)= new_and_catch({ cwd => 'path_that_does_not_exist' }, $^X, '-v' ); ok( $proc, undef ); # 4 $proc->wait if defined $proc; ok( $err, undef ); # 5 ($proc, $err)= new_and_catch({ autodie => 1, cwd => 'path_that_does_not_exist' }, $^X, '-v' ); ok( $proc, undef ); # 6 $proc->wait if defined $proc; ok( $err ); # 7 Makefile.header100644001750001750 74614134163660 16477 0ustar00useruser000000000000Proc-Background-1.30my @programs_to_install = qw(timed-process); # 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; my %optional_PL_FILES= map {("bin/$_.PL" => "bin/$_")} @programs_to_install; my @optional_EXE_FILES= map {"bin/$_"} @programs_to_install; sleep_exit.pl100755001750001750 50214134163660 16542 0ustar00useruser000000000000Proc-Background-1.30/tuse 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; 10-io-redirect.t100644001750001750 522414134163660 16700 0ustar00useruser000000000000Proc-Background-1.30/tuse strict; use Test; BEGIN { plan tests => 7; } use FindBin; use File::Spec::Functions qw( catfile tmpdir ); use Proc::Background; =head1 DESCRIPTION This tests the options 'stdin','stdout','stderr' that assign the file handles of the child process. It writes a unique string to a temp file, then runs a child process that reads stdin and echoes to stdout and stderr, then it checks that stdout and stderr files have the correct content. =cut sub open_or_die { open my $fh, $_[0], $_[1] or die "open($_[2]): $!"; $fh; } sub readfile { my $fh= open_or_die('<:raw', $_[0]); local $/= undef; scalar <$fh>; } sub writefile { my $fh= open_or_die('>:raw', $_[0]); print $fh $_[1] or die "print: $!"; close $fh or die "close: $!"; } my $tmp_prefix= $FindBin::Script; $tmp_prefix =~ s/-.*//; my $stdin_fname= catfile(tmpdir, "$tmp_prefix-stdin-$$.txt" ); my $stdout_fname= catfile(tmpdir, "$tmp_prefix-stdout-$$.txt"); 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"; writefile($stdin_fname, $content); my $proc= Proc::Background->new({ stdin => open_or_die('<', $stdin_fname), stdout => open_or_die('>', $stdout_fname), stderr => open_or_die('>', $stderr_fname), command => [ $^X, '-we', <<'END' ], use strict; binmode STDIN; binmode STDOUT; binmode STDERR; $/= undef; my $content= ; print STDOUT $content; print STDERR $content; END }); ok( !!$proc, 1, 'started child' ); # 1 $proc->wait; ok( $proc->exit_code, 0, 'exit_code' ); # 2 ok( readfile($stdout_fname), $content, 'stdout content' ); # 3 ok( readfile($stderr_fname), $content, 'stderr content' ); # 4 # Test redirection to Win32 NUL or unix /dev/null $proc= Proc::Background->new({ stdin => undef, stdout => undef, stderr => undef, command => [ $^X, '-we', <<'END' ], use strict; print "Nobody should see this\n"; print STDERR "Nobody should see this\n"; END }); ok( !!$proc, 1, 'started child' ); # 5 $proc->wait; ok( $proc->exit_code, 0, 'exit_code' ); # 6 # Let the child process write the final 'ok' message $|= 1; $proc= Proc::Background->new({ stdin => undef, stdout => \*STDOUT, stderr => $stderr_fname, command => [ $^X, '-we', <<'END' ], use strict; binmode STDERR; print STDERR "appended a line\n"; print "ok 7\r\n"; END }); $proc->wait; $proc->exit_code == 0 or die "Final test exited with ".$proc->exit_code; my $err= readfile($stderr_fname); $err eq $content."appended a line\n" or die "Final test wrong stderr: $err"; unlink $stdin_fname; unlink $stdout_fname; unlink $stderr_fname; bin000755001750001750 014134163660 14231 5ustar00useruser000000000000Proc-Background-1.30timed-process.PL100644001750001750 437714134163660 17417 0ustar00useruser000000000000Proc-Background-1.30/binuse 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! Proc000755001750001750 014134163660 15132 5ustar00useruser000000000000Proc-Background-1.30/libBackground.pm100644001750001750 5527214134163660 17742 0ustar00useruser000000000000Proc-Background-1.30/lib/Procpackage Proc::Background; $Proc::Background::VERSION = '1.30'; # ABSTRACT: Generic interface to Unix and Win32 background process management require 5.004_04; use strict; use Exporter; use Carp; use Cwd; use Scalar::Util; @Proc::Background::ISA = qw(Exporter); @Proc::Background::EXPORT_OK = qw(timeout_system); # Determine if the operating system is Windows. my $is_windows = $^O eq 'MSWin32'; my $weaken_subref = Scalar::Util->can('weaken'); # 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 $path_sep; my @extensions = (''); if ($is_windows) { $is_absolute_re = '^(?:(?:[a-zA-Z]:[\\\\/])|(?:[\\\\/]{2}\w+[\\\\/]))'; $has_dir_element_re = "[\\\\/]"; $path_sep = "\\"; push(@extensions, '.exe'); } else { $is_absolute_re = "^/"; $has_dir_element_re = "/"; $path_sep = "/"; } # 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(@Proc::Background::ISA, 'Proc::Background::Win32'); } else { require Proc::Background::Unix; unshift(@Proc::Background::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 ( undef, 'empty command string' ) 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; } } return defined $path? ( $path, undef ) : ( undef, "no executable program located at $command" ); } else { my $cwd = cwd; if ($command =~ /$has_dir_element_re/o) { my $p1 = "$cwd$path_sep$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$path_sep$dir" unless $dir =~ /$is_absolute_re/o; my $p1 = "$dir$path_sep$command"; foreach my $ext (@extensions) { my $p2 = "$p1$ext"; if (-f $p2 and -x _) { $path = $p2; last; } } last if defined $path; } } return defined $path? ( $path, undef ) : ( undef, "cannot find absolute location of $command" ); } } # Define the set of allowed options, to warn about unknown ones. # Make it a method so subclasses can override it. %Proc::Background::_available_options= ( autodie => 1, command => 1, exe => 1, cwd => 1, stdin => 1, stdout => 1, stderr => 1, autoterminate => 1, die_upon_destroy => 1, ); sub _available_options { return \%Proc::Background::_available_options; } # 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; # The parameters are an optional %options hashref followed by any number # of arguments to become the @argv for exec(). If options are given, check # the keys for typos. my $options; if (@_ and ref $_[0] eq 'HASH') { $options= shift; my $known= $class->_available_options; my @unknown= grep !$known->{$_}, keys %$options; carp "Unknown options: ".join(', ', @unknown) if @unknown; } else { $options= {}; } my $self= bless {}, $class; $self->{_autodie}= 1 if $options->{autodie}; # Resolve any confusion between the 'command' option and positional @argv params. # Store the command in $self->{_command} so that the ::Unix and ::Win32 don't have # to deal with it redundantly. my $cmd= $options->{command}; if (defined $cmd) { croak "Can't use both 'command' option and command argument list" if @_; # Can be an arrayref or a single string croak "command must be a non-empty string or an arrayref of strings" unless (ref $cmd eq 'ARRAY' && defined $cmd->[0] && length $cmd->[0]) or (!ref $cmd && defined $cmd && length $cmd); } else { # Back-compat: maintain original API quirks confess "Proc::Background::new called with insufficient number of arguments" unless @_; return $self->_fatal('command is undefined') unless defined $_[0]; # Interpret the parameters as an @argv if there is more than one, # or if the 'exe' option was given. $cmd= (@_ > 1 || defined $options->{exe})? [ @_ ] : $_[0]; } $self->{_command}= $cmd; $self->{_exe}= $options->{exe} if defined $options->{exe}; # Also back-compat: failing to fork or CreateProcess returns undef return unless $self->_start($options); # Save the start time $self->{_start_time} = time; if ($options->{autoterminate} || $options->{die_upon_destroy}) { $self->autoterminate(1); } return $self; } # The original API returns undef from the constructor in case of various errors. # The autodie option converts these undefs into exceptions. sub _fatal { my ($self, $message)= @_; croak $message if $self->{_autodie}; warn "$0: $message"; return undef; } sub autoterminate { my ($self, $newval)= @_; if (@_ > 1 and ($newval xor $self->{_die_upon_destroy})) { if ($newval) { # Global destruction can break this feature, because there are no guarantees # on which order object destructors are called. In order to avoid that, need # to run all the ->die methods during END{}, and that requires weak # references which weren't available until 5.8 $weaken_subref->( $Proc::Background::_die_upon_destroy{$self+0}= $self ) if $weaken_subref; # could warn about it for earlier perl... but has been broken for 15 years and # who is still using < 5.8 anyway? } else { delete $Proc::Background::_die_upon_destroy{$self+0}; } $self->{_die_upon_destroy}= $newval? 1 : 0; } $self->{_die_upon_destroy} || 0 } sub DESTROY { my $self = shift; if ($self->{_die_upon_destroy}) { # During a mainline exit() $? is the prospective exit code from the # parent program. Preserve it across any waitpid() in die() local $?; $self->terminate; delete $Proc::Background::_die_upon_destroy{$self+0}; } } END { # Child processes need killed before global destruction, else the # Win32::Process objects might get destroyed first. for (grep defined, values %Proc::Background::_die_upon_destroy) { $_->terminate; delete $_->{_die_upon_destroy} } %Proc::Background::_die_upon_destroy= (); } # Reap the child. If the first argument is false, then return immediately. # Else, block waiting for the process to exit. If no second argument is # given, wait forever, else wait for that number of seconds. # 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, $blocking, $wait_seconds) = @_; 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 exit value lost. # (2, undef) : process still running. my ($result, $exit_value) = $self->_waitpid($blocking, $wait_seconds); 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 suspended { $_[0]->{_suspended}? 1 : 0 } sub suspend { my $self= shift; return $self->_fatal("can't suspend, process has exited") if !$self->{_os_obj}; $self->{_suspended} = 1 if $self->_suspend; return $self->{_suspended}; } sub resume { my $self= shift; return $self->_fatal("can't resume, process has exited") if !$self->{_os_obj}; $self->{_suspended} = 0 if $self->_resume; return !$self->{_suspended}; } sub wait { my ($self, $timeout_seconds) = @_; # If $self->{_exit_value} exists, then we already waited. return $self->{_exit_value} if exists($self->{_exit_value}); carp "calling ->wait on a suspended process" if $self->{_suspended}; # If neither _os_obj or _exit_value are set, then something is wrong. return undef if !exists($self->{_os_obj}); # Otherwise, wait for the process to finish. return $self->_reap(1, $timeout_seconds)? $self->{_exit_value} : undef; } sub terminate { shift->die(@_) } sub die { my $self = shift; croak "process is already terminated" if $self->{_autodie} && !$self->{_os_obj}; # See if the process has already died. return 1 unless $self->alive; # Kill the process using the OS specific method. $self->_terminate(@_? ([ @_ ]) : ()); # See if the process is still alive. !$self->alive; } sub command { $_[0]->{_command}; } sub exe { $_[0]->{_exe} } sub start_time { $_[0]->{_start_time}; } sub exit_code { return undef unless exists $_[0]->{_exit_value}; return $_[0]->{_exit_value} >> 8; } sub exit_signal { return undef unless exists $_[0]->{_exit_value}; return $_[0]->{_exit_value} & 127; } 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; my $delay= $timeout; while ($delay > 0 && defined $proc->{_os_obj}) { last if defined $proc->wait($delay); # If it times out, it's likely that wait() already waited the entire duration. # But, if it got interrupted, there might be time remaining. # But, if the system clock changes, this could break horribly. Constrain it to a sane value. my $t= time; if ($t < $end_time - $delay) { # time moved backward! $end_time= $t + $delay; } else { $delay= $end_time - $t; } } my $alive = $proc->alive; $proc->terminate if $alive; if (wantarray) { return ($proc->wait, $alive); } else { return $proc->wait; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Proc::Background - Generic interface to Unix and Win32 background process management =head1 SYNOPSIS use Proc::Background; timeout_system($seconds, $command, $arg1, $arg2); timeout_system($seconds, "$command $arg1 $arg2"); my $proc1 = Proc::Background->new($command, $arg1, $arg2) || die "failed"; my $proc2 = Proc::Background->new("$command $arg1 1>&2") || die "failed"; if ($proc1->alive) { $proc1->terminate; $proc1->wait; } say 'Ran for ' . ($proc1->end_time - $proc1->start_time) . ' seconds'; Proc::Background->new({ autodie => 1, # Throw exceptions instead of returning undef cwd => 'some/path/', # Set working directory for the new process exe => 'busybox', # Specify executable different from argv[0] command => [ $command ] # resolve ambiguity of command line vs. argv[0] }); # Set initial file handles Proc::Background->new({ stdin => undef, # /dev/null or NUL stdout => '/append/to/fname', # will try to open() stderr => $log_fh, # use existing handle command => \@command, }); # Automatically kill the process if the object gets destroyed my $proc4 = Proc::Background->new({ autoterminate => 1 }, $command); $proc4 = undef; # calls ->terminate =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 CONSTRUCTOR =over 4 =item B [options] I, [I, [I, ...]] =item B [options] 'I [I [I ...]]' This creates a new background process. Just like C, you can supply a single string of the entire command line, or individual arguments. The first argument may be a hashref of named options. To resolve the ambiguity between a command line vs. a single-element argument list, see the C option below. By default, the constructor returns an empty list on failure, except for a few cases of invalid arguments which call C. For platform-specific details, see L or L, but in short: =over 7 =item Unix This implementation uses C/C. If you supply a single-string command line, it is passed to the shell. If you supply multiple arguments, they are passed to C. In the multi-argument case, it will also check that the executable exists before calling C. =item Win32 This implementation uses the L. 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, appending C<".exe"> if needed. If you supply multiple arguments, the first is used as the C and the command line is built using L. =back B =over =item C This module traditionally has returned C if the child could not be started. Modern Perl recommends the use of exceptions for things like this. This option, like Perl's L pragma, causes all fatal errors in starting the process to die with exceptions instead of returning undef. =item C 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. =item C Specify the executable. This can serve two purposes: on Win32 it avoids the parsing of the commandline, and on Unix it can be used to run an executable while passing a different value for C<$ARGV[0]>. =item C, C, C Specify one or more overrides for the standard handles of the child. The value should be a Perl filehandle with an underlying system C value. As a convenience, you can pass C to open the C device on Win32 or C on Unix. You may also pass a plain-scalar file name which this module will attmept to open for reading or appending. (for anything more elaborate, see L instead) 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. =item C Specify a path which should become the child process's current working directory. The path must already exist. =item C If you pass a true value for this option, then destruction of the Proc::Background object (going out of scope, or script-end) will kill the process via C<< ->terminate >>. Without this option, the child process continues running. C is an alias for this option, used by previous versions of this module. =back =back =head1 ATTRIBUTES =over =item B The command (string or arrayref) that was passed to the constructor. =item B The path to the executable that was passed as an option to the constructor, or derived from the C. =item B Return the value that the Perl function time() returned when the process was started. =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. This makes a non-blocking call to C to check the real status of the process if it has not been reaped yet. =item B Boolean whether the process is thought to be stopped. This does not actually consult the operating system, and just returns the last known status from a call to C or C. It is always false if C is false. =item B Returns the exit code of the process, assuming it exited cleanly. Returns C if the process has not exited yet, and 0 if the process exited with a signal (or TerminateProcess). Since 0 is ambiguous, check for C first. =item B Returns the value of the signal the process exited with, assuming it died on a signal. Returns C if it has not exited yet, and 0 if it did not die to a signal. =item B Return the value that the Perl function time() returned when the exit status was obtained from the process. =item B This writeable attribute lets you enable or disable the autoterminate option, which could also be passed to the constructor. =back =head1 METHODS =over =item B $exit= $proc->wait; # blocks forever $exit= $proc->wait($timeout_seconds); # since version 1.20 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, this returns undef. This function may be called multiple times even after the process has exited and it will return the same exit status. Since version 1.20, you may pass an optional argument of the number of seconds to wait for the process to exit. This may be fractional, and if it is zero then the wait will be non-blocking. Note that on Unix this is implemented with L before a call to wait(), so it may not be compatible with scripts that use alarm() for other purposes, or systems/perls that resume system calls after a signal. In the event of a timeout, the return will be undef. =item B Pause the process. This returns true if the process is stopped afterward. This throws an excetion if the process is not C and C is enabled. =item B Resume a paused process. This returns true if the process is not stopped afterward. This throws an exception if the process is not C and C is enabled. =item B, 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 exited. C<@kill_sequence> is a list of actions and seconds-to-wait for that action to end the process. The default is C< TERM 2 TERM 8 KILL 3 KILL 7 >. On Unix this sends SIGTERM and SIGKILL; on Windows it just calls TerminateProcess (graceful termination is still a TODO). Note that C (formerly named C) on Proc::Background 1.10 and earlier on Unix called a sequence of: ->die( ( HUP => 1 )x5, ( QUIT => 1 )x5, ( INT => 1 )x5, ( KILL => 1 )x5 ); which wasn't what most people need, since SIGHUP is open to interpretation, and QUIT is almost always immediately fatal and generates a coredump. The new default should accomodate programs that acknowledge a second SIGTERM, and give enough time for it to exit on a laggy system while still not holding up the main script too much. C is preserved as an alias for C. This throws an exception if the process has been reaped and C is enabled. =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. 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 SEE ALSO =over =item L IPC::Run is a much more complete solution for running child processes. It handles dozens of forms of redirection and pipe pumping, and should probably be your first stop for any complex needs. However, also note the very large and slightly alarming list of limitations it lists for Win32. Proc::Background is a much simpler design and should be more reliable for simple needs. =item L If you are running on Win32, this article by Daniel Colascione helps describe the problem you are up against for passing argument lists: L This module gives you parsing / quoting per the standard CommandLineToArgvW behavior. But, if you need to pass arguments to be processed by C then you need to do additional work. =back =head1 AUTHORS =over 4 =item * Blair Zajac =item * Michael Conrad =back =head1 CONTRIBUTORS =for stopwords Florian Schlichting Kevin Ryde Salvador Fandiño =over 4 =item * Florian Schlichting =item * Kevin Ryde =item * Salvador Fandiño =back =head1 VERSION version 1.30 =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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. =cut Background000755001750001750 014134163660 17211 5ustar00useruser000000000000Proc-Background-1.30/lib/ProcUnix.pm100644001750001750 2203314134163660 20652 0ustar00useruser000000000000Proc-Background-1.30/lib/Proc/Backgroundpackage Proc::Background::Unix; $Proc::Background::Unix::VERSION = '1.30'; # ABSTRACT: Unix-specific implementation of process create/wait/kill require 5.004_04; use strict; use Exporter; use Carp; use POSIX qw( :errno_h :sys_wait_h ); # Test for existence of FD_CLOEXEC, needed for child-error-through-pipe trick my ($FD_CLOEXEC); eval { require Fcntl; $FD_CLOEXEC= Fcntl::FD_CLOEXEC(); }; # For un-explained mysterious reasons, Time::HiRes::alarm seem to misbehave on 5.10 and earlier # but core alarm works fine. my $alarm= ($] >= 5.012)? do { require Time::HiRes; \&Time::HiRes::alarm; } : sub { # round up to whole seconds CORE::alarm(POSIX::ceil($_[0])); }; @Proc::Background::Unix::ISA = qw(Exporter); # Start the background process. If it is started sucessfully, then record # the process id in $self->{_os_obj}. sub _start { my ($self, $options)= @_; # There are three main scenarios for how-to-exec: # * single-string command, to be handled by shell # * arrayref command, to be handled by execve # * arrayref command with 'exe' (fake argv0) # and one that isn't logical: # * single-string command with exe # throw an error for that last one rather than trying something awkward # like splitting the command string. my @argv; my $cmd= $self->{_command}; my $exe= $self->{_exe}; if (ref $cmd eq 'ARRAY') { @argv= @$cmd; ($exe, my $err) = Proc::Background::_resolve_path(defined $exe? $exe : $argv[0]); return $self->_fatal($err) unless defined $exe; $self->{_exe}= $exe; } elsif (defined $exe) { croak "Can't combine 'exe' option with single-string 'command', use arrayref 'command' instead."; } if (defined $options->{cwd}) { -d $options->{cwd} or return $self->_fatal("directory does not exist: '$options->{cwd}'"); } my ($new_stdin, $new_stdout, $new_stderr); $new_stdin= _resolve_file_handle($options->{stdin}, '<', \*STDIN) if exists $options->{stdin}; $new_stdout= _resolve_file_handle($options->{stdout}, '>>', \*STDOUT) if exists $options->{stdout}; $new_stderr= _resolve_file_handle($options->{stderr}, '>>', \*STDERR) if exists $options->{stderr}; # Fork a child process. my ($pipe_r, $pipe_w); if (defined $FD_CLOEXEC) { # use a pipe for the child to report exec() errors pipe $pipe_r, $pipe_w or return $self->_fatal("pipe: $!"); # This pipe needs to be in the non-preserved range that doesn't exist after exec(). # In the edge case where a pipe received a FD less than $^F, the CLOEXEC flag isn't set. # Try again on higher descriptors, then close the lower ones. my @rejects; while (fileno $pipe_r <= $^F or fileno $pipe_w <= $^F) { push @rejects, $pipe_r, $pipe_w; pipe $pipe_r, $pipe_w or return $self->_fatal("pipe: $!"); } } my $pid; { if ($pid = fork()) { # parent $self->{_os_obj} = $pid; $self->{_pid} = $pid; if (defined $pipe_r) { close $pipe_w; # wait for child to reply or close the pipe local $SIG{PIPE}= sub {}; my $msg= ''; while (0 < read $pipe_r, $msg, 1024, length $msg) {} close $pipe_r; # If child wrote anything to the pipe, it failed to exec. # Reap it before dying. if (length $msg) { waitpid $pid, 0; return $self->_fatal($msg); } } last; } elsif (defined $pid) { # child # Make absolutely sure nothing in this block interacts with the rest of the # process state, and that flow control never skips the _exit(). 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" if defined $new_stdin; open STDOUT, '>&', $new_stdout or die "Can't redirect STDOUT: $!\n" if defined $new_stdout; open STDERR, '>&', $new_stderr or die "Can't redirect STDERR: $!\n" if defined $new_stderr; if (defined $exe) { exec { $exe } @argv or die "$0: exec failed: $!\n"; } else { exec $cmd or die "$0: exec failed: $!\n"; } }; if (defined $pipe_w) { print $pipe_w $@; close $pipe_w; # force it to flush. Nothing else needs closed because we are about to _exit } else { print STDERR $@; } }; POSIX::_exit(1); } elsif ($! == EAGAIN) { sleep 5; redo; } else { return $self->_fatal("fork: $!"); } } $self; } sub _resolve_file_handle { my ($thing, $mode, $default)= @_; if (!defined $thing) { open my $fh, $mode, '/dev/null' or croak "open(/dev/null): $!"; return $fh; } elsif (ref $thing) { # use 'undef' to mean no-change return (fileno($thing) == fileno($default))? undef : $thing; } else { open my $fh, $mode, $thing or croak "open($thing): $!"; return $fh; } } # Wait for the child. # (0, exit_value) : sucessfully waited on. # (1, undef) : process already reaped and exit value lost. # (2, undef) : process still running. sub _waitpid { my ($self, $blocking, $wait_seconds) = @_; { # Try to wait on the process. # Implement the optional timeout with the 'alarm' call. my $result= 0; if ($blocking && $wait_seconds) { local $SIG{ALRM}= sub { die "alarm\n" }; $alarm->($wait_seconds); eval { $result= waitpid($self->{_os_obj}, 0); }; $alarm->(0); } else { $result= waitpid($self->{_os_obj}, $blocking? 0 : WNOHANG); } # Process finished. Grab the exit value. if ($result == $self->{_os_obj}) { delete $self->{_suspended}; 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 _suspend { kill STOP => $_[0]->{_os_obj}; } sub _resume { kill CONT => $_[0]->{_os_obj}; } sub _terminate { my $self = shift; my @kill_sequence= @_ && ref $_[0] eq 'ARRAY'? @{ $_[0] } : qw( TERM 2 TERM 8 KILL 3 KILL 7 ); # Try to kill the process with different signals. Calling alive() will # collect the exit status of the program. while (@kill_sequence and $self->alive) { my $sig= shift @kill_sequence; my $delay= shift @kill_sequence; kill($sig, $self->{_os_obj}); next unless defined $delay; last if $self->_reap(1, $delay); # block before sending next signal } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Proc::Background::Unix - Unix-specific implementation of process create/wait/kill =head1 DESCRIPTION This module does not have a public interface. Use L. =head1 NAME Proc::Background::Unix - Implementation of process management for Unix systems =head1 IMPLEMENTATION =head2 Command vs. Exec Unix systems start a new process by creating a mirror of the current process (C) and then having it alter its own state to prepare for the new program, and then calling C to replace the running code with code loaded from a new file. However, there is a second common method where the user wants to specify a command line string as they would type it in their shell. In this case, the actual program being executed is the shell, and the command line is given as one element of its argument list. Perl already supports both methods, such that if you pass one string to C containing shell characters, it calls the shell, and if you pass multiple arguments, it directly invokes C. This module mostly just lets Perl's C do its job, but also checks for the existence of the executable first, to make errors easier to catch. This check is skipped if there is a single-string command line. Unix lets you run a different executable than what is listed in the first argument. (this feature lets one Unix executable behave as multiple different programs depending on what name it sees in the first argument) You can use that feature by passing separate options of C and C to this module's constructor instead of a simple argument list. But, you can't mix a C option with a shell-interpreted command line string. =head2 Errors during Exec If the C option is enabled, and the system supports C, this module uses a trick where the forked child relays any errors through a pipe so that the parent can throw and handle the exception directly instead of creating a child process that is dead-on-arrival with the error on STDERR. =head1 AUTHORS =over 4 =item * Blair Zajac =item * Michael Conrad =back =head1 VERSION version 1.30 =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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. =cut Win32.pm100644001750001750 2366114134163660 20641 0ustar00useruser000000000000Proc-Background-1.30/lib/Proc/Backgroundpackage Proc::Background::Win32; $Proc::Background::Win32::VERSION = '1.30'; # ABSTRACT: Windows-specific implementation of process create/wait/kill require 5.004_04; use strict; use Exporter; use Carp; use Win32; use Win32::Process qw( NORMAL_PRIORITY_CLASS INFINITE ); use Win32::ShellQuote (); @Proc::Background::Win32::ISA = qw(Exporter); sub _start { my ($self, $options)= @_; my ($exe, $cmd, $cmdline)= ( $self->{_exe}, $self->{_command}, undef ); # 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 # application executable, if not already specified as an option. if (ref $cmd ne 'ARRAY') { $cmdline= $cmd; ($exe) = Win32::ShellQuote::unquote_native($cmdline) unless defined $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. else { $exe = $cmd->[0] unless defined $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); my $cwd= '.'; if (defined $options->{cwd}) { -d $options->{cwd} or return $self->_fatal("directory does not exist: '$options->{cwd}'"); $cwd= $options->{cwd}; } # On Strawberry Perl, CreateProcess will inherit the current process STDIN/STDOUT/STDERR, # but there is no way to specify them without altering the current process. # So, redirect handles, then create process, then revert them. my ($inherit, $new_stdin, $old_stdin, $new_stdout, $old_stdout, $new_stderr, $old_stderr); 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" 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" 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" if defined $new_stderr; } { local $@; eval { open STDIN, '<&', $new_stdin or die "Can't redirect STDIN: $!\n" if defined $new_stdin; open STDOUT, '>&', $new_stdout or die "Can't redirect STDOUT: $!\n" if defined $new_stdout; open STDERR, '>&', $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 # hash key. my $os_obj = 0; # Create the process. Win32::Process::Create($os_obj, $exe, $cmdline, $inherit, NORMAL_PRIORITY_CLASS, $cwd) or die Win32::FormatMessage( Win32::GetLastError() )."\n"; $self->{_pid} = $os_obj->GetProcessID; $self->{_os_obj} = $os_obj; }; chomp($err= $@); # Now restore handles before throwing exception open STDERR, '>&', $old_stderr or warn "Can't restore STDERR: $!\n" if defined $old_stderr; open STDOUT, '>&', $old_stdout or warn "Can't restore STDOUT: $!\n" if defined $old_stdout; open STDIN, '<&', $old_stdin or warn "Can't restore STDIN: $!\n" if defined $old_stdin; } if ($self->{_os_obj}) { return 1; } else { return $self->_fatal($err); } } sub _resolve_file_handle { my ($thing, $mode, $default)= @_; if (!defined $thing) { open my $fh, $mode, 'NUL' or croak "open(NUL): $!"; return $fh; } elsif (ref $thing) { return fileno($thing) == fileno($default)? undef : $thing; } else { open my $fh, $mode, $thing or croak "open($thing): $!"; return $fh; } } # Reap the child. # (0, exit_value) : sucessfully waited on. # (1, undef) : process already reaped and exit value lost. # (2, undef) : process still running. sub _waitpid { my ($self, $blocking, $wait_seconds) = @_; # Try to wait on the process. my $result = $self->{_os_obj}->Wait($wait_seconds? int($wait_seconds * 1000) : $blocking ? INFINITE : 0); # Process finished. Grab the exit value. if ($result == 1) { delete $self->{_suspended}; my $exit_code; $self->{_os_obj}->GetExitCode($exit_code); if ($exit_code == 256 && $self->{_called_terminateprocess}) { return (0, 9); # simulate SIGKILL exit status } else { return (0, $exit_code<<8); } } # Process still running. elsif ($result == 0) { return (2, 0); } # If we reach here, then something odd happened. return (0, 1<<8); } sub _suspend { $_[0]->{_os_obj}->Suspend(); } sub _resume { $_[0]->{_os_obj}->Resume(); } sub _terminate { my $self = shift; my @kill_sequence= @_ && ref $_[0] eq 'ARRAY'? @{ $_[0] } : qw( TERM 2 TERM 8 KILL 3 KILL 7 ); # Try the kill the process several times. # _reap will collect the exit status of the program. while (@kill_sequence and $self->alive) { my $sig= shift @kill_sequence; my $delay= shift @kill_sequence; # TODO: fix _taskkill, then re-enable: $sig eq 'KILL'? $self->_terminateprocess : $self->_taskkill; $self->_terminateprocess; next unless defined $delay; last if $self->_reap(1, $delay); # block before sending next signal } } # Use taskkill.exe as a sort of graceful SIGTERM substitute. sub _taskkill { my $self = shift; # TODO: This doesn't work reliably. Disabled for now, and continue to be heavy-handed # using TerminateProcess. The right solution would either be to do more elaborate setup # to make sure the correct taskkill.exe is used (and available), or to dig much deeper # into Win32 API to enumerate windows or threads and send WM_QUIT, or whatever other APIs # processes might be watching on Windows. That should probably be its own module. my $pid= $self->{_pid}; my $out= `taskkill.exe /PID $pid`; # If can't run taskkill, fall back to TerminateProcess $self->_terminateprocess unless $? == 0; } # Win32 equivalent of SIGKILL is TerminateProcess() sub _terminateprocess { my $self = shift; $self->{_os_obj}->Kill(256); # call TerminateProcess, essentially SIGKILL $self->{_called_terminateprocess} = 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Proc::Background::Win32 - Windows-specific implementation of process create/wait/kill =head1 DESCRIPTION This module does not have a public interface. Use L. =head1 NAME Proc::Background::Win32 - Implementation of process management for Win32 systems =head1 IMPLEMENTATION =head2 Perl Fork Limitations When Perl is built as a native Win32 application, the C and C are a broken approximation of their Unix counterparts. Calling C creates a I instead of a process, and there is no way to exit the thread without running Perl cleanup code, which could damage the parent in unpredictable ways, like closing file handles. Calling C will kill both parent and child (the whole process), and even calling C in the child still runs global destruction. File handles are shared between parent and child, so any file handle redirection you perform in the forked child will affect the parent and vice versa. In short, B call C or C on native Win32 Perl. =head2 Command Line This module implements background processes using C, which uses the Windows API's concepts of C, C, C, C, 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. This module C 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, 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. The first argument is used as the executable (unless you specified the C<'exe'> option), and gets the same path lookup. =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: 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 =head1 AUTHORS =over 4 =item * Blair Zajac =item * Michael Conrad =back =head1 VERSION version 1.30 =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 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. =cut