PAR-Packer-1.041/0000755000175000017500000000000013200634513013521 5ustar roderichroderichPAR-Packer-1.041/LICENSE0000644000175000017500000004366413026021203014533 0ustar roderichroderichCopyright 2002-2010 by Audrey Tang . 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 --- Copyright 2002-2010 by Audrey Tang . 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 --- Copyright 2002-2010 by Audrey Tang . 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 MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End PAR-Packer-1.041/package/0000755000175000017500000000000013200634513015114 5ustar roderichroderichPAR-Packer-1.041/package/parl.nsi0000644000175000017500000000075413026021203016563 0ustar roderichroderichSetCompressor bzip2 !define MUI_VERSION "0.62" !define MUI_NAME "parl" !define PERL_PATH "C:\perl" XPStyle On Name "PAR Loader" DirText "Select the location of parl.exe:" OutFile "${MUI_NAME}-${MUI_VERSION}-win32.exe" InstallDir $SYSDIR AutoCloseWindow true ShowInstDetails hide InstallColors /windows InstProgressFlags smooth colored Section "Install" SetOverwrite try SetOutPath $INSTDIR File "${PERL_PATH}\bin\parl.exe" File "${PERL_PATH}\bin\perl*.dll" SectionEnd PAR-Packer-1.041/META.yml0000644000175000017500000000217213200634513014774 0ustar roderichroderich--- abstract: 'PAR Packager' author: - 'Audrey Tang ' build_requires: ExtUtils::MakeMaker: '0' IPC::Run3: '0.048' Test::More: '0' configure_requires: DynaLoader: '0' ExtUtils::CBuilder: '0' ExtUtils::Embed: '0' File::Basename: '0' File::Glob: '0' File::Spec::Functions: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, 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: PAR-Packer no_index: directory: - t - inc - contrib recommends: Digest: '0' Digest::SHA: '0' Module::Signature: '0' Tk: '0' Tk::ColoredButton: '0' Tk::EntryCheck: '0' Tk::Getopt: '0' requires: Archive::Zip: '1.02' Compress::Zlib: '1.30' File::Temp: '0.05' Getopt::ArgvFile: '1.07' IO::Compress::Gzip: '0' Module::ScanDeps: '1.21' PAR: '1.014' PAR::Dist: '0.22' Text::ParseWords: '0' perl: '5.008009' resources: MailingList: par@perl.org repository: git://github.com/rschupp/PAR-Packer.git version: '1.041' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PAR-Packer-1.041/MANIFEST0000644000175000017500000000400113200634513014645 0ustar roderichroderichAUTHORS Changes contrib/automated_pp_test/automated_pp_test.pl contrib/automated_pp_test/hello_tk.pl contrib/automated_pp_test/hi.ico contrib/automated_pp_test/pipe_a_command.pm contrib/automated_pp_test/prior_to_test.pm contrib/automated_pp_test/remove_file_and_try_executable_again.pm contrib/automated_pp_test/test_in_further_subdir.pm contrib/docs/where_is_it.txt contrib/docs/who_am_i.txt contrib/extract_embedded/extract-embedded.pl contrib/gui_pp/gpp contrib/gui_pp/gpp_readme.txt contrib/pare/pare contrib/pare/pare_readme.txt contrib/procedural_pp/pp_old contrib/stdio/Stdio.pm contrib/stdio/Stdio_readme.txt lib/App/Packer/PAR.pm lib/PAR/Filter.pm lib/PAR/Filter/Bleach.pm lib/PAR/Filter/Bytecode.pm lib/PAR/Filter/Obfuscate.pm lib/PAR/Filter/PatchContent.pm lib/PAR/Filter/PodStrip.pm lib/PAR/Packer.pm lib/PAR/StrippedPARL/Base.pm lib/pp.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP myldr/boot.c myldr/Dynamic.in myldr/embed_files.pl myldr/encode_append.pl myldr/env.c myldr/find_files_to_embed/guess.pl myldr/find_files_to_embed/ldd.pl myldr/find_files_to_embed/otool.pl myldr/find_files_to_embed/recursive_objdump.pl myldr/internals.c myldr/main.c myldr/Makefile.PL myldr/mktmpdir.c myldr/mktmpdir.h myldr/par_pl2c.pl myldr/run_with_inc.pl myldr/sha1.c.PL myldr/Static.in myldr/usernamefrompwuid.c myldr/utils.c myldr/winres/pp.ico myldr/winres/pp.manifest myldr/winres/pp.rc package/parl.nsi README script/par.pl script/parl.pod script/pp script/tkpp t/00-pod.t t/10-parl-generation.t t/20-pp.t t/30-current_exec.t t/40-packer_cd_option.t t/80-doublecolon.t t/90-rt101800.t t/90-rt103861.t t/90-rt104560.t t/90-rt104635.t t/90-rt104635/eg/foo t/90-rt104635/Foo.pm t/90-rt104635/lib/Foo/Bar.pm t/90-rt122949.t t/90-rt59710.t t/Double/Colon.pm t/Double/Colon/Barnie.pm t/Double/Colon/Foo/Bar/Quux.pm t/Double/Colon/Fred.pm t/test-proc t/utils.pl META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) PAR-Packer-1.041/META.json0000644000175000017500000000404613200634513015146 0ustar roderichroderich{ "abstract" : "PAR Packager", "author" : [ "Audrey Tang " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "PAR-Packer", "no_index" : { "directory" : [ "t", "inc", "contrib" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "DynaLoader" : "0", "ExtUtils::CBuilder" : "0", "ExtUtils::Embed" : "0", "File::Basename" : "0", "File::Glob" : "0", "File::Spec::Functions" : "0" } }, "runtime" : { "recommends" : { "Digest" : "0", "Digest::SHA" : "0", "Module::Signature" : "0", "Tk" : "0", "Tk::ColoredButton" : "0", "Tk::EntryCheck" : "0", "Tk::Getopt" : "0" }, "requires" : { "Archive::Zip" : "1.02", "Compress::Zlib" : "1.30", "File::Temp" : "0.05", "Getopt::ArgvFile" : "1.07", "IO::Compress::Gzip" : "0", "Module::ScanDeps" : "1.21", "PAR" : "1.014", "PAR::Dist" : "0.22", "Text::ParseWords" : "0", "perl" : "5.008009" } }, "test" : { "requires" : { "IPC::Run3" : "0.048", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/rschupp/PAR-Packer.git", "web" : "https://github.com/rschupp/PAR-Packer" }, "x_MailingList" : "par@perl.org" }, "version" : "1.041", "x_serialization_backend" : "JSON::PP version 2.27400_02" } PAR-Packer-1.041/Makefile.PL0000644000175000017500000001042713171432404015501 0ustar roderichroderich#!/usr/bin/perl use strict; use warnings; use ExtUtils::MakeMaker; use ExtUtils::CBuilder; if ($] == 5.010000) { # 5.10.0 breaks how PAR intercepts loading of shared libraries warn <<'...'; *** Perl version 5.10.0 is not supported. Please upgrade to 5.10.1 or better. ... exit 0; } sub if_win { return ($^O eq 'MSWin32') ? @_ : (); } my $have_cc = ExtUtils::CBuilder->new->have_compiler; warn "No compiler found, won't generate 'script/parl$Config::Config{_exe}!\n" unless $have_cc; WriteMakefile1( NAME => 'PAR::Packer', VERSION_FROM => 'lib/PAR/Packer.pm', ABSTRACT_FROM => 'lib/PAR/Packer.pm', LICENSE => 'perl_5', AUTHOR => [ 'Audrey Tang ' ], MIN_PERL_VERSION => '5.008009', CONFIGURE_REQUIRES => { 'ExtUtils::Embed' => 0, 'ExtUtils::CBuilder' => 0, 'DynaLoader' => 0, 'File::Basename' => 0, 'File::Glob' => 0, 'File::Spec::Functions' => 0, }, PREREQ_PM => { 'File::Temp' => '0.05', 'Compress::Zlib' => ($^O eq 'MSWin32') ? '1.16' : '1.30', 'IO::Compress::Gzip' => 0, 'Archive::Zip' => '1.02', 'Module::ScanDeps' => '1.21', 'PAR::Dist' => '0.22', 'PAR' => '1.014', 'Text::ParseWords' => 0, 'Getopt::ArgvFile' => '1.07', }, TEST_REQUIRES => { 'Test::More' => 0, 'IPC::Run3' => '0.048', if_win( 'Win32::Exe' => '0.17'), }, MAN1PODS => { 'script/par.pl' => 'blib/man1/par.pl.1', 'script/pp' => 'blib/man1/pp.1', 'script/tkpp' => 'blib/man1/tkpp.1', $have_cc ? ( 'script/parl.pod' => 'blib/man1/parl.1' ) : (), }, EXE_FILES => [ 'script/par.pl', 'script/pp', 'script/tkpp', ], DIR => $have_cc ? [ 'myldr' ] : [], NEEDS_LINKING => $have_cc, META_MERGE => { 'meta-spec' => { version => 2 }, prereqs => { runtime => { recommends => { # for digital signature support 'Digest' => 0, 'Digest::SHA' => 0, 'Module::Signature' => 0, # for tkpp 'Tk' => 0, 'Tk::ColoredButton' => 0, 'Tk::EntryCheck' => 0, 'Tk::Getopt' => 0, if_win( 'Win32::Process' => 0), }, }, }, resources => { repository => { type => 'git', url => 'git://github.com/rschupp/PAR-Packer.git', web => 'https://github.com/rschupp/PAR-Packer', }, MailingList => 'par@perl.org', }, no_index => { directory => [ 'contrib' ], }, }, ); sub WriteMakefile1 { #Compatibility code for old versions of EU::MM. Written by Alexandr Ciornii, version 2. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{AUTHOR} and ref($params{AUTHOR}) eq 'ARRAY' and $eumm_version < 6.5705) { $params{META_ADD}->{author}=$params{AUTHOR}; $params{AUTHOR}=join(', ',@{$params{AUTHOR}}); } if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; WriteMakefile(%params); } PAR-Packer-1.041/myldr/0000755000175000017500000000000013200634513014650 5ustar roderichroderichPAR-Packer-1.041/myldr/Dynamic.in0000644000175000017500000000271213026021203016556 0ustar roderichroderichpackage PAR::StrippedPARL::Dynamic; use 5.008001; use strict; use warnings; our $VERSION = '0.958'; use base 'PAR::StrippedPARL::Base'; our $Data_Pos = tell DATA; =head1 NAME PAR::StrippedPARL::Dynamic - Data package containing a dynamic PARL =head1 SYNOPSIS # For details, see PAR::StrippedPARL::Base. PAR::StrippedPARL::Dynamic->write_parl($file) or die "Some error..."; =head1 DESCRIPTION This class is internal to PAR. Do not use it outside of PAR. This class is basically just a container for a dynamic binary PAR loader which doesn't include the PAR code like the F or F you are used to. If you're really curious, I'll tell you it is just a copy of the F (or F) file. The data is appended during the C phase of the PAR build process, but only if applicable: If you perl is static, you won't get the dynamic loader. If the binary data isn't appended during the build process, the class methods will return the empty list. =head1 CLASS METHODS Inherits the methods from L. =cut sub _data_pos { my $class = shift; return $Data_Pos; } =head1 AUTHORS Steffen Mueller Esmueller@cpan.orgE, Audrey Tang Ecpan@audreyt.orgE =head1 COPYRIGHT AND LICENSE Copyright 2006-2009 by Steffen Mueller Esmueller@cpan.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F. =cut __DATA__ PAR-Packer-1.041/myldr/utils.c0000644000175000017500000001641313061555571016174 0ustar roderichroderich/* * Copyright (c) 1997 Todd C. Miller * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * */ #ifdef WIN32 # include #else # include #endif #include #include "env.c" #if defined __linux__ || defined __FreeBSD__ /* Look at /proc/$$/{exe,file} for the current executable Returns malloc()ed string. Caller must free. Returns NULL if can't be found. Note that FreeBSD has /proc unmounted by default. You'd think we could get this info via the kvm interface, but it turns out that to get kvm_getprocs()/kvm_read() to return any information we don't already have, we need read-access to /boot/kmem, which we don't have. And I couldn't get to work anyway. Email me (philip-at-pied.nu) if want a stab at the code. */ char *par_current_exec_proc( void ) { char proc_path[MAXPATHLEN + 1], link[MAXPATHLEN + 1]; char *ret = NULL; int n; n = sprintf( proc_path, "/proc/%i/%s", (int)getpid(), #if defined __FreeBSD__ "file" #else "exe" #endif ); if( n < 0 ) return NULL; n = readlink( proc_path, link, MAXPATHLEN); if( n < 0 ) return NULL; ret = (char *)malloc( n+1 ); if( ret == NULL ) return NULL; memcpy( ret, link, n ); ret[n] = '\0'; return ret; } #endif char *par_current_exec( void ) { #if defined __linux__ || defined __FreeBSD__ return par_current_exec_proc(); #else return NULL; #endif } char *par_findprog(char *prog, char *path) { char *p, filename[MAXPATHLEN]; /* char *ret; */ /* Commented out for reason described below */ int proglen, plen; char *par_temp = par_getenv("PAR_TEMP"); /* NOTE: This code is #include'd both from a plain C program (static.c) * and our custom Perl interpreter (main.c). In the latter case, * lstat() or stat() may be #define'd as calls into PerlIO and * expect &PL_statbuf as second parameter, rather than a pointer * to a struct stat. Try to distinguish these cases by checking * whether PL_statbuf is defined. */ #ifndef PL_statbuf struct stat PL_statbuf; #endif #ifdef WIN32 if ( GetModuleFileName(0, filename, MAXPATHLEN) ) { par_setenv("PAR_PROGNAME", filename); return strdup(filename); } #endif /* Special case if prog contains '/' */ if (strstr(prog, dir_sep)) { par_setenv("PAR_PROGNAME", prog); return(prog); } /* I'm commenting out this block because using par_current_exec_proc() * ends up breaking the PAR feature of inferring the script-to-be-run * from the name of the executable in case of symlinks because /proc/ * has the name of the executable and not that of the symlink. */ /* #if defined __linux__ || defined __FreeBSD__ ret = par_current_exec_proc(); #else ret = NULL; #endif if( ret != NULL ) { par_setenv( "PAR_PROGNAME", ret ); return ret; } */ /* Walk through PATH (path), looking for ourself (prog). This fails if we are invoked in an obscure manner; Basically, execvp( "/full/path/to/prog", "prog", NULL ) and "/full/path/to" isn't in $PATH. Of course, I can't think of a situation this will happen. */ proglen = strlen(prog); p = strtok(path, path_sep); while ( p != NULL ) { if (*p == '\0') p = "."; if ( par_temp != NULL && ( strcmp(par_temp, p) == 0 ) ) { p = strtok(NULL, path_sep); continue; } plen = strlen(p); /* strip trailing '/' */ while (p[plen-1] == *dir_sep) { p[--plen] = '\0'; } if (plen + 1 + proglen >= MAXPATHLEN) { par_setenv("PAR_PROGNAME", prog); return(prog); } sprintf(filename, "%s%s%s", p, dir_sep, prog); if ((stat(filename, &PL_statbuf) == 0) && S_ISREG(PL_statbuf.st_mode) && access(filename, X_OK) == 0) { par_setenv("PAR_PROGNAME", filename); return(strdup(filename)); } p = strtok(NULL, path_sep); } par_setenv("PAR_PROGNAME", prog); return(prog); } char *par_basename (const char *name) { const char *base = name; const char *p; for (p = name; *p; p++) { if (*p == *dir_sep) base = p + 1; } return (char *)base; } char *par_dirname (const char *path) { static char bname[MAXPATHLEN]; register const char *endp; /* Empty or NULL string gets treated as "." */ if (path == NULL || *path == '\0') { return(strdup(".")); } /* Strip trailing slashes */ endp = path + strlen(path) - 1; while (endp > path && *endp == *dir_sep) endp--; /* Find the start of the dir */ while (endp > path && *endp != *dir_sep) endp--; /* Either the dir is "/" or there are no slashes */ if (endp == path) { if (*endp == *dir_sep) { return strdup("."); } else { return strdup(dir_sep); } } else { do { endp--; } while (endp > path && *endp == *dir_sep); } if (endp - path + 2 > sizeof(bname)) { return(NULL); } strncpy(bname, path, endp - path + 1); return(bname); } void par_init_env () { char par_clean[] = "__ENV_PAR_CLEAN__ \0"; char *buf; /* ignore PERL5LIB et al. as they make no sense for a self-contained executable */ par_unsetenv("PERL5LIB"); par_unsetenv("PERLLIB"); par_unsetenv("PERL5OPT"); par_unsetenv("PERLIO"); par_unsetenv("PAR_INITIALIZED"); par_unsetenv("PAR_SPAWNED"); par_unsetenv("PAR_TEMP"); par_unsetenv("PAR_CLEAN"); par_unsetenv("PAR_DEBUG"); par_unsetenv("PAR_CACHE"); par_unsetenv("PAR_PROGNAME"); if ( (buf = par_getenv("PAR_GLOBAL_DEBUG")) != NULL ) { par_setenv("PAR_DEBUG", buf); } if ( (buf = par_getenv("PAR_GLOBAL_TMPDIR")) != NULL ) { par_setenv("PAR_TMPDIR", buf); } if ( (buf = par_getenv("PAR_GLOBAL_TEMP")) != NULL ) { par_setenv("PAR_TEMP", buf); } else if ( (buf = par_getenv("PAR_GLOBAL_CLEAN")) != NULL ) { par_setenv("PAR_CLEAN", buf); } else { buf = par_clean + 12 + strlen("CLEAN"); if (strncmp(buf, "PAR_CLEAN=", strlen("PAR_CLEAN=")) == 0) { par_setenv("PAR_CLEAN", buf + strlen("PAR_CLEAN=")); } } par_setenv("PAR_INITIALIZED", "1"); return; } int par_env_clean () { static int rv = -1; if (rv == -1) { char *buf = par_getenv("PAR_CLEAN"); rv = ( ((buf == NULL) || (*buf == '\0') || (*buf == '0')) ? 0 : 1); } return rv; } PAR-Packer-1.041/myldr/internals.c0000644000175000017500000000611613026021203017007 0ustar roderichroderichXS(XS_Internals_PAR_BOOT) { GV* tmpgv; AV* tmpav; SV** svp; SV* tmpsv; int i; int ok = 0; char *buf; TAINT; if (!(buf = par_getenv("PAR_INITIALIZED")) || buf[0] != '1' || buf[1] != '\0') { par_init_env(); } /* Remove the PAR/parl options from @ARGV */ if ((tmpgv = gv_fetchpv("ARGV", TRUE, SVt_PVAV))) {/* @ARGV */ tmpav = GvAV(tmpgv); for (i = 1; i < options_count; i++) { svp = av_fetch(tmpav, i-1, 0); if (!svp) break; if (strcmp(fakeargv[i], SvPV_nolen(*svp))) break; ok++; } if (ok == options_count - 1) { for (i = 1; i < options_count; i++) { tmpsv = av_shift(tmpav); } } } if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */ #ifdef WIN32 sv_setpv(GvSV(tmpgv),"perl.exe"); #else sv_setpv(GvSV(tmpgv),"perl"); #endif SvSETMAGIC(GvSV(tmpgv)); } if ((tmpgv = gv_fetchpv("0", TRUE, SVt_PV))) {/* $0 */ char *prog = NULL; if ( ( prog = par_getenv("PAR_PROGNAME") ) ) { sv_setpv(GvSV(tmpgv), prog); } else { #ifdef HAS_PROCSELFEXE S_procself_val(aTHX_ GvSV(tmpgv), fakeargv[0]); #else #ifdef OS2 sv_setpv(GvSV(tmpgv), os2_execname(aTHX)); #else prog = par_current_exec(); if( prog != NULL ) { sv_setpv( GvSV(tmpgv), prog ); free( prog ); } else { sv_setpv(GvSV(tmpgv), fakeargv[0]); } #endif #endif } #if (PERL_REVISION == 5 && PERL_VERSION == 8 \ && ( PERL_SUBVERSION >= 1 && PERL_SUBVERSION <= 5)) || \ (PERL_REVISION == 5 && PERL_VERSION == 9 && PERL_SUBVERSION <= 1) /* 5.8.1 through 5.8.5, as well as 5.9.0 does not copy fakeargv, sigh */ { char *p; STRLEN len = strlen( fakeargv[0] ); New( 42, p, len+1, char ); Copy( fakeargv[0], p, len, char ); SvSETMAGIC(GvSV(tmpgv)); Copy( p, fakeargv[0], len, char ); fakeargv[0][len] = '\0'; Safefree( p ); } /* #else SvSETMAGIC(GvSV(tmpgv)); */ #endif } /* PAR::Packer isn't included in a packed executable, but we provide * this scalar so that a packed script may refer to the version * of PAR::Packer it was built with. */ sv_setpv(get_sv("PAR::Packer::VERSION", GV_ADD), PAR_PACKER_VERSION); TAINT_NOT; /* create temporary PAR directory */ stmpdir = par_getenv("PAR_TEMP"); if ( !stmpdir ) { stmpdir = par_mktmpdir( fakeargv ); if ( !stmpdir ) croak("Unable to create cache directory"); } i = PerlDir_mkdir(stmpdir, 0700); if ( (i != 0) && (i != EEXIST) && (i != -1) ) { croak("%s: creation of private cache subdirectory %s failed (errno=%i)\n", fakeargv[0], stmpdir, i); } } static void par_xs_init(pTHX) { xs_init(aTHX); newXSproto("Internals::PAR::BOOT", XS_Internals_PAR_BOOT, "", ""); } PAR-Packer-1.041/myldr/env.c0000644000175000017500000001176613052301016015611 0ustar roderichroderich/* * Copyright (c) 1987, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #if defined(LIBC_SCCS) && !defined(lint) static const char sccsid[] = "@(#)getenv.c 8.1 (Berkeley) 6/4/93"; static const char sccsid[] = "@(#)setenv.c 8.1 (Berkeley) 6/4/93"; #endif /* LIBC_SCCS and not lint */ #include #include /* * __findenv -- * Returns pointer to value associated with name, if any, else NULL. * Sets offset to be the offset of the name/value combination in the * environmental array, for use by setenv(3) and unsetenv(3). * Explicitly removes '=' in argument name. * * This routine *should* be a static; don't use it. */ static char * __findenv(name, offset) register const char *name; int *offset; { extern char **environ; register int len; register const char *np; register char **p, *c; if (name == NULL || environ == NULL) return (NULL); for (np = name; *np && *np != '='; ++np) continue; len = np - name; for (p = environ; (c = *p) != NULL; ++p) #ifdef WIN32 if (strnicmp(c, name, len) == 0 && c[len] == '=') { #else if (strncmp(c, name, len) == 0 && c[len] == '=') { #endif *offset = p - environ; return (c + len + 1); } return (NULL); } static char * par_getenv(name) const char *name; { int i; return __findenv(name, &i); } /* * setenv -- * Set the value of the environmental variable "name" to be * "value". If rewrite is set, replace any current value. */ static int par_setenv(name, value) const char *name; register const char *value; { #ifdef WIN32 char* p = (char*)malloc((size_t)(strlen(name) + strlen(value) + 2)); if (!p) return (-1); sprintf(p, "%s=%s", name, value); _putenv(p); return (0); #else extern char **environ; static int alloced = 0; /* if allocated space before */ register char *c; size_t l_value; int offset; if (*value == '=') /* no `=' in value */ ++value; l_value = strlen(value); if ((c = __findenv(name, &offset))) { /* find if already exists */ if (strlen(c) >= l_value) { /* old larger; copy over */ while ((*c++ = *value++)); return (0); } } else { /* create new slot */ register int cnt; register char **p; for (p = environ, cnt = 0; *p; ++p, ++cnt); if (alloced) { /* just increase size */ environ = (char **)realloc((char *)environ, (size_t)(sizeof(char *) * (cnt + 2))); if (!environ) return (-1); } else { /* get new space */ alloced = 1; /* copy old entries into it */ p = malloc((size_t)(sizeof(char *) * (cnt + 2))); if (!p) return (-1); memmove(p, environ, cnt * sizeof(char *)); environ = p; } environ[cnt + 1] = NULL; offset = cnt; } for (c = (char *)name; *c && *c != '='; ++c); /* no `=' in name */ if (!(environ[offset] = /* name + `=' + value */ malloc((size_t)((int)(c - name) + l_value + 2)))) return (-1); for (c = environ[offset]; (*c = *name++) && *c != '='; ++c); for (*c++ = '='; (*c++ = *value++);); return (0); #endif } /* * unsetenv(name) -- * Delete environmental variable "name". */ static void par_unsetenv(name) const char *name; { #ifdef WIN32 par_setenv(name, ""); #else extern char **environ; register char **p; int offset; while (__findenv(name, &offset)) /* if set multiple times */ for (p = &environ[offset];; ++p) if (!(*p = *(p + 1))) break; #endif } PAR-Packer-1.041/myldr/find_files_to_embed/0000755000175000017500000000000013200634513020610 5ustar roderichroderichPAR-Packer-1.041/myldr/find_files_to_embed/otool.pl0000644000175000017500000000147213167146202022312 0ustar roderichroderich#!perl use strict; use warnings; use File::Basename; sub is_system_lib { shift =~ m{^/usr/lib|^/System/Library/} }; sub find_files_to_embed { my ($par, $libperl) = @_; my $dlls = otool($par); # weed out system libs (but exclude the shared perl lib) while (my ($name, $path) = each %$dlls) { delete $dlls->{$name} if is_system_lib($path) && basename($path) !~ /perl/; } return $dlls; } # NOTE: "otool -L" is NOT recursive, i.e. it's the equivalent # of "objdump -ax" or "readelf -d" on Linux, but NOT "ldd". # So perhaps a recursive method like the one for objdump below is in order. sub otool { my ($file) = @_; my $out = qx(otool -L $file); die qq["otool -L $file" failed\n] unless $? == 0; return { map { basename($_) => $_ } $out =~ /^ \s+ (\S+) /gmx }; } 1; PAR-Packer-1.041/myldr/find_files_to_embed/guess.pl0000644000175000017500000000336513167513256022316 0ustar roderichroderich#!perl use strict; use warnings; use Config; use File::Glob; use File::Basename; use File::Spec; my $ld = $Config{ld} || (($^O eq 'MSWin32') ? 'link.exe' : $Config{cc}); $ld = $Config{cc} if ($^O =~ /^(?:dec_osf|aix|hpux)$/); sub find_files_to_embed { my ($par, $libperl) = @_; # If on Windows and Perl was built with GCC 4.x or higher, then libperl*.dll # may depend on some libgcc_*.dll (e.g. Strawberry Perl 5.12). # This libgcc_*.dll has to be included into with any packed executable # in the same way as libperl*.dll itself, otherwise a packed executable # won't run when libgcc_*.dll isn't installed. # The same holds for libstdc++*.dll (e.g. Strawberry Perl 5.16). my ($libgcc, $libstdcpp, $libwinpthread); if ($^O eq 'MSWin32' and defined $Config{gccversion} # gcc version >= 4.x was used and $Config{gccversion} =~ m{\A(\d+)}ms && $1 >= 4) { $libgcc = find_dll("libgcc_*.$Config{so}"); $libwinpthread = find_dll("libwinpthread*.$Config{so}"); } if ($ld =~ /(\b|-)g\+\+(-.*)?(\.exe)?$/) { # g++ was used to link $libstdcpp = find_dll("libstdc++*.$Config{so}"); } return { map { basename($_) => $_ } grep { defined } $libperl, $libgcc, $libwinpthread, $libstdcpp }; } sub find_dll { my ($dll_glob) = @_; # look for $dll_glob # - in the same directory as the perl executable itself # - in the same directory as gcc (only useful if it's an absolute path) # - in PATH my ($dll_path) = map { File::Glob::bsd_glob(File::Spec->catfile($_, $dll_glob)) } dirname($^X), dirname($Config{cc}), File::Spec->path(); return $dll_path; } 1; PAR-Packer-1.041/myldr/find_files_to_embed/recursive_objdump.pl0000644000175000017500000000336613167513105024711 0ustar roderichroderich#!perl use strict; use warnings; use File::Basename; use Cwd; use File::Spec; use DynaLoader; my $system_root = Cwd::abs_path($ENV{SystemRoot}); sub is_system_lib { Cwd::abs_path(shift) =~ m{^\Q$system_root\E/}i } sub find_files_to_embed { my ($par, $libperl) = @_; return recursive_objdump($par, dirname($^X)); } sub recursive_objdump { my ($path, @search_first_in) = @_; # NOTE: Looks like Perl on Windows (e.g. Strawberry) doesn't set # $Config{ldlibpthname} - one could argue that its value should be "PATH". # But even where it is defined (e.g. "LD_LIBRARY_PATH" on Linux) # DynaLoader *appends* (an appropriately split) # $ENV{$Config{ldlibpthname}} to its search path, @dl_library_path, # which is wrong in our context as we want it to be searched first. # Hence, provide our own value for @dl_library_path. local @DynaLoader::dl_library_path = (@search_first_in, File::Spec->path()); my %dlls; my %seen; my $walker; $walker = sub { my ($obj) = @_; return if $seen{lc $obj}++; my $out = qx(objdump -ax "$obj"); die "objdump failed: $!\n" unless $? == 0; foreach my $dll ($out =~ /^\s*DLL Name:\s*(\S+)/gm) { next if $dlls{lc $dll}; # already found my ($file) = DynaLoader::dl_findfile($dll) or next; $dlls{lc $dll} = $file; next if is_system_lib($file); # no need to recurse on a system library $walker->($file); # recurse } }; $walker->(Cwd::abs_path($path)); # weed out system libraries while (my ($name, $path) = each %dlls) { delete $dlls{$name} if is_system_lib($path); } return \%dlls; } 1; PAR-Packer-1.041/myldr/find_files_to_embed/ldd.pl0000644000175000017500000000270713167146173021732 0ustar roderichroderich#!perl use strict; use warnings; sub is_system_lib; sub find_files_to_embed { my ($par, $libperl) = @_; if ($^O =~ /cygwin/i) { chomp(my $system_root = qx( cygpath --unix '$ENV{SYSTEMROOT}' )); print STDERR "### SystemRoot (as Unix path) = $system_root\n"; *is_system_lib = sub { shift =~ m{^/usr/bin/(?!cygcrypt\b)|^\Q$system_root\E/}i }; # NOTE: cygcrypt-0.dll is not (anymore) in the set of default Cygwin packages } else { *is_system_lib = sub { shift =~ m{^(?:/usr)?/lib(?:32|64)?/} }; } my $dlls = ldd($par); # weed out system libs (but exclude the shared perl lib) while (my ($name, $path) = each %$dlls) { delete $dlls->{$name} if is_system_lib($path) && $name !~ /perl/; } return $dlls; } sub ldd { my ($file) = @_; my $out = qx(ldd $file); die qq["ldd $file" failed\n] unless $? == 0; # NOTE: On older Linux/glibc (e.g. seen on Linux 3.2.0/glibc 2.13) # ldd prints a line like # linux-vdso.so.1 => (0x00007fffd2ff2000) # (without a pathname between "=>" and the address) # while newer versions omit "=>" in this case. my %dlls = $out =~ /^ \s* (\S+) \s* => \s* ( \/ \S+ ) /gmx; while (my ($name, $path) = each %dlls) { unless (-r $path) { warn qq[# ldd reported strange path: $path\n]; delete $dlls{$name}; next; } } return \%dlls; } 1; PAR-Packer-1.041/myldr/encode_append.pl0000644000175000017500000000227413052301016017770 0ustar roderichroderich#!perl use strict; use warnings; # Used in myldr/Makefile.PL / myldr/Makefile. # This script appends the uuencoded contents of $ARGV[0] to the file # specified as $ARGV[1] as __DATA__ section. Any previous _DATA_ is replaced. # section. # # copyright 2006-2009, Steffen Mueller $/ = undef; my $usage = <; close $in; $contents =~ s/^__DATA__\r?\n.*\z//ms; # cf. Config.pm $contents .= sprintf <<'...', ($^V) x 2; $^V eq %vd or die sprintf("Perl (%%s) version (%%vd) doesn't match the version (%vd) ". "that PAR::Packer was built with; please rebuild PAR::Packer", $^X, $^V); 1; ... open my $enc, '<', $encfile or die $!; binmode $enc; unlink $outfile; open my $out, '>', $outfile or die $!; binmode $out; print $out $contents; print $out "\n__DATA__\n"; print $out pack 'u', <$enc>; close $out; close $enc; PAR-Packer-1.041/myldr/Static.in0000644000175000017500000000257213026021203016425 0ustar roderichroderichpackage PAR::StrippedPARL::Static; use 5.008001; use strict; use warnings; our $VERSION = '0.958'; use base 'PAR::StrippedPARL::Base'; our $Data_Pos = tell DATA; =head1 NAME PAR::StrippedPARL::Static - Data package containing a static PARL =head1 SYNOPSIS # For details, see PAR::StrippedPARL::Base. PAR::StrippedPARL::Static->write_parl($file) or die "Some error..."; =head1 DESCRIPTION This class is internal to PAR. Do not use it outside of PAR. This class is basically just a container for a static binary PAR loader which doesn't include the PAR code like the F or F you are used to. If you're really curious, I'll tell you it is just a copy of the F (or F) file. The data is appended during the C phase of the PAR build process. If the binary data isn't appended during the build process, the class methods will return the empty list. =head1 CLASS METHODS Inherits the methods from L. =cut sub _data_pos { my $class = shift; return $Data_Pos; } =head1 AUTHORS Steffen Mueller Esmueller@cpan.orgE, Audrey Tang Ecpan@audreyt.orgE =head1 COPYRIGHT AND LICENSE Copyright 2006-2009 by Steffen Mueller Esmueller@cpan.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F. =cut __DATA__ PAR-Packer-1.041/myldr/mktmpdir.c0000644000175000017500000002615513052301016016646 0ustar roderichroderich#include "mktmpdir.h" #define PAR_TEMP "PAR_TEMP" #ifdef O_BINARY # define OPEN_O_BINARY O_BINARY #else # define OPEN_O_BINARY 0 #endif #ifndef P_tmpdir #define P_tmpdir "/tmp" #endif /* NOTE: The code below is #include'd both from a plain C program (boot.c) * and our custom Perl interpreter (main.c). In the latter case, * lstat() or stat() may be #define'd as calls into PerlIO and * expect &PL_statbuf as second parameter, rather than a pointer * to a struct stat. Try to distinguish these cases by checking * whether PL_statbuf is defined. */ static int isWritableDir(const char* val) { #ifndef PL_statbuf struct stat PL_statbuf; #endif return par_lstat(val, &PL_statbuf) == 0 && ( S_ISDIR(PL_statbuf.st_mode) || S_ISLNK(PL_statbuf.st_mode) ) && access(val, W_OK) == 0; } #ifndef WIN32 /* check that: * - val is a directory (and not a symlink) * - val is owned by the user * - val has mode 0700 */ static int isSafeDir(const char* val) { #ifndef PL_statbuf struct stat PL_statbuf; #endif return par_lstat(val, &PL_statbuf) == 0 && S_ISDIR(PL_statbuf.st_mode) && PL_statbuf.st_uid == getuid() && (PL_statbuf.st_mode & 0777) == 0700; } #endif void par_setup_libpath( const char * stmpdir ) { const char *key = NULL , *val = NULL; int i; char *ld_path = LDLIBPTHNAME; char *ld_path_env = NULL; if ( (val = par_getenv(ld_path)) == NULL || strlen(val) == 0 ) { par_setenv(ld_path, stmpdir); } else if ( !strstr(val, stmpdir) ) { /* prepend stmpdir to (value of) environment variable */ ld_path_env = malloc( strlen(stmpdir) + strlen(path_sep) + strlen(val) + 1); sprintf( ld_path_env, "%s%s%s", stmpdir, path_sep, val); par_setenv(ld_path, ld_path_env); } } char *par_mktmpdir ( char **argv ) { int i; const char *tmpdir = NULL; const char *key = NULL , *val = NULL; /* NOTE: all arrays below are NULL terminated */ const char *temp_dirs[] = { P_tmpdir, #ifdef WIN32 "C:\\TEMP", #endif ".", NULL }; const char *temp_keys[] = { "PAR_TMPDIR", "TMPDIR", "TEMPDIR", "TEMP", "TMP", NULL }; const char *user_keys[] = { "USER", "USERNAME", NULL }; const char *subdirbuf_prefix = "par-"; const char *subdirbuf_suffix = ""; char *progname = NULL, *username = NULL; char *stmpdir = NULL, *top_tmpdir = NULL; int f, j, k, stmp_len = 0; char sha1[41]; SHA_INFO sha_info; unsigned char buf[32768]; unsigned char sha_data[20]; if ( (val = par_getenv(PAR_TEMP)) && strlen(val) ) { par_setup_libpath(val); return strdup(val); } #ifdef WIN32 { DWORD buflen = MAXPATHLEN; username = malloc(MAXPATHLEN); GetUserName((LPTSTR)username, &buflen); // FIXME this is uncondifionally overwritten below - WTF? } #endif /* Determine username */ username = get_username_from_getpwuid(); if ( !username ) { /* fall back to env vars */ for ( i = 0 ; username == NULL && (key = user_keys[i]); i++) { if ( (val = par_getenv(key)) && strlen(val) ) username = strdup(val); } } if ( username == NULL ) username = "SYSTEM"; /* sanitize username: encode all bytes as 2 hex digits */ { char *hexname = malloc(2 * strlen(username) + 1); char *u, *h; for ( u = username, h = hexname ; *u != '\0' ; u++, h += 2) sprintf(h, "%02x", *(unsigned char*)u); username = hexname; } /* Try temp environment variables */ for ( i = 0 ; tmpdir == NULL && (key = temp_keys[i]); i++ ) { if ( (val = par_getenv(key)) && strlen(val) && isWritableDir(val) ) { tmpdir = strdup(val); break; } } #ifdef WIN32 /* Try the windows temp directory */ if ( tmpdir == NULL && (val = par_getenv("WinDir")) && strlen(val) ) { char* buf = malloc(strlen(val) + 5 + 1); sprintf(buf, "%s\\temp", val); if (isWritableDir(buf)) { tmpdir = buf; } else { free(buf); } } #endif /* Try default locations */ for ( i = 0 ; tmpdir == NULL && (val = temp_dirs[i]) && strlen(val) ; i++ ) { if ( isWritableDir(val) ) { tmpdir = strdup(val); } } /* "$TEMP/par-$USER" */ stmp_len = strlen(tmpdir) + strlen(subdirbuf_prefix) + strlen(username) + strlen(subdirbuf_suffix) + 1024; /* stmpdir is what we are going to return; top_tmpdir is the top $TEMP/par-$USER, needed to build stmpdir. NOTE: We need 2 buffers because snprintf() can't write to a buffer it is also reading from. */ top_tmpdir = malloc( stmp_len ); sprintf(top_tmpdir, "%s%s%s%s", tmpdir, dir_sep, subdirbuf_prefix, username); #ifdef WIN32 _mkdir(top_tmpdir); /* FIXME bail if error (other than EEXIST) */ #else { if (mkdir(top_tmpdir, 0700) == -1 && errno != EEXIST) { fprintf(stderr, "%s: creation of private subdirectory %s failed (errno=%i)\n", argv[0], top_tmpdir, errno); return NULL; } if (!isSafeDir(top_tmpdir)) { fprintf(stderr, "%s: private subdirectory %s is unsafe (please remove it and retry your operation)\n", argv[0], top_tmpdir); return NULL; } } #endif stmpdir = malloc( stmp_len ); /* Doesn't really work - XXX */ val = par_getenv( "PATH" ); if (val != NULL) progname = par_findprog(argv[0], strdup(val)); if (progname == NULL) progname = argv[0]; /* If invoked as "/usr/bin/parl foo.par myscript.pl" then progname should * be ".../parl", and we don't want to base our checksum on that, but * rather on "foo.par". */ { #ifdef WIN32 #define STREQ(a,b) (strcasecmp(a,b) == 0) #else #define STREQ(a,b) (strcmp(a,b) == 0) #endif int prog_len = strlen(progname); int parl_len = strlen(PARL_EXE); if (prog_len >= parl_len && STREQ(progname + prog_len - parl_len, PARL_EXE) && (prog_len == parl_len || progname[prog_len - parl_len - 1] == dir_sep[0]) && argv[1] && strlen(argv[1]) >= 4 && STREQ(argv[1] + strlen(argv[1]) - 4, ".par")) progname = argv[1]; #undef STREQ } if ( !par_env_clean() && (f = open( progname, O_RDONLY | OPEN_O_BINARY ))) { lseek(f, -18, 2); read(f, buf, 6); if(buf[0] == 0 && buf[1] == 'C' && buf[2] == 'A' && buf[3] == 'C' && buf[4] == 'H' && buf[5] == 'E') { /* pre-computed cache_name in this file */ /* "$TEMP/par-$USER/cache-$cache_name" */ lseek(f, -58, 2); read(f, buf, 41); sprintf( stmpdir, "%s%scache-%s%s", top_tmpdir, dir_sep, buf, subdirbuf_suffix ); } else { /* "$TEMP/par-$USER/cache-$SHA1" */ lseek(f, 0, 0); sha_init( &sha_info ); while( ( j = read( f, buf, sizeof( buf ) ) ) > 0 ) { sha_update( &sha_info, buf, j ); } close( f ); sha_final( sha_data, &sha_info ); for( k = 0; k < 20; k++ ) { sprintf( sha1+k*2, "%02x", sha_data[k] ); } sha1[40] = '\0'; sprintf( stmpdir, "%s%scache-%s%s", top_tmpdir, dir_sep, sha1, subdirbuf_suffix ); } } else { int i = 0; /* "$TEMP/par-$USER/temp-$PID" */ par_setenv("PAR_CLEAN", "1"); sprintf( stmpdir, "%s%stemp-%u%s", top_tmpdir, dir_sep, getpid(), subdirbuf_suffix ); /* Ensure we pick an unused directory each time. If the directory already exists when we try to create it, bump a counter and try "$TEMP/par-$USER/temp-$PID-$i". This will guard against cases where a prior invocation crashed leaving garbage in a temp directory that might interfere. */ while (my_mkdir(stmpdir, 0700) == -1 && errno == EEXIST) { sprintf( stmpdir, "%s%stemp-%u-%u%s", top_tmpdir, dir_sep, getpid(), ++i, subdirbuf_suffix ); } } free(top_tmpdir); /* set dynamic loading path */ par_setenv(PAR_TEMP, stmpdir); par_setup_libpath( stmpdir ); return stmpdir; } #ifdef WIN32 static void par_rmtmpdir ( char *stmpdir ) { struct _finddata_t cur_file; int subsub_len; char *subsubdir; char *slashdot; long hFile; int tries = 0; HMODULE dll; if ((stmpdir == NULL) || !strlen(stmpdir)) return; subsub_len = strlen(stmpdir) + 258; subsubdir = malloc( subsub_len ); sprintf(subsubdir, "%s\\*.*", stmpdir); hFile = _findfirst( subsubdir, &cur_file ); if ( hFile == -1 ) return; do { if (!strstr(cur_file.name, "\\")) { sprintf(subsubdir, "%s\\%s", stmpdir, cur_file.name); } else { sprintf(subsubdir, "%s", cur_file.name); } if (!(slashdot = strstr(subsubdir, "\\.")) || (strcmp(slashdot,"\\.") && strcmp(slashdot,"\\.."))) { if ((cur_file.attrib & _A_SUBDIR)) { par_rmtmpdir( subsubdir ); } else { dll = GetModuleHandle(cur_file.name); tries = 0; while ( _unlink(subsubdir) && ( tries++ < 10 ) ) { if ( dll ) FreeLibrary(dll); }; } } } while ( _findnext( hFile, &cur_file ) == 0 ); _findclose(hFile); _rmdir(stmpdir); } #else static void par_rmtmpdir ( char *stmpdir ) { DIR *partmp_dirp; Direntry_t *dp; char *subsubdir = NULL; int subsub_len; struct stat stbuf; /* remove temporary PAR directory */ if (!stmpdir || !*stmpdir) return; partmp_dirp = opendir(stmpdir); if ( partmp_dirp == NULL ) return; while ( ( dp = readdir(partmp_dirp) ) != NULL ) { if ( strcmp (dp->d_name, ".") != 0 && strcmp (dp->d_name, "..") != 0 ) { subsub_len = strlen(stmpdir) + 1 + strlen(dp->d_name) + 1; subsubdir = malloc( subsub_len); sprintf(subsubdir, "%s/%s", stmpdir, dp->d_name); if (stat(subsubdir, &stbuf) != -1 && S_ISDIR(stbuf.st_mode)) { par_rmtmpdir(subsubdir); } else { unlink(subsubdir); } free(subsubdir); subsubdir = NULL; } } closedir(partmp_dirp); rmdir(stmpdir); } #endif void par_cleanup (char *stmpdir) { char *dirname = par_dirname(stmpdir); char *basename = par_basename(dirname); if ( par_env_clean() && stmpdir != NULL && strlen(stmpdir)) { if ( strstr(basename, "par-") == basename ) { par_rmtmpdir(stmpdir); /* Don't try to remove dirname because this will introduce a race with other applications that are trying to start. */ } } } PAR-Packer-1.041/myldr/Makefile.PL0000644000175000017500000002333313171207472016635 0ustar roderichroderich#!perl # Copyright 2002-2009 by Audrey Tang. # Copyright (c) 2002 Mattia Barbon. # This package is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. use strict; use warnings; use Config; use File::Spec::Functions ':ALL'; use ExtUtils::Embed; use ExtUtils::MakeMaker; use DynaLoader; use File::Basename; xsinit(undef); # used for searching libperls. sub find_file { my $file = shift; my @paths = ( $Config{bin}, catdir($Config{'archlibexp'}, 'CORE'), split(/\Q$Config{path_sep}\E/, $ENV{$Config{ldlibpthname}} || ''), split(/ /, $Config{libpth}), ); my $libperl; if ($libperl = DynaLoader::dl_findfile("-lperl")) { if (-l $libperl) { my $realpath = readlink($libperl); if (!file_name_is_absolute($realpath)) { $realpath = rel2abs(catfile(dirname($libperl), $realpath)); } $libperl = $realpath; } return $libperl if -e $libperl; } foreach my $path (@paths) { $libperl = catfile($path, $file); return $libperl if -e $libperl; # for MinGW $libperl = catfile($path, $1) if $file =~ /^lib(.+)/; return $libperl if -e $libperl; # for Cygwin $libperl = catfile($path, $file.$Config{_a}); return $libperl if -e $libperl; } } my $debug = $ENV{DEBUG}; my $chunk_size = 32768; my $exe = $Config{_exe}; my $link_exe = (($^O eq 'os2' and $Config{ldflags} =~ /-Zexe/) ? '' : $exe); my $o = $Config{obj_ext}; my $gccversion = $Config{gccversion}; # NOTE: on some platforms, ccopts or ldopts may contain newlines chomp( my $pccflags = ccopts() ); chomp( my $pldflags = ldopts() ); my $dynperl = $Config{useshrplib} && ($Config{useshrplib} ne 'false'); $dynperl = 1 if $pldflags =~ /\B-lperl\b/; # Gentoo lies to us! my $cc = $Config{cc}; my $ld = $Config{ld} || (($^O eq 'MSWin32') ? 'link.exe' : $Config{cc}); $ld = $Config{cc} if ($^O =~ /^(?:dec_osf|aix|hpux)$/); my $par_pl = catfile('..', 'script', "par.pl"); my $par_exe = catfile('.', "par$exe"); my $par_exe_link = catfile('.', "par$link_exe"); my $boot_exe = catfile('.', "boot$exe"); my $boot_exe_link = catfile('.', "boot$link_exe"); my $parl_exe = "parl$exe"; my $parldyn_exe = "parldyn$exe"; my( $out, $ccdebug, $lddebug, $warn, $rm, $mv, $mt_cmd ); my $res = ''; my $res_section = ''; my $boot_ldflags = ''; if( $cc =~ m/^cl\b/i ) { $out = '-out:'; $ccdebug = $debug ? '-Zi -Zm1000 ' : '-Zm1000 '; $lddebug = $debug ? '-debug ' : '-release '; $warn = $debug ? '-W3' : ''; my $machinearch = $Config{ptrsize} == 8 ? 'AMD64' : 'X86'; $res = 'ppresource.obj'; $res_section = <<"..."; $res: rc winres\\pp.rc cvtres /NOLOGO /MACHINE:$machinearch /OUT:$res winres\\pp.res ... # Embed the manifest file for VC 2005 (aka VC8) or higher, but not for the # 64-bit Platform SDK compiler. if( $Config{ptrsize} == 4 and $Config{ccversion} =~ /^(\d+)/ and $1 >= 14 ) { $mt_cmd = 'if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1'; } else { $mt_cmd = '-$(NOOP)'; } } elsif ($cc =~ m/\bgcc\b/i or ($cc =~ m/\bcc\b/i and $gccversion)) { $out = '-o '; $ccdebug = $debug ? '-g ' : ''; $lddebug = ($debug or $^O eq 'darwin') ? '' : '-s '; $warn = $debug ? '-Wall -Wno-comments ' : ''; if ( $^O =~ /^(?:MSWin|cygwin)/ ) { my $target = $Config{ptrsize} == 8 ? 'pe-x86-64' : 'pe-i386'; $res = 'ppresource.coff'; # Note: On cygwin the command below will be processed by the # cygwin shell, so backslashes in pathnames might be a problem. # Instead use forward slashes which work on Windows as well. $res_section = <<"..."; $res: windres -i winres/pp.rc -o $res --input-format=rc --output-format=coff --target=$target ... } $mt_cmd = '-$(NOOP)'; $boot_ldflags .= ' -static-libgcc' if $^O eq 'MSWin32'; } else { $out = '-o '; $ccdebug = ''; $lddebug = ''; $warn = ''; $mt_cmd = '-$(NOOP)'; } my $perl58lib = ""; if($ENV{ACTIVEPERL_MINGW} and $Config{cf_email}=~/ActiveState.com/i){ $perl58lib = "-l$Config{libperl}"; $perl58lib =~ s/\.lib$//; } my $cflags = "$ccdebug$warn$pccflags"; my $optimize = $Config{optimize}; my $ldflags = "$lddebug$pldflags $perl58lib"; my $static_ldflags = $ldflags; my $libperl; if ($dynperl) { if ($^O eq 'os2') { $libperl = OS2::DLLname(); } else { my $file = $Config{libperl}; my $so = $Config{so} || 'so'; $file = "libperl.$so" if $file eq 'libper'; # workaround Red Hat bug $file =~ s/\.(?!\d)[^.]*$/.$Config{so}/; $file =~ s/^lib// if $^O eq 'MSWin32'; $libperl = find_file($file); if (not -e $libperl) { $file =~ s/\.(?!\d)[^.]*$/.a/; $libperl = find_file($file); } $dynperl = 0 if !-e $libperl; } } $static_ldflags =~ s/(^|\s)-l\S*perl\S*(\s|$)/ /g; $boot_ldflags .= " $static_ldflags"; if ($dynperl) { # on Debian derived distros make sure that the Debian package "libperl-dev" # is installed (which contains the /usr/lib/libperl.so symlink) die qq[You need to install the distro (Debian, Ubuntu etc) package "libperl-dev"\n] if $^O =~ /^(linux|gnukfreebsd)$/i && -x "/usr/bin/dpkg" # probably Debian or a derivative && system("dpkg -S $^X >/dev/null 2>&1") == 0 # we're building with the system (distro) perl && system("dpkg -l libperl-dev >/dev/null 2>&1") != 0; # check install status of libperl-dev } else { my $file = $Config{libperl}; $file = 'libperl.a' if $file eq 'libper'; # same redhat bug? Just making sure... $libperl = find_file($file); $ldflags = $static_ldflags; } my $par = (($dynperl && $^O ne 'os2') ? $boot_exe : $par_exe); my @strippedparl = qw( Static.pm ); push @strippedparl, qw( Dynamic.pm ) if $dynperl; my @parl_exes = $parl_exe; push @parl_exes, $parldyn_exe if $dynperl; # Determine whether we can find a config.h. If yes, include it in # usernamefrompwuid.h. If not, set I_PWD to undefined in that header. # -- Steffen my $configh = "$Config::Config{archlibexp}/CORE/config.h"; open PWOUT, '> usernamefrompwuid.h' or die "open 'usernamefrompwuid.h': $!"; if (not -f $configh) { print PWOUT "#undef I_PWD\n"; } else { print PWOUT "#include \"$configh\"\n"; } close PWOUT; WriteMakefile( NAME => "myldr", SKIP => [qw(static static_lib dynamic dynamic_lib)], VERSION_FROM => "../lib/PAR/Packer.pm", NO_MYMETA => 1, PL_FILES => {}, PM => { map { $_ => catfile('$(INST_LIBDIR)', qw( PAR StrippedPARL ), $_) } @strippedparl }, EXE_FILES => \@parl_exes, MAN1PODS => {}, MAN3PODS => {}, macro => { FIXIN => '$(NOOP)' }, ); sub MY::postamble { my $make_frag = <<"EOT"; LD=$ld CC=$cc CFLAGS=$cflags -DLDLIBPTHNAME=\\"$Config{ldlibpthname}\\" -DPARL_EXE=\\"parl$exe\\" -DPAR_PACKER_VERSION=\\"\$(VERSION)\\" OPTIMIZE=$optimize LDFLAGS=$Config{ldflags} PERL_LDFLAGS=$ldflags STATIC_LDFLAGS=$static_ldflags OBJECTS=main$o $res MKTMP_STUFF=mktmpdir.c mktmpdir.h utils.c sha1.c .c$o: \$(CC) -c \$(CFLAGS) \$(OPTIMIZE) \$< pure_all:: $parl_exe Static.pm main$o: main.c my_par_pl.c perlxsi.c internals.c \$(MKTMP_STUFF) sha1.c: \$(PERLRUN) sha1.c.PL $res_section clean:: -\$(RM_F) boot_embedded_files.c my_par_pl.c -\$(RM_F) main$o boot$o $res -\$(RM_F) sha1.c -\$(RM_F) *.opt *.pdb perlxsi.c -\$(RM_F) usernamefrompwuid.h -\$(RM_F) $par_exe $boot_exe @parl_exes Dynamic.pm Static.pm $par_exe: \$(OBJECTS) \$(LD) \$(OBJECTS) \$(PERL_LDFLAGS) $out$par_exe_link $mt_cmd my_par_pl.c: $par_pl \$(PERLRUN) par_pl2c.pl my_par_pl < $par_pl > \$@ $parl_exe: $par \$(PERLRUN) -Mblib=.. run_with_inc.pl $par -q -B -O\$@ Static.pm: Static.in $par \$(PERLRUN) encode_append.pl Static.in $par Static.pm .DEFAULT: -\$(NOOP) .SUFFIXES: $o # dummy targets to satisfy ExtUtils::MakeMaker dynamic:: static:: test:: EOT if ($dynperl) { my $method; for ($^O) { # sane platforms: use "ldd" if (/linux|solaris|freebsd|openbsd|cygwin/i) { print STDERR qq[# using "ldd" to find shared libraries needed by $par_exe\n]; $method = "ldd"; last; } # Mac OS X: use "otool -L" if available # Note: old versions of otool don't accept --version if (/darwin/i && (qx(otool --version 2>&1) || qx(otool -h /bin/ls 2>&1), $? == 0)) { print STDERR qq[# using "otool -L" to find shared libraries needed by $par_exe\n]; $method = "otool"; last; } # Windows with Mingw toolchain: use "objdump" recursively if (/mswin32/i && (qx(objdump --version), $? == 0)) { print STDERR qq[# using "objdump" recursively to find DLLs needed by $par_exe\n]; $method = "recursive_objdump"; last; } # fallback print STDERR qq[# guessing what DLLs are needed by $par_exe\n]; $method = "guess"; } $make_frag .= <<"EOT"; pure_all:: $parldyn_exe Dynamic.pm $parldyn_exe: $par_exe \$(PERLRUN) -Mblib=.. run_with_inc.pl $par_exe -q -B -O\$@ boot$o: \$(MKTMP_STUFF) boot_embedded_files.c $boot_exe: boot$o \$(LD) boot$o $boot_ldflags $res $out$boot_exe_link $mt_cmd boot_embedded_files.c: $par_exe \$(PERLRUN) embed_files.pl -c $chunk_size $par_exe $method "$libperl" > \$@ Dynamic.pm: Dynamic.in $par_exe \$(PERLRUN) encode_append.pl Dynamic.in $par_exe Dynamic.pm EOT } return $make_frag; } # local variables: # mode: cperl # end: PAR-Packer-1.041/myldr/winres/0000755000175000017500000000000013200634513016157 5ustar roderichroderichPAR-Packer-1.041/myldr/winres/pp.manifest0000644000175000017500000000147613026021203020326 0ustar roderichroderich PAR-Packer Application PAR-Packer-1.041/myldr/winres/pp.rc0000644000175000017500000000213713026021203017117 0ustar roderichroderich// pp.RES is created using Microsoft toolchain rc // // rc pp.rc #define PP_MANIFEST_FILEFLAGS 0 #include CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "winres\\pp.manifest" VS_VERSION_INFO VERSIONINFO FILEVERSION 0,0,0,0 PRODUCTVERSION 0,0,0,0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS PP_MANIFEST_FILEFLAGS FILEOS VOS_NT_WINDOWS32 FILETYPE VFT_APP FILESUBTYPE VFT2_UNKNOWN BEGIN BLOCK "StringFileInfo" BEGIN BLOCK "000004B0" BEGIN VALUE "CompanyName", " \0" VALUE "FileDescription", " \0" VALUE "FileVersion", "0.0.0.0\0" VALUE "InternalName", " \0" VALUE "LegalCopyright", " \0" VALUE "LegalTrademarks", " \0" VALUE "OriginalFilename", " \0" VALUE "ProductName", " \0" VALUE "ProductVersion", "0.0.0.0\0" END END BLOCK "VarFileInfo" BEGIN VALUE "Translation", 0x00, 0x04B0 END END WINEXE ICON winres\\pp.ico PAR-Packer-1.041/myldr/winres/pp.ico0000644000175000017500000001614613026021203017272 0ustar roderichroderichhF ¨®hV ¨¾( BBBnnn±±±ÿÿÿsssŸŸŸXXX²²²ýýýkkküüü×××ÚÚÚ–––ŽŽŽFFFËËË    þþþÉÉÉÁÁÁ“““³³³îîîôôôãããåå墢¢ººº¯¯¯qqqµµµõõõ‰‰‰ŠŠŠ444èèè555ZZZ···ØØØÐÐÐ ¾¾¾mmm ›››///ÍÍÍÙÙÙMMMDDDPPP<<<dddÂÂÂ222 AAAAAAAAAAAAAA5@#A1CAADE.<&5&"1  ".!. !"##%&'%EA   1A€ÀàðððàÀ€€€€Žÿ( @  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~€€€‚‚‚ƒƒƒ„„„………†††‡‡‡ˆˆˆ‰‰‰ŠŠŠ‹‹‹ŒŒŒŽŽŽ‘‘‘’’’“““”””•••–––———˜˜˜™™™ššš›››œœœžžžŸŸŸ   ¡¡¡¢¢¢£££¤¤¤¥¥¥¦¦¦§§§¨¨¨©©©ªªª«««¬¬¬­­­®®®¯¯¯°°°±±±²²²³³³´´´µµµ¶¶¶···¸¸¸¹¹¹ººº»»»¼¼¼½½½¾¾¾¿¿¿ÀÀÀÁÁÁÂÂÂÃÃÃÄÄÄÅÅÅÆÆÆÇÇÇÈÈÈÉÉÉÊÊÊËËËÌÌÌÍÍÍÎÎÎÏÏÏÐÐÐÑÑÑÒÒÒÓÓÓÔÔÔÕÕÕÖÖÖ×××ØØØÙÙÙÚÚÚÛÛÛÜÜÜÝÝÝÞÞÞßßßàààáááâââãããäääåååæææçççèèèéééêêêëëëìììíííîîîïïïðððñññòòòóóóôôôõõõööö÷÷÷øøøùùùúúúûûûüüüýýýþþþÿÿÿ444<<<<<<<<<<<<<<<<<<<<<, \´ÔÔÔÔÔÔÔÔÔÔÜÔÔÔÔÔÔÔÔÔÔÔ´4QdÌìôôôüôüôôôüôüôüôüüüôôìÄ4QQdÄäìôôôôôôôôôôôôôôôôôôìì¼4QQQdÄäìììäìììääääììäìäììììä¼4QQQQd¼äì쬌¬ÔÄ””œ”ŒŒ”””œœœìܼ4QQQQQd¼ÜäìäÄQ”¬dä¤L4,\ÄÌQ´Ôäܼ4QQQQQQd¼ÜääìääQ„täŒl¤œlŒ¼t¬Ôäܼ4d¼Üääìää¼QŒÔÔŒ¬ÌtÌܤQÄäܼ4d¼ÜäääääÜŒ|œ´|„œlÌä¼tÄäÜ´4\¼ÜÜääääÔœ¤\”ŒÌ<”d̼ŒQÜÔ´4d´ÔÜÜÜäÜŒŒ¬,¼´ÌZÄdœl”¤ÜÔ´4\´ÔÜÜäÜÜt”ÔL¤ôŒ<Ôt”tœLÜÌ´4d´ÔÜÜÜäÜtQôt„ìÌdä|l¤´l¤Ô´4d´ÌÜÜÌ|Œ„´üÌÄüô´ü¼d̬„Q¼¬4\´ÌÔÌŒ¤ÜÜìüüüüüôüì´ì¬|”Q¬4\¬ÌÌlœôüüüüüüüüüüüüüÄ”ŒQ¬4\¬Ä¼|äüüüüüüüüüüüüüüì̬Q¬4\¬´LÄüüüìôüüüüüüüüüüô¼QĬ4\¬´LÔüüô´ÜüüüüüüüüüüÌQÌĤ4\¬Ä¤Qüüü´œôüüüüüüüüô”QÌĤ,\¤¤Q„ìüüÌd´ìüüüüüüüÔl¬Ì¼¤4\¤dt¼ôüüÄQ„œäüüüüüäŒQÌÌĤ4\¤lŒäôüüœQÌQ”ìüüüü¼tÌÌļœ,\¤¬d\d¤¤Q¬ÌÄt”äôüäQ¼ÌÌļœ4\¤´¼¼ŒQQÄÄÌ̬Q||”l|¼ÌÄļœ,\œ¼ÄÄÄÄÄÄÄÄÄÄÄQQQQ¼ÄÄÄÄ´œ4Tœ´ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄļ´œ,Tœ¼Äļ¼¼¼¼¼¼¼¼¼¼¼¼¼¼¼¼¼´œ,\œ´Ä¼´´´´´´´´´´´´´´´´´´¬œ,T„”œœ”””””””””””””””””””„$DT\\\\\\\\\\\\\\\\\\\\\\T4??????????????????????????( BBBnnn±±±ÿÿÿsssŸŸŸXXX²²²ýýýkkküüü×××ÚÚÚ–––ŽŽŽFFFËËË    þþþÉÉÉÁÁÁ“““³³³îîîôôôãããåå墢¢ººº¯¯¯qqqµµµõõõ‰‰‰ŠŠŠ444èèè555ZZZ···ØØØÐÐÐ ¾¾¾mmm ›››///ÍÍÍÙÙÙMMMDDDPPP<<<dddÂÂÂ222 AAAAAAAAAAAAAA5@#A1CAADE.<&5&"1  ".!. !"##%&'%EA   1A€ÀàðððàÀ€€€€Žÿ( @  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~€€€‚‚‚ƒƒƒ„„„………†††‡‡‡ˆˆˆ‰‰‰ŠŠŠ‹‹‹ŒŒŒŽŽŽ‘‘‘’’’“““”””•••–––———˜˜˜™™™ššš›››œœœžžžŸŸŸ   ¡¡¡¢¢¢£££¤¤¤¥¥¥¦¦¦§§§¨¨¨©©©ªªª«««¬¬¬­­­®®®¯¯¯°°°±±±²²²³³³´´´µµµ¶¶¶···¸¸¸¹¹¹ººº»»»¼¼¼½½½¾¾¾¿¿¿ÀÀÀÁÁÁÂÂÂÃÃÃÄÄÄÅÅÅÆÆÆÇÇÇÈÈÈÉÉÉÊÊÊËËËÌÌÌÍÍÍÎÎÎÏÏÏÐÐÐÑÑÑÒÒÒÓÓÓÔÔÔÕÕÕÖÖÖ×××ØØØÙÙÙÚÚÚÛÛÛÜÜÜÝÝÝÞÞÞßßßàààáááâââãããäääåååæææçççèèèéééêêêëëëìììíííîîîïïïðððñññòòòóóóôôôõõõööö÷÷÷øøøùùùúúúûûûüüüýýýþþþÿÿÿ444<<<<<<<<<<<<<<<<<<<<<, \´ÔÔÔÔÔÔÔÔÔÔÜÔÔÔÔÔÔÔÔÔÔÔ´4QdÌìôôôüôüôôôüôüôüôüüüôôìÄ4QQdÄäìôôôôôôôôôôôôôôôôôôìì¼4QQQdÄäìììäìììääääììäìäììììä¼4QQQQd¼äì쬌¬ÔÄ””œ”ŒŒ”””œœœìܼ4QQQQQd¼ÜäìäÄQ”¬dä¤L4,\ÄÌQ´Ôäܼ4QQQQQQd¼ÜääìääQ„täŒl¤œlŒ¼t¬Ôäܼ4d¼Üääìää¼QŒÔÔŒ¬ÌtÌܤQÄäܼ4d¼ÜäääääÜŒ|œ´|„œlÌä¼tÄäÜ´4\¼ÜÜääääÔœ¤\”ŒÌ<”d̼ŒQÜÔ´4d´ÔÜÜÜäÜŒŒ¬,¼´ÌZÄdœl”¤ÜÔ´4\´ÔÜÜäÜÜt”ÔL¤ôŒ<Ôt”tœLÜÌ´4d´ÔÜÜÜäÜtQôt„ìÌdä|l¤´l¤Ô´4d´ÌÜÜÌ|Œ„´üÌÄüô´ü¼d̬„Q¼¬4\´ÌÔÌŒ¤ÜÜìüüüüüôüì´ì¬|”Q¬4\¬ÌÌlœôüüüüüüüüüüüüüÄ”ŒQ¬4\¬Ä¼|äüüüüüüüüüüüüüüì̬Q¬4\¬´LÄüüüìôüüüüüüüüüüô¼QĬ4\¬´LÔüüô´ÜüüüüüüüüüüÌQÌĤ4\¬Ä¤Qüüü´œôüüüüüüüüô”QÌĤ,\¤¤Q„ìüüÌd´ìüüüüüüüÔl¬Ì¼¤4\¤dt¼ôüüÄQ„œäüüüüüäŒQÌÌĤ4\¤lŒäôüüœQÌQ”ìüüüü¼tÌÌļœ,\¤¬d\d¤¤Q¬ÌÄt”äôüäQ¼ÌÌļœ4\¤´¼¼ŒQQÄÄÌ̬Q||”l|¼ÌÄļœ,\œ¼ÄÄÄÄÄÄÄÄÄÄÄQQQQ¼ÄÄÄÄ´œ4Tœ´ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄļ´œ,Tœ¼Äļ¼¼¼¼¼¼¼¼¼¼¼¼¼¼¼¼¼´œ,\œ´Ä¼´´´´´´´´´´´´´´´´´´¬œ,T„”œœ”””””””””””””””””””„$DT\\\\\\\\\\\\\\\\\\\\\\T4??????????????????????????PAR-Packer-1.041/myldr/sha1.c.PL0000644000175000017500000002640213026021203016156 0ustar roderichroderich#!perl use strict; use warnings; use Config; (my $file = __FILE__) =~ s/\.PL$//; open my $fh, '>', $file or die "Could not open '$file' for writing: $!\n"; print $fh <<'EOH'; /* Borrowed by Alan Stewart in 2004 from SHA1.xs, part of Digest::SHA1 */ /* Digest::SHA1 by Gisle Aas Copyright 1999-2003, Uwe Hollerbach Copyright 1997 */ /* you can redistribute it and/or modify it under the same terms as Perl itself. */ /* $Id: SHA1.xs,v 1.11 2003/10/13 07:14:04 gisle Exp $ */ /* NIST Secure Hash Algorithm */ /* heavily modified by Uwe Hollerbach */ /* from Peter C. Gutmann's implementation as found in */ /* Applied Cryptography by Bruce Schneier */ /* Further modifications to include the "UNRAVEL" stuff, below */ /* This code is in the public domain */ #include /* Useful defines & typedefs */ EOH print $fh "#ifndef H_PERL\n"; printf $fh "typedef %s U8;\n", $Config{u8type}; printf $fh "#define BYTEORDER 0x%s\n", $Config{byteorder}; print $fh "#endif\n"; print $fh <<'EOF'; #if defined(U64TYPE) && (defined(USE_64_BIT_INT) || ((BYTEORDER != 0x1234) && (BYTEORDER != 0x4321))) typedef U64TYPE PAR_ULONG; # if BYTEORDER == 0x1234 # undef BYTEORDER # define BYTEORDER 0x12345678 # elif BYTEORDER == 0x4321 # undef BYTEORDER # define BYTEORDER 0x87654321 # endif #else # if (!defined(__GNUC__) || !defined(_WINNT_H) || defined(__MINGW32__)) typedef unsigned long PAR_ULONG; /* 32-or-more-bit quantity */ # endif #endif #define SHA_BLOCKSIZE 64 #define SHA_DIGESTSIZE 20 typedef struct { PAR_ULONG digest[5]; /* message digest */ PAR_ULONG count_lo, count_hi; /* 64-bit bit count */ U8 data[SHA_BLOCKSIZE]; /* SHA data buffer */ int local; /* unprocessed amount in data */ } SHA_INFO; /* UNRAVEL should be fastest & biggest */ /* UNROLL_LOOPS should be just as big, but slightly slower */ /* both undefined should be smallest and slowest */ #define SHA_VERSION 1 #define UNRAVEL /* #define UNROLL_LOOPS */ /* SHA f()-functions */ #define f1(x,y,z) ((x & y) | (~x & z)) #define f2(x,y,z) (x ^ y ^ z) #define f3(x,y,z) ((x & y) | (x & z) | (y & z)) #define f4(x,y,z) (x ^ y ^ z) /* SHA constants */ #define CONST1 0x5a827999L #define CONST2 0x6ed9eba1L #define CONST3 0x8f1bbcdcL #define CONST4 0xca62c1d6L /* truncate to 32 bits -- should be a null op on 32-bit machines */ #define T32(x) ((x) & 0xffffffffL) /* 32-bit rotate */ #define R32(x,n) T32(((x << n) | (x >> (32 - n)))) /* the generic case, for when the overall rotation is not unraveled */ #define FG(n) \ T = T32(R32(A,5) + f##n(B,C,D) + E + *WP++ + CONST##n); \ E = D; D = C; C = R32(B,30); B = A; A = T /* specific cases, for when the overall rotation is unraveled */ #define FA(n) \ T = T32(R32(A,5) + f##n(B,C,D) + E + *WP++ + CONST##n); B = R32(B,30) #define FB(n) \ E = T32(R32(T,5) + f##n(A,B,C) + D + *WP++ + CONST##n); A = R32(A,30) #define FC(n) \ D = T32(R32(E,5) + f##n(T,A,B) + C + *WP++ + CONST##n); T = R32(T,30) #define FD(n) \ C = T32(R32(D,5) + f##n(E,T,A) + B + *WP++ + CONST##n); E = R32(E,30) #define FE(n) \ B = T32(R32(C,5) + f##n(D,E,T) + A + *WP++ + CONST##n); D = R32(D,30) #define FT(n) \ A = T32(R32(B,5) + f##n(C,D,E) + T + *WP++ + CONST##n); C = R32(C,30) static void sha_transform(SHA_INFO *sha_info) { int i; U8 *dp; PAR_ULONG T, A, B, C, D, E, W[80], *WP; dp = sha_info->data; /* the following makes sure that at least one code block below is traversed or an error is reported, without the necessity for nested preprocessor if/else/endif blocks, which are a great pain in the nether regions of the anatomy... */ #undef SWAP_DONE #if BYTEORDER == 0x1234 #define SWAP_DONE /* assert(sizeof(PAR_ULONG) == 4); */ for (i = 0; i < 16; ++i) { T = *((PAR_ULONG *) dp); dp += 4; W[i] = ((T << 24) & 0xff000000) | ((T << 8) & 0x00ff0000) | ((T >> 8) & 0x0000ff00) | ((T >> 24) & 0x000000ff); } #endif #if BYTEORDER == 0x4321 #define SWAP_DONE /* assert(sizeof(PAR_ULONG) == 4); */ for (i = 0; i < 16; ++i) { T = *((PAR_ULONG *) dp); dp += 4; W[i] = T32(T); } #endif #if BYTEORDER == 0x12345678 #define SWAP_DONE /* assert(sizeof(PAR_ULONG) == 8); */ for (i = 0; i < 16; i += 2) { T = *((PAR_ULONG *) dp); dp += 8; W[i] = ((T << 24) & 0xff000000) | ((T << 8) & 0x00ff0000) | ((T >> 8) & 0x0000ff00) | ((T >> 24) & 0x000000ff); T >>= 32; W[i+1] = ((T << 24) & 0xff000000) | ((T << 8) & 0x00ff0000) | ((T >> 8) & 0x0000ff00) | ((T >> 24) & 0x000000ff); } #endif #if BYTEORDER == 0x87654321 #define SWAP_DONE /* assert(sizeof(PAR_ULONG) == 8); */ for (i = 0; i < 16; i += 2) { T = *((PAR_ULONG *) dp); dp += 8; W[i] = T32(T >> 32); W[i+1] = T32(T); } #endif #ifndef SWAP_DONE #error Unknown byte order -- you need to add code here #endif /* SWAP_DONE */ for (i = 16; i < 80; ++i) { W[i] = W[i-3] ^ W[i-8] ^ W[i-14] ^ W[i-16]; #if (SHA_VERSION == 1) W[i] = R32(W[i], 1); #endif /* SHA_VERSION */ } A = sha_info->digest[0]; B = sha_info->digest[1]; C = sha_info->digest[2]; D = sha_info->digest[3]; E = sha_info->digest[4]; WP = W; #ifdef UNRAVEL FA(1); FB(1); FC(1); FD(1); FE(1); FT(1); FA(1); FB(1); FC(1); FD(1); FE(1); FT(1); FA(1); FB(1); FC(1); FD(1); FE(1); FT(1); FA(1); FB(1); FC(2); FD(2); FE(2); FT(2); FA(2); FB(2); FC(2); FD(2); FE(2); FT(2); FA(2); FB(2); FC(2); FD(2); FE(2); FT(2); FA(2); FB(2); FC(2); FD(2); FE(3); FT(3); FA(3); FB(3); FC(3); FD(3); FE(3); FT(3); FA(3); FB(3); FC(3); FD(3); FE(3); FT(3); FA(3); FB(3); FC(3); FD(3); FE(3); FT(3); FA(4); FB(4); FC(4); FD(4); FE(4); FT(4); FA(4); FB(4); FC(4); FD(4); FE(4); FT(4); FA(4); FB(4); FC(4); FD(4); FE(4); FT(4); FA(4); FB(4); sha_info->digest[0] = T32(sha_info->digest[0] + E); sha_info->digest[1] = T32(sha_info->digest[1] + T); sha_info->digest[2] = T32(sha_info->digest[2] + A); sha_info->digest[3] = T32(sha_info->digest[3] + B); sha_info->digest[4] = T32(sha_info->digest[4] + C); #else /* !UNRAVEL */ #ifdef UNROLL_LOOPS FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(1); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(2); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(3); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); FG(4); #else /* !UNROLL_LOOPS */ for (i = 0; i < 20; ++i) { FG(1); } for (i = 20; i < 40; ++i) { FG(2); } for (i = 40; i < 60; ++i) { FG(3); } for (i = 60; i < 80; ++i) { FG(4); } #endif /* !UNROLL_LOOPS */ sha_info->digest[0] = T32(sha_info->digest[0] + A); sha_info->digest[1] = T32(sha_info->digest[1] + B); sha_info->digest[2] = T32(sha_info->digest[2] + C); sha_info->digest[3] = T32(sha_info->digest[3] + D); sha_info->digest[4] = T32(sha_info->digest[4] + E); #endif /* !UNRAVEL */ } /* initialize the SHA digest */ static void sha_init(SHA_INFO *sha_info) { sha_info->digest[0] = 0x67452301L; sha_info->digest[1] = 0xefcdab89L; sha_info->digest[2] = 0x98badcfeL; sha_info->digest[3] = 0x10325476L; sha_info->digest[4] = 0xc3d2e1f0L; sha_info->count_lo = 0L; sha_info->count_hi = 0L; sha_info->local = 0; } /* update the SHA digest */ static void sha_update(SHA_INFO *sha_info, U8 *buffer, int count) { int i; PAR_ULONG clo; clo = T32(sha_info->count_lo + ((PAR_ULONG) count << 3)); if (clo < sha_info->count_lo) { ++sha_info->count_hi; } sha_info->count_lo = clo; sha_info->count_hi += (PAR_ULONG) count >> 29; if (sha_info->local) { i = SHA_BLOCKSIZE - sha_info->local; if (i > count) { i = count; } memcpy(((U8 *) sha_info->data) + sha_info->local, buffer, i); count -= i; buffer += i; sha_info->local += i; if (sha_info->local == SHA_BLOCKSIZE) { sha_transform(sha_info); } else { return; } } while (count >= SHA_BLOCKSIZE) { memcpy(sha_info->data, buffer, SHA_BLOCKSIZE); buffer += SHA_BLOCKSIZE; count -= SHA_BLOCKSIZE; sha_transform(sha_info); } memcpy(sha_info->data, buffer, count); sha_info->local = count; } static void sha_transform_and_copy(unsigned char digest[20], SHA_INFO *sha_info) { sha_transform(sha_info); digest[ 0] = (unsigned char) ((sha_info->digest[0] >> 24) & 0xff); digest[ 1] = (unsigned char) ((sha_info->digest[0] >> 16) & 0xff); digest[ 2] = (unsigned char) ((sha_info->digest[0] >> 8) & 0xff); digest[ 3] = (unsigned char) ((sha_info->digest[0] ) & 0xff); digest[ 4] = (unsigned char) ((sha_info->digest[1] >> 24) & 0xff); digest[ 5] = (unsigned char) ((sha_info->digest[1] >> 16) & 0xff); digest[ 6] = (unsigned char) ((sha_info->digest[1] >> 8) & 0xff); digest[ 7] = (unsigned char) ((sha_info->digest[1] ) & 0xff); digest[ 8] = (unsigned char) ((sha_info->digest[2] >> 24) & 0xff); digest[ 9] = (unsigned char) ((sha_info->digest[2] >> 16) & 0xff); digest[10] = (unsigned char) ((sha_info->digest[2] >> 8) & 0xff); digest[11] = (unsigned char) ((sha_info->digest[2] ) & 0xff); digest[12] = (unsigned char) ((sha_info->digest[3] >> 24) & 0xff); digest[13] = (unsigned char) ((sha_info->digest[3] >> 16) & 0xff); digest[14] = (unsigned char) ((sha_info->digest[3] >> 8) & 0xff); digest[15] = (unsigned char) ((sha_info->digest[3] ) & 0xff); digest[16] = (unsigned char) ((sha_info->digest[4] >> 24) & 0xff); digest[17] = (unsigned char) ((sha_info->digest[4] >> 16) & 0xff); digest[18] = (unsigned char) ((sha_info->digest[4] >> 8) & 0xff); digest[19] = (unsigned char) ((sha_info->digest[4] ) & 0xff); } /* finish computing the SHA digest */ static void sha_final(unsigned char digest[20], SHA_INFO *sha_info) { int count; PAR_ULONG lo_bit_count, hi_bit_count; lo_bit_count = sha_info->count_lo; hi_bit_count = sha_info->count_hi; count = (int) ((lo_bit_count >> 3) & 0x3f); ((U8 *) sha_info->data)[count++] = 0x80; if (count > SHA_BLOCKSIZE - 8) { memset(((U8 *) sha_info->data) + count, 0, SHA_BLOCKSIZE - count); sha_transform(sha_info); memset((U8 *) sha_info->data, 0, SHA_BLOCKSIZE - 8); } else { memset(((U8 *) sha_info->data) + count, 0, SHA_BLOCKSIZE - 8 - count); } sha_info->data[56] = (U8)((hi_bit_count >> 24) & 0xff); sha_info->data[57] = (U8)((hi_bit_count >> 16) & 0xff); sha_info->data[58] = (U8)((hi_bit_count >> 8) & 0xff); sha_info->data[59] = (U8)((hi_bit_count >> 0) & 0xff); sha_info->data[60] = (U8)((lo_bit_count >> 24) & 0xff); sha_info->data[61] = (U8)((lo_bit_count >> 16) & 0xff); sha_info->data[62] = (U8)((lo_bit_count >> 8) & 0xff); sha_info->data[63] = (U8)((lo_bit_count >> 0) & 0xff); sha_transform_and_copy(digest, sha_info); } EOF close $fh; PAR-Packer-1.041/myldr/boot.c0000644000175000017500000001764713165210662016003 0ustar roderichroderich#undef readdir #ifdef _MSC_VER #include #else #include #include #endif #include "mktmpdir.c" typedef struct { size_t len; unsigned char *buf; } chunk_t; typedef struct { const char *name; size_t size; chunk_t *chunks; } embedded_file_t; #include "boot_embedded_files.c" #define EXTRACT_FAIL 0 #define EXTRACT_OK 1 #define EXTRACT_ALREADY 2 /* extract EMB_FILE to file STMPDIR/EXT_NAME and set *EXT_PATH to the latter; * return EXTRACT_ALREADY if the extracted file already exists (and has the * expected size), EXTRACT_OK if successful, EXTRACT_FAIL otherwise */ static int extract_embedded_file(embedded_file_t *emb_file, const char* ext_name, const char* stmpdir, char** ext_path) { int fd; chunk_t *chunk; struct stat statbuf; int len = strlen(stmpdir) + 1 + strlen(ext_name); char *tmp_path; *ext_path = malloc(len + 1); sprintf(*ext_path, "%s/%s", stmpdir, ext_name); if (par_lstat(*ext_path, &statbuf) == 0 && statbuf.st_size == emb_file->size ) return EXTRACT_ALREADY; /* file already exists and has the expected size */ tmp_path = malloc(len + 1 + 20 + 1); /* 20 decimal digits should be enough to hold up to 2^64-1 */ sprintf(tmp_path, "%s.%lu", *ext_path, (unsigned long)getpid()); fd = open(tmp_path, O_CREAT | O_WRONLY | OPEN_O_BINARY, 0755); if ( fd == -1 ) return EXTRACT_FAIL; chunk = emb_file->chunks; while (chunk->len) { if ( write(fd, chunk->buf, chunk->len) != chunk->len ) return EXTRACT_FAIL; chunk++; } if (close(fd) == -1) return EXTRACT_FAIL; chmod(tmp_path, 0750); if (rename(tmp_path, *ext_path) == -1) unlink(tmp_path); /* NOTE: The error presumably is something like ETXTBSY (scenario: * another process was faster at extraction *ext_path than us and is * already using it in some way); anyway, let's assume *ext_path * is "good" and clean up our copy. */ return EXTRACT_OK; } /* turn off automatic globbing of process arguments when using MingW */ #if defined(WIN32) && defined(__MINGW32__) int _CRT_glob = 0; #endif #ifdef WIN32 #define unpack_S(p) (*(WORD*)(p)) #define unpack_L(p) (*(DWORD*)(p)) #define ASSERT(expr, msg) if (!(expr)) fprintf(stderr, "assertion failed: %s\n", msg) /* seek file descriptor fd to member Subsystem (a WORD) of the * IMAGE_OPTIONAL_HEADER structure of a Windows executable * (so that the next 2 bytes read/written from/to fd get/set Subsystem); * cf. sub _fix_console in PAR/Packer.pm */ void seek_to_subsystem( int fd ) { BYTE buf[64]; DWORD off; WORD size, magic; lseek(fd, 0, SEEK_SET); // CHECK != -1 read(fd, buf, 64); // CHECK == 64 ASSERT(unpack_S(buf) == 0x5a4d, "MZ magic bytes"); // "MZ" off = unpack_L(buf+60); lseek(fd, off, SEEK_SET); // CHECK != -1 read(fd, buf, 4 + 20 + 2); // CHECK == 4 + 20 + 2 ASSERT(unpack_L(buf) == 0x4550, "PE header"); // "PE\0\0" size = unpack_S(buf+20); magic = unpack_S(buf+24); ASSERT(( size == 224 && magic == 0x10b ) || ( size == 240 && magic == 0x20b ), "IMAGE_NT_OPTIONAL_HDR_MAGIC"); lseek(fd, off + 4 + 20 + 68, SEEK_SET); // CHECK != -1 } /* algorithm stolen from Win32::ShellQuote, in particular quote_literal() */ char* shell_quote(const char *src) { /* some characters from src may be replaced with two chars, * add enclosing quotes and trailing \0 */ char *dst = malloc(2 * strlen(src) + 3); char *p = src; char *q = dst; char c; *q++ = '"'; /* opening quote */ while (c = *p) { if (c == '\\') { char *bs = p; /* span of backslashes */ int n = strspn(bs, "\\"); memcpy(q, bs, n); /* copy the span */ q += n; if (bs[n] == '\0' || bs[n] == '"') { memcpy(q, bs, n); /* copy the span once more */ q += n; } p += n; continue; } if (c == '"') *q++ = '\\'; /* escape the following quote */ *q++ = c; p++; } *q++ = '"'; /* closing quote */ *q++ = '\0'; return dst; } #endif char pp_version_info[] = "@(#) Packed by PAR::Packer " PAR_PACKER_VERSION; int main ( int argc, char **argv, char **env ) { int rc, i; char *stmpdir; embedded_file_t *emb_file; char *my_file; char *my_perl; char *my_prog; #ifdef WIN32 typedef BOOL (WINAPI *pALLOW)(DWORD); HINSTANCE hinstLib; pALLOW ProcAdd; char **argp; #ifndef ASFW_ANY #define ASFW_ANY -1 #endif #endif #define DIE exit(255) par_init_env(); stmpdir = par_mktmpdir( argv ); if ( !stmpdir ) DIE; /* error message has already been printed */ rc = my_mkdir(stmpdir, 0700); if ( rc == -1 && errno != EEXIST) { fprintf(stderr, "%s: creation of private cache subdirectory %s failed (errno= %i)\n", argv[0], stmpdir, errno); DIE; } /* extract embedded_files[0] (i.e. the custom Perl interpreter) * into stmpdir (but under the same basename as argv[0]) */ my_prog = par_findprog(argv[0], strdup(par_getenv("PATH"))); rc = extract_embedded_file(embedded_files, par_basename(my_prog), stmpdir, &my_perl); if (rc == EXTRACT_FAIL) { fprintf(stderr, "%s: extraction of %s (custom Perl interpreter) failed (errno=%i)\n", argv[0], my_perl, errno); DIE; } if (rc == EXTRACT_OK) /* i.e. file didn't already exist */ { #ifdef __hpux { /* HPUX will only honour SHLIB_PATH if the executable is specially marked */ char *chatr_cmd = malloc(strlen(my_perl) + 200); sprintf(chatr_cmd, "/usr/bin/chatr +s enable %s > /dev/null", my_perl); system(chatr_cmd); } #endif #ifdef WIN32 { /* copy IMAGE_OPTIONAL_HEADER.Subsystem (GUI vs console) * from this executable to the just extracted my_perl */ int fd; WORD subsystem; fd = open(my_prog, O_RDONLY | OPEN_O_BINARY, 0755); ASSERT(fd != -1, "open my_prog"); seek_to_subsystem(fd); read(fd, &subsystem, 2); // CHECK == 2 close(fd); // CHECK != -1 fd = open(my_perl, O_RDWR | OPEN_O_BINARY, 0755); ASSERT(fd != -1, "open my_perl"); seek_to_subsystem(fd); write(fd, &subsystem, 2); // CHECK == 2 close(fd); // CHECK != -1 } #endif } /* extract the rest of embedded_files into stmpdir */ emb_file = embedded_files + 1; while (emb_file->name) { if (extract_embedded_file(emb_file, emb_file->name, stmpdir, &my_file) == EXTRACT_FAIL) { fprintf(stderr, "%s: extraction of %s failed (errno=%i)\n", argv[0], my_file, errno); DIE; } emb_file++; } /* finally spawn the custom Perl interpreter */ argv[0] = my_perl; #ifdef WIN32 hinstLib = LoadLibrary("user32"); if (hinstLib != NULL) { ProcAdd = (pALLOW) GetProcAddress(hinstLib, "AllowSetForegroundWindow"); if (ProcAdd != NULL) { (ProcAdd)(ASFW_ANY); } } par_setenv("PAR_SPAWNED", "1"); /* quote argv strings if necessary, cf. Win32::ShellQuote */ for (argp = argv; *argp; argp++) { int len = strlen(*argp); if ( len == 0 || (*argp)[len-1] == '\\' || strpbrk(*argp, " \t\n\r\v\"") ) { *argp = shell_quote(*argp); } } rc = spawnvp(P_WAIT, my_perl, (char* const*)argv); par_cleanup(stmpdir); exit(rc); #else execvp(my_perl, argv); DIE; #endif } PAR-Packer-1.041/myldr/mktmpdir.h0000644000175000017500000000311013043700726016650 0ustar roderichroderich#ifdef _MSC_VER # if _MSC_VER < 1900 # define snprintf _snprintf # endif # if _MSC_VER < 1500 # define vsnprintf _vsnprintf # endif # define strncasecmp _strnicmp # define strcasecmp _stricmp #endif #include #include #include #include #include #include #ifdef WIN32 # include # define Direntry_t struct direct # include #else # include # define Direntry_t struct dirent # include #endif #ifndef W_OK #define W_OK 0x02 #endif #ifndef X_OK #define X_OK 0x04 #endif #ifndef S_ISDIR # define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR) #endif #ifndef S_ISLNK # ifdef _S_ISLNK # define S_ISLNK(m) _S_ISLNK(m) # else # ifdef _S_IFLNK # define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK) # else # ifdef S_IFLNK # define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK) # else # define S_ISLNK(m) (0) # endif # endif # endif #endif #ifndef S_ISREG #define S_ISREG(x) 1 #endif #ifndef MAXPATHLEN #define MAXPATHLEN 32767 #endif #ifdef HAS_LSTAT #define par_lstat lstat #else #define par_lstat stat #endif #if defined(WIN32) || defined(OS2) static const char *dir_sep = "\\"; static const char *path_sep = ";"; #else static const char *dir_sep = "/"; static const char *path_sep = ":"; #endif #ifdef WIN32 # include # define my_mkdir(file, mode) _mkdir(file) #else # define my_mkdir(file, mode) mkdir(file,mode) #endif #include "utils.c" #include "sha1.c" #include "usernamefrompwuid.c" PAR-Packer-1.041/myldr/run_with_inc.pl0000644000175000017500000000047013026021203017666 0ustar roderichroderich#!perl use strict; use warnings; use File::Temp; $ENV{PAR_TMPDIR} = File::Temp::tempdir(TMPDIR => 1, CLEANUP => 1); # add -I options corresponding to @INC after the first element of @ARGV, # then execute it splice @ARGV, 1, 0, map { "-I$_" } @INC; system(@ARGV) == 0 or die "system(@ARGV) failed: $!\n"; PAR-Packer-1.041/myldr/embed_files.pl0000644000175000017500000000543613167166656017477 0ustar roderichroderich#!perl # Copyright (c) 2002 Mattia Barbon. # Copyright (c) 2002 Audrey Tang. # This package is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. use strict; use warnings; use Getopt::Long; use File::Basename; use IO::Compress::Gzip qw(gzip $GzipError); my $chunk_size = 32768; my $compress = 0; GetOptions( "c|chunk-size=i" => \$chunk_size, "z|compress" => \$compress) && @ARGV == 3 or die "Usage: $0 [-c CHUNK][-z] par method libperl > file.c\n"; my ($par, $method, $libperl) = @ARGV; print STDERR qq[# using method $method to find files to embed\n]; require "./find_files_to_embed/$method.pl"; my $files_to_embed = find_files_to_embed($par, $libperl); my $filenn = "file00"; # 100 files should be enough my @embedded; # par is always the first embedded file push @embedded, embed($filenn++, basename($par), $par); while (my ($name, $file) = each %$files_to_embed) { push @embedded, embed($filenn++, $name, $file); } print "static embedded_file_t embedded_files[] = {\n"; print " { \"$_->{name}\", $_->{size}, $_->{chunks} },\n" foreach @embedded; print " { NULL, 0, NULL }\n};"; exit 0; sub embed { my ($prefix, $name, $file) = @_; print STDERR qq[# embedding "$file" as "$name"\n]; return { name => $name, size => -s $file, chunks => file2c($prefix, $file) }; } sub file2c { my ($prefix, $path) = @_; my $bin = do # a scalar reference { open my $in, "<", $path or die "open input file '$path': $!"; binmode $in; local $/ = undef; my $slurp = <$in>; close $in; \$slurp; }; if ($compress) { my $gzipped; my $status = gzip($bin, \$gzipped) or die "gzip failed: $GzipError\n"; $bin = \$gzipped; } my $len = length $$bin; my $chunk_count = int(( $len + $chunk_size - 1 ) / $chunk_size); my @chunks; for (my $offset = 0, my $i = 0; $offset <= $len; $offset += $chunk_size, $i++) { my $name = "${prefix}_${i}"; push @chunks, { name => $name, len => print_chunk(substr($$bin, $offset, $chunk_size), $name), }; } print "static chunk_t ${prefix}[] = {\n"; print " { $_->{len}, $_->{name} },\n" foreach @chunks; print " { 0, NULL } };\n\n"; return $prefix; } sub print_chunk { my ($chunk, $name) = @_; my $len = length($chunk); print qq[static unsigned char ${name}[] =]; my $i = 0; do { print qq[\n"]; while ($i < $len) { printf "\\x%02x", ord(substr($chunk, $i++, 1)); last if $i % 16 == 0; } print qq["]; } while ($i < $len); print ";\n"; return $len; } # local variables: # mode: cperl # end: PAR-Packer-1.041/myldr/par_pl2c.pl0000644000175000017500000000104613026021203016700 0ustar roderichroderich#!perl use strict; use warnings; use blib; # PAR::Filter::Podstrip might not be installed yet use PAR::Filter::PodStrip; my ($var) = @ARGV; my $slurp = do { local $/ = undef; }; PAR::Filter::PodStrip->new->apply(\$slurp); print "const char *$var =\n"; foreach (split(/\n/, $slurp)) { s/^\s*|\s*$//g; # strip leading and trailing whitespace next if /^#|^$/; # skip comment and empty lines s/(["\\])/\\$1/g; # escape quotes and backslashes print qq["$_\\n"\n]; } print ";\n" PAR-Packer-1.041/myldr/usernamefrompwuid.c0000644000175000017500000000141113026021203020555 0ustar roderichroderich#include "usernamefrompwuid.h" #ifdef I_PWD # include # include #endif /* This piece of code uses getpwuid from pwd.h to determine the current * user name. * Since pwd.h might not be available and perl's configure script probed * for this, we require access to perl's config.h. Whether or not we have that * can be determined by the Makefile.PL in myldr/. It writes the * usernamefrompwuid.h file for us. In the header, we include config.h if * available or sets I_PWD to undefined. * -- Steffen Mueller */ char *get_username_from_getpwuid () { char *username = NULL; #ifdef I_PWD struct passwd *userdata = NULL; userdata = getpwuid(getuid()); if (userdata) username = userdata->pw_name; #endif return(username); } PAR-Packer-1.041/myldr/main.c0000644000175000017500000001032713026021203015733 0ustar roderichroderich#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "perlxsi.c" #include "my_par_pl.c" /* Workaround for mapstart: the only op which needs a different ppaddr */ #undef Perl_pp_mapstart #define Perl_pp_mapstart Perl_pp_grepstart #undef OP_MAPSTART #define OP_MAPSTART OP_GREPSTART static PerlInterpreter *my_perl; static char *stmpdir; static int options_count; static char **fakeargv; #ifdef HAS_PROCSELFEXE /* This is a function so that we don't hold on to MAXPATHLEN bytes of stack longer than necessary */ STATIC void S_procself_val(pTHX_ SV *sv, char *arg0) { char buf[MAXPATHLEN]; int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1); /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe) includes a spurious NUL which will cause $^X to fail in system or backticks (this will prevent extensions from being built and many tests from working). readlink is not meant to add a NUL. Normal readlink works fine. */ if (len > 0 && buf[len-1] == '\0') len--; /* FreeBSD's implementation is acknowledged to be imperfect, sometimes returning the text "unknown" from the readlink rather than the path to the executable (or returning an error from the readlink). Any valid path has a '/' in it somewhere, so use that to validate the result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703 */ if (len > 0 && memchr(buf, '/', len)) sv_setpvn(sv, buf, len); else sv_setpv(sv,arg0); } #endif /* HAS_PROCSELFEXE */ #include "mktmpdir.c" #include "internals.c" int main ( int argc, char **argv, char **env ) { int exitstatus; int i; int argno = 0; #ifdef PERL_GPROF_MONCONTROL PERL_GPROF_MONCONTROL(0); #endif #ifdef PERL_SYS_INIT3 PERL_SYS_INIT3(&argc, &argv, &env); #endif #if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) && defined(HAS_PTHREAD_ATFORK) /* XXX Ideally, this should really be happening in perl_alloc() or * perl_construct() to keep libperl.a transparently fork()-safe. * It is currently done here only because Apache/mod_perl have * problems due to lack of a call to cancel pthread_atfork() * handlers when shared objects that contain the handlers may * be dlclose()d. This forces applications that embed perl to * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't * been called at least once before in the current process. * --GSAR 2001-07-20 */ PTHREAD_ATFORK(Perl_atfork_lock, Perl_atfork_unlock, Perl_atfork_unlock); #endif if (!PL_do_undump) { my_perl = perl_alloc(); if (!my_perl) exit(1); perl_construct( my_perl ); PL_perl_destruct_level = 0; } #ifdef PERL_EXIT_DESTRUCT_END PL_exit_flags |= PERL_EXIT_DESTRUCT_END; #endif /* PERL_EXIT_DESTRUCT_END */ #ifdef PERL_EXIT_EXPECTED PL_exit_flags |= PERL_EXIT_EXPECTED; #endif /* PERL_EXIT_EXPECTED */ #if (defined(CSH) && defined(PL_cshname)) if (!PL_cshlen) PL_cshlen = strlen(PL_cshname); #endif #ifdef PERL_PROFILING #define PROFILING_OPTION 1 #else #define PROFILING_OPTION 0 #endif #ifdef ALLOW_PERL_OPTIONS #define EXTRA_OPTIONS 3 #else #define EXTRA_OPTIONS 4 #endif /* ALLOW_PERL_OPTIONS */ New(666, fakeargv, argc + EXTRA_OPTIONS + 1 + PROFILING_OPTION, char *); fakeargv[argno++] = argv[0]; #ifdef PERL_PROFILING fakeargv[argno++] = "-d:DProf"; #endif fakeargv[argno++] = "-e"; fakeargv[argno++] = (char *)my_par_pl; #ifndef ALLOW_PERL_OPTIONS fakeargv[argno++] = "--"; #endif /* ALLOW_PERL_OPTIONS */ options_count = argno; for (i = 1; i < argc; i++) fakeargv[i + options_count - 1] = argv[i]; fakeargv[argc + options_count - 1] = NULL; exitstatus = perl_parse(my_perl, par_xs_init, argc + options_count - 1, fakeargv, NULL); if (exitstatus == 0) exitstatus = perl_run( my_perl ); perl_destruct( my_perl ); if ( par_getenv("PAR_SPAWNED") == NULL ) { if ( stmpdir == NULL ) stmpdir = par_getenv("PAR_TEMP"); if ( stmpdir != NULL ) par_cleanup(stmpdir); } perl_free( my_perl ); PERL_SYS_TERM(); return exitstatus; } PAR-Packer-1.041/MANIFEST.SKIP0000644000175000017500000000127613200633702015424 0ustar roderichroderich#defaults ^\..*\.swp$ ^contrib/automated_pp_test/pp_switch_tests ^inc/\.author/\.keep ^myldr/Makefile$ ^myldr/Makefile\.old$ ^myldr/MYMETA\. ^myldr/Dynamic.pm ^myldr/Static.pm ^myldr/boot$ ^myldr/boot_embedded_files.c ^myldr/x?static(?:.[^c].*)?$ ^myldr/my_.*$ ^myldr/parl ^myldr/perlxsi.c$ ^myldr/par(?:\.\w+)?$ ^myldr/pm_to_blib ^myldr/sha1.[co]$ ^myldr/usernamefrompwuid.h$ ^myldr/.*\.pdb$ ^myldr/usernamefrompwuid\.h$ ^package/parl-.*$ ^script/parl(?:\.(?!pod).+)?$ ^script/parldyn(?:\.(?!pod).+)?$ ^Makefile$ ^Makefile.old$ ^META\. ^MYMETA\. ^blib/ ^pm_to_blib ^blibdirs \B\.svn\b \B\.git\b \B\.gitignore\b ^a\.out$ .*\.bak$ .*\.swp$ .*\.o$ .*\.obj$ .*\.exe$ ^nohup.out ^typescript ^PAR-Packer-.* PAR-Packer-1.041/Changes0000644000175000017500000022465613200634155015035 0ustar roderichroderich1.041 2017-11-08 - Fix problem with --link libraries on MacOS - libraries where packed into the wrong location in the zip - hence they were not extracted into the cache area where they could be found via DYLD_LIBRARY_PATH - hence the packed executable either couldn't find them or found incompatible versions outside the cache area - reported by Phil Kime 1.040 2017-10-21 - no changes to modules and scripts, only fixes for configure, build and test - require a version of IPC::Run3 that gets shell quoting on Windows right - restructure how we find the files to embed into boot.c - avoid an error with newer gcc: "error: 'for' loop initial declarations are only allowed in C99 or C11 mode" - fix tests when running without "." in @INC even (even in tests) 1.039 2017-09-28 - Brown paper bag: add missing t/utils.pl 1.038 2017-09-27 - Fix "RT#122949: PAR-Packer-1.37 executables split arguments containing whitespace" - on Windows, quote elements of argv array passed to spawnvp(); algorithm stolen from Win32::ShellQuote. - introduce helper t/utils.pl to streamline tests - require IPC::Run3 for test - make test work with "dot-less" perl and PERL_USE_UNSAFE_INC=0 1.037 2017-05-28 - Fix RT#121268 for PAR-Packer: error installing PAR-Packer on windows10 ( 64Bit ) - on Windows, make dl_findfile() search first in the directory containing the perl executable (to avoid erroneous hits in other members of PATH) - Fix RT#120038: [PATCH] Fix build for VS2015 (VC++ 14) and merge pull request from Steve Hay (shay@cpan.org) - makes PAR::Packer work with VisualStudio 2015. Thanks, Steve! - Fix RT#120041: --exclude gets confused by missing modules - guard against Module::ScanDeps::_find_in_inc() returning () - Fail early when packing with a version of Perl that's different frome the one PAR::Packer was built with. Scenario: User has built and installed PAR::Packer (or got it pre-packaged), then installs a newer version of Perl, then does pp -o foo.exe foo.pl But running foo.exe then fails with foo.exe C:\Users\jon\AppData\Local\Temp\parlzcPb.exe: Perl lib version (5.24.1) doesn't match executable 'perl.exe' version (5.24.0) at C:/Perl64/lib/Config.pm line 62. Compilation failed in require at C:/Perl64/lib/Errno.pm line 10. ... C:\Perl64\site\bin/pp: Failed to extract a parl from 'PAR::StrippedPARL::Static' to file 'C:\Users\jon\AppData\Local\Temp\parl3swwQJc.exe' at C:/Perl64/site/lib/PAR/Packer.pm line 1184, line 1. Now, pp will fail and with a more useful message. - Switch from Module::Install to ExtUtils::MakeMaker - Rewrite the library search (for "pp --link ...") - start with $Config{libpth} which is *not* the runtime loader (e.g. ld.so on Linux) search path, but rather the linker (ld) search path - but it's the best guess without having to grok /etc/ld.so.conf - augment that with $ENV{LD_LIBRARY_PATH} or similar - Rework how we determine the name under which a library should be installed - use objdump (on Linux and other ELF-based OS) and otool on Darwin - fall back to "chasing symlinks" otherwise - Remove PAR_ARGV_*, PAR_ARGC stuff from script/par.pl and myldr/boot.c. - Dunno what problem this obscure way of passing the command line arguments from a packed executable to the custom Perl interpreter was intended to fix, but arguments pass just fine through execvp (or spawnvp) to perl_parse. - Only set the environment variable for the shared library search path (e.g. LD_LIBRARY_PATH) that is relevant for the operating system that we're running on - Use DynaLoader::dl_findfile to locate DLLs instead of homegrown stuff. - Remove "par_base" - prebuilt .par's haven't been available for ages 1.036 2016-12-29 - Fix RT#118094: Race condition exists when building cache for pp built executables - guard against concurrent extraction attempts - bump "requires" on PAR to a version with additional guards - Fix RT#118903: Does not install when '.' is not in @INC - apply patch from Graham Ollis (PLICEASE), thanks! - make the Module::Install stuff work in the "author" case NOTE: "use lib '.'" does *not* work in this case - Move to GitHub. Thanks, OpenFoundry, for years of service. - add Perl_5 LICENSE file, make "repository" point to GitHub - always refer to the included LICENSE file - point bug reports to bug-par-packer@rt.cpan.org - add an empty file "inc/.author/.keep" as Git doesn't track empty directories - Fix RT #118053: Problem with packed perl archive for biber on 64-bit Cygwin - embed cygcrypt-0.dll since it isn't (anymore) in the set of default Cygwin packages - Upgrade to Module::Install 1.17 1.035 2016-07-23 - Fix RT#116254: Compilation error under strawberry perl 5.24 x64 s/PP_VERSION/PAR_PACKER_VERSION/ as Strawberry Perl also defines PP_VERSION (in c/x86_64-w64-mingw32/include/wincrypt.h) 1.034 2016-07-17 - Fix RT#116056: Fixes for Cygwin build of PAR::Packer - detect whether we're using a 32-bit or 64-bit perl - fix elision of "-l" from $static_ldflags - add $static_ldflags back to $boot_ldflags - Add information to packed executable about which version of PAR::Packer was used to build it (suggested by Johan Vromans): - accessible from the packaged Perl script as $PAR::Packer::VERSION - by looking for the string "Packed by PAR::Packer ..." in the executable itself (using "strings exe | grep ..." or the like) - Use ldd on cygwin, too - NOTE: a "system lib" on cygwin is either in /usr/bin or a Windows "system lib" 1.033 2016-05-19 - Fix RT#114229: v1.32 still won't install on strawberry perl v5.22.2 This is actually a problem caused by (some) newer versions of ExtUtils::MakeMaker. - Drop the "re-exec myself" in myldr/internals.c, may cause problems on machines with low argv+env limits; the reason for this execvp() is unknown and it's only relevant for standalone invocations of parl, anyway (ie. NOT when running a packed executable) - Really suppress generation of myldr/MYMETA.* and don't install man pages for myldr/{Dynamic,Static}.pm (nothing there to see anyway). 1.032 2016-05-07 - Unbreak PAR::Packer for Perl 5.23.9 and higher: Perl 5.23.9 removed the keys starting with "_<" from %:: script/par.pl used to glean the DLLs loaded via require_modules() from these keys; replace them with @DynaLoader::dl_shared_objects. - Fix RT#114155: Makefile.PL error - not loading ExtUtils::MakeMaker - extract-embedded.pl: show starting offset of embedded files 1.031 2016-04-10 - Fix RT#113618: Strange issue with not packing libperl.dylib Restore guessing what files to embed in myldr/Makefile.PL, but make myldr/embed_files.pl ignore this list if it knows a better way to determine these files. Also use "otools -h" on OSX, as "otool --version" doesn't work on older versions of OSX. Thanks to Phil Kime for help in investigating this. - Implement namespace options for "-M" like ActiveState's perlapp: pp now accepts "-M Foo::", "-M Foo:*" and "-M Foo:**". Bump requirements for Module::ScanDeps to 1.21 for the helper function to implement this. - Fix RT#113463: Fix spelling error in manpage Applied patch from the Debian Perl group. Thanks, guys! 1.030 2016-03-29 - Fix RT#111455: unable to use -x and -u with pp RT#110480: Unpacking exe: File exists Do not add %Preload dependencies of "-M" arguments to the list of input files, this causes several problems (and doesn't gain anything). - Fix RT#111896: PAR Question Solaris 10 Link myldr/boot only with what's actually required. Move detection of libraries that should be embedded into myldr/boot from myldr/Makefile.PL into myldr/embed_files.pl. Get rid of guessing the shared libraries our custom Perl interpreter is linked with (and hence have to be packed into boot_embedded_files.c) - at least on platforms where we know how to determine the shared libraries required by an executable: - use "ldd" on Linux, Solaris and BDSs - use "otool -L" on Mac OS X if available - use "objdump -ax" on Windows if available (when using the Mingw toolchain) - file2c.pl: switch back from array of unsiged to (hex encoded) strings. At least for gcc, the former is much harder on the compiler, both in CPU time and memory consumption. - Skip a test if Archive::Unzip::Burst is detected (this messes up expected mtimes for extracted files). - Make a test work with early versions of Perl 5.8.x (x < 9) that have a bug with compiled regexes and the /m modifier. 1.029 2016-01-12 - Add option "-u" ("--unicode") to pp to explicitly package Unicode support - Remove all references to http://par.perl.org/, doesn't exist anymore - Remove Internals::PAR::CLEARSTACK - it hasn't been enabled for ages, causes segfaults if enabled and doesn't even compile with perl > 5.23.6 1.028 2015-11-19 - Fix RT#109123: v1.027 tests are not passed under windows Apparently, even when called with a list, system() on Strawberry Perl on Windows has a problem with arguments containing double quotes, hence avoid them. 1.027 2015-11-18 - Add option -M Foo::Bar:: to pp (note the trailing double colon): it adds Foo/Bar.pm and anything below Foo/Bar. Bump required Module::ScanDeps version for Module::ScanDeps::add_preload_rule() to implement this. - Fix RT#109110: Incompatible with Module::ScanDeps 1.20 1.026 2015-07-19 - Fix RT#101800: [PATCH] Reinstate files to inc dir if deleted by external process - The actual fix is in PAR (cf r1584) (add a "canary" file), bump the required version of PAR, add a test. - Find the "\nPAR.pm\n" signature in a .par (or packed executable) even if it's not at end of the file (algorithm stolen from Archive::Zip's search for the EOCD signature). - This is intended to help code signing which may add stuff at the end of the executable. - Fix RT#104635 for PAR-Packer: IO error the first time an executable built by the packer is run on OSX - Fix RT#104509: Problem signing PAR file, and RT#104560: [PATCH] list added files in manifest - Apply (slightly modified) patch by Shawn Laffan (SLAFFAN@cpan.org) from RT#104560. Thanks, Shawn! - Make MIME::Types work "out of the box" - pack its data file MIME/types.db - patch the code to read MIME/types.db - bump required version of Module::ScanDeps (needed for MIME::Types %preload rule and fix for handling of "open FH, '<:encoding(utf8)', ..." since that's what MIME::Types does) - Bump requirement on PAR (for the fix for RT #103861), add a test. - Update tkpp ito 1.5: - using -M will now work (the current directory added in @INC) - tkpp delete and test building file. - Make pp fail when an unknown option is encountered. - Remove PAR::Packer::_append_parl(), not called anywhere. - Add license; update repository OpenFoundry repository URL 1.025 2015-01-24 - Fix PAR::Packer "make test" problem with Strawberry Portable - Fix for PAR-Packer 1.024 with a nonstandard libperl.so name Patch from markus.jansen@ericsson.com, thanks! - Fix #101662: Prevent shared libs from being cached in memory on AIX Applied patch from Thoke@northpeak.org, thanks. Note: this is one half of the fix, the other is in PAR 1.024 2014-11-07 - Fix RT #99231: Problem with PAR::Packer 1.022 on Perl 5.20.1 and earlier. Correct a typo to really fix this bug. 1.023 2014-11-02 - Fix RT #99231: Problem with PAR::Packer 1.022 on Perl 5.20.1 and earlier. Add libwinpthreads*.dll to embedded files (used on recent Strawberry builds). Patch by sergio.fanchiotti@standardandpoors.com, thanks! - Fix RT #63939: The behaviour of "pp --link ..." is subtly different between OSX and Linux. Applied patch from lamprecht@cpan.org, thanks! - Bump required version of Module::ScanDeps, makes t/90-rt59710.t pass again on perl 5.21.x - die if a requested shared library (option -l) can't be found. - Add a patch rule so that Mozilla::CA finds its (extracted) cacert.pem file. - Rename ChangeLog file to Changes and reformat it according to CPAN::Changes::Spec. - Upgrade to Module::Install 1.14. 1.022 2014-09-19 - Fix RT#98955: installation fails | Can't locate String/ShellQuote.pm Revert the fix for RT#98791: In order to be fullfilled at "perl Makefile.PL" {String,Win32}::ShellQuote would need to be in the _distributed_ META.yml as "configure_require". But this can't handle arch-specific "configure_require"s and we can't require _both_ as Win32::ShellQuote won't build on *nix systems. - Simply enclose the filenames in double quotes, should work on both *nix and Windows in all reasonable scenarios. - Drop incorrectly specified 'Digital signature support' "feature": simply "recommends" the required modules. 1.021 2014-09-14 - Fix #98791: PAR-Packer fails to build with DWIMPerl/Strawberry Perl due to unquoted path name - quote the list of embedded file wrt OS native shell - require Win32::ShellQuote on Windows and String::ShellQuote otherwise 1.020 2014-08-24 - Implement option --xargs for pp: - splits value of --xargs using Text::ParseWords::shellquote - passes result as @ARGV when running script for -x - bump required version of Module::ScanDeps to the first to implement this - Update to Module::Install 1.10 1.019 2014-07-07 - Fix RT #96288: PAR::Packer unable to build under Win32/ActivePerl v5.14.2 RT #96739: "bsd_glob" is not defined on perl 5.14.x and earlier RT #97018 (Issue while upgrading PAR::Packer ) Don't "use File::Glob ':bsd_glob'": - this remaps CORE::glob() to File::Glob::bsd_glob() globally, but some versions of ExtUtils::MakeMaker rely on CORE::glob() legacy behaviour - the tag :bsd_glob isn't exported in Perl <= 14.2 - explicitly call File::Glob::bsd_glob() instead of glob() - Fix RT #59224 (make error with version 1.006 on aix 5.3) The string contents of myldr/my_par_pl.c (generated from script/par.pl by myldr/par_pl2c.pl) is passed in argv[] during the build. This is too large for the default limit (24k) that AIX 5.3 has for passing argv+env in execve(). Shrink it a bit by removing leading whitespace and comment-only lines (in addition to using PAR::Filter::PodStrip). - Update documentation wrt the name of the cache directory. 1.018 2014-05-18 - [DJIBEL] tkpp 1.4 : Since PAR::Packer 1.015, tkpp doesn't work. I Removed --icon and --info options. Now tkpp work. - Bug fixes: Use bsd_glob() instead of glob() to avoid problems with patterns that contain whitespace, e.g. "C:\\Program Files\..." on Windows. Found by Victor Wheeler . Fix RT #93008: install failure with ubuntu / puppet (and several similar ones): When building on a Debian derived Linux distro (and building with the system perl) check that distro package "libperl-dev" is installed. 1.017 2013-12-01 - Fix RT #84588: OSX: incorrect detection of gcc (unsupported option '-static-libgcc'), RT #90198: PAR::Packer fails to compile in Mac OS X 10.9 Mavericks, RT #91086: PAR-Packer-1.016 fails to install on OSX) - clang on OSX pretends to be gcc, but doesn't implement gcc's option "-static-libgcc" - use this option only on Windows (when using the MingW toolchain). - Drop a test that was using Inline::C just to wrap native execvp(). - It caused failures on CPAN Testers (if accidentally Inline was installed) that were unrelated to PAR::Packer. 1.016 2013-11-30 - Fix RT #90870: Segmentation fault (core dumped) (MooX::Options) - any "die" in a packed executable causes the executable to segfault (at least on Linux and Perl 5.18.1) - remove a line from XS code that sets an internal perl variable 1.015 2013-10-09 - featurectomy: remove --icon and --info options from pp and PAR::Packer - they don't work on some versions of Windows (result in corrupted executables) - these options are just passed on to Win32::Exe, so you may simply post-process the executable, e.g. using exe_update.pl from Win32::Exe - Fix RT #82916: Terminating during unpack results in corrupted cache, failure on next start - apply (slightly modified) patch from shutton@pobox.com, thanks! - Fix RT #88297 (-M crashes pp if option contains backslashes) - _add_file(): do _not_ use $zip->memberNamed(...) to refer to the just added Archive::Zip::Member; instead use the return value of $zip->addFile or $zip->addString - don't modify embedded files after initial extraction - fixes bug (on Windows) reported by Ken Tuchman - minor changes - use File::Spec::Functions, get rid of ugly File::Spec->... calls - set $pre_res using catfile() instead of hardcoding a backslash; this might help on Cygwin - fix -Mblib option for run_with_inc.pl: we want the blib in the top level directory 1.014 2012-12-21 - tkpp 1.3 : --addfile option in GUI updated : - now it is possible to set a new filename or dirname in package using (old;new). - Bug fixes, etc. - RT #75636: PAR::Packer Windows installation error (and suggested fix) - apply PAR-Packer-1.013_V2.diff from above bug report - Some versions of GCC link myldr/boot.exe with libgcc*.dll; this renders any packed executable non-portable to machines that don't have (this version of) libgcc*.dll installed (problem reported by chandrashekaran_kannan@hotmail.com); to fix add '-static-libgcc' to the command for linking boot.exe (when using the GCC toolchain) - This also uncovered the following problem: on some platforms (e.g. ActiveState + MingW) ldopts() may contain a spurious trailing newline; chomp ldopts() and ccopts() for sanity - Recent versions od Strawberry perl (5.16.x) link their perl*.dll against the MingW libstdc++*.dll - hence pack it, too (same as libgcc_*.dll). Rewrite how we generate the C file(s) containing the custom perl interpreter, libperl DLL, libgcc DLL etc as large byte arrays and how we extract this stuff on bootstrap. - Bump requirement for Module::ScanDeps to a version that can grok Unicode::UCD from Perl 5.17 to avoid test failures - PAR 1.007 caused several tests to fail (t/20-pp.t, tests 8-9, 12). IMHO these are bogus (depend on unspecified behaviour) and previously succeeded only by accident; removed the offending sub tests - RT #75750: PAR::Filter::Bleach is broken - NOTE: original code works as intended due to the funny way pack 'b' is implemented, but apply patch just for sanity - RT #78396: [manifypods] Error 255 - s/MAN3PODS/MAN1PODS/ as suggested - Update to Module::Install 1.06 1.013 2012-02-22 - New version of Tkpp (Version 1.2) (cf. RT #69517) - incorporate new script/tkpp from Djibril Ousmanou (DJIBEL), many thanks! - add "recommends" to Makefile.PL for Tk and additional Tk modules needed - Bug fixes, etc. - RT #74302: Win32 executable additional information (--info) not updated - finally apply patches from Mark Dootson (MDOOTSON) - thanks, Mark: rework resource handling for Win32 executables - BIG FAT WARNING: --info still doesn't work, so I disabled this option for now; at least on some platforms, "pp --info ..." results in a corrupted executable that Windows refuses to execute - fix a problem with "pp --gui": the copy of par.exe extracted to the cache area (but with the same name as the packed executable) still used a console window though packed with "pp --gui ..." (bug reported in private communication) - RT #73491: cache directory naming problem Now the top level cache directory (typically $TEMPIR/par-$USER) will have $USER "encoded" as hex bytes. This avoids problems between the charset used for $USER and the charset allowed by the OS for filenames. - RT #75193 [PATCH] Fix build on Win32/VC++ - bump dependency on PAR to 1.005 - require latest version of Win32::Exe - run run_with_inc.pl using a nonce PAR_TMPDIR, too 1.012 2011-12-02 - Bug fixes, etc. - run all tests using a nonce PAR_TMPDIR (otherwise CPAN Testers goes crazy as top level /tmp/par-USER directories (or similar) from previous tests may now be considered "unsafe") - bump dependency on PAR to 1.005 which has the same behaviour 1.011 2011-12-01 - Bug fixes, etc. - RT #69560/CVE-2011-4114: PAR packed files are extracted to unsafe and predictable temporary directories - create parent of cache directory (i.e. /tmp/par-USER) with mode 0700 - if it already exists, make sure that (and bail out if not) - it's not a symlink - it's mode 0700 - it's owned by USER - depend on PAR 1.004 (which contains the other half of the fix for CVE-2011-4114) - bump Perl version requirement to 5.8.1 (Schwern: The End Of 5.6 Is Nigh!) - explicitly mark Perl 5.10.0 as an unsupported version 1.010 2011-07-13 - Bug fixes, etc. - Adapt for changes in XSloader.pm (>= 0.14) The old rule in PatchContent.pm no longer works with this version; this effectively disables how PAR::Packer intercepts loading of DLLs. Add a new rule for the code in recent XSloader.pm. NOTE: This problem affected all users of Perl >= 5.14.0 as this was the first stable release to include XSLoader 0.14. Also affected: Strawberry (at least) 5.12.3 which also comes with XSLoader 0.14. - RT #67311: missing dll - Windows: search more places for the dreaded libgcc*.dll - when linking boot.exe use $(CC) not $(LD) - RT #67681: can'r wrtie file During packing several temp files are created in the user's working directory - this will fail if the working directory is read-only. Fix up all calls to File::Temp::tempfile with TMPDIR => 1 and drop the bogus check whether cwd is writable. -RT #68916: Solaris with Sun Workshop: heavy cosmetic issue Fix use of plain "char" array in files generated by myldr/file2c.pl. - RT #57273: Error building on Strawberry 5.12.0.1 64-bit (win32.coff file format not recognized) RT #69357: bug-PAR-Packer Hopefully fix the lonstanding "no 64-bit version of win32.coff" problem on 64-bit Windows using the MingW tool chain We simply don't link myldr/boot.exe with win32.coff in this environment. NOTE: test 32 of t/20-pp.t may fail. I have received conflicting reports about this, but just to want to make a release to get wider coverage. 1.009 2011-03-26 - Bug fixes, etc. - RT #53463: PAR::Packer 1.002 on HPUX 11.23 PA-RISC issue (HPUX) patch from Lars-Gunnar Taube - add SHLIB_PATH to ld_path_keys in myldr/mktmpdir.c - call "chatr +s enable ..." on the extracted custom perl - RT #65535: Unable to run perl script packaged with pp under cygwin on another Windows XP installation - lib/PAR/Filter/PatchContent.pm: patch AutoLoader.pm to add "cygwin" to the list of "is_dosish" $^O identifiers; otherwise AutoLoader::find_filename() will mangle filenames that start with a drive letter - script/par.pl: use PAR::Filter::PatchContent to patch any modules embedded in the packed excutable; this supersedes the ad hoc patching of XSLoader.pm and will now also patch AutoLoader.pm - myldr/Makefile.PL: when generating $parl_exe or $parldy_exe make sure that we use the PAR::* modules (e.g PAR::Filter::PatchContent) from the build environment rather than a possibly installed older version - "Fix" #64485: pp PodStrip module included document how to inhibit pod stripping (copied from PAR.pm POD) - bump required Module::ScanDeps to 1.01 (hopefully fixes failures in t/90-rt59710.t with Perl 5.13.x) - reworked the build system a bit to fix recurring problems with dmake on Windows and parallel makes in general: - copy myldr/{parl,parldyn} to blib/scripts from myldr/Makefile - myldr/Makefile was completely handcrafted; try to generate it using standard ExtUtils::MakeMaker tools as much as possible - generate myldr/{Dynamic,Static}.pm from templates {Dynamic,Static}.in - rename static.c to boot.c - add "configure_requires" for ExtUtils::Embed - pick up some POD spelling fixes from Debian (thanks, Jonathan Yu ) 1.008 2010-11-21 - Bug fixes, etc. - RT #61528: bug similar to RT 55994 (Windows) relax heuristic to check whether the configured C compiler is actually gcc (Ed Zagar) - RT #61874: Windows: Packed executable handles wildcards different from script myldr/static.c: turn off automatic globbing of process arguments when building with MingW (Roderich) - RT #62357: .cgi extension not taken as script call into Module::ScanDeps with $Module::ScanDeps::ScanFileRE set to qr/./ so that we don't discriminate against scripts that have an extension other than .pl, .pm, .al or .t (or no extension at all) (Roderich) - RT #63083: pp: Undefined subroutine &DynaLoader::bootstrap called in pp-compiled bianry fix the name where the shared perl DSO ($libperl in myldr/Makefile.PL) is extracted to so that it matches the reference the linker wrote into $par_exe; heuristic currently only available for Linux (assuming we have GNU binutils installed), but might work on other ELF-based systems, too (Roderich) - t/30-current_exec.t: fix a test failure on Cygwin (cygwin.dll was not on PATH) (Roderich) 1.007 2010-09-09 - Bug fixes, etc. - RT #56582: PAR-packer compilation on Windows XP32 box applied patch from Jean-Michel Male to fix building with Microsoft Visual Studio (Roderich) - RT #50747: (no subject) finally use permissions 0775 in my_mkfile() (Roderich) - require modern Module::Install (chorny) and update Module::Install et al. to version 1.00 (Roderich) - RT #59710: Par-Packer not including all dependencies When cleaning @INC at the end of bootstrapping (just before we run the actual packed script) canonicalize $ENV{PAR_TEMP} before we use it to match elements of @INC. This works around non-canonicalized values (e.g. a trailing slash) for $ENV{TMPDIR} or P_tmpdir (as #define'd in ) (the latter seen on FreeBSD and OSX) (Roderich) - RT #56020: PAR::Packer and PDF::API2 Unicode::UCD: failed to find UnicodeData.txt that's actually a bug in Module::ScanDeps); bump requirement on Module::ScanDeps to a versionthat has the fix (correct %Preload rule for Unicode::UCD) 1.006 2010-06-26 - Bug fixes, etc. - RT #58266: fix "install PAR::Packer failed for strawberry perl 5.12.0.1 (parldyn.exe not found)" Apparently exec() on Windows spawns the new process, but then exits immediately without wait()ing for the new process (observed at least on ActiveState Perl 5.10.1 and Straberry Perl 5.12.0.1). That causes myldr/run_with_inc.pl to return control to myldr/Makefile prematurely, causing (depending on timing) the build to fail. Work around this by using system() instead. - While we're at it, clean up some dubious dependencies in myldr/Makefile.PL. - Drop test_requires IPC::Run3 introduced in 1.005, simply skip all tests in t/30-current_exec.t when run in a path that contains spaces. 1.005 2010-06-05 - Bug fixes, etc. - RT #57494: add attributes.pm to list of always required modules (Roderich) - RT #55994: fix "Can't call method "remove" on an undefined value at .../Win32/Exe.pm" (patch from DJIBEL) - RT #57948: pp-generated executable and a missing dependency on libgcc_s_sjlj-1.dll (Roderich) - RT #58095: test fails on OS X (when building in a directory with blanks in its pathname); NOTE: adds a test_requires on IPC::Run3 (Roderich) - spring cleaning in myldr directory (Roderich) 1.004 2010-04-20 - Bug fixes, etc. - RT #52794, #56654: script/par.pl: remove munging of @inc on Windows; it causes problems with Strawberry Perl 1.003 2010-04-10 - Bug fixes, etc. - RT #56171: add PerlIO and PerlIO::scalar to the list of always required modules (Roderich) - Fix t/30-current_exec.t failing when cwd contains regexp metacharacters (Niko Tyni) - Link to repository in meta information (chorny) 1.002 2009-12-17 - Bug fixes, etc. - RT #52407: fix calls of sprintf in myldr/mktmpdir.c that rely on unspecified behaviour (output buffer is also among the input parameters). (Roderich) 1.001 2009-11-24 - Bug fixes, etc. - Fix to the rejection of "main.pl" as input scripts. Previously, we rejected /main\.pl$/, now we only reject files named "main.pl" as we should (Markus Jansen) 1.000 2009-11-22 - No functional changes since the latest development release. - But let's (finally) encourage the notion that this is production grade software by using a version >= 1! 0.992_06 2009-11-20 - Bug fixes, etc. 0.992_05 2009-11-13 - Bug fixes, etc. - Apply patches from RT #49900: [PATCH] build problems (Marcela Maslanova) - When computing the SHA1 in par_mktmpdir (myldr/mktmpdir.c) rewind file descriptor f first. Otherwise we checksum just the last 12 bytes of file progname. (Roderich) - RT #18472: "parl foo.par script.pl ..." uses a cache area that doesn't depend on foo.par Indeed, the (name of) the cache area used for "parl foo.par ..." is derived from the SHA1 checksum of parl.exe, and _not_ foo.par. This patch changes that for the common use case above. It is not a complete fix though, as this would require to parse the parl command line arguments on the C level. (Roderich) 0.992_04 2009-09-11 - New features - Reject "main.pl" as input scripts since this can override the bootstrapping code. For wizards who really want this, there should be still "-a main.pl;script/main.pl". - Bug fixes, etc. - Fix RT #48614: ignore setting of PERL5OPT (and others) in a packed executable (Roderich) - Fix RT #48027: Fix building with ActivePerl & MinGW 0.992_03 2009-07-24 - Bug fixes, etc. - Fix "Can't locate IO/file.pm in @INC ..." bug (Markus Jansen) 0.992_02 2009-07-23 - New features - Add the cachedeps option to pp: PAR::Packer can now use the new Module::ScanDeps feature of caching the module dependencies for a significant packaging speed-up. 0.992_01 2009-07-19 - New features - Reusable pp packaged applications (see pp's --reusable option) - Bug fixes, etc. - Accept other extensions than .par in -p mode. 0.991 2009-03-21 - New features - Add Roderich's reeally useful debugging tool "extract_embedded.pl" to the contrib/ subdirectory. It can be used to extract the contents of a "parl" binary. - Bug fixes, etc. - Add Errno and Tie::Hash::NamedCapture (if available) to required_modules - Fix the stripping of =encoding POD lines in PAR::Filter::PodStrip - Throw a proper error if a module specified via -M cannot be found (Roderich Schupp, Gabor Szabo) - Don't update exe's with icons twice on Win32. - Band-aid fix for RT #41790 in par.pl - Some very slightly more careful handling of environment variables in par.pl - Fix SEGV crash during startup if $PATH is not defined (Johannes Lode) - Documentation - RT #12104. Improved documentation in pp on -T/--tempcache. 0.982 2008-07-29 - Bug fixes, etc. - Fix bleadperl compilation. - Ensure extracted files are marked executable on HP-UX so they can be used by the dynamic linker. (Scott Stanton) - Fixed incorrect error handling code in test for directory existence when creating a private temporary directory. (Scott Stanton) - On Windows, attempt to use the system temp directory before trying the temp_dirs locations. (Scott Stanton) - Don't remove the top level par- directory for PAR_CLEAN=1 because doing so introduces a race condition with other applications trying to create the directory on startup. (Scott Stanton) - When creating the temporary directory for PAR_CLEAN=1, ensure that the directory does not already exist to avoid picking up stale files from a prior invocation of a different par application. This eliminates the need to rename the temp directory before removing it, which was causing race conditions in multi-threaded apps. (Scott Stanton) - Now officially requires Perl 5.6.1 and up in the Makefile.PL. This has been the case for a long time anyway, but this change should suppress some spurious CPAN testers failures. - Documentation - Clarified examples in the pp documentation, thanks to Dave Howorth. 0.981 2008-05-14 - Bug fixes, etc. - Make get_username_from_getpwuid work for uid=0. (Scott Stanton) - Fixed crash in get_username_from_getpwuid when getpwuid fails. (Scott Stanton) - Fix broken build on win32 when searching for dll and finding static perl library. (Alexey Borzenkov) - Fix compilation on MacOS 10.5's gcc because that doesn't seem to support the --output option. (Matthew Andersen) o0.980 2008-05-14 - Emergency bug fix release - The test suite in the previous release was broken by my debugging code. Sorry about that. (Steffen) 0.979 2008-05-13 - Bug fixes, etc. - Add a preprocessor conditional to myldr/internals.c to make PAR::Packer compile with blead (Avar Bjarmason, Nicholas Clark) - Also strip =encoding POD directive during PAR::Filter::PodStrip. - Temporarily disable the shared-libraries cleanup code in par.pl that was introduced in 0.977 by Scott. This may result in stale cache directories even if PAR_CLEAN is in effect. On the other hand, this means threaded applications work again. 0.978 2008-02-28 - Bug fixes, etc. - Fix pp -r for absolute file names (RT #33355) (Slaven Rezic) - Fix for FreeBSD's unreliable procfs (RT #33349) (Slaven Rezic) - Fix @INC ordering in par.pl: This might just fix the infamous "Only available with the XS version..." bug (see #24192) (Michael Schwern, Slaven Rezic) - Fix pp.pm version (Audrey) - Require Win32::Process on win32 (Audrey) - The parl-generation tests are now skipped if a pre-built .par binary is being used. (Mark Dootson) - Shared library extraction now checks first whether the file exists and whether it has the same size as the one to be extracted. In that case, the extraction is skipped. This should fix an issue with overwriting DLLs on Windows, see http://www.nntp.perl.org/group/perl.par/3325 (Scott Stanton) - When re-building the distribution because of a change in e.g. script/par.pl, the DATA sections of blib\PAR\StrippedPARL\{Dynamic,Static}.pm were not updated accordingly. 0.977 2007-12-20 - New features - Support for Perl 5.10 and later. - New -E flag for "pp" that works just like "perl -E" for Perl 5.10+, namely enabling new syntactic features like "say". - Bug fixes, etc. - When deleting the temp directory in the background, rename the directory to a unique name to avoid potential collisions caused by pid reuse (primarily an issue on Windows). - PAR::Packer now depends on Module::ScanDeps 0.78 because 0.77 had a critical bug. If you are having trouble with M::SD 0.78, please a) report it in the bug tracker and b) try versions of M::SD below 0.77. - If running with the "clean" option, go through extra pain in par.pl to clean up if the OS doesn't allow opened shared libraries to be deleted. (Scott Stanton) - Use the P_tmpdir macro as temporary directory on Unix if available. See RT #29784. - Included PWD fix. See RT #29050. - Added deletion of 'orig_parl' on Win32 in PAR::Packer. 0.976 2007-07-29 - New features - If available, the packager will include the new and slightly experimental Archive::Unzip::Burst module in generated binary executables. This can speed up the initial extraction of such a binary by a significant factor. (Total running time went from 8 seconds to 1.4 seconds in a simplistic test.) - The preprocessor option/define PERL_PROFILING can be used while compiling myldr/ (parl) to enable Devel::DProf profiling of the archive extraction. - Bug fixes, etc. - myldr/Makefile workaround for HPUX. (RT #24950) - Makefile.PL doesn't require 5.006 any more but uses 'strict' now. - Makefile.PL doesn't use Module::AutoInstall any more. It's evil. - Dependency on PAR.pm upgraded to 0.976. - Marked PAR::Filter::Bytecode as deprecated. Added references to PAR::Filter::Crypto. 0.975 2007-05-06 - Bug fixes, etc. - Trailing backslashes in @INC paths handled in PAR::StrippedParl::Base - Win32 added to 'required modules' to handle changes in Win32 core present in ActiveState build 820 and development branches. - No longer assume -B when using pp -P (or -p). (Roderich Schupp) 0.973 2007-02-03 - New features - If PERL5LIB is set, that variable may be ignored in some parts of the myldr/ build process. We now warn the user during Makefile.PL if PERL5LIB is set. (Gaal Yahas) - Bug fixes, etc. - Cosmetics: Add "use strict;" and "use warnings;" to some files that lacked it. - Several bug fixes for the tests from Malcolm Nooning. Related to making them work on Windows with spaces in paths. - Added regexp escaping to the "pp -X foo.par" use case. (Eric Wilhelm) 0.970 2006-12-03 - This is the first release of PAR-Packer as a separate distribution. - PAR and PAR-Packer (+pp, parl, etc.) have been separated because there is usually no reason for the PAR Packager to be present on a user system which just needs PAR.pm to access .par archives. - PAR-Packer will include all development tools such as those included in the contrib/ subdirectory. - Bug fixes, etc. - Moved most code from script/pp to lib/pp.pm so it gets picked up by the CPAN indexer. Hence you will be able to write "install pp" in the CPAN shell to install pp/PAR::Packer. - PAR::StrippedPARL::Base->write_parl() failed to work if the @INC directories contained spaces in 0.960. (Steven Mackenzie) - Much improved documentation of the environment variables (Glenn Linderman) - Fix for a spaces-in-pathname problem on Windows for t/30-current_exec.t. (Malcolm Nooning) 0.960 2006-11-21 - Bug fixes, etc. - myldr/Makefile.PL fix: Clean up myldr/usernamefrompwuid.h. - Silence warning in myldr/internals.c. - Silence warnings seen on Irix from myldr/env.c. - Skip most tests in 10-parl-generation.t if there is no parl. - Skip loading ActiveState Perl's "sitecustomize.pl" in par.pl. - Load modules via require and other files via do. - The parl-regeneration-for-every-pp-call addition of the 0.958 release should now also work for static perls. - New features - Adressing RT ticket #6612: Now using getpwuid() to determine the user name if supported by the OS. 0.959 2006-11-12 - This is just a hotfix release because 0.958 lacked META.yml. One day, I will switch from Module::Install to Module::Build... 0.958 2006-10-25 - Bug fixes, etc. - myldr/Makefile.PL fix: make static.o depend on mktmpdir.c, my_perl.c, my_par.c. (Roderich Schupp) - Modules included with the -M option to pp were previously scanned for dependencies but not mapped through the %Module::ScanDeps::Preload hash for custom dependencies. That's fixed now. - $ENV{PAR_RUN} isn't set by PAR::Packer any more because nothing in the PAR sources uses it. $ENV{PAR_RUN} is no longer used by PAR at all. - Unified the environment variables which are looked at for finding the system's temporary directory. - New features - During the build process, PAR appends stripped down copies of parl (and parldyn if applicable) to the data classes PAR::StrippedPARL::Static and ::Dynamic. These parls-without-embedded-modules are used for packaging so the formerly embedded modules are now packaged from the packaging system. (Instead of stemming from the system where PAR/parl was built.) - The "use PAR { repository => $url };" syntax now also supports the use of user-constructed PAR::Repository::Client objects instead of an URL. - The -F (module code filter) option now supports selective filtering of modules. The syntax is "-F FILTER=REGEX" or - as before - "-F FILTER". The regular expression is applied to the *file name*, of the module inside the PAR (e.g. Foo/Bar.pm). This behaviour was chosen over matching against the module name (e.g. Foo::Bar) because the filters can be applied to module-like and script files as well (.pl, .al, etc.). - Updated PAR/FAQ.pod with the new FAQ's from the PAR wiki. - Added a POD file PAR/Environment.pod which is intended to become an index of all environment variables PAR uses of its own or recognizes from its users. Still mostly a stub. 0.957 2006-10-24 - Bug fixes, etc. - Fix executable PARs top properly detect embedded scripts named the same as the executable. (Jesse Vincent) - Comment out the call to par_current_exec_proc (in the C loader) which breaks the use of symlinks to pp-ed executables when not called with a path. (I.e. using a search in $PATH). 0.956 2006-10-03 - This is another hotfix release. Fixed a mindless bug introduced in 0.955. 0.955 2006-10-03 - Bug fixes, etc. - 0.952 introduced removal of system module search paths if -B is in effect. This resulted in some valid PAR-related paths being removed as well. Fixed. Upgrading from 0.952 and 0.954 is suggested. - Changed the use of hard-coded '/' as path-separator to using File::Spec. 0.954 2006-09-26 - This release is equivalent to 0.953. The 0.953 CPAN upload is broken! 0.953 2006-09-18 - Bug fixes, etc. - Added optional POD tests. - Modified -B so that if -B is in effect, all entries are stripped out of @INC except for the PAR hooks. This happens right before the script contained in the pp-ed binary is executed. 0.952 2006-08-22 - New features - Added the "install" option to the PAR loading syntax. If specified, the contents of the PAR distribution are permanently installed. This requires PAR::Repository::Client 0.04. - Bug fixes, etc. - Fixed broken META.yml in 0.951. 0.951 2006-08-12 (This includes any changes up to 0.950.) - New features - Introduced new PAR loading syntax and semantics: use PAR { file => 'path/to/par/or/URL' }; ==> equivalent to "use PAR 'path/to/par/or/URL';" - Introduced the 'fallback' option: (default = 0) use PAR { file => 'foo.par', fallback => 1 }; ==> Loads modules from the PAR file only if loading them from @INC did not succeed. - Introduced the 'run' option which executes a script in a PAR archive just like perl -MPAR foo.par script.pl - If PAR::Repository::Client is installed, you can add a repository of .par distributions to your library search path as follows: use PAR { repository => 'http://foo' }; - Of course, 'run' also works with repositories: use PAR { repository => 'http://foo', run => 'my_app' }; (This searches the repository for any distributions that have a my_app script.) --> For details on repositories, have a look at the PAR::Repository::Client module. - Bug fixes, etc. - Commented a couple of the routines in PAR.pm. (Yay!) - New test script for the new fallback loading feature. - Fixed a bug in the Spreadsheet::ParseExcel handling in PatchContent.pm. 0.942 2006-07-22 - Bug fixes, etc. - Better support for diagnostics.pm (in conjunction with Module::ScanDeps 0.62.) - Now requiring Module::ScanDeps 0.62. 0.941 2006-06-20 (No, PAR isn't stagnating. It's just that 1.00 would draw close if we continued with 0.01 increases.) - Bug fixes, etc. - Version 0.94 of PAR would use the same cache area for all pp-ed applications due to a faulty hotfix for Digest::SHA. This applies to PAR 0.94 only. Think of 0.941 being PAR 0.94 done right. 0.94 2006-06-01 - New Features - Added support for reading options to pp from a file using a '@filename' argument to pp: pp -o foo --gui @filename foo.pl - Bug fixes, etc. - Workaround for a bug in Digest::SHA 5.38 and 5.39 that would prevent PAR from being built. - Fixed details in the 2-pp.t test file. - Now recognizes text files that aren't picked up by the -T operator but by the "file" tool. - Applied Roderich Schupp's patch to 30-current_exec.t to fix a path issue. - Now requiring Module::ScanDeps 0.60 which fixes a couple of bugs which might be observed as PAR bugs. - Now working well with Spreadsheet::ParseExcel which uses an invalid POD section to comment out a code block. This wasn't recognized by PAR::Filter::PodStrip as POD and hence partly left in... - If the output directory doesn't exist, we create it now and output a meaningful error message if that failed. 0.93 2006-05-19 - New Features - Added support for PAR_TMPDIR (PAR_GLOBAL_TMPDIR) so that the temp directory can be controlled for just the PAR file bits. (Leolo) - Added par_current_exec_proc() which finds the file of the current executable in /proc, if possible. (Leolo) - Added par_current_exec() which finds he file of the current executable, if possible on this OS. (Leolo) - par_findprog() now uses par_current_exec() if possible. - Bug Fixes, etc. - Upgraded to Module::Install 0.62+ (Audrey Tang, Steffen Mueller) - Document a strange interaction with chdir() and relative paths. (Chris Dolan) - Documented the bits that make up PAR_TEMP. (Leolo) - Fixed the call to par_findprog. path (aka val) was set to tmpdir. (Leolo) - Documented the CACHE name at the end of a self-executing PAR. (Leolo) - myldr/Makefile.PL now generates some dependencies for main.c (Leolo) - Applied patch from RT ticket. (tsee) https://rt.cpan.org/Ticket/Display.html?id=13959 - Applied Ivan Kudryavtsev's patch that fixes a couple of calls to PAR subroutines in PatchContent filtered code. (tsee) 0.92 2006-02-22 - Bug Fixes - Now requiring Module::ScanDeps 0.56 which handles autouse correctly. - Now shipping with a correct SIGNATURE. (Which was broken for 0.91.) 0.91 2006-02-13 - Bug Fixes - Applied Alan Stewart's patch which fixes @ARGV pollution in daughter programs. See also http://www.nntp.perl.org/group/perl.par/2152 - Now mentioning the ENV var "PAR_VERBATIM" in the documentation. See also http://www.nntp.perl.org/group/perl.par/2196 - Applied Malcolm Nooning's fix for the test suite. We used to get failed tests on Windows because of spaces in path names. - Applied Roderich Schupp's and Malcolm Nooning's patches to the test suite fixing problems with Cygwin. - Applied Vincent Ladeuil's patch to PAR::Filter::Bleach to return a true value for modules that loaded okay. - Changed 'PAR_BASE' in the Makefile.PL to 'SMUELLER'. 0.90 2005-11-25 - Bug Fixes - When compiling with static libperl, myldr/ may fail "make" due to sha1.c not generated properly. - Pod stripping could fail on __DATA__ sections for files with CRLF line endings. - The documentation erroneously referred to the PAR_TEMP environment variable, whereas it should be PAR_GLOBAL_TEMP. - Compilation fixes for MinGW/MSYS. 0.89 2005-06-10 - Bug Fixes - Stop static.c from pulling in Perl header files, otherwise parl.exe ends up depending on the Perl DLL on Win32 when Perl is built without PERL_IMPLICIT_SYS. - With *nix and File::Path 1.06, par.pl's avoidance of loading Cwd.pm caused syntax errors. 0.88 2005-06-07 - Bug Fixes - Extracted .pl files should be loadable via the coderef-in-@INC too, just like .pm files and autosplit files. This makes PAR work with Perl 5.8.7 on Win32. - Fix the build with GCC 4.0. - If $ENV{PWD} is not defined, fallback to use `pwd` to obtain the working directory for invoking. 0.87 2005-01-31 - Bug Fixes - On Win32, some versions of File::Spec::Win32 contains explicit "use Cwd;" lines, which renders parl.exe unusable. - Executable made by "pp" may fail when invoked as "./a.out" or "../a.out", due to incorrect PWD handling logic. 0.86 2004-12-11 - New Features - New "pp -z" (--compress) option to set compression level (0-9). - New "pp -T" (--tempcache) option to override the per-executable directory name; it defaults to a hash of the executable, computed at compile time. This makes startup much faster for large executables. - The hash algorithm described above now prefers Digest::SHA if installed, otherwise Digest::SHA1, then fallbacks to Digest::MD5. - Functionality of "pp -X" is now extended: if the argument after -X is a zip or par file, files in it are excluded from the produced executable, and the executable will "use" the zip/par instead. For multiple -X args, successive args are only "use"d if they contain additional unique files. - "pp -l" now searches for libraries in "." and PATH in Win32. - "pp -l" shared libraries are now added to %skip, so it will not be included in both shlib/ and lib/. - "pp -l" now chases symbolic links. For example, if "libsomelib.so" is a symlink to "libsomelib.so.1", which is another symlink to "libsomelib.so.1.2", pp now follows these symlinks and add the real file the par, rather than "libsomelib.so". - New contributed code in "contrib/stdio/": Useful Tk console for "pp -g" users. - New contributed tutorial documents, currently in "contrib/docs/", which will eventually be turned into POD documents. - Running "perl Makefile.PL" with $ENV{DEBUG} set to true now produces "parl" with debug symbols. - Remove Cwd.pm (and Cwd.so) from the bundled dependencies. - Bug Fixes - More robust probing for case-insensitive file systems. - PodStrip now attempts to match "standard" pod start before =cut, otherwise =cut gets removed by itself. - Win32 slashes are now normalized in privlib and archlib directories. - Don't extract shared libraries to inc/, since they were extracted in $PAR_TEMP already. - Don't re-extract shared libraries in subdirectories, since they are picked up by corresponding "use". - Tk now exits properly with a non-zero exit() value. - Fix libperl probing problem on Debian and Gentoo that manifests as a "libperl5.8.so not found" error during runtime. - gpp: Fixed typo in options with multiple filenames; cleaned up pp parameters. - When PAR_TEMP is set, shlib/ was not correctly added to the dynamic load path environment variables. - PAR now builds with Win32 VC++ without CVTRES.EXE available. - Detection of cl.exe, gcc.exe and cc.exe is now case-insensitive. 0.85 2004-07-02 - New Features - New version of "gpp"; see contrib/gui_pp/gpp_readme.txt for details. - Bug Fixes - MANIFEST and META.yml were not properly updated by PAR::Packer. - Setting directory aliases with "pp -a"/"pp -A" was broken. Fixed, and tests were added for it. - Statically-built executables was needlessly extracting libperl each time it runs; now it is eliminated and hence much faster. 0.83 2004-05-29 - New Features - Revamped PAR::FAQ and sychronized with par.perl.org. - In pp-generated programs, $0 is now set to the pathname leading to the invoked executable. Use $ENV{PAR_0} instead to get the filename that contains the main perl program. - Updated "contrib/gui_pp/gpp" to support PAR::Packer options. - Bug Fixes - Core XS modules, such as Data::Dumper, were skipped by "pp". - Fix t/2-pp.t for Cygwin by probing $Config{_exe} rather than uname(). - Scripts made by "pp -P", when invoked as "perl scriptname", should not search for the same-named programs in PATH. - Correctly remove leading slash and drive letters from absolute filenames passed to "pp -a". Also normalized blackslahes to slashes. - The PP_OPTS environment variable was not recognized. - "pp -a dirname;diralias" was broken. - "pp -f" and "pp -F" were broken. 0.82 2004-05-24 - New Features - New module PAR::Packer provides an OO interface to "pp"'s functionality; "pp" is now merely a thin wrapper for it. - New module App::Packer::PAR is a modified version of App::Packer, designed to work with PAR::Packer, and will hopefully be merged back to App::Packer. - The old, procedural "pp" is moved to contrib/; end-users should notice no changes in "pp"'s behaviour. - New options "pp -a" and "pp -A" (--addfile/--addlist) provides ways to include extra files and directories in the package. - The long option name for "pp -M" is changed from --add to --module. The old name is still recognized but no longer documented. Using "pp -M" to include non-library files is now deprecated; use "pp -a" instead. - par.pl and parl now writes messages to STDOUT, instead of STDERR. As a consequence, t/2-pp.t no longer prints extra warnings during "make test". - Bug Fixes - On Non-Win32 platforms, perl 5.8.0 and earlier versions produced pp-generated executables that immediately segfaults. - Running pp-generated executables with absolute pathname failed on statically-built perls. - Tests were failing due to a missing pipe_a_command.pm in MANIFEST. - Add the missing myldr/win32.coff for building on Cygwin/MinGW. - If the "perl" in path is different from the perl interpreter used for "make test", t/2-pp.t is known to fail and is now skipped. - Cygwin failed t/2-pp.t because "parl" is spelled as "parl.exe" there. 0.81 2004-05-23 - New Features - Regained support for Win9x, Cygwin and MinGW. - PAR now supports 64-bit platforms, such as Tru64 and AIX. - Cygwin and MinGW can now build EXEs with icons, too; MinGW can update the icons, but Cygwin cannot. - Newly supported modules: Pod::Usage, DBIx::SearchBuilder, DBIx::ReportBuilder, SVK::Command, SVN::Core, and the ':encoding()' IO discipline. - Bug Fixes - On non-Win32 systems, invoking pp-generated executable from PATH did not work. - Standalone executables were clobbered by existing perl environments with an identical "auto/IO" libpath as the author's environment. - Standalone executables did not work on systems with an unset dynamic load path environment variable (eg. LD_LIBRARY_PATH). - "pp -p -o multi.par 1.pl 2.pl; parl multi.par 1.pl" now works. - $ENV{PATH} and $ENV{TEMP} were truncated at first path delimiter. - "pp -f Bleach" did not work for ActivePerl on Win32. - Windows 9x systems were generating invalid cache directory names. - $ENV{path} is also recognized as $ENV{PATH} for Win32. 0.80 2004-03-17 - New Features - A comprehensive test suite for pp in contrib/automated_pp_test/. It is run as part of the "make test" process from t/2-pp.t. - Much better support for "pp -i" and "pp -N" (--icon/--info) using the Win32::Exe module. You may now use EXE and DLL as icon files. - If PAR_GLOBAL_CLEAN (-C, --clean) is not set, we now preemptively extracts files under the cache directory. That made POSIX.pm and other modules that depends on %INC pointing to real files work correctly. - Now uses SHA-1 to create temporary directories and files, instead of mtime. - Verbosity level is now 1..3, not 0..5; "pp -v" now takes an optional integer, so "pp -v input.pl" is no longer an error. - New flags "-vv" and "-vvv", as shorthands for "-v 2" and "-v 3". - The user-settable PAR_CLEAN and PAR_TEMP environment variables has been renamed to PAR_GLOBAL_CLEAN and PAR_GLOBAL_TEMP; the original variables are still accessible within the program. This is so that a pp-generated program can exec() or system() another one without crippling its environment variables. - File lookups are now case-insensitive on case-insensitive filesystems. - Another Tk-based GUI in contrib/gui_pp/; not installed by default. - OOified "pp" in contrib/object_oriented_pp/; not installed by default. - Bug Fixes - "pp -d" (--dependent) prevented "pp -C" (--clean) from working. - The "pp -m" (--multiarch) option was implemented incorrectly and thus broken. - Many documentation tweaks. - Previously, "pp -M" (--module) did not add the module itself, only its dependencies. - Suppress a bogus warning when $ENV{$Config{ldlibpthname}} is empty. - "parl -v" without Module::Signature installed could delete all files within the current directory. Oops. - On *nix systems, pp-generated executables erroneously linked to libperl even if "pp -d" (--dependent) is not set. - Spurious =cut directives in source files is now handled gracefully by PAR::Filter::PodStrip. - "pp -L" (--log) now logs all output messages to the log file, not just the ones printed by "pp" itself. 0.79 2004-01-08 - Bug Fixes - Setting PAR_CLEAN had the reversed effect. Oops. - Dynamic libraries in cached directories was not detected properly, resulting in "permission denied" errors during certain race conditions. 0.78 2004-01-07 - New Features - By default, executables generated by "pp" will now store extracted files in cache directories. You may override this by setting the PAR_CLEAN environment variable to "1", or generate executables using "pp -C". - New "pp -C" (--clean) option to make the generated executable clean up temporary directories after each run. - PAR_CLEARTEMP is renamed to PAR_CLEAN. - Bug Fixes - On Win32, temporary directories containing shared libraries was not being properly cleaned up. - If no suitable temporary directories are found, use the current directory (".") instead of the root directory ("/"). 0.77 2004-01-01 - New Features - New "pp -c" and "pp -x" (--compile/--execute) options run the script with "perl -c" to check for dependencies. - Also, the new "pp -n" (--noscan) command skips the default static scanning altogether. - Added support for "pp -c/-x/-n" to tkpp. - For dynamically-built perls, pp-generated .exe files will now appear in the process table with the same name as it was launched, instead of "par.exe". - New filter "Obfuscate", which uses B::Deobfuscate to strip away PODs and comments, as well as mangling variable names. - Merged tkpp 1.1 from Doug Gruber. - OS/2 is now supported. - External Zlib is no longer required to run pp-generated binaries. - Bug Fixes - Makefile.PL was failing if $Config{cc} contains spaces. - No longer needs setting "Windows 95 compatible mode" to run on WinXP. - On Win9x with Perl 5.6.1, "nmake" was failing due to extra "@[...]" symbols in Makefile. It should be fixed now. - The "bad signature" problem with newer Archive::Zip versions is fixed. - App::Packer::Backend::PAR was misplaced into App/Packer/PAR. - Signature tests were failing under new ExtUtils::MakeMaker versions. - ActiveState's PPM building machine was having problem with PAR; a ".pdb" entry in MANIFEST.SKIP is added to fix that. - Some self-built PAR instances on Windows were failing due to mismatching short and long pathnames. 0.76 2003-10-28 - New Features - Input filters. "pp --filter Bleach" now obfuscates the incoming script with PAR::Filter::Bleach; "pp --modfilter Bleach" applies Bleach to all packed modules. - Two previously built-in filters, PodStrip and PatchContent, are refactored out as PAR::Filter subclasses. - Two new filters, Bleach and Bytecode, are added for source-hiding purporses. - New utility, "tkpp", provides a GUI frontend to "pp". - New option, "pp --perlscript", to generate stand-alone scripts. - The old "PAR::Intro" documentation has been replaced by two new ones: "PAR::Tutorial" and "PAR::FAQ". - Tk pixmap (.xpm) files can now be packed with "pp --add". - Bug Fixes - Perl 5.8.1 has an off-by-one bug that prevents "parl" to function properly. We have now provided a workaround; this bug should also be fixed in Perl 5.8.2. - Fixed https support for LWP via the new Module::ScapDeps. 0.75 2003-09-21 - New Features - "pp -o file.exe file.par" now packs file.par into file.exe; this means you can hand-tweak PAR files generated by "pp -p" before packing it into an executable. - Bug Fixes - Packing multiple programs by "pp script1.pl script2.pl" was producing syntax errors; fixed. - "pp -M datafile" now works. - Exit code from pp-packed executables now properly propagates out. - Fixed "use base" detection, Math::BigInt support and spurious signature warnings, by updated versions of Module::ScapDeps and Module::Signature. - On Win32, the PE info headers no longer show PAR_XXXXXXXXXXX. 0.74 2003-08-20 - New Features - pp now has a set of "PatchContent" rules, dealing with non-PAR-compatible modules: Tk, Tk::Widget, Win32::API::Type, Win32::SystemInfo, SQL::Parser, diagnostics. These rules may get refactored back to PAR.pm in the future. - New function, PAR::reload_libs(), to reload currently used libraries inside PAR files. - PAR.pm itself is now never packed into pp-generated files, to perserve interface compatibility and reduce bloat. - PAR.pm now handles "use PAR 'othercode.par'" called from program or modules inside PAR files, even recursively. - A new icon for Win32 that is hopefully prettier. - Bug Fixes - All data after __DATA__ are preserved for included libraries. This helps self-reading modules like Net::LDAP::Constants. - PAR::read_file() was broken. It now works. - "use PAR" inside pp-generated executables was failing with 'file too short' errors due the mishandling of seek/tell. - Occasional crashes on Win32 due to rmdir() called too early with DLLs still open is fixed; however, "pp -d" executables may still exhibit this problem. - "pp -X" used to only take full pathnames as arguments. It now also takes "Module::Name" and "Module/Name.pm". - Dynamically built Perl under Cygwin failed to build, because libperl.dll.a was not found. - Eliminated "callback called on exit" warnings, and the related "access violation" error on Win32. 0.73 2003-08-06 - New Features - The PAR Homepage is now online at http://par.perl.org/. Documentations have been changed to link to it. - Bug Fixes - Tk applications can now properly access xpm/xbm files with Tk->findINC. - On Win32, pp-generated executables could not start from Explorer, if its path contains space characters. Fixed. - On Win32, pp-generated executables used to leave around an empty directory in $ENV{TEMP}. It is now properly rmdir'ed. - Some systems (notably OpenBSD and Debian) does not put their libperl.so in the default location, which breaks the build process; now searches inside $ENV{$Config{ldlibpthname}} and $Config{libpth} to find it. 0.72 2003-08-02 - New Features - CHECK and INIT blocks in programs inside PAR are now supported. - Bug Fixes - Two debug statements were mistakenly left in the source, resulting in "trying to get rid of /tmp/par_priv.xxxx.tmp" messages. - Building on Linux with GCC 3.2.2 was failing due to massive heap required for my_perl.c. Fixed by splitting it into 3k chunks. - Depends on Module::ScanDeps 0.21; it supports utf8 on Perl 5.6.1 and can significantly reduce executable file size by eliminating unneccessary shared libraries. 0.71 2003-07-30 - Bug Fixes - A nasty data-loss bug has been uncovered immediately after the previous release; it only affects Windows platforms, and may cause all files to be erased under the current root (\) directory. - Building on Red Hat linux was failing, with error message that says "my_perl not declared". This has since been fixed. 0.70 2003-07-29 - New Features - On machines with shared libperl, "pp" now makes truly stand-alone executables; the old behaviour is available with "pp --dependent". - Under Windows NT/2000/XP, "pp --icon=name.ico" now changes the icon for the generated executable; otherwise, a default "white camel" icon is used. - "use PAR 'http://example.com/foo.par'" now works, as does "perl -MPAR -Ihttp://example.com/foo.par". - PAR::Dist is now a mandatory prerequisite, which provides functions to turn any CPAN distribution into a PAR distribution, as well as to install, uninstall, sign and verify such files. - Integrated PAR::Dist into "par.pl" and "parl". For example, "parl -i Foo-0.01-i386-freebsd-5.8.0.par" installs a PAR distribution; "parl -v out.exe" verifies a digitally signed executable generated by "pp --sign". - A new option, "pp --multiarch", lets you generate PAR files that can work on several architectures. - "pp --sign" now adds digital signatures to generated executables and PAR files. - PAR files may now (recursively) contain other PAR files inside their par/ directories. - shlib/ and par/ directories inside PAR files can now contain architecture- and perl-version-specific subdirectories. - The "Cross-Platform Packaging and Deployment with PAR" tutorial is now online as http://www.autrijus.org/par-tutorial/. - Bug Fixes - MANIFEST.SKIP was broken on Win32. - C compilers that doesn't handle long line well can now compile PAR. - DLL files inside the same auto/ library as XS modules was not properly extracted and loaded. This specifically affects Win32. - Because parl's @INC is '.', pp-generated executables may miss IO.dll and other shared libraries since they couldn't be correctly found in @INC. 0.69 2003-05-31 - New Features - Under Perl 5.8, "pp -p" now works with Apache::PAR. See http://aut.dyndns.org/par-tutorial/slide018.html for a simple example. - "pp -M filename" now adds "filename" to /, not /lib/, unless filename ends in (pm|ix|al). This makes it possible to bundle "web.conf" needed by Apache::PAR. - "pp -l" now searchs in system library paths, and appends "lib" / prepends ".$dl_ext" where necessary. - Bug Fixes - PAR segfaults on some Unix platforms due to a NULL pointer used in mktmpdir.c. Fixed. - "pp -o out.par -p -e '...'" now honors -o; previously it used "a.out.par" anyway. - Inhibited spurious uninitialized warnings under -w in the POD-stripping code. - Win32 did not properly cleans up PAR_TEMP directory, resulting in failure for executables that reused the same PID. Fixed. 0.68 2003-05-26 - New Features - New 'pp -l' option to pack additional shared libraries (DLLs). - POD-stripped libraries inside PAR files now have #line directives inserted, so they report the original line numbers on failure. - PAR files generated by 'pp' now has a MANIFEST file that can be viewed by Gecko-based browsers with Javascript turned on, e.g.: jar:http://aut.dyndns.org/par/test.par!/MANIFEST - Bug Fixes - Each pp-executable instance now creates its own PAR_TEMP directory; this avoids permission errors when multiple users run the same binary. As a consequence, PAR_CLEARTEMP is now set to "1" by default. - Newer versions of shared Zlib library no longer causes "pp" to generate broken executables. - Fixed dynamic loading on Cygwin was failing due to missing +x mode. - Like "use lib", "use PAR 'name.par'" now unshift()s instead of push()es into @INC. Same applies for "par.pl -A" and "parl -A". - Fixed building on ActivePerl 626 and below due to a missing $Config{ld}. 0.67 2003-04-01 - New Features - PAR now works on Cygwin and MinGW/MSYS. - Globbing support in PAR::import(): use PAR "/path/*.pm"; - New license clarification messages added to POD and 'pp -V'. - All 'pp' options now has a short form (-o) and a long form (--output). - Revamped documentation for 'pp'. - New -g (--gui) flag for 'pp' to build console-less Win32 executables. - Bug Fixes - Building on Darwin Perl 5.6.0 was broken with 'cc -s'. - Building on 5.6.0 was broken due to bad 'base.pm'. - Win32 Tk::Widget autoloading was broken due to a binmode() bug. - IPC::Run was pod-stripped incorrectly. Fixed. - Depends on Module::ScanDeps 0.19, which supports utf8 and .ph files. - Better AutoInstall support, which uses 'sudo' where necessary. 0.66 2003-03-20 - New Features - Adds PAR::Intro, a PODified version of the online presentation. - Adds App::Packer::Backend::PAR, a bridge between PAR and App::Packer. - Scripts and modules are now searched in "/" last, instead of first. - Experimental patch for packing shared libraries via "pp -l". - HTTP fetching of precompiled packages in addition to FTP. - Bug Fixes - Makefile.PL now downloads precompiled packages only if needed. - AutoInstall has been made to work for an easier installation. - The redundant "parl.exe.bat" is no longer created on Win32. - Pre-0.63 PARs used to leave broken .dll in TEMP; now they're cleaned. - "pp c:\something.pl" no longer treats c: as a relative path. - "pp -I dir" now searches 'dir' first, instead of last. - "pp" was broken on Perl 5.6.0 due to => stringification bugs. - Support for Tk::Widget autoloading has been added. - "parl" was not stripped if "gcc" was invoked as "cc"; fixed. - On a machine with multiple "parl"s, "pp" now uses the correct one. - File::Temp was missing as a dependency. - Known Issues - Cygwin support is still broken. - PAR does not include utf8_heavy.pl nor unicore/* for scripts that has "use utf8;". This has since been fixed by Module::ScanDeps 0.18. 0.65 2003-03-09 This release comes with several significant improvements: - Automatic binary installation Previously, users without a C compiler cannot build the 'parl' executable, and is therefore unable to create self-contained binaries using 'pp'. Now, if there is a binary package available for that architecture under my CPAN directory, the Makefile.PL script will automatically fetch it, unpack into blib/, and the installation will continue as normal, resulting in a fully-functional 'pp'. This feature is part of the soon-to-be-released Module::Install framework; it will greatly benefit all CPAN authors with non-pure-perl distributions. - POD stripping Packages generated with 'pp' will now strip POD sections from all packed dependencies (your own scripts is unaffected); all binary executables will save at least 276732 bytes, with additional ~20% saving in additional packed dependencies. You can turn off this feature with the PAR_VERBATIM environment variable. - XS Incompatibility solved Because 'pp'-generated executables includes some fixed version of shared libraries (IO, Zlib, etc), they used to break when the target system has different version of shared libraries. Now PAR::Heavy intercepts DynaLoader::dl_expandspec to always prefer the library inside the PAR file, so this issue is resolved. - 5.6.1 Reclaimed Thanks to Sisyphus and various others, building on Perl 5.6.1 (with its old ExtUtils::MakeMaker and lack of PTHREAD_ATFORK) now works again. 0.64 2003-03-02 - New Features - The t/0-signature.t test is re-enabled for people using my Module::Signature to verify the module's OpenPGP signature. - This release is the first distribution on CPAN to use the Module::Install framework, which is a stand-alone, extensible drop-in replacement for ExtUtils::MakeMaker that needs no extra action/prerequisites for end users. - Bug Fixes - Dynamic loading on Win32 was broken, due to a binmode() bug reported by Bill Atkins, D. Menzel and others. - Building on Win32 in directory names that contain spaces did not work. 0.63 2003-02-06 - Bug Fixes - The 'parl' binary (which replaces the old 'par' or 'par.exe') didn't work properly when bundling perl modules for self- contained executables, rendering 'pp' useless on machines without core perl. PAR-Packer-1.041/contrib/0000755000175000017500000000000013200634513015161 5ustar roderichroderichPAR-Packer-1.041/contrib/automated_pp_test/0000755000175000017500000000000013200634513020702 5ustar roderichroderichPAR-Packer-1.041/contrib/automated_pp_test/remove_file_and_try_executable_again.pm0000644000175000017500000001016713026021203030611 0ustar roderichroderich#!/usr/bin/perl -w ######################################################################## # Copyright 2004 by Malcolm Nooning # This program does not impose any # licensing restrictions on files generated by their execution, in # accordance with the 8th article of the Artistic License: # # "Aggregation of this Package with a commercial distribution is # always permitted provided that the use of this Package is embedded; # that is, when no overt attempt is made to make this Package's # interfaces visible to the end user of the commercial distribution. # Such use shall not be construed as a distribution of this Package." # # Therefore, you are absolutely free to place any license on the resulting # executable(s), as long as the packed 3rd-party libraries are also available # under the Artistic License. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # See F. # # # ######################################################################## # Usage: # $error = remove_file_and_try_executable_again # ( # $file_to_remove, # $test_number, # $sub_test_number, # $test_name_string, # $test_dir, # $pipe_command_string, # $executable_name", # $expected_results, # $os, # $verbose, # \$message, # $print_cannot_locate_message, # ); # ######################################################################## ######################################################################## our $VERSION = '0.07'; package remove_file_and_try_executable_again; use Exporter; @ISA = qw(Exporter); @EXPORT = ("remove_file_and_try_executable_again"); use POSIX qw(EXIT_SUCCESS EXIT_FAILURE); use Cwd qw(chdir); use pipe_a_command; use strict; ######################################################################### sub remove_file { my ($file, $message_ref, $verbose) = @_; if (-e($file)) { if (!(unlink($file))) { # Try a desparation chmod chmod(0775, $file); if (!(unlink($file))) { $$message_ref = $$message_ref . "\[620\]Cannot delete file $file \n"; return(EXIT_FAILURE); } } if ($verbose) { print ("\[625\]Removed file $file\n"); } } else { if ($verbose) { print ("You wanted me to remove file $file\n"); print ("but it does not exist. Skipping \.\.\. \n"); } } return (EXIT_SUCCESS); } ######################################################################### sub remove_file_and_try_executable_again { my ( $file_to_remove, $test_number, $sub_test, $test_name_string, $test_dir, $command_string, $executable_name, $expected_result, $os, $verbose, $message_ref, $print_cannot_locate_message, ) = @_; my $results = ""; my $error = EXIT_FAILURE; $error = remove_file($file_to_remove, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = "Test ${test_number}_${sub_test} : " . $$message_ref; return ($error); } #................................................................. $error = pipe_a_command( $test_number, $sub_test, $test_name_string, $test_dir, $command_string, $executable_name, $expected_result, $os, $verbose, $message_ref, $print_cannot_locate_message, ); return ($error); } ######################################################################### 1; PAR-Packer-1.041/contrib/automated_pp_test/automated_pp_test.pl0000644000175000017500000103642313165210662024776 0ustar roderichroderich#!/usr/bin/perl -w ######################################################################## # Copyright 2004-2006 by Malcolm Nooning # This program does not impose any # licensing restrictions on files generated by their execution, in # accordance with the 8th article of the Artistic License: # # "Aggregation of this Package with a commercial distribution is # always permitted provided that the use of this Package is embedded; # that is, when no overt attempt is made to make this Package's # interfaces visible to the end user of the commercial distribution. # Such use shall not be construed as a distribution of this Package." # # Therefore, you are absolutely free to place any license on the resulting # executable(s), as long as the packed 3rd-party libraries are also available # under the Artistic License. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # See F. # # ######################################################################## our $VERSION = 0.17; ######################################################################## # Prior to each test # . Remove any possible files that could exist from a previous # invocation of the test. If a file cannot be removed, report # the failure and move on to the next test. # # During each test # . After any file is created, check for it's existence to make # sure it is there. # . If a file cannot be created report the failure and move on # to the next test. # # After each test # . Do not do anything. If a test should cause a fault we # want to leave any work product (files) for postmortem analysis. # . Maybe we want to print result verbiage? # # Windows versus Unix # . For each test, the command to "system" or pipe, path, etc., # will be determined by the type of OS. # For example, # if Unix, use "./tmp1/foo1". For windows, use "temp\\foo1". # # Note when the expected result is just "hello": # "if ($result =~ m/hello/) {... # versus # chomp($result); # "if ($result eq "hello") {... # The $result can have the string "hello" in it and # also contain extraneous or other error strings, so # don't match for hello. Chomp and do an "eq". # ######################################################################## use Test::More tests => 34; use Cwd qw(chdir cwd); use Config; use File::Copy; use File::Path; use File::Spec; use File::Basename; use POSIX qw(uname); use POSIX qw(EXIT_SUCCESS EXIT_FAILURE); use Getopt::Long; use strict; ######################################################################## # Home grown perl modules go here use prior_to_test; use pipe_a_command; use test_in_further_subdir; use remove_file_and_try_executable_again; ######################################################################## our ($PERL, $PAR, $PP); our ($RUN_PP, $RUN_PAR); ######################################################################## # The module prior_to_test creates these four subdirs underneath # whatever test subdir it is to work with. They are created for # general use whether the current test uses them or not. ######################################################################## our $SUBDIR1 = "subdir1"; our $SUBDIR2 = "subdir2"; our $SUBDIR3 = "subdir3"; our $SUBDIR4 = "subdir4"; ######################################################################## ######################################################################## our $os = (uname())[0]; our $no_win32_exe = 0; if ($os =~ m/^Win/i) { eval { require Win32::Exe; Win32::Exe->import(); }; $no_win32_exe = $@; # EVAL_ERROR } ######################################################################## my $TRUE = 1; my $FALSE = 0; ######################################################################### sub how_many_cache_dirs { my ($par_scratch_dir, $num_cache_dirs_ref, $message_ref, $verbose) = @_; my $file; my $count = 0; $$num_cache_dirs_ref = 0; $$message_ref = ""; if ( -e($par_scratch_dir) ) { if (!(opendir(DIR, "$par_scratch_dir"))) { $$message_ref = "hmcd_msg020: Cannot opendir $par_scratch_dir:$!:\n"; return(EXIT_FAILURE); } #.................................... while ($file = readdir(DIR)) { next if ( $file =~ m/^\.{1,2}$/ ); $count++ if ($file =~ m/cache|temp/); print ("Incremented cache count for $file\n") if $verbose; } #.................................... if (!(closedir(DIR))) { $$message_ref = "hmcd_msg030: Cannot closedir $par_scratch_dir:$!:\n"; return(EXIT_FAILURE); } $$num_cache_dirs_ref = $count; return (EXIT_SUCCESS); } else { return (EXIT_SUCCESS); } } ######################################################################### sub deltree { my ($dir, $level, $message_ref, $ignore_errors) = @_; my $file = ""; my $error = EXIT_SUCCESS; my $dir_handle = 'DIR_'; my $type = ""; $ignore_errors = 0 if (!defined($ignore_errors)); #............................................................. # Since we are deleting entire directories here, we really # want to double check parameters. #............................................................. $type = ref(\$dir); if ($type !~ m/SCALAR/i) { print ("deltree_msg040: PROGRAMMING ERROR\n"); print ("dir $dir is type $type\n"); die("Please research and fix ... Exiting\n"); } #................. $type = ref(\$level); if ($type !~ m/SCALAR/i) { print ("deltree_msg042: PROGRAMMING ERROR\n"); print ("level $level is type $type\n"); die("Please research and fix ... Exiting\n"); } #................. $type = ref($message_ref); if ($type !~ m/SCALAR/i) { print ("deltree_msg044: PROGRAMMING ERROR\n"); print ("message ref is type $type\n"); die("Please research and fix ... Exiting\n"); } if ($level !~ m/^\d+$/) { print ("deltree_msg046: PROGRAMMING ERROR\n"); print ("level $level is not all digits\n"); die("Please research and fix ... Exiting\n"); } #............................................................. if (!(-e($dir))) { # Nothing to remove return (EXIT_SUCCESS); } no strict; # The symbolic dir handles cause strict complaints # Level is to prevent duplicate file handle names. if ( defined($level) ) { $level++; } else { $level = 0; } $dir_handle = $dir_handle . $level; if (!(opendir ($dir_handle, "$dir"))) { $$message_ref = "deltree_msg048: Could not read $dir:$!:\n"; print ("$$message_ref\n"); return(EXIT_FAILURE); } # Foreach file in directory... foreach $file (readdir($dir_handle)) { next if $file =~ /^\.+$/; # Skip . or .. if (-d File::Spec->catfile($dir, $file)) { $error = deltree(File::Spec->catfile($dir, $file), $level, $message_ref); # Recursion! if (!$ignore_errors) { return ($error) if ($error == EXIT_FAILURE); } } else { if (!(unlink File::Spec->catfile($dir, $file))) { if (!$ignore_errors) { $$message_ref = "deltree_msg050:Could not delete $dir/$file :$!:\n" . "If it appears to be a permissions problem, it could " . "be that another PAR application is running.\n" . "This particular test attempts to remove all par cache " . "directories. That cannot happen if a cache is in use\n"; return(EXIT_FAILURE); } } } } if (!(closedir($dir_handle))) { $$message_ref = "deltree_msg052:Could not close dir $dir/$file :$!:\n"; return (EXIT_FAILURE); } if (!(rmdir ($dir))) { if (!$ignore_errors) { $$message_ref = "deltree_msg054:Couldn\'t remove directory \'$dir\' :$!:\n"; return (EXIT_FAILURE); } } use strict; return(EXIT_SUCCESS); } ######################################################################## sub find_par_temp_base { my ($verbose) = @_; ################################################################# # Originally taken from par.pl:_set_par_temp. The lines # containing $Config{_delim} were replaced by # File::Spec->catdir(whatever, whatever); ################################################################# my $path = ""; my $par_temp = ""; my $progname = ""; my $username = ""; my $stmpdir = ""; my $mtime = ""; my $ctx = ""; if ($ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/) { $par_temp = $1; return $par_temp; } foreach $path ( (map $ENV{$_}, qw( TMPDIR TEMP TMP )), qw( C:\\TEMP /tmp . ) ) { next unless $path and -d $path and -w $path; $username = defined(&Win32::LoginName) ? &Win32::LoginName() : $ENV{USERNAME} || $ENV{USER} || 'SYSTEM'; $stmpdir = File::Spec->catdir($path, "par-".unpack("H*", $username)); last; } print ("fptb_msg062: stmpdir is $stmpdir\n") if $verbose; return ($stmpdir); } ######################################################################## sub okay_response { my ($we_top) = @_; $we_top->destroy; } ######################################################################## sub after_test { my ($test_number, $error, $message, $verbose) = @_; if ($error == EXIT_SUCCESS) { print ("Test $test_number PASSED\n") if $verbose; } else { print ("Test $test_number FAILED: \n$message\n") if $verbose; } } ######################################################################### sub create_file { my ($test_file, $verbiage, $verbose, $message_ref, $top_of_file_text) = @_; $$message_ref = ""; if (!(open(OUTFILE, ">$test_file"))) { $$message_ref = "\n\[CF01\]Cannot open file $test_file:$!:\n"; return (EXIT_FAILURE); } if (defined($top_of_file_text) && ($top_of_file_text ne "") ) { print OUTFILE $top_of_file_text; } if ($verbiage ne "") { print OUTFILE ("print \"${verbiage}\";"); } if (!(close(OUTFILE))) { $$message_ref = "\n\[CF02\]Cannot close file $test_file:$!:\n"; return (EXIT_FAILURE); } print ("\n\[CF03\]Created file $test_file\n") if $verbose; return (EXIT_SUCCESS); } ######################################################################### sub pp_hello_1 { my ($test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp hello' # The command should: # Pack 'hello' into executable 'a.exe' # # . Create the file "hello" with the code that will # print out the word "hello". # . system pp hello # a.exe will be created on windows # . pipe 'a' and collect the results. # # Success if the result is "hello", failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $test_file = $test_dir . "/$hello_pl_file"; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg070: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($test_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg072: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP \"$hello_pl_file\" "; if (system("$cmd")) { $$message_ref = "\namsg074: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_o_hello_hello_dot_pl { my ($test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -o hello hello.pl' # The command should: # Pack 'hello.pl' into executable 'hello.exe' # (The .exe assumes windows) # . Create hello.pl with the code that will print out the word "hello". # . system pp -o hello hello.pl # . pipe the hello executable and collect the results. # # Success if the result is "hello", failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $test_file = File::Spec->catfile($test_dir, $hello_pl_file); my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg076: sub $test_name_string: cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($test_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg078: sub $test_name_string: $$message_ref"; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" "; if (system("$cmd")) { $$message_ref = "\namsg080: sub $test_name_string: cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_o_foo_foo_dot_pl_bar_dot_pl { my ( $test_name_string, $os, $test_number, $test_dir, $foo_pl_file, $bar_pl_file, $foo_executable, $bar_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- #Test #---- # Goal: # Test of 'pp -o foo foo.pl bar.pl' # ---- # The command should: Pack 'foo.pl' and 'bar.pl' into 'foo' # # Outline # ------- # . Create foo.pl with the code that will print out the word "hello foo". # . Create bar.pl with the code that will print out the word "hello bar". # . system pp -o foo foo.pl bar.pl # . pipe ./foo and collect the results. It should be "hello foo". # . Copy foo to bar # . pipe ./bar and collect the results. It should be "hello bar". # #Success if both "hello foo" and "hello bar" were appropriately collected. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg082: sub $test_name_string: " . "cannot chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($foo_pl_file, "hello foo", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg083: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $error = create_file($bar_pl_file, "hello bar", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg084: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -o $foo_executable \"$foo_pl_file\" \"$bar_pl_file\" "; if (system("$cmd")) { $$message_ref = "\namsg085: sub $test_name_string: cannot system $cmd)\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $foo_executable, "hello foo", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $foo_executable?\n"; return ($error); } #................................................................. if(!(copy("$foo_executable", "$bar_executable"))) { $$message_ref = "\namsg086: sub $test_name_string: cannot " . "copy $foo_executable to $bar_executable\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $bar_executable, "hello bar", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nIs there a $bar_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_p_hello { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_dot_par, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -p hello' # The command should: Create a PAR hello, 'a.par' # # . Create file "hello" with the code that will print out the word "hello". # . system pp -p hello # . pipe './par a' and collect the results. It should be "hello". # # Success if "hello" was collected. Failure otherwise #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $test_file = $hello_pl_file; my $pipe_command_string = "$RUN_PAR "; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg088: sub $test_name_string cannot chdir " . "$test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($test_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg089: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -p \"$test_file\""; # This should produce $a_default_dot_par if (system("$cmd")) { $$message_ref = "\namsg090: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_dot_par, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_dot_par?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_p_minus_o_hello_dot_par_hello { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_par_file_with_dot_par, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -p -o file.par file' # The command should: Create a PAR file, 'file.par' # # . Create file "hello" with the code that will print out the word "hello". # . system pp -p -o hello.par hello # . pipe './par hello.par' and collect the results. It should # be hello. # . pipe './par hello' and collect the results. It should # once again be "hello". # Success if "hello" was collected both times. Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $test_file = $hello_pl_file; my $pipe_command_string = "$RUN_PAR "; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg095: sub $test_name_string cannot chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($test_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg096: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -p -o \"$hello_par_file_with_dot_par\" \"$test_file\""; if (system("$cmd")) { $$message_ref = "\namsg097: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_par_file_with_dot_par, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n"; return ($error); } #................................................................. $pipe_command_string = "$RUN_PAR hello"; $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, "", # We don't want the sub to try # to chmod +x anything. "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_o_hello_file_dot_par { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_par_file_with_dot_par, $hello_par_file_no_dot_par, $hello_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -o hello file.par' # The command should: Pack 'file.par' to executable 'hello' # # . Create file file.pl with the code that will print out the word "hello". # . system pp -p -o file.par file.pl # This will create the par file file.par # . pipe './par file.par' and collect the results. It should # be hello. # . pipe './par file' and collect the results. It should # once again be "hello". # . system pp -o file file.par # This will pack file.par into file.exe (Assuming windows) # . pipe 'file' and collect the results. It should again be "hello" # # Success if "hello" was collected all three times. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $test_file = $hello_pl_file; my $pipe_command_string = "$RUN_PAR "; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg098: sub $test_name_string cannot chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($test_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg099: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } # Create a par file $cmd = "$RUN_PP -p -o \"$hello_par_file_with_dot_par\" \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg100: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $hello_par_file_with_dot_par\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_par_file_with_dot_par, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n"; return ($error); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string . 'hello', "", # We don't want the sub to try # to chmod +x anything. "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n"; return ($error); } #................................................................. $cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" "; if (system("$cmd")) { $$message_ref = "\namsg102: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $hello_executable\n"); } } #................................................................. $pipe_command_string = ""; $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_S_minus_o_hello_file { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_par_file_with_dot_par, $hello_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -S -o hello hello.pl' # The command should: Create a PAR file, 'hello.par' # Pack 'hello.par' to executable 'hello' # # . Create file "hello.pl" with the code that will print out the # word "hello". # . system pp -S -o hello hello.pl # This will create the par file hello.par, and also pack hello.par # into the executable "hello.exe". (Assuming windows) # . pipe './par hello.par' and collect the results. It should # be "hello". # . pipe './par hello' and collect the results. It should be "hello". # . pipe the created executable and collect the results. It # should again be "hello" # # Success if "hello" was collected all three times. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = "$RUN_PAR "; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg105: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($hello_pl_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg106: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -S -o \"$hello_executable\" \"$hello_pl_file\" "; if (system("$cmd")) { $$message_ref = "\namsg107: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $hello_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. $pipe_command_string = "$RUN_PAR hello"; $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, "", # We don't want the sub to try # to chmod +x anything. "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable " . "and hello.par?\n"; return ($error); } #................................................................. $pipe_command_string = ""; $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_p_minus_o_out_dot_par_file { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -p -o out.par file' # The command should: Create 'out.par' from 'file' # Same as the test for 'pp -p -o file.par file' # except here we have renaming. # # . Create file "file" with the code that will print out the word "hello". # . system pp -p -o out.par file # . pipe './par out.par' and collect the results. It should # be "hello". # # Success if "hello" was collected. Failure otherwise #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = "$RUN_PAR "; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg110: sub $test_name_string cannot chdir " . "$test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($hello_pl_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg111: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -p -o out.par \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg112: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created out.par\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'out.par', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce out.par?\n"; return ($error); } return ($error); #................................................................. } ######################################################################### sub pp_minus_B_with_small_minus_p_tests { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -B -p -o out.par hello.pl' # The command should: Create 'out.par' from 'file' # Same as the test for 'pp -p -o file.par file' # except here we bundle core modules. # # # Since -B is the default except with -p or -P, the only way it # seemed relevent was to test was by testing -B with -p, and by # testing -B with -P. I did. -B or it's absense seems to mean # nothing when creating either a .par file # The file sizes with and without the -B within mere bytes # of each other. # # Anyone know a way to really test -B? # # The four tests were: # pp -p -o out.par hello.pl # pp -B -p -o out.par hello.pl # # Again, the "-B" does not seem to have relevence. # # What I will do for now is to include the four tests and execute # the generated .par and just check for "hello" being printed out. # I will do this even though it is a do-nothing test. At least it # shows that the -B does not harm anything. # # # WARNING: This tests only tests that the generated files produces # are okay. It does not check anything else. # # # . Create the file hello.pl with the code that will print out the word # "hello" and use strict. # . system pp -B -p -o out_par_B.par hello.pl # This creates out.par and bundles the core modules. # . system pp -p -o out_par.par hello.pl # This creates out.par # . pipe './par out_par.par', './par out_par_B.par' # # After all of the above, success if "hello" was collected each time. # Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = "$RUN_PAR "; my $cmd = ""; my $sub_test = 0; my $top_of_created_file_text = "use strict;\n"; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; print ("\n\nI will do test $test_name_string even though it DOES NOT \n"); print ("REALLY TEST ANYTHING. At least it may show that the -B \n"); print ("switch does not harm anything.\n\n"); #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg115: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($hello_pl_file, "hello", $verbose, $message_ref, $top_of_created_file_text); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg116: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -p -o out_par.par \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg117: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created out_par.par\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'out_par.par', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce out_par.par?\n"; return ($error); } #................................................................. $cmd = "$RUN_PP -B -p -o out_par_B.par \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg118: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created out_par_B.par\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'out_par_B.par', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce out_par_B.par?\n"; return ($error); } return ($error); #................................................................. } ######################################################################### sub pp_minus_B_with_large_minus_P_tests { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Test of 'pp -B -P -o out.pl hello.pl' # The command should: Create 'out.pl' from 'file' # Same as the test for 'pp -P -o file.pl file' # except here we bundle core modules. # # # Since -B is the default except with -p or -P, the only way it # seemed relevent was to test was by testing -B with -p, and by # testing -B with -P. I did. -B or it's absense seems to mean # nothing when creating either a .pl file # The file sizes with and without the -B within mere bytes # of each other. # # Anyone know a way to really test -B? # # The four tests I tried were: # pp -P -o out.pl hello.pl # pp -B -P -o out.pl hello.pl # # Again, the "-B" does not seem to have relevence. # # What I will do for now is to include the four tests and execute # the generated .pl and just check for "hello" being printed out. # I will do this even though it is a do-nothing test. At least it # shows that the -B does not harm anything. # # # WARNING: This tests only tests that the generated files produces # are okay. It does not check anything else. # # # . Create the file hello.pl with the code that will print out the word # "hello" and use strict. # . system pp -B -P -o out_pl_B.pl hello.pl # This creates out_pl_B.pl and bundles the core modules. # . system pp -P -o out_pl.pl hello.pl # This creates out.pl # . pipe 'perl out_pl.pl', 'perl out_pl_B.pl' # # After all of the above, success if "hello" was collected each time. # Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = "\"$PERL\" "; my $cmd = ""; my $sub_test = 0; my $top_of_created_file_text = "use strict;\n"; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; print ("\n\nI will do test $test_name_string even though it DOES NOT \n"); print ("REALLY TEST ANYTHING. At least it may show that the -B \n"); print ("switch does not harm anything.\n\n"); #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg120: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($hello_pl_file, "hello", $verbose, $message_ref, $top_of_created_file_text); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg121: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -P -o out_pl.pl \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg122: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created out_pl.pl\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'out_pl.pl', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce out_pl.pl?\n"; return ($error); } #................................................................. $cmd = "$RUN_PP -B -P -o out_pl_B.pl \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg125: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created out_pl_B.pl\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'out_pl_B.pl', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce out_pl_B.pl?\n"; } #................................................................. return ($error); #................................................................. } ######################################################################### sub pp_minus_e_print_hello { my ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -e "print \"hello\n\";" # ---- # The command should: Create 'a.exe' if windows # # Outline # ------- # . system pp -e "print \"hello\n\";" # . pipe 'a' and collect the results # Success if "hello" was collected. Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg130: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $cmd = "$RUN_PP -e \"print qq[hello\n];\""; if (system("$cmd")) { $$message_ref = "\namsg131: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_p_minus_e_print_hello { my ( $test_name_string, $os, $test_number, $test_dir, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -p -e "print \"hello\n\";" # ---- # The command should: Create 'a.par' # # Outline # ------- # system pp -p -e "print \"hello\n\";" # pipe 'par a.par' and collect the results # # Success if "hello" was collected. Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = "$RUN_PAR "; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg135: sub $test_name_string cannot" . " chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $cmd = "$RUN_PP -p -e \"print qq[hello\n];\""; if (system(" $cmd ")) { $$message_ref = "\namsg136: sub $test_name_string Cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created a.par\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, "a.par", "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce a.par?\n"; return ($error); } if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce a.par?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_P_minus_e_print_hello { my ( $test_name_string, $os, $test_number, $test_dir, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -P -e "print \"hello\n\";" # ---- # The command should: Create perl script 'a.pl' # # Outline # ------- # system pp -P -e "print \"hello\n\";" # pipe 'perl a.pl' and collect the results # # Success if "hello" was collected. Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = "\"$PERL\" "; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg138: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -P -e \"print qq[hello\n];\""; if (system(" $cmd ")) { $$message_ref = "\namsg139: sub $test_name_string Cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created a.par\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'a.pl', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce a.pl?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_c_hello { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -c hello # ---- # The command should: Create executable 'a.exe' # # WARNING: This tests only tests that the executable produced # is okay. It does not check anything else. # # Outline # ------- # Create a file that will print "hello". # system pp -c hello # pipe 'a' and collect the results # # Success if "hello" was collected. Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg150: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($hello_pl_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg151: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -c \"$hello_pl_file\" "; if (system(" $cmd ")) { $$message_ref = "\namsg152: sub $test_name_string Cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_x_hello { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -x hello # ---- # The command should: Create executable 'a.exe' # Also it will check dependencies # from "perl hello" during execution # # WARNING: This tests only tests that the executable produced # is okay. It does not check anything else. # # Outline # ------- # Create a file that will print "hello". # system pp -x hello # pipe 'a' and collect the results # # Success if "hello" was collected. Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg155: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($hello_pl_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg156: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -x \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg157: sub $test_name_string Cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_n_minus_x_hello { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -n -x hello # ---- # The command should: Create executable 'a.exe' # Also it will check dependencies # from "perl hello" during execution # # WARNING: This tests only tests that the executable produced # is okay. It does not check anything else. # # Outline # ------- # Create a file that will print "hello". # system pp -n -x hello # pipe 'a' and collect the results # # Success if "hello" was collected. Failure otherwise. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg160: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } $error = create_file($hello_pl_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg161: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } $cmd = "$RUN_PP -n -x \"$hello_pl_file\""; if (system("$cmd")) { $$message_ref = "\namsg162: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } return ($error); #................................................................. } ######################################################################### sub pp_minus_I_foo_hello { my ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -I /foo hello.pl # ---- # The command should: # Add the given directory to the perl library file search path. # # Outline # ------- # . Create a temp dir "hidden_dir" that Perl and PP would not know about. # . Create a module in it called hidden_print.pm that has a # subroutine called "hidden_print", that takes in a string # to print. # . Put the new module in the new temp dir. # . Create a file foo in the current dir with code that will # invoke hidden_print # . system 'pp foo.pl' # The file a.exe is created on windows. # . pipe 'a' # The result should be something like: "Can't locate hidden_print" # . system pp -I "hidden_dir" foo.pl # Once again, a.exe is created on windows # . pipe 'a' and collect the results. # . The result should be "hello" # . Copy the a.exe to a different subdirectory # . chdir to the new subdirectory # . pipe a.exe # . The result should be "hello" # . Remove the hidden_print file. # . pipe 'a' again and collect the results. # It should still pass. # # Success if as described above. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $hidden_dir = File::Spec->catdir($test_dir, $SUBDIR1); my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $TRUE; #.............................................. my $foo_top_of_file_text = ' use hidden_print; hidden_print("hello"); '; #.............................................. #.............................................. my $hidden_top_of_file_text = ' package hidden_print; use Exporter; @ISA = qw(Exporter); @EXPORT = ("hidden_print"); sub hidden_print { my ($text_to_print) = shift; print ("$text_to_print\n"); } 1; '; #.............................................. $$message_ref = ""; #.......................................................... if (!(chdir("$test_dir"))) { $$message_ref = "\namsg165: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($hidden_dir, "hidden_print\.pm"), "", $verbose, $message_ref, $hidden_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg166: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($test_dir, "foo\.pl"), "", $verbose, $message_ref, $foo_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg168: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg169: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #################################################### ##### This SHOULD fail, so don't return ##### return ($error) if ($error == EXIT_FAILURE); ################################################### $$message_ref = ""; # Wipe out the nasty messages from the # last pipe command. print ("\n"); # To add a line after the above expected error messages. #................................................................. $cmd = "$RUN_PP -I \"$hidden_dir\" foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg170: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #.......................................................... print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( File::Spec->catfile($test_dir, "foo.pl"), # File to remove $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); } ######################################################################### sub pp_minus_lib_foo_hello { my ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp --lib /foo hello.pl # ---- # The command should: # Add the given directory to the perl library file search path. # # Outline # ------- # First, to give an outline of the directories and files this # test will create. # ----------------------------------------------------- # | current working test dir/foo.pl | # | foo.pl has "use hidden_print;" | # |-----------------------------------------------------| # | current working test dir/$SUBDIR1/hidden_print.pm | # | hidden_print.pm prints the string passed in. | # ----------------------------------------------------- # # . In a dir $SUBDIR1 that PP would not know about, create # a module called hidden_print.pm that has a subroutine # called "hidden_print", that takes in a string to # print, and prints it. # . In the current directory, create a file foo.pl that invokes # hidden_print with the text "hello". # . system pp --lib $SUBDIR1 foo.pl # An a.exe is created on windows # . pipe 'a' and collect the results. # . The result should be "hello" # # Success if as described above. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1); my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $TRUE; #.............................................. my $foo_top_of_file_text = ' use hidden_print; hidden_print("hello"); '; #.............................................. my $hidden_print_top_of_file_text = ' package hidden_print; use Exporter; @ISA = qw(Exporter); @EXPORT = ("hidden_print"); sub hidden_print { my ($text_to_print) = shift; print ("$text_to_print"); } 1; '; #.............................................. $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg172: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($foo_dir, "hidden_print\.pm"), "", $verbose, $message_ref, $hidden_print_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg174: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($test_dir, "foo\.pl"), "", $verbose, $message_ref, $foo_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg176: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg178: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); ######################################################## ##### This SHOULD fail, so don't do the usual return ##### return ($error) if ($error == EXIT_FAILURE); ######################################################## $$message_ref = ""; # Wipe out the nasty messages from the # last pipe command. print ("\n"); # To add a line after the above expected error messages. #................................................................. $cmd = "$RUN_PP --lib \"$foo_dir\" foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg180: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #.......................................................... print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( File::Spec->catfile($foo_dir, "hidden_print\.pm"), $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); } ######################################################################### sub pp_minus_I_foo_minus_I_bar_hello { my ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -I /foo -I bar hello.pl # ---- # The command should: # Add the given directory to the perl library file search path. # # Outline # ------- # First, to give an outline of the directories and files this # test will create. # ---------------------------------------------------------- # | current working test dir/foo.pl | # | foo.pl has "use hidden_print_caller; " | # |----------------------------------------------------------| # | current working test dir/$SUBDIR1/hidden_print_caller.pm | # | hidden_print_caller.pm has "use hidden_print;" | # |----------------------------------------------------------| # | current working test dir/$SUBDIR2/hidden_print.pm | # | hidden_print.pm prints the string passed in. | # ---------------------------------------------------------- # # . In subdir $SUBDIR1, create # . Create a module in $SUBDIR2 called hidden_print.pm that # has a subroutine called "hidden_print", that takes in a # string to print, and prints it. # . Create a module in $SUBDIR1 called hidden_print_caller.pm # that has a routine called hidden_print_caller that # takes in a string to print, and invokes hidden_print to print it. # . In the current directory, create a file foo.pl that invokes # hidden_print_caller with the text "hello". # . system 'pp foo.pl' # The file a.exe is created on windows. # . pipe 'a' # The result should be: Nothing. # . system pp -I foo -I bar foo.pl # Once again, a.exe is created on windows # . pipe 'a' and collect the results. # . The result should be "hello" # . Copy a.exe to a different directory # . chdir to the directory. # . pipe 'a.exe' and collect the results. # . The result should be "hello" # # Success if as described above. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1); my $bar_dir = File::Spec->catdir($test_dir, $SUBDIR2); my $foo_dir_file = File::Spec->catfile($foo_dir, "hidden_print_caller\.pm"); my $bar_dir_file = File::Spec->catfile($bar_dir, "hidden_print\.pm"); my $foo_file = File::Spec->catfile($test_dir, "foo\.pl"); my $further_subdir = ""; my $further_file = ""; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $TRUE; #.............................................. my $foo_top_of_file_text = ' use hidden_print_caller; hidden_print_caller("hello"); '; #.............................................. #.............................................. my $hidden_print_caller_top_of_file_text = ' package hidden_print_caller; use Exporter; @ISA = qw(Exporter); @EXPORT = ("hidden_print_caller"); use hidden_print; sub hidden_print_caller { my ($text_to_print) = shift; hidden_print ("$text_to_print"); } 1; '; #.............................................. #.............................................. my $hidden_print_top_of_file_text = ' package hidden_print; use Exporter; @ISA = qw(Exporter); @EXPORT = ("hidden_print"); sub hidden_print { my ($text_to_print) = shift; print ("$text_to_print"); } 1; '; #.............................................. $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg182: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $bar_dir_file, "", $verbose, $message_ref, $hidden_print_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg184: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $foo_dir_file, "", $verbose, $message_ref, $hidden_print_caller_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg186: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $foo_file, "", $verbose, $message_ref, $foo_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg188: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP \"$foo_file\""; if (system("$cmd")) { $$message_ref = "\namsg190: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("\namsg192: sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); ######################################################## ##### This SHOULD fail, so don't do the usual return ##### return ($error) if ($error == EXIT_FAILURE); ######################################################## $$message_ref = ""; # Wipe out the nasty messages from the # last pipe command. print ("\n"); # To add a line after the above expected error messages. #................................................................. $cmd = "$RUN_PP -I \"$foo_dir\" -I \"$bar_dir\" \"$foo_file\""; if (system("$cmd")) { $$message_ref = "\namsg194: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $bar_dir_file, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); #................................................................. } ######################################################################### sub pp_minus_lib_foo_minus_lib_bar_hello { my ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp --lib /foo --lib bar hello.pl # ---- # The command should: # Add the given directory to the perl library file search path. # # Outline # ------- # First, to give an outline of the directories and files this # test will create. # ---------------------------------------------------------- # | current working test dir/foo.pl | # | foo.pl has "use hidden_print_caller;" | # |----------------------------------------------------------| # | current working test dir/$SUBDIR1/hidden_print_caller.pm | # | hidden_print_caller.pm has "use hidden_print;" | # |----------------------------------------------------------| # | current working test dir/$SUBDIR2/hidden_print.pm | # | hidden_print.pm prints the string passed in. | # ---------------------------------------------------------- # # . Create a module in $SUBDIR2 called hidden_print.pm that # has a subroutine called "hidden_print", that takes in a # string to print, and prints it. # . Create a module in $SUBDIR1 called hidden_print_caller.pm # that has a routine called hidden_print_caller that # takes in a string to print, and invokes hidden_print to print it. # . In the current directory, create a file foo.pl that invokes # hidden_print_caller with the text "hello". # . system pp --lib foo --lib bar foo.pl # Once again, a.exe is created on windows # . pipe 'a' and collect the results. # . The result should be "hello" # # Success if as described above. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1); my $bar_dir = File::Spec->catdir($test_dir, $SUBDIR2); my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $TRUE; #.............................................. my $foo_top_of_file_text = ' use hidden_print_caller; hidden_print_caller("hello"); '; #.............................................. #.............................................. my $hidden_print_caller_top_of_file_text = ' package hidden_print_caller; use Exporter; @ISA = qw(Exporter); @EXPORT = ("hidden_print_caller"); use hidden_print; sub hidden_print_caller { my ($text_to_print) = shift; hidden_print ("$text_to_print"); } 1; '; #.............................................. #.............................................. my $hidden_print_top_of_file_text = ' package hidden_print; use Exporter; @ISA = qw(Exporter); @EXPORT = ("hidden_print"); sub hidden_print { my ($text_to_print) = shift; print ("$text_to_print"); } 1; '; #.............................................. my $further_subdir = ""; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg196: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($bar_dir, "hidden_print\.pm"), "", $verbose, $message_ref, $hidden_print_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg198: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($foo_dir, "hidden_print_caller\.pm"), "", $verbose, $message_ref, $hidden_print_caller_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg200: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($test_dir, "foo\.pl"), "", $verbose, $message_ref, $foo_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg202: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg204: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); ######################################################## ##### This SHOULD fail, so don't do the usual return ##### return ($error) if ($error == EXIT_FAILURE); ######################################################## $$message_ref = ""; # Wipe out the nasty messages from the # last pipe command. print ("\n"); # To add a line after the above expected error messages. #................................................................. $cmd = "$RUN_PP --lib \"$foo_dir\"" . ' --lib ' . "\"$bar_dir\"" . ' foo.pl'; if (system("$cmd")) { $$message_ref = "\namsg206: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( File::Spec->catfile($test_dir, "foo\.pl"), $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); #................................................................. } ######################################################################### sub pp_minus_M_foo_hidden_print_foo { my ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -M module foo.pl # The command should: Add the given module # # Outline # ------- # ----------------------------------------------------- # | current working test dir/foo.pl | # | foo.pl has "use hidden_print;" | # |-----------------------------------------------------| # | current working test dir/$SUBDIR1/hidden_print.pm | # | hidden_print.pm prints the string passed in. | # | It is "package hidden_print;" | # ----------------------------------------------------- # # . Create $SUBDIR1/hidden_print.pm that has a subroutine # called "hidden_print", that takes in a string to # print, and prints it. # . In the current directory, create a file foo.pl that invokes # hidden_print with the text "hello". # . system pp foo.pl # An a.exe is created on windows # . pipe the created executable and collect the results. # There will be error # messages on the screen, and the results will be: nothing. # . system pp -M $SUBDIR1::hidden_print foo.pl # An a.exe is created on windows # . pipe the created executable and collect the results. # . The result should be "hello" # . Remove the included module # . Once again, pipe the created executable # The result should still be hello. # Success if as described above. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1); my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $hidden_print_file = File::Spec->catfile($foo_dir, "hidden_print\.pm"); my $print_cannot_locate_message = $FALSE; #.............................................. my $foo_top_of_file_text = ' use ' . $SUBDIR1 . '::hidden_print; hidden_print("hello"); '; #.............................................. my $hidden_print_top_of_file_text = ' package ' . $SUBDIR1 . '::hidden_print; use Exporter; @ISA = qw(Exporter); @EXPORT = ("hidden_print"); sub hidden_print { my ($text_to_print) = shift; print ("$text_to_print"); } 1; '; #.............................................. my $further_subdir = ""; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg208: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $hidden_print_file, "", $verbose, $message_ref, $hidden_print_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg210: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($test_dir, "foo\.pl"), "", $verbose, $message_ref, $foo_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg212: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg214: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #.......................................................... $cmd = "$RUN_PP -M ${SUBDIR1}::hidden_print foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg216: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $hidden_print_file, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); #................................................................. } ######################################################################### sub pp_minus_M_foo_minus_M_bar_hello { my ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of pp -M hidden1 -M hidden2 foo.pl # The command should: Add the given modules # # Outline # ------- # ----------------------------------------------------- # | current working test dir/foo.pl | # | foo.pl has "use foo_1;" | # | "use bar_1;" | # | foo_1; | # | bar_1; | # |-----------------------------------------------------| # | current working test dir/$SUBDIR1/foo_1.pm | # | foo_1.pm will print "hello_foo" | # |-----------------------------------------------------| # | current working test dir/$SUBDIR2/bar_1.pm | # | bar_1.pm will print "hello_bar" | # ----------------------------------------------------- # # . Create $SUBDIR1/foo_1.pm that has a subroutine called "foo_1", # that prints hello_foo. # . Create $SUBDIR2/bar_1.pm that has a subroutine called "bar_1", # that prints hello_bar. # . In the current directory, create a file foo.pl that invokes # foo_1 and bar_1. # . system pp foo.pl # An a.exe is created on windows # . pipe 'a' and collect the results. There will be error # messages on the screen, and the results will be: nothing. # . system pp -M $SUBDIR1::foo_1 -M $SUBDIR2::bar_1 foo.pl # An a.exe is created on windows # . pipe 'a' and collect the results. # . The result contain "hello_foo" and "hello_bar". # # Success if as described above. Failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1); my $bar_dir = File::Spec->catdir($test_dir, $SUBDIR2); my $subdir_foo_file = File::Spec->catfile($foo_dir, "foo_1\.pm"); my $print_cannot_locate_message = $FALSE; #.............................................. my $foo_top_of_file_text = ' use ' . $SUBDIR1 . '::foo_1; use ' . $SUBDIR2 . '::bar_1; foo_1; bar_1; '; #.............................................. my $foo_1_top_of_file_text = ' package ' . $SUBDIR1 . '::foo_1; use Exporter; @ISA = qw(Exporter); @EXPORT = ("foo_1"); sub foo_1 { print ("hello_foo"); } 1; '; #.............................................. my $bar_1_top_of_file_text = ' package ' . $SUBDIR2 . '::bar_1; use Exporter; @ISA = qw(Exporter); @EXPORT = ("bar_1"); sub bar_1 { print ("hello_bar"); } 1; '; #.............................................. my $further_subdir = ""; $$message_ref = ""; if (!(chdir("$test_dir"))) { $$message_ref = "\namsg230: sub $test_name_string cannot" . " chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $subdir_foo_file, "", $verbose, $message_ref, $foo_1_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg232: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($bar_dir, "bar_1\.pm"), "", $verbose, $message_ref, $bar_1_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg234: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($test_dir, "foo\.pl"), "", $verbose, $message_ref, $foo_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg236: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg238: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello_foohello_bar", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. $cmd = "$RUN_PP -M ${SUBDIR1}::foo_1 -M ${SUBDIR2}::bar_1 foo.pl"; if (system("$cmd")) { $$message_ref = "\namsg240: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello_foohello_bar", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $a_default_executable, "hello_foohello_bar", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $subdir_foo_file, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello_foohello_bar", $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); #................................................................. } ######################################################################### ######################################################################### sub pp_minus_X_module_foo { my ( $test_name_string, $os, $test_number, $test_dir, $foo_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of 'pp -X Foo::Bar foo' # ---- # The command should: Exclude a module (notice space after -X) # # Outline # ------- # . Create the perl file test_X_foo_bar with code that will utilize # the module "basename". That is, use File::Basename; # . Have the line "print basename($^X)" in the perl file # to invoke basename. # . system "pp -X File::Basename test_X_foo_bar". # . pipe the created 'a' and collect the results. # . # Success if the first result is "perl.exe" on Windows, and success # if it fails to give "perl.exe" the second time. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; #.............................................. my $foo_top_of_file_text = ' use File::Basename; my $basename = basename($^X); print $basename; '; #.............................................. my $further_subdir = ""; #.............................................. $$message_ref = ""; print ("\n\nI will do test $test_name_string even though it DOES NOT \n"); print ("REALLY TEST ANYTHING. At least it may show that the -X \n"); print ("switch does not harm anything.\n\n"); #.............................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg270: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($test_dir, $foo_pl_file), "", $verbose, $message_ref, $foo_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg282: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP \"" . File::Spec->catfile($test_dir, $foo_pl_file) . '"'; if (system("$cmd")) { $$message_ref = "\namsg284: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, 'perl', $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #................................................................. $cmd = "$RUN_PP -X File::Basename \"" . File::Spec->catfile($test_dir, $foo_pl_file) . '"'; if (system("$cmd")) { $$message_ref = "\namsg286: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n"); } } #................................................................. # Note: If Basename were really excluded this would fail. # But it doesn't!!! $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, 'perl', $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); } ######################################################################### sub pp_minus_r_hello { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of 'pp -r hello.pl' # ---- # The command should: Pack hello.pl into a.exe, and then run a.exe # after packaging it. # # Outline # ------- # . Create the perl file hello.pl with code that will print "hello". # . pipe "pp -r hello.pl" and collect the results. # # Success if "hello", failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; #.............................................. my $hello_top_of_file_text = ' print "hello"; '; #.............................................. $$message_ref = ""; #.............................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg300: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $hello_pl_file, "", $verbose, $message_ref, $hello_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg302: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $pipe_command_string = "$RUN_PP -r \"$hello_pl_file\""; $cmd = $pipe_command_string; # Just to keep our code # template here consistent. #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, "", # No separate executable name this time "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } #................................................................. return ($error); } ######################################################################### sub pp_minus_r_hello_a_b_c { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of 'pp -r hello.pl a b c' # ---- # The command should: Pack hello.pl into a.exe, and then run a.exe # after packaging it. The a b c are parameters. # # Outline # ------- # . Create the perl file hello.pl with code that will print "hello". # . pipe "pp -r hello.pl" and collect the results. # # Success if "hello", failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; #.............................................. my $hello_top_of_file_text = ' print "hello $ARGV[0] $ARGV[1] $ARGV[2]"; '; #.............................................. $$message_ref = ""; #.............................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg304: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $hello_pl_file, "", $verbose, $message_ref, $hello_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg306: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $pipe_command_string = "$RUN_PP -r \"$hello_pl_file\" \"one\" \"two\" \"three\""; $cmd = $pipe_command_string; # Just to keep our code # template here consistent. #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, "", # No separate executable name this time "hello one two three", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } #................................................................. return ($error); } ######################################################################### sub pp_hello_to_log_file { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of 'pp hello.pl --log=c' and 'pp -L c hello.pl' # ---- # The command should: Pack hello.pl into a.exe, and then run a.exe # after packaging it. The a b c are parameters. # # Outline # ------- # . Create the perl file hello.pl with code that will print "hello". # . pipe "pp hello.pl --log=c" and collect the results. # # THIS IS A DO-NOTHING TEST ... SO FAR ... # At least it will show that --log=c does no harm # # Success if "hello", failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $log_file = 'c.txt'; my $print_cannot_locate_message = $FALSE; #.............................................. my $hello_top_of_file_text = ' print "hello"; '; #.............................................. $$message_ref = ""; print ("\n\nI will do test $test_name_string even though it DOES NOT \n"); print ("REALLY TEST ANYTHING. At least it may show that the --log=c \n"); print ("switch does not harm anything.\n\n"); #.............................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg308: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $hello_pl_file, "", $verbose, $message_ref, $hello_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg310: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP hello.pl -v --log=$log_file"; if (system("$cmd")) { $$message_ref = "\namsg312: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n"); } } #.......................................................... if (-e($log_file) && (-s($log_file) > 10)) { if ($verbose) { print ("The log file $log_file has lines in it\n"); } } else { $$message_ref = "sub ${test_name_string}_$sub_test command $cmd \n" . "did not produce file $log_file or $log_file does not have " . "more than 10 bytes in it\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return ($error); } #.......................................................... if (!(unlink($a_default_executable))) { $$message_ref = "Test ${test_name_string}_$sub_test " . "cannot remove file $a_default_executable\n"; return(EXIT_FAILURE); } #.......................................................... $log_file = 'd.txt'; $cmd = "$RUN_PP -L $log_file -v hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg314: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n"); } } #.......................................................... if (-e($log_file) && (-s($log_file) > 10)) { if ($verbose) { print ("The log file $log_file has lines in it\n"); } } else { $$message_ref = "sub ${test_name_string}_$sub_test command $cmd \n" . "did not produce file $log_file or $log_file does not have " . "more than 10 bytes in it\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } #................................................................. return ($error); } ######################################################################### sub pp_name_four_ways { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of four ways to name the created executable # ---- # # % pp hello.pl (produces default a.exe on windows) # % pp -o output1.exe hello.pl # % pp --output output2.exe hello.pl # % pp --output=output3.exe hello.pl # # . Create the file hello.pl that will print "hello". # . system "pp hello.pl" # . system "pp -o output1.exe hello.pl" # . system "--output output2.exe hello.pl" # . system "--output=output3.exe hello.pl" # . pipe each of the three executables, one at a time, # and collect the results. Each should be "hello". # . Get the size of the executables. # . Compare the sizes. They should all be the same size. # # Success if "hello" in each case, failure otherwise. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; #.............................................. my $hello_top_of_file_text = ' print "hello"; '; #.............................................. $$message_ref = ""; #.............................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg320: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( $hello_pl_file, "", $verbose, $message_ref, $hello_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg322: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg324: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $a_default_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg326: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP -o output1.exe hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg328: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/output1.exe\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'output1.exe', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP --output output2.exe hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg340: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/output2.exe\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'output2.exe', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce output2.exe?\n"; return (EXIT_FAILURE); } #.......................................................... $cmd = "$RUN_PP --output=output3.exe hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg342: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/output3.exe\n"); } } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, 'output3.exe', "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $a_default_executable?\n"; } #.......................................................... return ($error); } ######################################################################### sub pp_minus_v_tests { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $a_default_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test -v with no arguements, with some other parameter, too, # in many different ways.\ # # pp -v 1 hello.pl > v_1.txt # pp -v 2 hello.pl > v_2.txt # pp -v 3 hello.pl > v_3.txt # # pp -v hello.pl > v.txt # pp -vv hello.pl > vv.txt # pp -vvv hello.pl > vvv.txt # # pp -o hello.exe -v hello.pl > o_v.txt # pp -o hello.exe -vv hello.pl > o_vv.txt # pp -o hello.exe -vvv hello.pl > o_vvv.txt # # pp -o hello.exe -v 1 hello.pl > o_v_1.txt # pp -o hello.exe -v 2 hello.pl > o_v_2.txt # pp -o hello.exe -v 3 hello.pl > o_v_3.txt # # pp -v 1 hello.pl -o hello.exe > v_1_h_o.txt # pp -v 2 hello.pl -o hello.exe > v_2_h_o.txt # pp -v 3 hello.pl -o hello.exe > v_3_h_o.txt # # . Create the file hello.pl with the code that will print out "hello". # . For each of the above shown five sets of three commands: # . "system" the commands, which capture the outputs in the # shown .txt files. # . Examine the three created text files for each set of five, # for the patterns shown below. # # For v 1 # pp:\s+Packing\s+hello.pl # pp:\s+ Running.*parl\w*.exe # For v 2 # pp:\s+Packing\s+hello.pl # pp:\s+Writing\s+PAR\s+on # pp:\s+ Running.*parl\w*.exe # For v 3 # pp:\s+Packing\s+hello.pl # pp:\s+Writing\s+PAR\s+on # pp:.* making\s+MANIFEST # pp:\s+ Running.*parl\w*.exe # # # . pipe the created executable and collect the results. # . If the created text file has an "o" in it, # pipe hello.exe on Windows. # Otherwise pipe just a.exe on windows. # # Hello should be the result in each case. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = ""; my $cmd = ""; my $at_least_one_line_not_found = $FALSE; my $MODULUS = 3; my $max_command_strings = ""; my $i; my $command_string = ""; my $text_file_to_examine = ""; my $modulus_result = ""; my @expected_lines = (); my $line = ""; my $all_lines = (); my $test_and_sub_test = "00_00"; my $file_to_send_to_pipe = ""; my @converted_array = (); my $print_cannot_locate_message = $FALSE; #.............................................. my $hello_top_of_file_text = ' print "hello"; '; #.............................................. my @command_strings = ( "$RUN_PP -v 1 hello.pl > v_1.txt", "$RUN_PP -v 2 hello.pl > v_2.txt", "$RUN_PP -v 3 hello.pl > v_3.txt", "$RUN_PP -v hello.pl > v.txt", "$RUN_PP -vv hello.pl > vv.txt", "$RUN_PP -vvv hello.pl > vvv.txt", "$RUN_PP -o hello.exe -v hello.pl > o_v.txt", "$RUN_PP -o hello.exe -vv hello.pl > o_vv.txt", "$RUN_PP -o hello.exe -vvv hello.pl > o_vvv.txt", "$RUN_PP -o hello.exe -v 1 hello.pl > o_v_1.txt", "$RUN_PP -o hello.exe -v 2 hello.pl > o_v_2.txt", "$RUN_PP -o hello.exe -v 3 hello.pl > o_v_3.txt", "$RUN_PP -v 1 hello.pl -o hello.exe > v_1_h_o.txt", "$RUN_PP -v 2 hello.pl -o hello.exe > v_2_h_o.txt", "$RUN_PP -v 3 hello.pl -o hello.exe > v_3_h_o.txt", ); if ($os !~ m/^Win|cygwin/i) { @converted_array = (); foreach $command_string (@command_strings) { $command_string =~ s/hello.exe/hello.out/g; push(@converted_array, ($command_string)); } @command_strings = (); push(@command_strings, @converted_array); } my @text_files_to_examine = ( 'v_1.txt', 'v_2.txt', 'v_3.txt', 'v.txt', 'vv.txt', 'vvv.txt', 'o_v.txt', 'o_vv.txt', 'o_vvv.txt', 'o_v_1.txt', 'o_v_2.txt', 'o_v_3.txt', 'v_1_h_o.txt', 'v_2_h_o.txt', 'v_3_h_o.txt', ); my @results_to_expect_v = ( 'pp:\s+Packing\s+hello.pl', 'pp:\s+Running.*parl\w*\.exe', ); my @results_to_expect_vv = ( 'pp:\s+Packing\s+hello.pl', 'pp:\s+Writing\s+PAR\s+on', 'pp:\s+Running.*parl\w*\.exe', ); my @results_to_expect_vvv = ( 'pp:\s+Packing\s+hello.pl', 'pp:\s+Writing\s+PAR\s+on', 'pp:.*ing\s+MANIFEST', 'pp:\s+Running.*parl\w*\.exe', ); #............. Remove the ".exe" parts if not Windows if ($os !~ m/^Win|cygwin/i) { @converted_array = (); foreach $line (@results_to_expect_v) { $line =~ s/parl\\w\*\\\.exe/\\bparl\\w*\\b/g; push(@converted_array, ($line)); } @results_to_expect_v = @converted_array; } if ($os !~ m/^Win|cygwin/i) { @converted_array = (); foreach $line (@results_to_expect_vv) { $line =~ s/parl\\w\*\\\.exe/\\bparl\\w*\\b/g; push(@converted_array, ($line)); } @results_to_expect_vv = @converted_array; } if ($os !~ m/^Win|cygwin/i) { @converted_array = (); foreach $line (@results_to_expect_vvv) { $line =~ s/parl\\w\*\\\.exe/\\bparl\\w*\\b/g; push(@converted_array, ($line)); } @results_to_expect_vvv = @converted_array; } #.......................................................... $max_command_strings = @command_strings; $$message_ref = ""; #.......................................................... if (!(chdir("$test_dir"))) { $$message_ref = "\namsg344: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #.......................................................... $error = create_file( File::Spec->catfile($test_dir, $hello_pl_file), "", $verbose, $message_ref, $hello_top_of_file_text, ); if ($error == EXIT_FAILURE) { $$message_ref = "\nsub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #.......................................................... for ($i = 0; $i < $max_command_strings; $i++) { @expected_lines = (); $all_lines = (); $at_least_one_line_not_found = $FALSE; $test_and_sub_test = $test_number . '_' . $i; $text_file_to_examine = $text_files_to_examine[$i]; if ($verbose) { print ("\n\nAbout to test $test_and_sub_test: "); print ("$test_name_string\n\n"); print ("Text file to examine is $text_file_to_examine\n"); } #.......................................................... # Remove any executables from prior iterations if ($text_file_to_examine =~ m/o/) { $file_to_send_to_pipe = $hello_executable; if (-e($hello_executable)) { # Remove any executables from prior sub tests if (!(unlink($hello_executable))) { $$message_ref = "\namsg346: " . "Test $test_and_sub_test: $test_name_string " . "cannot remove file $hello_executable\n"; return(EXIT_FAILURE); } } # exists } else { if (-e($a_default_executable)) { # Remove any executables from prior sub tests if (!(unlink($a_default_executable))) { $$message_ref = "\namsg348: " . "Test $test_and_sub_test: $test_name_string " . "cannot remove file $a_default_executable\n"; return(EXIT_FAILURE); } } # exists $file_to_send_to_pipe = $a_default_executable; } #.......................................................... $cmd = $command_strings[$i]; if (system("$cmd")) { $$message_ref = "\namsg350: sub ${test_name_string}_$test_and_sub_test" . " cannot system $cmd\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string "); print ("Hopefully, \"$cmd\" created $test_dir/"); if ($text_file_to_examine =~ m/o/) { print ("$hello_executable\n"); } else { print ("$a_default_executable\n"); } } } #.......................................................... if ( ($i % $MODULUS) == 0) { push(@expected_lines, (@results_to_expect_v)); } elsif ( ($i % $MODULUS) == 1) { push(@expected_lines, (@results_to_expect_vv)); } else { push(@expected_lines, (@results_to_expect_vvv)); } #.......................................................... # Get the results from the created text file. $text_file_to_examine = $text_files_to_examine[$i]; if (-e($text_file_to_examine)) { if (open (FH, "$text_file_to_examine")) { # Slurp in all the lines of the file at once local $/; $all_lines = ; if (!(close(FH))) { $$message_ref = "\namsg352: " . "Something is wrong with test $test_name_string " . "in directory $test_dir\n" . "File $text_file_to_examine exists, and I opened it, " . "but now I cannot close it.\n" . "Cannot continue with test $test_name_string\n"; return (EXIT_FAILURE); } } else { $$message_ref = "\namsg354: " . "Something is wrong with test $test_name_string " . "in directory $test_dir\n" . "File $text_file_to_examine exists but I cannot open it.\n" . "Cannot continue with test $test_name_string\n"; return (EXIT_FAILURE); } } else { $$message_ref = "\namsg356: " . "Something is wrong with test $test_name_string " . "in directory $test_dir\n" . "Command $cmd did not create file $text_file_to_examine\n" . "Cannot continue with test $test_name_string\n"; return (EXIT_FAILURE); } #.......................................................... # By this time, I have opened the text file, extracted # all of the lines into $all_lines, and closed the file. #.......................................................... foreach $line (@expected_lines) { if ($all_lines !~ m!$line!gm) { $at_least_one_line_not_found = $TRUE; print ("Line $line does not match\n") if ($verbose); } } #.......................................................... if ($at_least_one_line_not_found) { $$message_ref = "\namsg358: " . "Something is wrong with test $test_name_string " . "in directory $test_dir\n" . "Command $cmd did provide the expected results in file " . "$text_file_to_examine.\n I expected matches to regexp \n" . "@expected_lines" . "\nbut instead got \n$all_lines\n" . "Cannot continue with test $test_name_string\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("Test $test_name_string, command $cmd, \n"); print ("file $text_file_to_examine "); print ("had the expected results. \.\.\. passed so far "); print ("\.\.\.\n"); } } #.......................................................... # Now to see if the created executable works $error = pipe_a_command ( $test_number, $i, $test_name_string, $test_dir, $pipe_command_string, $file_to_send_to_pipe, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = " Test $test_and_sub_test \n" . $$message_ref . "\nDid $cmd produce $file_to_send_to_pipe?\n"; return ($error); } #................................................................. } # for $i #.......................................................... return (EXIT_SUCCESS); } ######################################################################### sub pp_minus_V { my ( $test_name_string, $os, $test_number, $test_dir, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test -V and of --version # ---- # # Outline # ------- # . pipe "pp -V" and collect the results. # . The string # "Such use shall not be construed as a distribution" # should be part of what was collected. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string_big_V = "$RUN_PP -V"; my $pipe_command_string_minus_minus = "$RUN_PP --version"; my $sub_test = 0; my $expected_string = "Such use shall not be construed as a distribution"; my $cmd = ""; my $print_cannot_locate_message = $FALSE; #.......................................................... if (!(chdir("$test_dir"))) { $$message_ref = "\namsg360: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $cmd = $pipe_command_string_big_V; # Keeps template the same # as possible. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string_big_V, "", $expected_string, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $expected_string?\n"; return (EXIT_FAILURE); } #................................................................. $cmd = $pipe_command_string_minus_minus; # Keeps template the # same as possible. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string_minus_minus, "", $expected_string, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $expected_string?\n"; return (EXIT_FAILURE); } #................................................................. return ($error); #................................................................. } ######################################################################### sub pp_help_tests { my ( $test_name_string, $os, $test_number, $test_dir, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test of 'pp -h' and of 'pp --help' # ---- # The help screen should be shown. # # Outline # ------- # . pipe "pp -h" and collect the results # . The string "PAR Packager" should have been collected. # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $pipe_command_string = "$RUN_PP -h"; my $sub_test = 0; my $expected_string = 'PAR Packager'; my $print_cannot_locate_message = $FALSE; #.......................................................... if (!(chdir("$test_dir"))) { $$message_ref = "\namsg370: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, "", $expected_string, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = "\nTest ${test_number}_$sub_test \n" . $$message_ref; return ($error); } #................................................................. $pipe_command_string = "$RUN_PP --help"; #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, "", $expected_string, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = "\nTest ${test_number}_$sub_test \n" . $$message_ref; } return ($error); #................................................................. } ######################################################################### sub test_par_clean { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test PAR_GLOBAL_CLEAN with different parameters # ---- # Notes: PAR_GLOBAL_CLEAN overides -C. If you set # PAR_GLOBAL_CLEAN to 1 or 0, -C doesn't do anything. # If -C does work, it creates temp-pid dirs, not # cache-sha1 dirs (important for how_many_cache_dirs()). # # Outline # ------- # . Compute the name of the par scratchpad directory. # . Try to delete each PAR cache directory # . Skip over the ones that cannot be deleted. It usually # means that they are in use. i.e. another PAR application # is running. # . $leftover = Count of the cache directories that are left. # # . Create hello.pl with the code that will print out the word "hello". # . # . Set PAR_GLOBAL_CLEAN = 0 # . system pp -o hello hello.pl # . pipe the hello executable and collect the results. # . Success if "hello" # . There should be 2 + $leftover cache directories. # . # . Again, remove the cache dirs that we can, and # count up $left_over_cache_dirs. # . Set PAR_GLOBAL_CLEAN = 1 # . Rerun (system and pipe) the above test # . There should be 0 + $leftover cache directories. # . # . Again, remove the cache dirs that we can, and # count up $left_over_cache_dirs. # . Test when perl was built as shared library # . Set PAR_GLOBAL_CLEAN = 0 # . system pp -d -o hello hello.pl # . Pipe the hello executable and collect the results. # . Success if "hello" # . There should be 2 + $leftover cache directories. # # . Again, remove the cache dirs that we can, and # count up $left_over_cache_dirs. # . Test when perl was built as shared library # . Set PAR_GLOBAL_CLEAN = 1 # . Rerun (system and pipe) the above test # . There should be 0 + $leftover cache directories. # . # . Again, remove the cache dirs that we can, and # count up $left_over_cache_dirs. # . Set PAR_GLOBAL_CLEAN = 0 # . system pp -C -o hello hello.pl # . pipe the hello executable and collect the results. # . Success if "hello" # . There should be 0 + $leftover cache directories. # . # . Again, remove the cache dirs that we can, and # count up $left_over_cache_dirs. # . Set PAR_GLOBAL_CLEAN = 1 # . Rerun the above system and pipe test # . There should be 0 + $leftover cache directories. # . # . Again, remove the cache dirs that we can, and # count up $left_over_cache_dirs. # . Test when perl was built as shared library # . Set PAR_GLOBAL_CLEAN = 0 # . system pp -C -d -o hello hello.pl # . Since PAR_GLOBAL_CLEAN exists, the -C will do NOTHING! # Hence a cache dir will be produced. # . Delete PAR_GLOBAL_CLEAN # . pipe the hello executable and collect the results. # . Since PAR_GLOBAL_CLEAN does not exist, the -C will # have its expected effect, and NOT produce a cache. # . Success if "hello" # . There should be 1 + $leftover cache directories. # . # . Again, remove the cache dirs that we can, and # count up $left_over_cache_dirs. # . Test when perl was built as shared library # . Set PAR_GLOBAL_CLEAN = 1 # . Rerun (system and pipe) the above test # . There should be 0 + $leftover cache directories. # . # . Reset Set PAR_GLOBAL_CLEAN to 0 so as to not interfere # with future tests. #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $sub_test = 0; my $test_file = $hello_pl_file; my $pipe_command_string = ""; my $cmd = ""; my $number_of_cache_dirs = 0; my $message = ""; my $par_scratch_dir = find_par_temp_base($verbose); my $print_cannot_locate_message = $FALSE; my $ignore_errors = $TRUE; my $left_over_cache_dirs = 0; my $should_be_cache_dirs = 0; #.......................................................... $$message_ref = ""; #.......................................................... print ("\namsg445: Removing $par_scratch_dir caches\n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); if ($error) { $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests. return(EXIT_FAILURE); } $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg446: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } print ("\namsg447: There are $left_over_cache_dirs cache dirs left\n") if $verbose; #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg448: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return (EXIT_FAILURE); } print ("amsg450:chdir to $test_dir\n") if ($verbose); #................................................................. $error = create_file($test_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg451: sub $test_name_string: $$message_ref"; $ENV{PAR_GLOBAL_CLEAN} = 0; return (EXIT_FAILURE); } #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 0; #................................................................. $cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" "; print ("\namsg452: About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg453:sub $test_name_string cannot system $cmd\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return (EXIT_FAILURE); } print ("amsg454: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg455:Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } #................................................................. $error = how_many_cache_dirs($par_scratch_dir, \$number_of_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg456: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } $should_be_cache_dirs = 2 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg457:There should be no more than $should_be_cache_dirs " . "cache dirs, \n but there are $number_of_cache_dirs instead\n"; return(EXIT_FAILURE); } #................................................................. ####################### # Next sub test ####################### #................................................................. print ("amsg458: Removing $par_scratch_dir caches\n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); if ($error) { $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests. return(EXIT_FAILURE); } $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg460: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 1; #................................................................. $cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" "; print ("\namsg461: About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg462:sub $test_name_string cannot system $cmd\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return (EXIT_FAILURE); } print ("amsg463: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg466:Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } #................................................................. $error = how_many_cache_dirs($par_scratch_dir, \$number_of_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg470: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } $should_be_cache_dirs = 0 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg472:There should be no more than $should_be_cache_dirs " . "cache dirs, \nbut there are $number_of_cache_dirs instead\n"; return(EXIT_FAILURE); } #................................................................. ####################### # Next sub test ####################### #................................................................. print ("amsg474:Removing $par_scratch_dir caches\n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); if ($error) { $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests. return(EXIT_FAILURE); } $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg480: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } #................................................................. if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) { # Perl was built as shared library, so the -d option is valid. #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 0; #................................................................. $cmd = "$RUN_PP -d -o \"$hello_executable\" \"$hello_pl_file\" "; print ("\namsg482: About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg484: sub $test_name_string " . "cannot system $cmd\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return (EXIT_FAILURE); } print ("amsg485: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg486:Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } #................................................................. $error = how_many_cache_dirs($par_scratch_dir, \$number_of_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg487: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } $should_be_cache_dirs = 2 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg488:There should be no more than $should_be_cache_dirs " . "cache dirs\nbut there are $number_of_cache_dirs instead\n"; return(EXIT_FAILURE); } #................................................................. } # shared lib ####################### # Next sub test ####################### #................................................................. print ("amsg489:Removing $par_scratch_dir caches\n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, # This is what we want $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg490: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } #................................................................. if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) { # Perl was built as shared library, so the -d option is valid. #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 1; #................................................................. $cmd = "$RUN_PP -d -o \"$hello_executable\" \"$hello_pl_file\" "; print ("\namsg491: About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg492:sub $test_name_string " . "cannot system $cmd\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return (EXIT_FAILURE); } print ("amsg493: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg494: Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } #................................................................. $error = how_many_cache_dirs($par_scratch_dir, \$number_of_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg498: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } $should_be_cache_dirs = 0 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg500:There should be no more than $should_be_cache_dirs " . "cache dirs, \nbut there are $number_of_cache_dirs instead\n"; return(EXIT_FAILURE); } #................................................................. } # Perl was built as shared library ####################### # Next sub test ####################### #................................................................. print ("amsg502: Removing $par_scratch_dir caches\n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); if ($error) { $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests. return(EXIT_FAILURE); } $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg504: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 0; #................................................................. # Careful! The -C should clean the cache $cmd = "$RUN_PP -C -o \"$hello_executable\" \"$hello_pl_file\" "; print ("\namsg505: About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg506:sub $test_name_string " . "cannot system $cmd\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return (EXIT_FAILURE); } print ("amsg508: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. # This, too, should clean the cache due to the -C flag. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg510: Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } $should_be_cache_dirs = 0 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg511: There should be no more than $should_be_cache_dirs " . "cache dirs\nbut there are $number_of_cache_dirs instead\n"; return(EXIT_FAILURE); } #................................................................. ####################### # Next sub test ####################### #................................................................. print ("amsg518: Removing $par_scratch_dir caches\n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); if ($error) { $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests. return(EXIT_FAILURE); } $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg520: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 1; #................................................................. $cmd = "$RUN_PP -C -o \"$hello_executable\" \"$hello_pl_file\" "; print ("\bamsg521: About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg522:sub $test_name_string " . "cannot system $cmd\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return (EXIT_FAILURE); } print ("amsg524: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg526: Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } #................................................................. $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg530: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } $should_be_cache_dirs = 0 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg532:There should be no more than $should_be_cache_dirs " . "cache dirs, \nbut there are $number_of_cache_dirs instead\n"; return(EXIT_FAILURE); } #................................................................. ####################### # Next sub test ####################### #................................................................. print ("amsg534: Removing $par_scratch_dir caches \n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); if ($error) { $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests. return(EXIT_FAILURE); } $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg536: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } print ("\namsg537: There are $left_over_cache_dirs cache dirs\n") if $verbose; #................................................................. if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) { # Perl was built as shared library, so the -d option is valid. #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 0; #................................................................. ################################################################### # Here, $ENV{PAR_GLOBAL_CLEAN} exists, so -C will do NOTHING!!! # Hence we will get a cache from the system command ################################################################### $cmd = "$RUN_PP -C -d -o \"$hello_executable\" \"$hello_pl_file\" "; print ("About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg538:sub $test_name_string " . "cannot system $cmd\n"; return (EXIT_FAILURE); } print ("amsg540: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. delete $ENV{PAR_GLOBAL_CLEAN}; ################################################################### # Here, $ENV{PAR_GLOBAL_CLEAN} does NOT exist, so -C WILL work!!! # Hence we will NOT get a cache from the piped command ################################################################### $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); $ENV{PAR_GLOBAL_CLEAN} = 0; if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg542: Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } #................................................................. $error = how_many_cache_dirs($par_scratch_dir, \$number_of_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg546: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } $should_be_cache_dirs = 1 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg548:There should be no more than $should_be_cache_dirs \n" . "cache dirs,\nbut there are $number_of_cache_dirs instead\n" . "\$left_over_cache_dirs is $left_over_cache_dirs\n"; return(EXIT_FAILURE); } #................................................................. } ####################### # Next sub test ####################### #................................................................. print ("amsg550: Removing $par_scratch_dir caches\n") if $verbose; $error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors); if ($error) { $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests. return(EXIT_FAILURE); } $error = how_many_cache_dirs($par_scratch_dir, \$left_over_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg552: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } print ("\namsg553: There are $left_over_cache_dirs cache dirs\n") if $verbose; #................................................................. $ENV{PAR_GLOBAL_CLEAN} = 1; # Since $ENV{PAR_GLOBAL_CLEAN} is 1, the -C should do NOTHING. #................................................................. #................................................................. if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) { # Perl was built as shared library, so the -d option is valid. #................................................................. $cmd = "$RUN_PP -C -d -o \"$hello_executable\" \"$hello_pl_file\" "; print ("About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose); if (system("$cmd")) { $$message_ref = "\namsg554:sub $test_name_string " . "cannot system $cmd\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return (EXIT_FAILURE); } print ("amsg556: sub $test_name_string did $cmd \n") if ($verbose); #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, "hello", $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg558: Did $cmd produce $hello_executable?\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests return ($error); } #................................................................. $error = how_many_cache_dirs($par_scratch_dir, \$number_of_cache_dirs, $message_ref, $verbose); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\namsg562: Error from call to how_many_cache_dirs\n"; $ENV{PAR_GLOBAL_CLEAN} = 0; return ($error); } $should_be_cache_dirs = 0 + $left_over_cache_dirs; if ($number_of_cache_dirs > $should_be_cache_dirs) { $$message_ref = "\namsg564:There should be no more than $should_be_cache_dirs " . "cache dirs, \nbut there are $number_of_cache_dirs instead\n"; return(EXIT_FAILURE); } $ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests #................................................................. return(EXIT_SUCCESS); #................................................................. } } ######################################################################### ######################################################################### sub pp_gui_tests { my ( $test_name_string, $os, $test_number, $test_dir, $orig_dir, $hello_pl_file, $hello_executable, $verbose, $message_ref, $no_win32_exe, ) = @_; #-------------------------------------------------------------------- # Goal: Test of 'pp --gui -o hello.exe hello.pl' # ---- # # Outline # ------- # . Create the file hello.pl with code that will print "hello". # . Build the out.exe with # pp --gui -o out.exe hello.pl # . Test the out.exe for gui. We can use Win32::Exe # itself to inspect the GUI of the resulting # exe, so the snippet below should do: # # my $exe = Win32::Exe->new('out.exe'); # is($exe->Subsystem, 'windows'); # Success if true in both cases, failure otherwise. # # # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $cmd = "$RUN_PP --gui -o $hello_executable $hello_pl_file"; my $sub_test = 0; my $file_to_copy = ""; my $exe = ""; my $FALSE = 0; my $test_file = $hello_pl_file; my $print_cannot_locate_message = $FALSE; print ("orig_dir is $orig_dir\n") if $verbose; #.......................................................... if ($os !~ m/^Win/i) { print ("Test $test_name_string not done on OS: $os\n"); return(EXIT_SUCCESS); } else { if ($no_win32_exe) { print ("Test $test_name_string not run because "); print ("Win32-Exe is not present\n"); return (EXIT_SUCCESS); } } #.......................................................... if (!(chdir("$test_dir"))) { $$message_ref = "\namsg566: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } if ($verbose) { print ("chdir to $test_dir\n"); } #................................................................. $error = create_file($test_file, "hello", $verbose, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\npgt_msg570: sub $test_name_string: $$message_ref"; return (EXIT_FAILURE); } #................................................................. if (system("$cmd")) { $$message_ref = "\namsg572: sub $test_name_string cannot system $cmd:$!:\n"; return (EXIT_FAILURE); } else { if ($verbose) { print ("sub $test_name_string did $cmd "); } } #................................................................. $exe = Win32::Exe->new($hello_executable); if ($exe->Subsystem ne 'windows') { $$message_ref = $$message_ref . "amsg576: sub $test_name_string " . ": exe->Subsystem is not windows\n"; return (EXIT_FAILURE) } return (EXIT_SUCCESS); #................................................................. } ######################################################################## sub create_small_minus_a_pl_file { my ($test_name_string, $sub_test, $verbose, $hello_pl_file, $modified_fqpn, $message_ref) = @_; $$message_ref = ""; my $error; if ($verbose) { print ("amsg580: sub create_small_minus_a_pl_file has \n"); print ("test_name_string is $test_name_string\n"); print ("sub_test is $sub_test\n"); print ("hello_pl_file is $hello_pl_file\n"); print ("modified_fqpn is $modified_fqpn\n"); } #...................................................................... my $pl_verbiage = '#!/usr/bin/perl' . "\n" . 'use PAR;' . "\n" . 'my $line;' . "\n" . "\n" . 'my $text = "";' . "\n" . '$text = PAR::read_file("' . quotemeta($modified_fqpn) . '");' . "\n" . "\n" . 'print($text);' . "\n" . "\n"; #...................................................................... $error = create_file($hello_pl_file, "", $verbose, $message_ref, $pl_verbiage); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg582: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } return(EXIT_SUCCESS); } ######################################################################### sub pp_test_small_minus_a { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test the small -a flag # ---- # # Outline # ------- # First Pass Outline # ------------------ # . Run two groups of tests, four total subtests # ........................................................................ # . my $text = PAR::read_file("a/small_a/text"); # . Test the above line to work with # pp -o hello.exe -a c:\a\small_a\text hello.pl # or # pp -o hello.exe -a c:/a/small_a/text hello.pl # or # pp -o hello.exe -a "c:/a/small_a/text;a/small_a/text" hello.pl # # . my $text = PAR::read_file("/a/small_a/text"); # . Test the above line to work with # pp -o hello.exe -a "c:/a/small_a/text;/a/small_a/text" hello.pl # ........................................................................ # # Detailed Outline # ---------------- # Note: "fqpn" means "fully qualified path name" # Examples: Assume the text file c:\a\small_a\text # $orig_fqpn = c:\a\small_a\text # This is the original fqpn # $forward_fqpn = c:/a/small_a/text # This is the original fqpn with forward slashes # $forward_with_slash_fqpn = /a/small_a/text # This is forward_fqpn with no drive letter or colon # $forward_no_slash_fqpn = a/small_a/text # This is forward_fqpn with no drive letter,colon or first slash # .............................................................. # Preliminary things to be done: # . Create the file $textfile, with a line of text ("hello"). # . Create $expected_results = "hello from open hello" # . Create (As shown in Examples just above) # . $orig_fqpn # . $forward_fqpn, # . $forward_with_slash_fqpn # . $forward_no_slash_fqpn # .................. # . Create hello.pl file to look like this: # my $text = PAR::read_file("$modified_fqpn"); # print($text); # .................. # # .............................................................. # First test group # . Obtain $modified_fqpn = $forward_no_slash_fqpn, # Test 1 # . system (pp -o hello.exe -a $orig_fqpn hello.pl); # . Run hello.exe # . Delete $textfile and run hello.exe again # . Copy to, and run, hello.exe from a different directory # # Test 2 # . Recreate $textfile # . system (pp -o hello.exe -a $forward_fqpn hello.pl); # . Run hello.exe # . Delete $textfile and run hello.exe again # . Copy to, and run, hello.exe from a different directory # # Test 3 # . Recreate $textfile # . system (pp -o hello.exe -a "$forward_fqpn;$forward_no_slash_fqpn" hello.pl); # . Run hello.exe # . Delete $textfile and run hello.exe again # . Copy to, and run, hello.exe from a different directory # # .............................................................. # Second test group # . Obtain $modified_fqpn = $forward_with_slash_fqpn, # Test 4 # . Make all of the slashes to be forward slashes. # . Recreate $textfile # . system (pp -o hello.exe -a "$forward_fqpn;$forward_with_slash_fqpn" hello.pl); # . Run hello.exe # . Delete $textfile and run hello.exe again # . Copy to, and run, hello.exe from a different directory # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $test_file = $hello_pl_file; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; my $message = ""; my $expected_results = "hello"; my $textfile = File::Spec->catdir($test_dir, "text"); my $orig_fqpn = $textfile; my $forward_fqpn; my $forward_with_slash_fqpn; my $forward_no_slash_fqpn; my $modified_fqpn; ($forward_fqpn = $textfile) =~ s!\\!\/!g; ($forward_with_slash_fqpn = $forward_fqpn) =~ s!^\w:!!; ($forward_no_slash_fqpn = $forward_with_slash_fqpn) =~ s!^\/!!; $modified_fqpn = $forward_no_slash_fqpn; #................................................................. if ($verbose) { $message = "\$textfile = $textfile\n" . "\$orig_fqpn = $orig_fqpn\n" . "\$forward_fqpn = $forward_fqpn\n" . "\$forward_with_slash_fqpn = $forward_with_slash_fqpn\n" . "\$forward_no_slash_fqpn = $forward_no_slash_fqpn\n" . "\$$modified_fqpn = $modified_fqpn\n" ; # print $message; } #................................................................. $$message_ref = ""; #................................................................. # Sub Test 1 #................................................................. #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg590: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($textfile, "", $verbose, $message_ref, "hello"); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg592: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $error = create_small_minus_a_pl_file ($test_name_string, $sub_test, $verbose, $hello_pl_file, $modified_fqpn, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg594: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -o $hello_executable -a \"$orig_fqpn\" hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg596: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $textfile, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. #................................................................. # Sub Test 2 #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg598: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($textfile, "", $verbose, $message_ref, "hello"); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg600: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -o $hello_executable -a \"$forward_fqpn\" hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg602: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $textfile, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR2, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. #................................................................. # Sub Test 3 #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg604: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($textfile, "", $verbose, $message_ref, "hello"); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg606: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -o $hello_executable -a \"$forward_fqpn;$forward_no_slash_fqpn\" hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg608: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $textfile, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR3, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. #................................................................. # Second test group # Sub Test 4 #................................................................. $modified_fqpn = $forward_with_slash_fqpn; #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg610: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($textfile, "", $verbose, $message_ref, "hello"); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg614: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $error = create_small_minus_a_pl_file ($test_name_string, $sub_test, $verbose, $hello_pl_file, $modified_fqpn, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg616: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -o $hello_executable -a \"$forward_fqpn;$forward_with_slash_fqpn\" hello.pl"; if (system("$cmd")) { $$message_ref = "\namsg618: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $textfile, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR4, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. #................................................................. return (EXIT_SUCCESS); #................................................................. } ######################################################################## sub create_large_minus_a_pl_file { my ($test_name_string, $sub_test, $verbose, $hello_pl_file, $all_text_files, $message_ref) = @_; $$message_ref = ""; my $error; if ($verbose) { print ("amsg630: sub create_large_minus_a_pl_file has \n"); print ("test_name_string is $test_name_string\n"); print ("sub_test is $sub_test\n"); print ("hello_pl_file is $hello_pl_file\n"); print ("all_text_files is $all_text_files\n"); } $all_text_files =~ s!^\w:!!; $all_text_files =~ s!^\\!!; $all_text_files =~ s!\\\\!\/!g; #...................................................................... my $pl_verbiage = '#!/usr/bin/perl -w' . "\n" . "\n" . 'use PAR;' . "\n" . 'use strict;' . "\n" . "\n" . 'my @files = split "[\r\n]+", PAR::read_file("' . quotemeta($all_text_files) . '");' . "\n" . "\n" . 'my $file = "";' . "\n" . 'my $text = "";' . "\n" . 'my $accumulated_text = "";' . "\n" . 'foreach $file (@files) {' . "\n" . ' $file =~ s!^\w:!!; ' . "\n" . ' $file =~ s!^\\\\!!;' . "\n" . ' $file =~ s!\\\\!\/!g;' . "\n" . ' $file =~ s!^\\/!!g;' . "\n" . "\n" . ' $text = PAR::read_file("$file");' . "\n" . ' chomp($text);' . "\n" . ' $accumulated_text = $accumulated_text . $text;' . "\n" . '}' . "\n" . 'print $accumulated_text;' ; #...................................................................... $error = create_file($hello_pl_file, "", $verbose, $message_ref, $pl_verbiage); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg632: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } print ("\namsg634: sub create_large_minus_a_pl_file was successful\n") if $verbose; return(EXIT_SUCCESS); } ######################################################################### sub pp_test_large_minus_A { my ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, $message_ref, ) = @_; #-------------------------------------------------------------------- # Goal: Test the large -A flag # ---- # First Pass Outline # ------------------ # ........................................................................ # . my $text = PAR::read_file("path/list_file"); # . Test the above line to work with # pp -o hello.exe -A list_file -a list_file hello.pl # or # pp -o hello.exe -A c:\path\list_file -a c:\path\list_file hello.pl # or # pp -o hello.exe -A c:/path/list_file -a c:\path\list_file hello.pl # Note for PAR::read_file("path/list_file"): "path" does NOT # contain the drive letter, colon or leading slash!!! # ........................................................................ # # # Outline # ------- # . Create the files (text1, text2) with a different line of # text ("hello01", "hello02") in each. # . Create a fourth text file, all_text_files, and # list the full path names of the first two files in it. # # . Create the file hello.pl that will # . PAR::read_file the file all_text_files and get the names # of the two files. # . For each of the two files, # . Strip any leading drive letter and colon # . Strip any leading back slash. # . Convert remaining back slashes to forward slashes # . PAR::read_file the file and get it's contents. # . Print the acumulated contents # # . system (pp -o hello.exe -A list_file -a list_file hello.pl) # . Run hello # . Delete all text files. # . Run hello again # . Copy hello to a different directory and run it again # # . system (pp -o hello.exe -A c:\path\list_file -a c:\path\list_file hello.pl) # . Run hello # . Delete all text files. # . Run hello again # . Copy hello to a different directory and run it again # # . system (pp -o hello.exe -A c:/path/list_file -a c:/path/list_file hello.pl) # . Run hello # . Delete all text files. # . Run hello again # . Copy hello to a different directory and run it again # #-------------------------------------------------------------------- my $error = EXIT_FAILURE; my $test_file = $hello_pl_file; my $pipe_command_string = ""; my $cmd = ""; my $sub_test = 0; my $print_cannot_locate_message = $FALSE; my $all_text_files = "all_text_files"; my $all_text_files_fqpn = File::Spec->catdir($test_dir, $all_text_files); my $expected_results = "hello01hello02"; # Note: The fully qualified path name must be given for PAR::read_file my $textfile01 = File::Spec->catdir($test_dir, "text01"); my $textfile02 = File::Spec->catdir($test_dir, "text02"); my $all_text_files_verbiage = "$textfile01\n$textfile02\n"; #................................................................. $$message_ref = ""; #................................................................. if (!(chdir("$test_dir"))) { $$message_ref = "\namsg638: sub $test_name_string cannot " . "chdir $test_dir\n:$!:\n"; return (EXIT_FAILURE); } #................................................................. $error = create_file($textfile01, "", $verbose, $message_ref, "hello01"); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg640: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $error = create_file($textfile02, "", $verbose, $message_ref, "hello02"); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg642: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $error = create_file( $all_text_files_fqpn, "", $verbose, $message_ref, "$textfile01\n$textfile02", ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg644 sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $error = create_large_minus_a_pl_file ($test_name_string, $sub_test, $verbose, $hello_pl_file, $all_text_files, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg646: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -o $hello_executable -A $all_text_files " . " -a $all_text_files " . " $hello_pl_file"; print ("\namsg648: About to system $cmd\n") if $verbose; if (system("$cmd")) { $$message_ref = "\namsg649: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $all_text_files, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. # Sub Test #................................................................. $error = create_large_minus_a_pl_file ($test_name_string, $sub_test, $verbose, $hello_pl_file, $all_text_files_fqpn, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg650: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $error = create_file( $all_text_files_fqpn, "", $verbose, $message_ref, "$textfile01\n$textfile02", ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg652 sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $cmd = "$RUN_PP -o $hello_executable -A \"$all_text_files_fqpn\" " . " -a \"$all_text_files_fqpn\" " . " $hello_pl_file"; print ("\namsg654: About to system $cmd\n") if $verbose; if (system("$cmd")) { $$message_ref = "\namsg656: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $all_text_files_fqpn, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. #................................................................. # Sub Test #................................................................. $error = create_large_minus_a_pl_file ($test_name_string, $sub_test, $verbose, $hello_pl_file, $all_text_files_fqpn, $message_ref); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg658: sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $error = create_file( $all_text_files_fqpn, "", $verbose, $message_ref, "$textfile01\n$textfile02", ); if ($error == EXIT_FAILURE) { $$message_ref = "\namsg670 sub $test_name_string: " . $$message_ref; return (EXIT_FAILURE); } #................................................................. $all_text_files_fqpn =~ s!\\!\/!g; $cmd = "$RUN_PP -o $hello_executable -A \"$all_text_files_fqpn\" " . " -a \"$all_text_files_fqpn\" " . " $hello_pl_file"; print ("\namsg672: About to system $cmd\n") if $verbose; if (system("$cmd")) { $$message_ref = "\namsg674: sub $test_name_string cannot system $cmd\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command ( $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. print ("About to remove a file and try executable again\n") if ($verbose); $error = remove_file_and_try_executable_again ( $all_text_files_fqpn, $test_number, $sub_test++, $test_name_string, $test_dir, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); if ($error == EXIT_FAILURE) { return ($error); } #................................................................. print ("About to test in a different subdir\n") if ($verbose); $error = test_in_further_subdir ( $test_number, $sub_test++, $test_name_string, $test_dir, $SUBDIR1, $pipe_command_string, $hello_executable, $expected_results, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. if ($error == EXIT_FAILURE) { $$message_ref = $$message_ref . "\nDid $cmd produce $hello_executable?\n"; return ($error); } #................................................................. #................................................................. return ($error); #................................................................. } ######################################################################### ######################################################################### ##################### Beginning - Start of Main ######################### ######################################################################### my $startdir = ""; my $answer = ""; my $orig_dir = cwd; my $test_name_string = ""; my $test_number = 1; my $error = EXIT_SUCCESS; my $message = ""; my $test_dir = ""; my $verbose = ""; my $debug_log = ""; my $debug = $FALSE; GetOptions( "verbose" => \$verbose, "debug" => \$debug, "startdir=s" => \$startdir, "perl_location=s" => \$PERL, "par_location=s" => \$PAR, "pp_location=s" => \$PP, ); $verbose = 0 if (!defined($verbose) or ($verbose eq "")); $PERL ||= $^X; if (!(-e($PERL))) { print ("The perl executable \"$PERL\" does not exist\n"); exit(EXIT_FAILURE); } ############################################################### # Examples for Posix os, hostname, release, version, hardware # # Example from Unix: # os FreeBSD, # hostname my_machine_name # release 4.3-RELEASE # version FreeBSD 4.3-RELEASE #0: Sat Apr # hardware i386 # Example from windows 2000: # os Windows NT # hostname my_machine_name # release 5.0 # version Build 2195 (Service Pack 2) # hardware x86 # # os examples: could match Win, CYGWIN_NT, FreeBSD, SunOS, Linux # ############################################################### if (!$PAR) { foreach my $dir ( split(/\Q$Config{path_sep}\E/, $ENV{PATH}) ) { $PAR = File::Spec->catfile($dir, 'par.pl'); last if -f $PAR; } } if (!(-f($PAR))) { print ("amsg5000: The par executable \"$PAR\" does not exist\n"); exit(EXIT_FAILURE); } $RUN_PP = "\"$PERL\" \"$PP\""; $RUN_PAR = "\"$PERL\" \"$PAR\""; my $_out = $Config{_exe} || '.out'; my $hello_pl_file = "hello.pl"; my $foo_pl_file = "foo.pl"; my $bar_pl_file = "bar.pl"; my $hello_par_file_with_dot_par = "hello.par"; my $hello_par_file_no_dot_par = "hello"; my $a_default_dot_par = "a.par"; my $a_default_executable = "a$_out"; my $hello_executable = "hello$_out"; my $foo_executable = "foo$_out"; my $bar_executable = "bar$_out"; if ($startdir eq "") { $startdir = File::Spec->catdir($orig_dir, 'pp_switch_tests'); } File::Path::rmtree([$startdir]) if -d $startdir; # Clean up after us. END { chdir(File::Spec->tmpdir); File::Path::rmtree([$startdir]); } if ($debug) { # Open up a debug log to log the tests that passed $debug_log = File::Spec->catfile($startdir, "debug.log"); if(!(open (DEBUG, ">$debug_log"))) { die ("Cannot open debug log $debug_log:$!:\n"); } } #SKIP: { # $test_number = 31; # skip("Skipping tests for brevity " . "$test_number \n", 30); ########################### Next Test 001 ################################## $test_name_string = "pp_hello_1"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_hello_1( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 002 ################################## $test_name_string = "pp_minus_o_hello_hello_dot_pl"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_o_hello_hello_dot_pl ($test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, \$message); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 003 ################################## $test_name_string = "pp_minus_o_foo_foo_dot_pl_bar_dot_pl"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_o_foo_foo_dot_pl_bar_dot_pl ( $test_name_string, $os, $test_number, $test_dir, $foo_pl_file, $bar_pl_file, $foo_executable, $bar_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 004 ################################## $test_name_string = "pp_minus_p_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_p_hello ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_dot_par, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 005 ################################## $test_name_string = "pp_minus_p_minus_o_hello_dot_par_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_p_minus_o_hello_dot_par_hello ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_par_file_with_dot_par, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 006 ################################## $test_name_string = "pp_minus_o_hello_file_dot_par"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_o_hello_file_dot_par ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_par_file_with_dot_par, $hello_par_file_no_dot_par, $hello_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 007 ################################## $test_name_string = "pp_minus_S_minus_o_hello_file"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_S_minus_o_hello_file ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_par_file_with_dot_par, $hello_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 008 ################################## $test_name_string = "pp_minus_p_minus_o_out_dot_par_file"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_p_minus_o_out_dot_par_file ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 009 ################################## $test_name_string = "pp_minus_B_with_small_minus_p_tests"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_B_with_small_minus_p_tests ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 010 ################################## $test_name_string = "pp_minus_B_with_large_minus_P_tests"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_B_with_large_minus_P_tests ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 011 ################################## $test_name_string = "pp_minus_e_print_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_e_print_hello ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 012 ################################## $test_name_string = "pp_minus_p_minus_e_print_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_p_minus_e_print_hello ( $test_name_string, $os, $test_number, $test_dir, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 013 ################################## $test_name_string = "pp_minus_P_minus_e_print_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_P_minus_e_print_hello ( $test_name_string, $os, $test_number, $test_dir, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 014 ################################## $test_name_string = "pp_minus_c_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_c_hello ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 015 ################################## $test_name_string = "pp_minus_x_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_x_hello ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); print ("\n\n"); # To get by some "hello" print outs that interfere ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 016 ################################## $test_name_string = "pp_minus_n_minus_x_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_n_minus_x_hello ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); print ("\n\n"); # To get by some "hello" print outs that interfere ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 017 ################################## $test_name_string = "pp_minus_I_foo_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_I_foo_hello ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 018 ################################## $test_name_string = "pp_minus_I_foo_minus_I_bar_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_I_foo_minus_I_bar_hello ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 019 ################################## $test_name_string = "pp_minus_lib_foo_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_lib_foo_hello ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 020 ################################## $test_name_string = "pp_minus_lib_foo_minus_lib_bar_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_lib_foo_minus_lib_bar_hello ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 021 ################################## $test_name_string = "pp_minus_M_foo_hidden_print_foo"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_M_foo_hidden_print_foo ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 022 ################################## $test_name_string = "pp_minus_M_foo_minus_M_bar_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_M_foo_minus_M_bar_hello ( $test_name_string, $os, $test_number, $test_dir, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 023 ################################## $test_name_string = "pp_minus_X_module_foo"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_X_module_foo ( $test_name_string, $os, $test_number, $test_dir, $foo_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 024 ################################## $test_name_string = "pp_minus_r_hello"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_r_hello ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 025 ################################## $test_name_string = "pp_minus_r_hello_a_b_c"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_r_hello_a_b_c ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 026 ################################## $test_name_string = "pp_hello_to_log_file"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_hello_to_log_file ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 027 ################################## $test_name_string = "pp_name_four_ways"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_name_four_ways ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 028 ################################## $test_name_string = "pp_minus_v_tests"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_v_tests ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $a_default_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 029 ################################## $test_name_string = "pp_minus_V"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_minus_V ( $test_name_string, $os, $test_number, $test_dir, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 030 ################################## $test_name_string = "pp_help_tests"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_help_tests ( $test_name_string, $os, $test_number, $test_dir, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); # } # SKIP ########################### Next Test 031 ################################## $test_name_string = "test_par_clean"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = test_par_clean ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); # XXX TODO: { todo_skip("Not yet clean", 1); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); } ########################### Next Test 032 ################################## $test_name_string = "pp_gui_tests"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_gui_tests ( $test_name_string, $os, $test_number, $test_dir, $orig_dir, $hello_pl_file, $hello_executable, $verbose, \$message, $no_win32_exe, ); after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 033 ################################## $test_name_string = "pp_test_small_minus_a"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_test_small_minus_a ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ########################### Next Test 034 ################################## $test_name_string = "pp_test_large_minus_A"; $error = prior_to_test($test_number, $startdir, $os, \$test_dir, $verbose, \$message); if ($error == EXIT_FAILURE) { $message = "\nCannot run test $test_name_string due to\n" . "prior_to_test: Test $test_number : $message\n"; die($message); } if ($verbose) { print ("About to run test $test_number: $test_name_string "); print ("in directory $test_dir\n"); } $error = pp_test_large_minus_A ( $test_name_string, $os, $test_number, $test_dir, $hello_pl_file, $hello_executable, $verbose, \$message, ); if ($debug) { if ($error) { print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n"); print DEBUG ("$message\n"); } else { print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n"); } } after_test($test_number++, $error, $message, $verbose); ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message"); print ("\n\n\n") if ($error == EXIT_FAILURE); ######################################################################## if ($debug) { close(DEBUG) or die ("At end of test: Cannot close file $debug_log:$!:\n"); } PAR-Packer-1.041/contrib/automated_pp_test/pipe_a_command.pm0000644000175000017500000001546113026021203024172 0ustar roderichroderich#!/usr/bin/perl -w ######################################################################## # Copyright 2004 by Malcolm Nooning # This program does not impose any # licensing restrictions on files generated by their execution, in # accordance with the 8th article of the Artistic License: # # "Aggregation of this Package with a commercial distribution is # always permitted provided that the use of this Package is embedded; # that is, when no overt attempt is made to make this Package's # interfaces visible to the end user of the commercial distribution. # Such use shall not be construed as a distribution of this Package." # # Therefore, you are absolutely free to place any license on the resulting # executable(s), as long as the packed 3rd-party libraries are also available # under the Artistic License. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # See F. # # ######################################################################## # ######################################################################## our $VERSION = '0.07'; ######################################################################## # Usage: # $error = # pipe_a_command( # $test_number, # $sub_test, # $test_name_string, # $test_dir, # $command_string, # e.g. "pp -I", or maybe empty "" # $executable_name, # $expected_result, # e.g. "hello" # $os, # $verbose, # $message_ref, # ); # # $error will be one of POSIX (EXIT_SUCCESS EXIT_FAILURE) # ######################################################################## # Outline # ------- # . chdir to the test directory # . Pipe executable and collect the result. # . Compare the result with the expected result. # . Report back success or failure. ######################################################################## # package pipe_a_command; use Exporter; @ISA = qw(Exporter); @EXPORT = ("pipe_a_command"); use POSIX qw(EXIT_SUCCESS EXIT_FAILURE); use File::Copy; use Cwd qw(chdir cwd); use strict; ######################################################################## sub pipe_a_command { my ( $test_number, $sub_test, $test_name_string, $directory, $command_string, $executable_name, $expected_result, $os, $verbose, $message_ref, $print_cannot_locate_message, ) = @_; my $results = ""; my $cwd1 = cwd; my $cwd2; my $cmd = ""; my $log_file = "log_file_from_pipe"; my $stdline = ""; #................................................................. if (!(chdir("$directory"))) { $$message_ref = "\n\[405\]" . "sub $test_name_string cannot chdir $directory\n:$!:\n"; return (EXIT_FAILURE); } $cwd2 = cwd; if ($verbose) { print ("pipe_a_command started in dir $cwd1\n"); print ("but is now in $cwd2\n"); } #................................................................. if ($os !~ m/^Win/i) { if ($executable_name ne "") { if (!(chmod (0775, "$executable_name"))) { $$message_ref = "\n\[410\]sub $test_name_string cannot " . "chmod file $executable_name\n"; return (EXIT_FAILURE); } } $executable_name = './' . $executable_name; } $cmd = "$command_string $executable_name"; #................................................................. ################################################################# # Open up a log file to hold the data. Then send the $cmd to # a pipe. Capture the stdout and stderr of the pipe and # print it to the log file. ################################################################# if (!(open (PIPE_LOGFILE, ">$log_file"))){ $$message_ref = "\n\[415\]sub $test_name_string cannot " . "open $log_file\n"; return (EXIT_FAILURE); } if ($print_cannot_locate_message) { print PIPE_LOGFILE ("\nThe Line Below SHOULD BE \"Can\'t locate \.\.\. "); print PIPE_LOGFILE (" along with a \"BEGIN failed \.\.\. \" line\n"); if ($verbose) { print ("\nThe Line Below SHOULD BE \"Can\'t locate \.\.\. "); print (" along with a \"BEGIN failed \.\.\. \" line\n"); } } if (!(open (CMD_STDOUT_AND_STDERR, "$cmd 2>&1 |"))){ close(PIPE_LOGFILE); $$message_ref = "\n\[420\]sub $test_name_string cannot " . "open a pipe for $cmd 2>&1 |\n"; return (EXIT_FAILURE); } # Take in any STDOUT and STDERR that "cmd" might cause while ($stdline = ) { print PIPE_LOGFILE $stdline; if ($verbose) { print $stdline; } } # Close before copying it to force an output flush. close(PIPE_LOGFILE); close(CMD_STDOUT_AND_STDERR); #................................................................ # Slurp in the results to a single scaler. if (open (FH, "$log_file")) { # Slurp in all the lines of the file at once local $/; $results = ; if (!(close(FH))) { $$message_ref = "Something is wrong with test $test_name_string " . "in directory $cwd1\n" . "File $log_file exists, and I opened it, " . "but now I cannot close it.\n" . "Cannot continue with test $test_name_string\n"; return (EXIT_FAILURE); } } else { $$message_ref = "Something is wrong with test $test_name_string " . "in directory $cwd1\n" . "File $log_file exists but I cannot open it.\n" . "Cannot continue with test $test_name_string\n"; return (EXIT_FAILURE); } #..................................................................... chomp($results); if ($verbose) { print ("\n\[415\]Test ${test_number}_${sub_test}: Directory "); print ("$directory, sub $test_name_string: \n"); print ("Result of $cmd was: \n"); print ("$results\n"); } #................................................................. if ($results !~ m/$expected_result/) { $$message_ref = "\n\[430\]\n" . "Test ${test_number}_${sub_test} " . "The command string \"$command_string $executable_name \" " . "in directory $directory," . "did not produce :: \"$expected_result\" ::\n" . "Instead, it produced :: $results ::\n" . "End of [430] results \n"; return (EXIT_FAILURE); } #................................................................. return (EXIT_SUCCESS); } PAR-Packer-1.041/contrib/automated_pp_test/hello_tk.pl0000644000175000017500000000410313026021203023026 0ustar roderichroderich#!/usr/bin/perl -w ######################################################################## # Copyright 2004 by Malcolm Nooning # This program does not impose any # licensing restrictions on files generated by their execution, in # accordance with the 8th article of the Artistic License: # # "Aggregation of this Package with a commercial distribution is # always permitted provided that the use of this Package is embedded; # that is, when no overt attempt is made to make this Package's # interfaces visible to the end user of the commercial distribution. # Such use shall not be construed as a distribution of this Package." # # Therefore, you are absolutely free to place any license on the resulting # executable(s), as long as the packed 3rd-party libraries are also available # under the Artistic License. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # See F. # # ######################################################################## our $VERSION = 0.02; use POSIX qw (EXIT_SUCCESS EXIT_FAILURE); use Tk; ######################################################################### sub okay_response { my ($we_top) = @_; $we_top->destroy; } ######################################################################### sub say_hello { my $message = "hello"; #............................................. my $okay_button; my $we_top = new MainWindow; $we_top->title("Hello"); $we_top->Label ( -text => $message . "\n", -justify => 'left', )->pack(); #..................................................................... $okay_button = $we_top->Button( -text => 'Okay', -command => [ \&okay_response, $we_top, ] )->pack; #..................................................................... ######### MainLoop; ######### } ######################################################################### say_hello; PAR-Packer-1.041/contrib/automated_pp_test/test_in_further_subdir.pm0000644000175000017500000001032113026021203026001 0ustar roderichroderich#!/usr/bin/perl -w ######################################################################## # Copyright 2004 by Malcolm Nooning # This program does not impose any # licensing restrictions on files generated by their execution, in # accordance with the 8th article of the Artistic License: # # "Aggregation of this Package with a commercial distribution is # always permitted provided that the use of this Package is embedded; # that is, when no overt attempt is made to make this Package's # interfaces visible to the end user of the commercial distribution. # Such use shall not be construed as a distribution of this Package." # # Therefore, you are absolutely free to place any license on the resulting # executable(s), as long as the packed 3rd-party libraries are also available # under the Artistic License. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # See F. # ## ######################################################################## our $VERSION = '0.07'; ######################################################################## my $TRUE = 1; my $FALSE = 0; ######################################################################### ######################################################################## # Usage: # $error = # test_in_further_subdir( # $test_number, # $sub_test, # $test_name_string, # $test_dir, # $further_subdir, # e.g. $SUBDIR1, 2, 3 or 4 # $command_string, # e.g. "pp -I", or maybe empty "" # $executable_name, # e.g. $a_default_executable # $expected_result, # e.g. "hello" # $os, # $verbose, # \$message, # ); # # $error will be one of POSIX (EXIT_SUCCESS EXIT_FAILURE) # ######################################################################## # Outline # ------- # . Copy the executable to a different subdirectory # . chdir to the new subdirectory # . Pipe executable and collect the result. # . Compare the result with the expected result. # . Report back success or failure. ######################################################################## # package test_in_further_subdir; use Exporter; @ISA = qw(Exporter); @EXPORT = ("test_in_further_subdir"); use POSIX qw(EXIT_SUCCESS EXIT_FAILURE); use File::Copy; use Cwd qw(chdir); use pipe_a_command; use strict; ######################################################################## sub test_in_further_subdir { my ( $test_number, $sub_test, $test_name_string, $test_dir, $further_subdir, $command_string, $executable_name, $expected_result, $os, $verbose, $message_ref, $print_cannot_locate_message, ) = @_; my $final_subdir = ""; my $final_executable = ""; my $results_copied = ""; my $error = EXIT_FAILURE; #................................................................. # Copy created executable to a different directory and make sure # it executes from there. $final_subdir = $test_dir . "/$further_subdir"; $final_executable = $final_subdir . "/$executable_name"; if(!(copy("$executable_name", "$final_executable"))) { $$message_ref = "\n\[300\]sub $test_name_string: " . "cannot copy $executable_name to $final_subdir\n"; return (EXIT_FAILURE); } #................................................................. $error = pipe_a_command( $test_number, $sub_test, $test_name_string, $final_subdir, $command_string, $executable_name, $expected_result, $os, $verbose, $message_ref, $print_cannot_locate_message, ); #................................................................. return ($error); #................................................................. } PAR-Packer-1.041/contrib/automated_pp_test/prior_to_test.pm0000644000175000017500000001652213026021203024132 0ustar roderichroderich#!/usr/bin/perl -w ######################################################################## # Copyright 2004 by Malcolm Nooning # This program does not impose any # licensing restrictions on files generated by their execution, in # accordance with the 8th article of the Artistic License: # # "Aggregation of this Package with a commercial distribution is # always permitted provided that the use of this Package is embedded; # that is, when no overt attempt is made to make this Package's # interfaces visible to the end user of the commercial distribution. # Such use shall not be construed as a distribution of this Package." # # Therefore, you are absolutely free to place any license on the resulting # executable(s), as long as the packed 3rd-party libraries are also available # under the Artistic License. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # See F. # # ######################################################################## our $VERSION = '0.06'; ######################################################################## # Usage: # $error = # prior_to_test($test_number, # $startdir, # $os, # \$test_sub_dir_to_use_this_test, # $verbose, # \$message); # # $error will be one of POSIX (EXIT_SUCCESS EXIT_FAILURE) # ######################################################################## # Outline # ------- # . chdir to the base directory. # . Decide which of three possible sub dirs to wipe out, # which will be tempn where the 'n' is test number mod 3. # . Wipe out the temp dir and all it's files and sub dirs # . Recreate the temp dir and four further sub dirs. # . Assign the temp dir name (the one used by the caller) # to be passed back up. # ######################################################################## # # There are three temp directories used so that we can inspect prior # test results if there is a crash, as well as the current test # results. The rationale is that it may be helpful to know what # we were doing prior to the present test. There should never be # a relationship, but, ... # ######################################################################## package prior_to_test; use Exporter; @ISA = qw(Exporter); @EXPORT = ("prior_to_test"); use POSIX qw(EXIT_SUCCESS EXIT_FAILURE); use File::Path; use File::Find; use Cwd qw(cwd); use strict; ############################################################## # The find command does not seem to like globals. Hence # the need for these two globals. my @global_files = (); my @global_dirs = (); ############################################################## # This sub is used in conjunction with the perl "find" module. sub push_to_file_or_dir_array { my $file_or_dir = $File::Find::name; return if ($file_or_dir =~ /^\.+$/); if (-d($file_or_dir)) { if ($file_or_dir =~ m/\w+/) { push (@global_dirs, ($file_or_dir)); } } else { push (@global_files, ($file_or_dir)); } } ######################################################################## sub remove_windows_tree { my ($test_sub_dir, $message_ref) = @_; my $file; my $dir; my $MAX_FILES_TO_DELETE = 100; my $actual_num_files = 0; my $cwd = cwd; $$message_ref = ""; # There should never be more than just files, or at most # files and subdirectories that contain no further # subdirectories. Thus we can use the find command without # using up too much ram. @global_files = (); @global_dirs = (); find(\&push_to_file_or_dir_array, ($test_sub_dir)); #.................................................................... # Before we start deleting files, make sure there are less than, oh, # some small number. There is not supposed to be many files or # directories. We can up the number if we need to but we want to # prevent an inadvertant disaster. $actual_num_files = @global_files; if ($actual_num_files >= $MAX_FILES_TO_DELETE) { # Ouch. Something is wrong $$message_ref = "ptt_055: " . "In preparation for a test, I am not permitted " . "to delete more than $MAX_FILES_TO_DELETE files\n" . "however, there are $actual_num_files files to " . "be deleted. I will not do it.\n" . "Please research and fix\n"; return(EXIT_FAILURE); } #.................................................................... # Delete the files first. Then we can delete the dirs # without worring about whether or not they are empty. foreach $file (@global_files) { if (!(unlink ("$file"))) { $$message_ref = "ptt_060: " . "Cannot unlink $file:$!:\n"; return (EXIT_FAILURE); } } # Remove the last dir first foreach $dir (reverse @global_dirs) { if (!(rmdir($dir))) { $$message_ref = "ptt_065: " . "I am in dir $cwd and I " . "cannot rmdir $dir:$!:\n" . "Are you using it in another window?\n"; return (EXIT_FAILURE); } } return (EXIT_SUCCESS); } ######################################################################## sub prior_to_test { my ( $test_number, $base_directory, $os, $test_sub_dir_to_use_ref, $verbose, $message_ref, ) = @_; my $MODULUS = 3; my $temp_num = ($test_number % $MODULUS); my $error = EXIT_FAILURE; my $test_sub_dir = ""; my $permission = 509; # 509 decimal is octal 0775 my $further_subdir = ""; my @further_subdirs = qw(subdir1 subdir2 subdir3 subdir4); my $further_subdir_to_create = ""; $$message_ref = ""; chdir($base_directory); # Remove the test directory, if present, if ($os =~ m!^Win!i) { $test_sub_dir = $base_directory . "\\temp" . "$temp_num"; if (-e("$test_sub_dir")) { $error = remove_windows_tree($test_sub_dir, $message_ref); return $error if ($error == EXIT_FAILURE); } } else { $test_sub_dir = $base_directory . "/temp" . "$temp_num"; if (-e("$test_sub_dir")) { if (system("rm -rf \"$test_sub_dir\"")) { $$message_ref = ( "ptt_075: " . ":$!:$?:\n"); return (EXIT_FAILURE); } } } # mkpath assuming unix. Windows defaults to read/write itself. if (!(mkpath ("$test_sub_dir", 0, $permission))) { $$message_ref = "ptt_080: Cannot create dir $test_sub_dir:$!:\n"; return (EXIT_FAILURE); } $$test_sub_dir_to_use_ref = $test_sub_dir; #................................................................. # Create subdirs underneath our test_sub_dir, just in case #................................................................. foreach $further_subdir (@further_subdirs) { $further_subdir_to_create = $test_sub_dir . "/$further_subdir"; if (!(mkpath ("$further_subdir_to_create", 0, $permission))) { $$message_ref = "ptt_085: " . "Cannot create dir $further_subdir_to_create:$!:\n"; return (EXIT_FAILURE); } } #................................................................. return (EXIT_SUCCESS); } ######################################################################## 1; PAR-Packer-1.041/contrib/automated_pp_test/hi.ico0000644000175000017500000001307613026021203021775 0ustar roderichroderich@@((@€€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÃÏÛçóÿÿÿ//ÿSSÿkgÿÿ‹‹ÿ——ÿ££ÿ¯¯ÿ»»ÿÇÇÿÏÇÿÛÛÿççÿóóÿû÷++S77_CCkOOwWWcc‹oo—§‹‹³——¿§§Ï³³Û¿¿çÇÇïÏÏ÷S++_77kCCwOOƒ[[gg›ss§³‹‹¿——Ë££×¯¯ã»»ëÃÃûÓÓ/S/;_;GkGSwS_ƒ_kkw›wƒ§ƒ³›¿›§Ë§³×³¿ã¿ËïË×ûׇo——§§·³›ÃëÓÏ·ßÛÃë‹—o“£{Ÿ¯‡«»“·ÇŸËÛ³×ç¿ãóË o›{£‡¯·›Ã§Ï³Û#¿ç+Ëó7×ÿÿóÿÿëÿÿßÿÿÓÿÿÇÿÿ·ÿÿ£ÿÿ—ÿÿƒÿÿkÿÿKÿçç××ÃÇ··£§——‹‹wwggOS/3ëÿÿçÿÿßÿÿÓÿÿ»ÿÿ›ÿÿ?ÿÿó÷çëßßÓÓÇÇ»»³¯§§›——ww__GG33ÿÿ÷ÿÿçÿÿÛÿÿÇÿÿ»ÿÿ—ÿÿÿÿSïïãã××ËË¿¿³³££—“‹ƒ{{gk[[GK##óÿóßÿç×ÿ×ÃÿÏ»ÿ»£ÿ£‡ÿ‡gÿg7ÿ7 ÿóëã×Ë¿³§Ÿ“‡wog_SG7#÷óÿëëÿßßÿÓÓÿÃÃÿ¯¯ÿ››ÿ‹‹ÿwwÿggÿSSÿCCÿ//ÿÿGWgs‹—£¯»ÃÏÛçó|T›iº~Ù“ðªÿ$¶ÿHÂÿlÎÿÚÿ´æðððÜÜÜÈÈÈ´´´   €€€ÿÿÿÿÿÿÿÿÿÿÿÿ ÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ ÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ ÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚‚ÄÄÄÄÄ‚‚‚‚ÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚ÄÄÄÄÄ‚ÄÄÄÄÄÄÄ‚‚‚‚ÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚‚ÄÄ‚‚‚‚ÄÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚‚ÄÄ‚‚‚‚ÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚‚ÄÄÄ‚‚‚‚ÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚‚ÄÄÄÄÄ‚‚‚‚ÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚‚‚‚‚‚‚‚ÄÄ‚‚‚‚ÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚ÄÄÄÄÄÄ‚‚‚‚ÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚ÄÄÄÄ‚‚‚‚ÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚ÄÄ‚‚‚‚ÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚ÄÄÄ‚‚‚‚ÄÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚ÄÄÄ‚‚‚‚ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚ÄÄÄÄÄ‚ÄÄ‚‚‚‚ÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚Ä‚‚‚‚ÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚Ä‚‚‚‚ÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ‚‚Ä‚‚‚‚ÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÄÄÄÄÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀPAR-Packer-1.041/contrib/stdio/0000755000175000017500000000000013200634513016303 5ustar roderichroderichPAR-Packer-1.041/contrib/stdio/Stdio_readme.txt0000644000175000017500000000070713026021203021437 0ustar roderichroderichTk::Stdio is based on Tk::Stderr. This module provides an "on demand" console window, appearing only when standard IO is needed. As such, it is not just a PAR module, but is useful for any Perl executable generated without a normal DOS console. That could be a PAR package made with "pp -g" or a Perl script that intentionally closes the associated console to avoid having a DOS window hanging around. See the pod in the module for usage. Alan Stewart PAR-Packer-1.041/contrib/stdio/Stdio.pm0000644000175000017500000002554713026021203017730 0ustar roderichroderich##============================================================================== ## Tk::Stdio - capture program standard output and standard error, ## accept standard input ##============================================================================== ## Tk::Stdio is based on: ## ## Tk::Stderr - capture program standard error output ##============================================================================== require 5.006; package Tk::Stdio; use strict; use warnings; use vars qw($VERSION @ISA); ($VERSION) = q$Revision: 1.0 $ =~ /Revision:\s+(\S+)/ or $VERSION = "0.0"; use base qw(Tk::Derived Tk::MainWindow); use Tk::Text; use Tk::Frame; =pod =head1 NAME Tk::Stdio - capture standard output and error, accept standard input, display in separate window =head1 SYNOPSIS use Tk::Stdio; $mw = MainWindow->new->InitStdio; print "something\n"; ## goes to standard IO window print STDERR 'stuff'; ## likewise warn 'eek!'; ## likewise my $input = ; ## keyboard entry is in standard IO window my $char = getc; ## likewise =head1 DESCRIPTION This module captures the standard output or error of a program and redirects it to a read only text widget, which doesn't appear until necessary. When it does appear, the user can close it; it'll appear again when there is more output. Standard input can be entered in the widget, which becomes temporarily writable. =cut $Tk::Stdio::first_char = '1.0'; # 'line.char' set in READLINE or GETC ##============================================================================== ## Populate ##============================================================================== sub Populate { my ( $mw, $args ) = @_; my $private = $mw->privateData; $private->{ReferenceCount} = 0; $private->{Enabled} = 0; $mw->SUPER::Populate($args); $mw->withdraw; $mw->protocol( WM_DELETE_WINDOW => [ $mw => 'withdraw' ] ); my $f = $mw->Frame( Name => 'stderr_frame', )->pack( -fill => 'both', -expand => 1 ); my $text = $f->Scrolled( 'Text', -wrap => 'char', -scrollbars => 'oe', -state => 'disabled', -fg => 'white', -bg => 'black', -insertbackground => 'white', )->pack( -fill => 'both', -expand => 1 ); $text->bind( '