r1679 - in packages: . libpar-perl libpar-perl/branches
libpar-perl/branches/upstream libpar-perl/branches/upstream/current
libpar-perl/branches/upstream/current/contrib
libpar-perl/branches/upstream/current/contrib/automated_pp_test
libpar-perl/branches/upstream/current/contrib/docs
libpar-perl/branches/upstream/current/contrib/gui_pp
libpar-perl/branches/upstream/current/contrib/pare
libpar-perl/branches/upstream/current/contrib/procedural_pp
libpar-perl/branches/upstream/current/contrib/stdio
libpar-perl/branches/upstream/current/inc
libpar-perl/branches/upstream/current/inc/ExtUtils
libpar-perl/branches/upstream/current/inc/Module
libpar-perl/branches/upstream/current/inc/Module/Install
libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE
libpar-perl/branches/upstream/current/inc/Test
libpar-perl/branches/upstream/current/lib
libpar-perl/branches/upstream/current/lib/App
libpar-perl/branches/upstream/current/lib/App/Packer
libpar-perl/branches/upstream/current/lib/PAR
libpar-perl/branches/upstream/current/lib/PAR/Filter
libpar-perl/branches/upstream/current/myldr
libpar-perl/branches/upstream/current/package
libpar-perl/branches/upstream/current/script
libpar-perl/branches/upstream/current/t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Sat Dec 17 17:40:42 UTC 2005
Author: eloy
Date: 2005-12-17 17:40:04 +0000 (Sat, 17 Dec 2005)
New Revision: 1679
Added:
packages/libpar-perl/
packages/libpar-perl/branches/
packages/libpar-perl/branches/upstream/
packages/libpar-perl/branches/upstream/current/
packages/libpar-perl/branches/upstream/current/AUTHORS
packages/libpar-perl/branches/upstream/current/ChangeLog
packages/libpar-perl/branches/upstream/current/MANIFEST
packages/libpar-perl/branches/upstream/current/MANIFEST.SKIP
packages/libpar-perl/branches/upstream/current/META.yml
packages/libpar-perl/branches/upstream/current/Makefile.PL
packages/libpar-perl/branches/upstream/current/README
packages/libpar-perl/branches/upstream/current/SIGNATURE
packages/libpar-perl/branches/upstream/current/TODO
packages/libpar-perl/branches/upstream/current/contrib/
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/automated_pp_test.pl
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/hello_tk.pl
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/hi.ico
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/pipe_a_command.pm
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/prior_to_test.pm
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/remove_file_and_try_executable_again.pm
packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/test_in_further_subdir.pm
packages/libpar-perl/branches/upstream/current/contrib/docs/
packages/libpar-perl/branches/upstream/current/contrib/docs/where_is_it.txt
packages/libpar-perl/branches/upstream/current/contrib/docs/who_am_i.txt
packages/libpar-perl/branches/upstream/current/contrib/gui_pp/
packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp
packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp_readme.txt
packages/libpar-perl/branches/upstream/current/contrib/pare/
packages/libpar-perl/branches/upstream/current/contrib/pare/pare
packages/libpar-perl/branches/upstream/current/contrib/pare/pare_readme.txt
packages/libpar-perl/branches/upstream/current/contrib/procedural_pp/
packages/libpar-perl/branches/upstream/current/contrib/procedural_pp/pp_old
packages/libpar-perl/branches/upstream/current/contrib/stdio/
packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio.pm
packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio_readme.txt
packages/libpar-perl/branches/upstream/current/inc/
packages/libpar-perl/branches/upstream/current/inc/ExtUtils/
packages/libpar-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm
packages/libpar-perl/branches/upstream/current/inc/Module/
packages/libpar-perl/branches/upstream/current/inc/Module/Install.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/
packages/libpar-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/Base.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/Can.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/Fetch.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/Include.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/Makefile.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/Metadata.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/PAR.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE/
packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE/PAR.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/Win32.pm
packages/libpar-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm
packages/libpar-perl/branches/upstream/current/inc/Test/
packages/libpar-perl/branches/upstream/current/inc/Test/Builder.pm
packages/libpar-perl/branches/upstream/current/inc/Test/More.pm
packages/libpar-perl/branches/upstream/current/lib/
packages/libpar-perl/branches/upstream/current/lib/App/
packages/libpar-perl/branches/upstream/current/lib/App/Packer/
packages/libpar-perl/branches/upstream/current/lib/App/Packer/PAR.pm
packages/libpar-perl/branches/upstream/current/lib/PAR.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/
packages/libpar-perl/branches/upstream/current/lib/PAR/FAQ.pod
packages/libpar-perl/branches/upstream/current/lib/PAR/Filter.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/
packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bleach.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bytecode.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Obfuscate.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PatchContent.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PodStrip.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Heavy.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Packer.pm
packages/libpar-perl/branches/upstream/current/lib/PAR/Tutorial.pod
packages/libpar-perl/branches/upstream/current/myldr/
packages/libpar-perl/branches/upstream/current/myldr/Makefile.PL
packages/libpar-perl/branches/upstream/current/myldr/env.c
packages/libpar-perl/branches/upstream/current/myldr/file2c.pl
packages/libpar-perl/branches/upstream/current/myldr/internals.c
packages/libpar-perl/branches/upstream/current/myldr/main.c
packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.c
packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.h
packages/libpar-perl/branches/upstream/current/myldr/parlsig.pl
packages/libpar-perl/branches/upstream/current/myldr/sha1.c.PL
packages/libpar-perl/branches/upstream/current/myldr/static.c
packages/libpar-perl/branches/upstream/current/myldr/utils.c
packages/libpar-perl/branches/upstream/current/myldr/win32.coff
packages/libpar-perl/branches/upstream/current/myldr/win32.obj
packages/libpar-perl/branches/upstream/current/myldr/win32.res
packages/libpar-perl/branches/upstream/current/package/
packages/libpar-perl/branches/upstream/current/package/parl.nsi
packages/libpar-perl/branches/upstream/current/script/
packages/libpar-perl/branches/upstream/current/script/par.pl
packages/libpar-perl/branches/upstream/current/script/parl.pod
packages/libpar-perl/branches/upstream/current/script/pp
packages/libpar-perl/branches/upstream/current/script/tkpp
packages/libpar-perl/branches/upstream/current/t/
packages/libpar-perl/branches/upstream/current/t/1-basic.t
packages/libpar-perl/branches/upstream/current/t/2-pp.t
packages/libpar-perl/branches/upstream/current/t/hello.par
packages/libpar-perl/tags/
Log:
[svn-inject] Installing original source of libpar-perl
Added: packages/libpar-perl/branches/upstream/current/AUTHORS
===================================================================
--- packages/libpar-perl/branches/upstream/current/AUTHORS 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/AUTHORS 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,123 @@
+Here is a list of people and their CPAN id, extracted from the Changes
+file and the mailing list archives. These people have either submitted
+patches or suggestions, or their bug reports or comments have inspired
+the appropriate patches. Corrections, additions, deletions welcome:
+
+Abhijit Menon-Sen (AMS)
+Alan Stewart
+Alan Teague
+Alasdair Allan (AALLAN)
+Alvin Belden
+Andrew Lee
+Andy Balaam
+Andy Lester (PETDANCE)
+Antti Lankila
+Arthur Bergman (ABERGMAN)
+Ask Bjoern Hansen (ABH)
+Barrie Slaymaker (RBS)
+Barry Jaspan
+Bill Atkins (BATKINS)
+Brad Elliott
+Brigitte Jellinek
+Bruce Winter
+Chia-Liang Kao (CLKAO)
+Chip Salzenberg (CHIPS)
+Christian Schiefer
+Clayton O'Neill (CMO)
+Corey Goldberg
+Cosimo Streppone (COSIMO)
+D. Menzel
+Daniel Cohen-Laroque
+Daniel Shane (DSHANE)
+Darek Adamkiewicz (DADAMK)
+David Dyck
+David Romano
+Doug Gruber
+Doug Miles
+Edward S. Peschko
+Edward Wildgoose
+Eric Paulson
+Gerald Richter (GRICHTER)
+Germain Garand (GGARAND)
+Glenn Mabbutt
+H. Wade Minter
+Henrique Dias (HDIAS)
+Hirosi Taguti
+Iain Cass
+Iain Truskett (SPOON)
+Ilya Zakharevich (ILYAZ)
+Indy Singh
+Jan Dubois (JDB)
+Jeff Goff (JGOFF)
+Jerry Veldhuis
+Jesse Schoch
+Jesse Vincent (JESSE)
+Jody Belka (KNEW)
+Johan Lindstroem (JOHANL)
+John McMahon
+John Siracusa (JSIRACUSA)
+Jonathan Leffler (JOHNL)
+Joseph Landman
+Jouke Visser (JOUKE)
+Karl Forner
+Kieran J Broadfoot
+Lindsay Morris
+Luc Willems
+Malcolm Nooning
+Marcus Ramberg (MRAMBERG)
+Markus Jansen
+Martin Fabiani
+Martin Hosken (MHOSKEN)
+Matt Sergeant (MSERGEANT)
+Matthew Braid (MDBGRIZ)
+Matthew Riedel
+Mattia Barbon (MBARBON)
+Michael Goldberger
+Mike Campbell
+Mike Stok (MIKESTOK)
+Morbus Iff
+Murat Uenalan (MUENALAN)
+Nathan Byrd (NBYRD)
+Ned Konz (NEDKONZ)
+Nicholas Clark (NWCLARK)
+Nicolas FROMENT
+Nomota KIM
+Paritosh Tyagi
+Paul Miller
+Peter Klewinghaus
+Patrice Parmentier
+Patrick Whitney
+Phil Sallee
+Piotr Martyniuk
+PodMaster (PODMASTER)
+Rafael Garcia-Suarez (RGARCIA)
+Randal L. Schwartz (MERLYN)
+Randy Carpenter
+Randy W. Sims (RANDYS)
+Reini Urban
+Richard Soderberg (RSOD)
+Rick Fitzsimmons
+Rob Casey (ROBAU)
+Robert Allerstorfer
+Robert Creager (RCREAGER)
+Robert Wyrick
+Roderich Schupp (RSCHUPP)
+Ryan Briones
+Sascha Wuestemann
+Sim Lim Hai
+Simon Andrews
+Simon Cozens (SIMON)
+Sisyphus
+Steve Hay (SHAY)
+Stephen Pick
+TP Diffenbach
+Thomas Loo (TLOO)
+Thomas Rush
+Tim Conrow
+Tina Mueller (TINITA)
+Tom Pollard
+Tommy Butler
+Ton Hospel (THOSPEL)
+Uri Guttman (URI)
+Vladimir Yu. Tereshchenko
+Vincent Ladeuil
Added: packages/libpar-perl/branches/upstream/current/ChangeLog
===================================================================
--- packages/libpar-perl/branches/upstream/current/ChangeLog 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/ChangeLog 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,793 @@
+[Changes for 0.90 - November 25, 2005]
+
+* 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.
+
+[Changes for 0.89 - June 10, 2005]
+
+* 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.
+
+[Changes for 0.88 - June 7, 2005]
+
+* Bug Fixes
+
+ - Extracted .pl files should be loadable via the coderef-in- at 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.
+
+[Changes for 0.87 - January 31, 2005]
+
+* 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.
+
+[Changes for 0.86 - December 11, 2004]
+
+* 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.
+
+[Changes for 0.85 - July 2, 2004]
+
+* 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.
+
+[Changes for 0.83 - May 29, 2004]
+
+* 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.
+
+[Changes for 0.82 - May 24, 2004]
+
+* 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.
+
+[Changes for 0.81 - May 23, 2004]
+
+* 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.
+
+[Changes for 0.80 - March 17, 2004]
+
+* 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.
+
+
+[Changes for 0.79 - January 8, 2004]
+
+* 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.
+
+[Changes for 0.78 - January 7, 2004]
+
+* 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 ("/").
+
+[Changes for 0.77 - January 1, 2004]
+
+* 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.
+
+[Changes for 0.76 - October 28, 2003]
+
+* 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.
+
+[Changes for 0.75 - September 21, 2003]
+
+* 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.
+
+[Changes for 0.74 - August 20, 2003]
+
+* 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.
+
+[Changes for 0.73 - August 6, 2003]
+
+* 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.
+
+[Changes for 0.72 - August 2, 2003]
+
+* 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.
+
+[Changes for 0.71 - July 30, 2003]
+
+* 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.
+
+[Changes for 0.70 - July 29, 2003]
+
+* 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.
+
+[Changes for 0.69 - May 31, 2003]
+
+* 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.
+
+[Changes for 0.68 - May 26, 2003]
+
+* 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}.
+
+[Changes for 0.67 - April 1, 2003]
+
+* 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.
+
+[Changes for 0.66 - March 20, 2003]
+
+* 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.
+
+[Changes for 0.65 - March 9, 2003]
+
+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.
+
+[Changes for 0.64 - March 2, 2003]
+
+* 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.
+
+[Changes for 0.63 - February 6, 2003]
+
+* 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.
+
Added: packages/libpar-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libpar-perl/branches/upstream/current/MANIFEST 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/MANIFEST 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,75 @@
+AUTHORS
+ChangeLog
+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/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
+inc/ExtUtils/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/PAR.pm
+inc/Module/Install/PRIVATE.pm
+inc/Module/Install/PRIVATE/PAR.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Test/Builder.pm
+inc/Test/More.pm
+lib/App/Packer/PAR.pm
+lib/PAR.pm
+lib/PAR/FAQ.pod
+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/Heavy.pm
+lib/PAR/Packer.pm
+lib/PAR/Tutorial.pod
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
+META.yml
+myldr/env.c
+myldr/file2c.pl
+myldr/internals.c
+myldr/main.c
+myldr/Makefile.PL
+myldr/mktmpdir.c
+myldr/mktmpdir.h
+myldr/parlsig.pl
+myldr/sha1.c.PL
+myldr/static.c
+myldr/utils.c
+myldr/win32.coff
+myldr/win32.obj
+myldr/win32.res
+package/parl.nsi
+README
+script/par.pl
+script/parl.pod
+script/pp
+script/tkpp
+SIGNATURE Public-key signature (added by MakeMaker)
+t/1-basic.t
+t/2-pp.t
+t/hello.par
+TODO
Added: packages/libpar-perl/branches/upstream/current/MANIFEST.SKIP
===================================================================
--- packages/libpar-perl/branches/upstream/current/MANIFEST.SKIP 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/MANIFEST.SKIP 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,21 @@
+#defaults
+^\..*\.sw.$
+^myldr/Makefile$
+^myldr/Makefile\.old$
+^myldr/main.[^c].*$
+^myldr/x?static(?:.[^c].*)?$
+^myldr/my_.*$
+^myldr/perlxsi.c$
+^myldr/par(?:\.\w+)?$
+^myldr/sha1.[co]$
+^myldr/.*\.pdb$
+^package/parl-.*$
+^script/parl(?:\.(?!pod).+)?$
+^script/parldyn(?:\.(?!pod).+)?$
+^MANIFEST.bak$
+^Makefile$
+^Makefile.old$
+^blib/
+^pm_to_blib
+^blibdirs
+\B\.svn\b
Added: packages/libpar-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libpar-perl/branches/upstream/current/META.yml 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/META.yml 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,21 @@
+name: PAR
+version: 0.90
+abstract: Perl Archive Tookit
+author: Autrijus Tang (autrijus at autrijus.org)
+license: perl
+distribution_type: module
+requires:
+ perl: 5.6.0
+ File::Temp: 0.05
+ Compress::Zlib: 1.3
+ Archive::Zip: 1
+ Module::ScanDeps: 0.45
+ PAR::Dist: 0.06
+recommends:
+ Digest: 0
+ Module::Signature: 0.35
+no_index:
+ directory:
+ - contrib
+ - inc
+generated_by: Module::Install version 0.39
Added: packages/libpar-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libpar-perl/branches/upstream/current/Makefile.PL 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/Makefile.PL 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+
+use 5.006;
+use inc::Module::Install;
+
+name ('PAR');
+abstract ('Perl Archive Tookit');
+version_from('lib/PAR.pm');
+license ('perl');
+
+requires ('perl' => 5.006);
+requires ('File::Temp' => 0.05);
+requires ('Compress::Zlib' => ($^O eq 'MSWin32') ? 1.16 : 1.30);
+requires ('Archive::Zip' => 1.00);
+requires ('Module::ScanDeps' => 0.45);
+requires ('PAR::Dist' => 0.06);
+features (
+ 'Windows --icon and --info support' => [
+ -default => 0,
+ recommends ('Parse::Binary' => 0.04),
+ recommends ('Win32::Exe' => 0.04),
+ ],
+) if ($^O eq 'MSWin32');
+
+features (
+ 'Digital signature support' => [
+ -default => 0,
+ recommends ('Digest' => 0),
+ (
+ (eval { require Digest::SHA1; 1 } or
+ eval { require Digest::SHA; 1 } or
+ eval { require Digest::SHA::PurePerl; 1 }) ? () :
+ recommends( (can_cc() ? 'Digest::SHA' : 'Digest::SHA::PurePerl') => 0 )
+ ),
+ recommends ('Module::Signature' => 0.35),
+ ],
+) if (eval { require Crypt::OpenPGP; 1 } or can_run('gpg'));
+
+include('ExtUtils::AutoInstall');
+include_deps('Test::More');
+
+sign(1);
+auto_install_now( -default => 0 );
+no_index(directory => 'contrib');
+
+&Autrijus->write;
+&WriteAll;
+&Autrijus->fix;
Added: packages/libpar-perl/branches/upstream/current/README
===================================================================
--- packages/libpar-perl/branches/upstream/current/README 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/README 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,152 @@
+This is the README file for PAR, a toolkit to create and use perl scripts
+and modules stored inside compressed .par files.
+
+Please type "perldoc PAR" after installation to see the module usage
+information, and "perldoc PAR::FAQ" for frequently answered questions.
+
+For packing scripts with prerequisite modules into stand-alone scripts
+or executables (aka PerlApp, Perl2exe, or 'perlcc that works'), see
+"perldoc pp" and "perldoc tkpp".
+
+For running ".par" files directly, see "perldoc parl".
+
+To generate/execute self-contained perl scripts, see "perldoc par.pl".
+
+An extensive "Cross-Platform Packaging and Deployment with PAR" tutorial
+is available as "perldoc PAR::Tutorial". A slightly outdated version is
+also available online at <http://www.autrijus.org/par-tutorial/>.
+
+* Installation
+
+PAR uses the standard perl module install process:
+
+ cpansign -v # optional; see SIGNATURE for details
+ perl Makefile.PL
+ make # or 'nmake' on Win32
+ make test
+ make install
+
+If your system has a C compiler, or if somebody has built a PAR package for
+your architecture, the 'pp' tool and a stand-alone binary version of par.pl
+will be installed, so you can generate self-executable binaries like this:
+
+ pp -o foo.exe /home/test.pl
+
+* Binary installation with pre-built PAR files
+
+This distribution uses the Module::Install framework to offer
+pre-compiled, architecture-dependent PAR packages to save your
+compilation time. This process is completely automatic -- no
+actions are required on your part.
+
+However, if nobody has generated such a package for your architecture,
+you will see a short messages like this:
+
+ Fetching 'PAR-0.81-i386-freebsd-5.8.0.par' from www.cpan.org...
+ *** No installation package available for your architecture.
+ However, you may wish to generate one with 'make par' and send
+ it to <AUTRIJUS at cpan.org>, so other people on the same platform
+ can benefit from it.
+ *** Proceeding with normal installation...
+
+If you are on a platform where normal users do not have a C compiler
+installed (MSWin32, darwin, etc.), please follow the instruction above
+and mail the generated PAR package (or more preferably, a URL to download
+that package) to me. Thanks!
+
+* Notes for Windows users
+
+If you are using Microsoft Windows, you will probably need the 'nmake'
+utility before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/nmake15.exe
+
+If you are connected to the internet, "perl Makefile.PL" is capable
+of automatically fetch it, and install into your Perl/bin directory.
+You will see a message like this:
+
+ The required 'nmake' executable not found, fetching it...
+
+However, if you are not yet online, or wish to install 'nmake' into
+another directory, then please download the file manually, save it to
+a directory in %PATH (e.g. C:\WINDOWS\COMMAND), then launch the MS-DOS
+command line shell, "cd" to that directory, and run "nmake15.exe" from
+there; that will create the 'nmake.exe' file.
+
+You may then resume the installation process above, but replace 'make'
+with 'nmake' in the last three lines.
+
+Also, if you do not have the compiler used to compile your version or
+Perl (e.g. MinGW, GCC on Cygwin, or Microsoft Visual C++ for ActivePerl),
+and nobody has generated a Windows-specific PAR yet, you will not be able to
+generate binary executables using 'pp'.
+
+Microsoft Visual C++ users: Do not forget to run "vcvars32.bat" (or equivalent)
+before "perl Makefile.PL"!
+
+* Typical Usage
+
+Here are some recipes showing how to utilize pp to bundle source.pl with
+all its dependencies, on target machines with different expected
+settings:
+
+- Stand-alone setup
+
+ % pp -o packed.exe source.pl # makes packed.exe
+ # Now, deploy 'packed.exe' to target machine...
+ $ packed.exe # run it
+
+- Perl interpreter only, without core modules:
+
+ % pp -B -p source.pl # makes source.par
+ % par.pl -B -Opacked.pl source.par # makes packed.pl
+ # Now, deploy 'packed.pl' to target machine...
+ $ perl packed.pl # run it
+
+- Perl with core module installed:
+
+ % pp -p source.pl # makes source.par
+ % par.pl -b -Opacked.pl source.par # makes packed.pl
+ # Now, deploy 'packed.pl' to target machine...
+ $ perl packed.pl # run it
+
+- Perl with PAR.pm and its dependencies installed:
+
+ % pp -p source.pl # makes source.par
+ % echo "use PAR 'source.par';" > packed.pl;
+ % cat source.pl >> packed.pl; # makes packed.pl
+ # Now, deploy 'source.par' and 'packed.pl' to target machine...
+ $ perl packed.pl # run it
+
+Note that if your perl was built with a shared library, the
+'Stand-alone setup' above will still need a separate perl5x.dll or
+libperl.so to function correctly. Patches to include a copy
+of libperl with the executable are most welcome.
+
+Please consult the documentation of 'pp' for more information.
+
+* Source Repository
+
+You can check out the most recent revision from PAR's Subversion repository:
+
+ http://svn.openfoundry.org/par/trunk/
+
+There is anonymous access to all. Commit access is handed out liberally;
+contact the mailing list for details.
+
+* Contact
+
+<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at <par at perl.org>, or send an empty mail to
+<par-subscribe at perl.org> to participate in the discussion.
+
+Please submit bug reports to <bug-par at rt.cpan.org>.
+
+* Copyright
+
+Copyright 2002, 2003, 2004, 2005 by Autrijus Tang <autrijus at autrijus.org>.
+
+All rights reserved. You can redistribute and/or modify
+this bundle under the same terms as Perl itself.
+
+See <http://www.perl.com/perl/misc/Artistic.html>.
Added: packages/libpar-perl/branches/upstream/current/SIGNATURE
===================================================================
--- packages/libpar-perl/branches/upstream/current/SIGNATURE 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/SIGNATURE 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,97 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.41.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It would check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 1bbd8d95d6633a8cc0f729c7283710b62d7bbf91 AUTHORS
+SHA1 bd7b45531ddea819c35b781d1941f9d2627d906d ChangeLog
+SHA1 168cf7566e4573eaedc6e0dc503a619886bf0573 MANIFEST
+SHA1 a425969945e62fcc7783784916d552d370b94951 MANIFEST.SKIP
+SHA1 edebde589988f5a79d480ff985cc4abc58dd12e9 META.yml
+SHA1 8954dbccfff96033c2b790b3a3d9a4bed829e8b0 Makefile.PL
+SHA1 b8c8fc2e7f81dd4331c02f8cbda68e19fbd5c4f4 README
+SHA1 aa8cd09fa1945de92b01d77b979b4c8769f148c2 TODO
+SHA1 4b474033fa138db434003eddb7536d82d2ce4b57 contrib/automated_pp_test/automated_pp_test.pl
+SHA1 31c0a2375a9f05052499fce55574b0411786f372 contrib/automated_pp_test/hello_tk.pl
+SHA1 3a32ffa47e874433d554b80633a3e125901d1bcf contrib/automated_pp_test/hi.ico
+SHA1 a1de215a67c9b3aea01a90a8cc470c3a534315d6 contrib/automated_pp_test/pipe_a_command.pm
+SHA1 2d3b9779713b656cd94de882911f389584e925c0 contrib/automated_pp_test/prior_to_test.pm
+SHA1 62d39b2306b17b845b876a7fe56c9997685fbffd contrib/automated_pp_test/remove_file_and_try_executable_again.pm
+SHA1 77a0eb02b1d8743ce16d1e762dd9125a4eaa113f contrib/automated_pp_test/test_in_further_subdir.pm
+SHA1 2b131d29057aeb0b63d4b98e80eeeebc62002a27 contrib/docs/where_is_it.txt
+SHA1 de2340efaea767d9367c1f92c7e117c747dfd48c contrib/docs/who_am_i.txt
+SHA1 5f6ae715822f2483c9ada55ab32dfcaf2798667a contrib/gui_pp/gpp
+SHA1 13db62c6e2077cd551d2aaee85fab52795440e4a contrib/gui_pp/gpp_readme.txt
+SHA1 0e486fcdfccc73b120b72aad213a0a3b87e4a347 contrib/pare/pare
+SHA1 0d80cbbe5457a5a2db9c3cf7115c828d46ad1fe4 contrib/pare/pare_readme.txt
+SHA1 562619426ae68be93148d6c52dbdc5e16294f7f9 contrib/procedural_pp/pp_old
+SHA1 eff2e79f0964da302217673f16abea9424a2bbdd contrib/stdio/Stdio.pm
+SHA1 e44e340a0a4b63c57a81173f3592c6f9c21c0d4d contrib/stdio/Stdio_readme.txt
+SHA1 6e3780de396adc1991ee4daafb5ae13bb93ae6a3 inc/ExtUtils/AutoInstall.pm
+SHA1 014bc8da033c1ff45d83d925ff658aa5fea343d8 inc/Module/Install.pm
+SHA1 485d8ff10f85ab63ab4d29b77eccd298043a692e inc/Module/Install/AutoInstall.pm
+SHA1 a7f7e2bfb0ac6f8ad965832ef3a246a7bd433058 inc/Module/Install/Base.pm
+SHA1 7b0e82ea99187c2121bfc8fe590de8363e8100d7 inc/Module/Install/Can.pm
+SHA1 d097dedadac0edcafbee3a14c262e24089f5795e inc/Module/Install/Fetch.pm
+SHA1 08bfc9e53d1e15f5556c9d282a7db70a68b9ff06 inc/Module/Install/Include.pm
+SHA1 4a702e765fcb130e262b9ba69a83c6c9da4e89e7 inc/Module/Install/Makefile.pm
+SHA1 2f9a6d1fe7413b0c41760664d3a2d7f23793911a inc/Module/Install/Metadata.pm
+SHA1 c658c36dd5ad01202224a867a3c88cb2a98821ed inc/Module/Install/PAR.pm
+SHA1 aa7491995a15f183d75d8d9428f7614c1c855b0f inc/Module/Install/PRIVATE.pm
+SHA1 f288814ac325546e91779b68f9821d427c8107b4 inc/Module/Install/PRIVATE/PAR.pm
+SHA1 8ee248d67d4c61a4f01e6a96c41afbd93be4c9ef inc/Module/Install/Win32.pm
+SHA1 3c099dd7fb73a49bcc489b152c3ca3c7a1b36427 inc/Module/Install/WriteAll.pm
+SHA1 9d135b52aef905c9b23bb1ead96ca8a48dd6cb82 inc/Test/Builder.pm
+SHA1 0b38d0a7e1db5f84cd3c8b9716cd8c5fc1b35ef2 inc/Test/More.pm
+SHA1 36ab1e3f0cc53b0902d9dac5f37f009eea2d20ef lib/App/Packer/PAR.pm
+SHA1 00032eb2b043d20acf656b536dcb7a7f133f8478 lib/PAR.pm
+SHA1 882fbe5fa73105cb7dff7112f561ef1e203970d4 lib/PAR/FAQ.pod
+SHA1 4116b3d780bac95786fb5f3f399776394af6a7f6 lib/PAR/Filter.pm
+SHA1 7555dad2a51468f5ebb6e1568a176c93b3cf596c lib/PAR/Filter/Bleach.pm
+SHA1 8f28af8d74ee814aa1e53e75db1025a0cd23c9d9 lib/PAR/Filter/Bytecode.pm
+SHA1 3c64d6750fc5fa51f6becfe3b77fec60eccdf6cc lib/PAR/Filter/Obfuscate.pm
+SHA1 152b6b65489c06723ee214771a151b9623b61ae6 lib/PAR/Filter/PatchContent.pm
+SHA1 e195ad51ac8ece60e27664e1987e4ff8eb34c4fe lib/PAR/Filter/PodStrip.pm
+SHA1 1cb5f65672261273f2b1635b32dbbf6d5e869a6f lib/PAR/Heavy.pm
+SHA1 e5482b60122002730a085fb833e4be54faf93118 lib/PAR/Packer.pm
+SHA1 ba16ae003a67dae31d1eea7f670a68601a4373f4 lib/PAR/Tutorial.pod
+SHA1 2baa5c9a2c7d88c5969d97f68e02afac045c6f53 myldr/Makefile.PL
+SHA1 4cb31931bfa898bba56d645b574983930492ab18 myldr/env.c
+SHA1 756242c3edcacb7d17cd9779b24f5249bd6d9d3a myldr/file2c.pl
+SHA1 333851193e3d00e2ca89623505a98829f2e8e2fc myldr/internals.c
+SHA1 867e346fca981617b48b505bf494f999950fff0c myldr/main.c
+SHA1 ec05dc3763fa1b34fa1e6fb683f596962d36d816 myldr/mktmpdir.c
+SHA1 2eb81ebccc155c56bf9ea5f6c068d42b1071d0f2 myldr/mktmpdir.h
+SHA1 72afd945a0dc5ed00ab5af9ab962727fcf555525 myldr/parlsig.pl
+SHA1 89862cdbf80d79e6525966589bc6cd3df93fb785 myldr/sha1.c.PL
+SHA1 0fb985b730168a862c4ae2f415d5775694134793 myldr/static.c
+SHA1 a04f43509c4638af15d67b441f268c0763917b11 myldr/utils.c
+SHA1 7b3e5be07f3db44c7f1a37ece3feea173e39fa9d myldr/win32.coff
+SHA1 32d843a5700babb314f255c171c4852637d66b1f myldr/win32.obj
+SHA1 fa6066c09715081d4d3f36685852207ff70caf9e myldr/win32.res
+SHA1 c2186f98dd13bc70c29beeede8d4a0fc598791a3 package/parl.nsi
+SHA1 2e0303b3ec1a3e69c75d62664bb6d24860fa8a3a script/par.pl
+SHA1 11f862dcecc4517dbc1818689ea08af633f744a0 script/parl.pod
+SHA1 05822cccfc3c014e041f041b67351f5a6a0cd162 script/pp
+SHA1 c84573da4ce6038635644f1eca205b85c9a32cf9 script/tkpp
+SHA1 dc1c8eb9ff09172ea1df02257b68032695673e2e t/1-basic.t
+SHA1 ca42829ecd023b952704469ac0adcb78ad164401 t/2-pp.t
+SHA1 a0258484d56cc699190be4cd93a16d145a0e1d16 t/hello.par
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.2 (FreeBSD)
+
+iD8DBQFDh5cotLPdNzw1AaARAjreAKCzmQX2s7ee8WOf2KlWl8TsBzvsxACeLzt8
+iP/wf9PZX3zE76F9XiOPkjc=
+=HJhc
+-----END PGP SIGNATURE-----
Added: packages/libpar-perl/branches/upstream/current/TODO
===================================================================
--- packages/libpar-perl/branches/upstream/current/TODO 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/TODO 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,34 @@
+- Implement inflate algorithm in perl as a non-XS fallback.
+
+- Implement Archive::Zip, Compress::Zlib and friends in C for performance.
+
+- Overrides @INC to provide coexistence support for multiple
+ versions of a module on the same machine. Or use Ingy's only.pm.
+
+- caller() from pp'ed executable should return nothing, instead
+ of the current calling stacks. Currently there's a workaround
+ as PAR_CLEARSTACK in myldr/main.c, but it segfaults and hence
+ is commented out by default.
+
+- make CHECK blocks work by perl_parse the code instead of
+ eval"". this should clenaly solve the above problem as well.
+
+- POSIX.pm does not currently work with "pp -C". Need to change
+ it to either use preemptive extraction, or extract under the
+ appropriate directory.
+
+- On Cygwin, PAR_TEMP is not cleaned up even with "pp -C", because
+ the cleanup time happened too late. Need to either use spawn()
+ or somehow assign win32's auto-unlink flags.
+
+- Implement selective filtering to -F.
+
+- Perl 5.9.2 on linux breaks PAR.
+
+- Cygwin needs perl_5_x_y.dll to be bundled instead of libperl.dll.
+ It also needs cygcrypt.dll etc, but that is another matter altogether.
+
+- Better document all PAR_* environment variables in PAR.pm.
+
+- Skip some binary modules (such as IO.dll) inside .par when packing standalone
+ executables, if parl already contains a copy of them.
Added: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/automated_pp_test.pl
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/automated_pp_test.pl 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/automated_pp_test.pl 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,8536 @@
+#!/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 L<http://www.perl.com/perl/misc/Artistic.html>
+#
+#
+#
+########################################################################
+our $VERSION = 0.12;
+########################################################################
+# 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;
+########################################################################
+
+
+########################################################################
+# 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();
+
+ require Win32::Exe::IconFile;
+ Win32::Exe::IconFile->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 ("$dir/$file")) {
+ $error = deltree("$dir/$file", $level, $message_ref); # Recursion!
+ if (!$ignore_errors) {
+ return ($error) if ($error == EXIT_FAILURE);
+ }
+ } else {
+ if (!(unlink ("$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;
+ }
+
+ 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-$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 = '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 = $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 = "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 = "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,
+ $perl,
+ $par,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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 = "$perl $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 = "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,
+ $perl,
+ $par,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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 = "$perl $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 = '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 = "$perl $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,
+ $perl,
+ $par,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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 = "$perl $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 = '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 = '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,
+ $perl,
+ $par,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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 = "$perl $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 = '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 = "$perl $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,
+ $perl,
+ $par,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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".
+ # . pipe './par out' and collect the results. It should be "hello".
+ #
+ # Success if "hello" was collected both times. Failure otherwise
+ #--------------------------------------------------------------------
+
+ my $error = EXIT_FAILURE;
+ my $pipe_command_string = "$perl $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 = '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);
+ }
+
+ #.................................................................
+
+ $pipe_command_string = "$perl $par out";
+ $error = pipe_a_command
+ (
+ $test_number,
+ $sub_test++,
+ $test_name_string,
+ $test_dir,
+ $pipe_command_string,
+ "", # Don't let sub 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 out.par?\n";
+ }
+ 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,
+ $perl,
+ $par,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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'
+ # './par out_par', './par out_par_B'
+ #
+ # After all of the above, success if "hello" was collected each time.
+ # Failure otherwise.
+ #--------------------------------------------------------------------
+
+ my $error = EXIT_FAILURE;
+
+ my $pipe_command_string = "$perl $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 = '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);
+ }
+ #.................................................................
+
+ $pipe_command_string = "$perl $par out_par";
+ $error = pipe_a_command
+ (
+ $test_number,
+ $sub_test++,
+ $test_name_string,
+ $test_dir,
+ $pipe_command_string,
+ "", # Don't let sub 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 out_par.par?\n";
+ return ($error);
+ }
+
+ #.................................................................
+ $cmd = '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);
+ }
+
+ #.................................................................
+
+ $pipe_command_string = "$perl $par out_par_B";
+ $error = pipe_a_command
+ (
+ $test_number,
+ $sub_test++,
+ $test_name_string,
+ $test_dir,
+ $pipe_command_string,
+ "", # Don't let sub 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 out_par_B.par?\n";
+ }
+
+ 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,
+ $perl,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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 = '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 = '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 = 'pp -e "print \"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,
+ $perl,
+ $par,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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
+ # pipe 'par a' and collect the results
+ #
+ # Success if "hello" was collected each time. Failure otherwise.
+ #--------------------------------------------------------------------
+
+ my $error = EXIT_FAILURE;
+
+ my $pipe_command_string = "$perl $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 = 'pp -p -e "print \"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);
+ }
+
+ #.................................................................
+
+ $pipe_command_string = "$perl $par a";
+ $error = pipe_a_command
+ (
+ $test_number,
+ $sub_test++,
+ $test_name_string,
+ $test_dir,
+ $pipe_command_string,
+ "",
+ "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);
+ #.................................................................
+
+}
+
+#########################################################################
+sub pp_minus_P_minus_e_print_hello {
+ my (
+ $test_name_string,
+ $os,
+ $test_number,
+ $test_dir,
+ $verbose,
+ $message_ref,
+ $perl,
+ ) = @_;
+
+ #--------------------------------------------------------------------
+ # 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 = 'pp -P -e "print \"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 = '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 = '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 = '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 = $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;
+ at ISA = qw(Exporter);
+ at 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( $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( $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 = '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 = '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
+ (
+ "$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 = $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;
+ at ISA = qw(Exporter);
+ at 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( $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( $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 = '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 = '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
+ (
+ "$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 = $test_dir . "/$SUBDIR1";
+ my $bar_dir = $test_dir . "/$SUBDIR2";
+ my $foo_dir_file = $foo_dir . "/hidden_print_caller\.pm";
+ my $bar_dir_file = $bar_dir . "/hidden_print\.pm";
+ my $foo_file = $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;
+ at ISA = qw(Exporter);
+ at 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;
+ at ISA = qw(Exporter);
+ at 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 = '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 = '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 = $test_dir . "/$SUBDIR1";
+ my $bar_dir = $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;
+ at ISA = qw(Exporter);
+ at 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;
+ at ISA = qw(Exporter);
+ at 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( $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( $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( "$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 = '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 = '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
+ (
+ "$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 = $test_dir . "/$SUBDIR1";
+ my $pipe_command_string = "";
+ my $cmd = "";
+ my $sub_test = 0;
+ my $hidden_print_file = "$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;
+ at ISA = qw(Exporter);
+ at 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( $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 = '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 = "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 = $test_dir . "/$SUBDIR1";
+ my $bar_dir = $test_dir . "/$SUBDIR2";
+ my $subdir_foo_file = "$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;
+ at ISA = qw(Exporter);
+ at EXPORT = ("foo_1");
+
+sub foo_1 {
+ print ("hello_foo");
+}
+1;
+';
+
+#..............................................
+ my $bar_1_top_of_file_text = '
+package ' . $SUBDIR2 . '::bar_1;
+
+use Exporter;
+ at ISA = qw(Exporter);
+ at 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( $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( $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 = '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 = "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( $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 = 'pp ' . "\"$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 = 'pp -X File::Basename ' . "\"$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 = "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 =
+ "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 = '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 = '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 = '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 = '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 = '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 = '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.exe
+ # For v 2
+ # pp:\s+Packing\s+hello.pl
+ # pp:\s+Writing\s+PAR\s+on
+ # pp:\s+ Running.*parl.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.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 = (
+
+ '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',
+ );
+
+ if ($os !~ m/^Win/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.exe',
+ );
+
+ my @results_to_expect_vv = (
+ 'pp:\s+Packing\s+hello.pl',
+ 'pp:\s+Writing\s+PAR\s+on',
+ 'pp:\s+Running.*parl.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.exe',
+ );
+
+
+ #............. Remove the ".exe" parts if not Windows
+ if ($os !~ m/^Win/i) {
+ @converted_array = ();
+ foreach $line (@results_to_expect_v) {
+ $line =~ s/parl.exe/\/parl\\b/g;
+ push(@converted_array, ($line));
+ }
+ @results_to_expect_v = ();
+ push(@results_to_expect_v, @converted_array);
+ }
+
+ if ($os !~ m/^Win/i) {
+ @converted_array = ();
+ foreach $line (@results_to_expect_vv) {
+ $line =~ s/parl.exe/\/parl\\b/g;
+ push(@converted_array, ($line));
+ }
+ @results_to_expect_vv = ();
+ push(@results_to_expect_vv, @converted_array);
+ }
+
+ if ($os !~ m/^Win/i) {
+ @converted_array = ();
+ foreach $line (@results_to_expect_vvv) {
+ $line =~ s/parl.exe/\/parl\\b/g;
+ push(@converted_array, ($line));
+ }
+ @results_to_expect_vvv = ();
+ push(@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( $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 = <FH>;
+
+ 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 = 'pp -V';
+ my $pipe_command_string_minus_minus = '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 "Perl Packager" should have been collected.
+ #
+ #--------------------------------------------------------------------
+ my $error = EXIT_FAILURE;
+ my $pipe_command_string = 'pp -h';
+ my $sub_test = 0;
+ my $expected_string = 'Perl 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 = '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 = "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 = "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 = "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 = "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 = "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 = "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 = "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 = "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 --icon hi.ico -o hello.exe hello.pl'
+ # ----
+ # The file hi.ico should already exist in the same
+ # directory as the running program, so that it can
+ # be copied to the test directory. hello.pl is created.
+ #
+ # Outline
+ # -------
+ # . Create the file hello.pl with code that will print "hello".
+ # . Assume the icon hi.ico already exists.
+ # . Build the out.exe with
+ # pp --gui --icon hi.ico -o out.exe hello.pl
+ # . Test the out.exe for gui and icon. We can use Win32::Exe
+ # itself to inspect the GUI and icon status of the resulting
+ # exe, so the snippet below should do:
+ #
+ # my $exe = Win32::Exe->new('out.exe');
+ # my $ico = Win32::Exe->new('hi.ico');
+ # is($exe->Subsystem, 'windows');
+ # is($exe->dump_iconfile, $ico->dump_iconfile);
+ # Success if true in both cases, failure otherwise. #
+ #
+ #
+ #--------------------------------------------------------------------
+ my $error = EXIT_FAILURE;
+ my $cmd = 'pp --gui --icon hi.ico -o ' . "$hello_executable $hello_pl_file";
+
+ my $sub_test = 0;
+ my $file_to_copy = "";
+ my $exe = "";
+ my $ico = "";
+ my $FALSE = 0;
+ my $exe_is_okay = $FALSE;
+ my $ico_is_okay = $FALSE;
+ 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");
+ }
+
+
+ #.................................................................
+ $file_to_copy = $orig_dir . '/hi.ico';
+ if(!(copy($file_to_copy, "$test_dir"))) {
+ $$message_ref = "\namsg568: sub $test_name_string: cannot " .
+ "copy $file_to_copy to $test_dir:$!:\n";
+ return (EXIT_FAILURE);
+ }
+ if ($verbose) {
+ print ("Copied $file_to_copy 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);
+ $ico = Win32::Exe::IconFile->new('hi.ico');
+ #.................................................................
+
+ if ($ico->dump_iconfile eq $exe->dump_iconfile) {
+ $ico_is_okay = $TRUE;
+ } else {
+ $ico_is_okay = $FALSE;
+ $$message_ref = $$message_ref . "amsg574: sub $test_name_string " .
+ ": ico->dump_iconfile is not exe->dump_iconfile\n";
+ }
+
+ #.................................................................
+ if ($exe->Subsystem eq 'windows') {
+ $exe_is_okay = $TRUE;
+ } else {
+ $exe_is_okay = $FALSE;
+ $$message_ref = $$message_ref . "amsg576: sub $test_name_string " .
+ ": exe->Subsystem is not windows\n";
+ }
+
+ if ($exe_is_okay && $ico_is_okay) {
+ if ($verbose) {
+ print ("Win32::Exe shows a good icon file\n");
+ }
+
+ return (EXIT_SUCCESS);
+ } else {
+ $$message_ref = $$message_ref .
+ "\nThe command $cmd did not produce a good icon on exe\n";
+ return (EXIT_FAILURE)
+ }
+ #.................................................................
+
+}
+
+########################################################################
+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("' . $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 = "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 = "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 = "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 = "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(' . "\"$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 = "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 = "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 = "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 $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 $hello_executable = "hello\.exe";
+my $foo_executable = "foo\.exe";
+my $bar_executable = "bar\.exe";
+my $a_default_executable = "a\.exe";
+my $a_default_dot_par = "a\.par";
+
+my $verbose = "";
+my $debug_log = "";
+my $debug = $FALSE;
+my $perl = "";
+my $par = "";
+
+GetOptions( "verbose" => \$verbose,
+ "debug" => \$debug,
+ "startdir=s" => \$startdir,
+ "perl_location=s" => \$perl,
+ "par_location=s" => \$par,
+ );
+
+
+$verbose = 0 if (!defined($verbose) or ($verbose eq ""));
+
+$perl = $^X if ($perl eq "");
+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);
+}
+
+my $_out = $Config{_exe} || '.out';
+
+$hello_pl_file = "hello.pl";
+$foo_pl_file = "foo.pl";
+$bar_pl_file = "bar.pl";
+$hello_par_file_with_dot_par = "hello.par";
+$hello_par_file_no_dot_par = "hello";
+$a_default_executable = "a$_out";
+$a_default_dot_par = "a.par";
+$hello_executable = "hello$_out";
+$foo_executable = "foo$_out";
+$bar_executable = "bar$_out";
+
+$startdir ||= File::Spec->catdir(File::Spec->tmpdir, 'pp_switch_tests');
+
+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,
+ $perl,
+ $par,
+ );
+
+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,
+ $perl,
+ $par,
+ );
+
+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,
+ $perl,
+ $par,
+ );
+
+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,
+ $perl,
+ $par,
+ );
+
+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,
+ $perl,
+ $par,
+ );
+
+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,
+ $perl,
+ $par,
+ );
+
+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,
+ $perl,
+ );
+
+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,
+ $perl,
+ $par,
+ );
+
+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,
+ $perl,
+ );
+
+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");
+}
+
Added: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/hello_tk.pl
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/hello_tk.pl 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/hello_tk.pl 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,71 @@
+#!/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 L<http://www.perl.com/perl/misc/Artistic.html>
+#
+#
+#
+########################################################################
+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;
Added: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/hi.ico
===================================================================
(Binary files differ)
Property changes on: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/hi.ico
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/pipe_a_command.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/pipe_a_command.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/pipe_a_command.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,212 @@
+#!/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 L<http://www.perl.com/perl/misc/Artistic.html>
+#
+#
+#
+########################################################################
+#
+########################################################################
+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;
+ at ISA = qw(Exporter);
+ at 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 = <CMD_STDOUT_AND_STDERR>) {
+ 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 = <FH>;
+
+ 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);
+
+}
Added: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/prior_to_test.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/prior_to_test.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/prior_to_test.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,232 @@
+#!/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 L<http://www.perl.com/perl/misc/Artistic.html>
+#
+#
+#
+########################################################################
+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;
+ at ISA = qw(Exporter);
+ at 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;
Added: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/remove_file_and_try_executable_again.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/remove_file_and_try_executable_again.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/remove_file_and_try_executable_again.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,132 @@
+#!/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 L<http://www.perl.com/perl/misc/Artistic.html>
+#
+#
+#
+########################################################################
+# 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;
+ at ISA = qw(Exporter);
+ at 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;
Added: packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/test_in_further_subdir.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/test_in_further_subdir.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/automated_pp_test/test_in_further_subdir.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,129 @@
+#!/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 L<http://www.perl.com/perl/misc/Artistic.html>
+#
+##
+########################################################################
+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;
+ at ISA = qw(Exporter);
+ at 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);
+ #.................................................................
+}
Added: packages/libpar-perl/branches/upstream/current/contrib/docs/where_is_it.txt
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/docs/where_is_it.txt 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/docs/where_is_it.txt 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,649 @@
+
+Where is it? What's it called? How do I get it?
+
+#####################################################################
+This is a description of where things go in a PAR package and where they get
+unpacked, how they are (re)named, and how to retrieve them from a running PAR
+program.
+
+Caveats up front: The following screens snips are from WinXP, ActiveState
+Perl 5.8.4 (build 810) and PAR 0.85. There are only a few Windows specifics,
+like the prompt and .exe file extensions, but the rest should apply to Linux as
+well. The program listings are shown at the bottom of this doc and will run
+anywhere.
+
+1 August 2004
+
+While looking my example outputs, I realized there is a bug in the pp -B
+option for PAR 0.85 on Win32, I also forgot to explain -B. In order to make
+the examples correct as shown, I have added -B to some of the pp command
+lines, and then explained -B later.
+
+4 August 2004 - Revision 1
+
+Added use of -l and -z options. The bug mentioned above has been patched,
+after PAR 0.85. The -z option was added after 0.85.
+
+6 September 2004 - Revision 2
+
+Documented use of "pp -X <parfile>" in PAR 0.86
+
+19 September 2004 - Revision 3
+#####################################################################
+
+PAR is all about packing up files and unpacking them, so a number of options
+to pp are there to control what gets included and what gets excluded. Those
+options are: -B -c -d -l -M -n -p -P -x -X for packing and -C for unpacking.
+
+The PAR packager "pp" can produce four kinds of PAR packages: PAR
+files, standalone Perl files, standalone binaries with the Perl lib bundled,
+and binaries without the Perl lib (see who_am_i.txt for a details about each).
+All four forms contain a zip file section which contains the main script and
+all of the files on which it depends.
+
+----------
+
+Let's generate some PAR files and look at the contents with an ordinary zip
+tool - zipinfo from Info-ZIP. Most zip tools can be used to examine pp
+generated executables as well, but will not preserve the PAR structure if you
+edit with them.
+
+Each time pp runs, the source will be passed to Module::ScanDeps for
+dependency analysis. First, a program that doesn't depend on anything.
+
+ C:\Perl\Par\using_par>cd \Par
+
+ C:\Par>pp -B -p -o example1.par example1.pl
+
+ C:\Par>zipinfo -1 example1.par
+ script/
+ MANIFEST
+ META.yml
+ script/example1.pl
+ script/main.pl
+
+ C:\Par>
+
+There is a MANIFEST file that contains a list of the files in the zip.
+META.yml contains the following:
+
+ build_requires: {}
+ conflicts: {}
+ dist_name: example1.par
+ distribution_type: par
+ dynamic_config: 0
+ generated_by: 'PAR::Packer version 0.12
+ license: unknown
+ par:
+ clean: 0
+ signature: ''
+ verbatim: 0
+ version: 0.85
+
+As of PAR 0.85, the only critical part of META.yml is the "clean: 0". This is
+where the frontend code discovers whether it was packaged with "pp -C".
+
+There is a script/ directory which contains our program "example1.pl" and a
+helper script "main.pl":
+
+ my $zip = $PAR::LibCache{$ENV{PAR_PROGNAME}} || Archive::Zip->new(__FILE__);
+ my $member = eval { $zip->memberNamed('script/example1.pl') }
+ or die qq(Can't open perl script "script/example1.pl": No such file
+ or directory ($zip));
+ PAR::_run_member($member, 1);
+
+After the frontend runs, execution continues with main.pl, which has the name
+of the program coded into it. Main.pl extracts the program and runs it.
+
+----------
+
+Now let's use a module, so there is a dependency. It's only "use strict;" so
+we don't need much.
+
+ C:\Par>pp -B -p -o example2.par example2.pl
+
+ C:\Par>zipinfo -1 example2.par
+ lib/
+ script/
+ MANIFEST
+ META.yml
+ lib/AutoLoader.pm
+ lib/Carp.pm
+ lib/Carp/Heavy.pm
+ lib/Config.pm
+ lib/DynaLoader.pm
+ lib/Exporter.pm
+ lib/Exporter/Heavy.pm
+ lib/File/Glob.pm
+ lib/List/Util.pm
+ lib/Scalar/Util.pm
+ lib/Term/Cap.pm
+ lib/Text/ParseWords.pm
+ lib/Thread.pm
+ lib/XSLoader.pm
+ lib/auto/DynaLoader/autosplit.ix
+ lib/auto/DynaLoader/dl_expandspec.al
+ lib/auto/DynaLoader/dl_find_symbol_anywhere.al
+ lib/auto/DynaLoader/dl_findfile.al
+ lib/auto/File/Glob/Glob.bs
+ lib/auto/File/Glob/Glob.dll
+ lib/auto/File/Glob/Glob.exp
+ lib/auto/List/Util/Util.bs
+ lib/auto/List/Util/Util.dll
+ lib/auto/List/Util/Util.exp
+ lib/auto/Thread/Thread.bs
+ lib/auto/Thread/Thread.dll
+ lib/auto/Thread/Thread.exp
+ lib/auto/re/re.bs
+ lib/auto/re/re.dll
+ lib/auto/re/re.exp
+ lib/auto/threads/shared/shared.bs
+ lib/auto/threads/shared/shared.dll
+ lib/auto/threads/shared/shared.exp
+ lib/overload.pm
+ lib/re.pm
+ lib/strict.pm
+ lib/threads/shared.pm
+ lib/vars.pm
+ lib/warnings.pm
+ lib/warnings/register.pm
+ script/example2.pl
+ script/main.pl
+
+ C:\Par>
+
+Wow ! We got strict.pm and a lot of other stuff. ScanDeps picks up anything
+and everything that may or may not be needed - any "use" or "require" and a
+couple other things, even if they are conditional. ScanDeps also has a table
+of preloaded dependencies for some well known modules, that aren't found by
+analysis. In this example, there is ~130K of extra stuff. You will probably
+always get more than you really need. Better safe than sorry.
+
+----------
+
+If you want to reduce the size of the PAR and you are sure that you will never
+invoke some module, you can exclude it with -X. I know this program will not
+need threads, so:
+
+ C:\Par>pp -X Thread -B -p -o example2.par example2.pl
+
+ C:\Par>zipinfo -1 example2.par
+ lib/
+ script/
+ MANIFEST
+ META.yml
+ lib/AutoLoader.pm
+ lib/Carp.pm
+ lib/Carp/Heavy.pm
+ lib/Config.pm
+ lib/DynaLoader.pm
+ lib/Exporter.pm
+ lib/Exporter/Heavy.pm
+ lib/File/Glob.pm
+ lib/List/Util.pm
+ lib/Scalar/Util.pm
+ lib/Term/Cap.pm
+ lib/Text/ParseWords.pm
+ lib/XSLoader.pm
+ lib/auto/DynaLoader/autosplit.ix
+ lib/auto/DynaLoader/dl_expandspec.al
+ lib/auto/DynaLoader/dl_find_symbol_anywhere.al
+ lib/auto/DynaLoader/dl_findfile.al
+ lib/auto/File/Glob/Glob.bs
+ lib/auto/File/Glob/Glob.dll
+ lib/auto/File/Glob/Glob.exp
+ lib/auto/List/Util/Util.bs
+ lib/auto/List/Util/Util.dll
+ lib/auto/List/Util/Util.exp
+ lib/auto/re/re.bs
+ lib/auto/re/re.dll
+ lib/auto/re/re.exp
+ lib/overload.pm
+ lib/re.pm
+ lib/strict.pm
+ lib/vars.pm
+ lib/warnings.pm
+ lib/warnings/register.pm
+ script/example2.pl
+ script/main.pl
+
+ C:\Par>
+
+Now Thread.pm and it's dependencies are gone. See later for more on using -X.
+
+----------
+
+Letting ScanDeps look for dependencies is the default method, but not the only
+one, and maybe not the best one. Let's prevent ScanDeps from analyzing the
+code itself (-n) and let the Perl compiler do it (-c).
+
+ C:\Par>pp -n -c -B -p -o example2.par example2.pl
+
+ C:\Par>zipinfo -1 example2.par
+ lib/
+ script/
+ MANIFEST
+ META.yml
+ lib/strict.pm
+ script/example2.pl
+ script/main.pl
+
+ C:\Par>
+
+That looks good. Just the strict.pm that we needed. Why not do this all of the
+time? Because Perl code can hide a use or require in eval's and strings and
+all kinds of conditional places that don't happen until the program runs.
+
+----------
+
+How about running the program (-x) and see what it needs?
+
+ C:\Par>pp -n -x -B -p -o example2.par example2.pl
+ My temp dir is
+ I was extracted as
+
+ C:\Par>zipinfo -1 example2.par
+ lib/
+ script/
+ MANIFEST
+ META.yml
+ lib/strict.pm
+ script/example2.pl
+ script/main.pl
+
+ C:\Par>
+
+Notice that example2.pl was executed and produced output (although not exactly
+valid, since it didn't have a PAR environment yet). This is the "ultimate"
+method, but when your program runs during the pp process, you have to be sure
+to exercise it through every branch that might conditionally use or require
+something. In the case of modules like LWP, that might mean making the program
+access several kinds of web pages and protocols, just to discover all the
+supporting modules needed.
+
+----------
+
+Both -c and -x execute the program. However, -c first turns the program into
+one giant subroutine that is never called. Perl compiles it, so any BEGIN and
+END blocks in the program will execute during pp.
+
+Using -c or -x without -n will add all the modules ScanDeps finds by
+analysis plus any additional modules that -c or -x finds.
+
+----------
+
+The last resort is -M to add a module manually. Let's add English.pm even
+though it isn't needed.
+
+ C:\Par>pp -n -c -M English -B -p -o example2.par example2.pl
+
+ C:\Par>zipinfo -1 example2.par
+ lib/
+ script/
+ MANIFEST
+ META.yml
+ lib/Carp.pm
+ lib/English.pm
+ lib/Exporter.pm
+ lib/strict.pm
+ lib/warnings.pm
+ script/example2.pl
+ script/main.pl
+
+ C:\Par>
+
+----------
+
+So much for program components. What if we want to put some data files into
+the PAR package? There are two data files listed below. The contents don't
+really matter for these examples. Let's add one file.
+
+ C:\Par>pp -B -p -o example1.par example1.pl -a some.dat
+
+ C:\Par>zipinfo -1 example1.par
+ script/
+ MANIFEST
+ META.yml
+ script/example1.pl
+ script/main.pl
+ some.dat
+
+ C:\Par>
+
+It's in the root directory of the zip. If we give a full path name:
+
+ C:\Par>pp -B -p -o example1.par example1.pl -a c:/Par/some.dat
+
+ C:\Par>zipinfo -1 example1.par
+ script/
+ MANIFEST
+ META.yml
+ script/example1.pl
+ script/main.pl
+ Par/some.dat
+
+ C:\Par>
+
+now it's in the Par/ directory. Since this is a Windows example, there was a
+drive letter in the full path. It was stripped off because drive letters make
+no sense inside the zip.
+
+You might want the file somewhere else in the zip besides root or the same
+path as the source file. You might also want to change it's name. The -a
+accepts aliases following the source name and separated by a semicolon.
+
+ C:\Par>pp -B -p -o example1.par example1.pl -a some.dat;that_dir/new.dat
+
+ C:\Par>zipinfo -1 example1.par
+ script/
+ MANIFEST
+ META.yml
+ script/example1.pl
+ script/main.pl
+ that_dir/new.dat
+
+ C:\Par>
+
+The file that_dir/new.dat in the zip is a copy of some.dat.
+
+Packaging a lot of files would require a lot of -a, but you can put a list of
+files (and their aliases) into a file and use -A. The syntax for each line
+inside of the -A list is the same as the -a option. Using a.lst shown below:
+
+ C:\Par>pp -B -p -o example1.par example1.pl -A a.lst
+
+ C:\Par>zipinfo -1 example1.par
+ script/
+ MANIFEST
+ META.yml
+ script/example1.pl
+ script/main.pl
+ deep/dir/a_new_name.dat
+ real/deep/dir/more.dat
+
+ C:\Par>
+
+The file deep/dir/a_new_name.dat is a copy of some.dat and
+real/deep/dir/more.dat is a copy of more.dat.
+
+Note: Windows users need to quote any path parts or file names that contain
+spaces. Paths in zip files always use forward slashes (/). Backslashes in -a
+and -A will be converted.
+
+----------
+
+The -B option is enabled automatically for standalone executables but not for
+-p or -P. Without -B, the -p and -P options will include required non-core
+modules, but not required core modules - ones that come standard with the Perl
+installation. Since -p or -P packages usually expect a Perl installation (perl
+and the perl lib) to run them, you may wish to assume the core modules are
+available from the installation.
+
+The -d option determines whether the perl lib will be packaged in standalone
+executables or not. It is not inside the PAR zip file, but packaged in front
+of it, where the binary frontend can unpack it, before the Perl interpreter
+starts and Zip functions become available.
+
+The modules that the Perl portion of the frontend needs to run are also
+packaged before the PAR zip. These are the dependencies for par.pl.
+
+If -d is used, or -p/-P is used without -B, and there will be no Perl
+installation on the target machine, you will have to deliver the perl
+executable and/or the perl lib (libperl.so or perl5x.dll) with the PAR
+package. Default libpaths may have to be overridden. On Windows, perl5x.dll
+can be placed in the same dir as the PAR executable and it will be found
+first, even if there is an installation elsewhere.
+
+----------
+
+Once all the right stuff is packaged and the program runs, some or all of it
+will be unpacked into a temp directory. What does the temp directory look
+like? That depends on whether the program is packaged with -C or the
+environment variable PAR_GLOBAL_CLEAN is true.
+
+ C:\Par>pp -o example1.exe example1.pl
+
+ C:\Par>set PAR_GLOBAL_CLEAN=1
+
+ C:\Par>example1.exe
+ My temp dir is C:\TEMP\par-astewart\temp-1796
+ I was extracted as C:\TEMP\par-astewart\temp-1796\9P9JWzM5Dq
+
+ C:\Par>set PAR_GLOBAL_CLEAN=0
+
+ C:\Par>example1.exe
+ My temp dir is C:\TEMP\par-astewart\cache-5d6e482c4d108512958af35b77e03
+ 4164acfac08
+ I was extracted as C:\TEMP\par-astewart\cache-5d6e482c4d108512958af35b7
+ 7e034164acfac08\2487795e.pl
+
+ C:\Par>set PAR_GLOBAL_CLEAN=
+
+ C:\Par>pp -C -o example1.exe example1.pl
+
+ C:\Par>example1.exe
+ My temp dir is C:\TEMP\par-astewart\temp-740
+ I was extracted as C:\TEMP\par-astewart\temp-740\TRW5NnPCan
+
+ C:\Par>
+
+Either -C or PAR_GLOBAL_CLEAN=1 causes the temp dir to be a short name based
+on my login name and the program pid. The temp dir will change each time
+because of pid and be deleted after execution because of "clean".
+PAR_GLOBAL_CLEAN overrides -C/not -C.
+
+If not "clean", the temp dir is a long name based on my login name and an SHA1
+hash of the entire PAR packaged program. It will not change from execution to
+execution, unless you modify and repackage the program. It will also not be
+deleted after each execution. The contents will be re-used and not
+re-extracted from the PAR. In addition, all of the source files in the zip
+file will be extracted into the $ENV{PAR_TEMP}."/inc/" directory. Binary
+shared libs will not be extracted to inc/. @INC will have additional entries
+pointing to inc/ and inc/lib/, causing .pm files to load from there.
+
+Whether "clean" or not "clean", some files will be extracted to the temp dir.
+Shared libs will always be extracted there. If running "clean", the .pm files
+that are actually loaded will be extracted there. The files extracted to the
+temp dir are renamed to CRC32 names to avoid conflicts and mapped to the real
+names inside PAR. The program itself is there under a CRC32 pseudonym. If you
+need to open and read the program as a file, or pass the program as a file to
+a module, it's temp name is in $ENV{PAR_0};
+
+Additional shared libraries packed with the -l option are packed in a
+directory named for the machine architecture under shlib/ rather than under
+inc/. When they are unpacked, they are in the temp dir.
+
+----------
+
+Two examples of using -l are msvcr70.dll (the runtime library for the VC++
+7.0 compiler) and wxmsw242.dll (from the Wx Perl module).
+
+If you compiled PAR using VC++ 7.0, the executables made with PAR need that
+runtime. If your target machine doesn't have it, then:
+
+ pp -l msvcr70.dll ...
+
+will search the PATH and include it. Since it ends up next to the executable
+in the temp dir, it will be linked.
+
+If you packaged a Wx Perl script without -l, PAR knows about Wx.dll because
+Wx.pm requests it, but doesn't know that Wx.dll loads wxmsw242.dll. Wx.dll
+would end up in the temp dir and wxmsw242.dll would end up in inc/. Wx.dll
+wouldn't be able to find wxmsw242.dll. Packaging with:
+
+ pp -l C:\Perl\site\lib\auto\Wx\wxmsw242u.dll ...
+
+moves it from inc/ to shlib/ in the package and unpacks to temp next to Wx.dll
+and it works!
+
+----------
+
+So how can I access the files I added with -a or -A ? Again, it depends on
+"clean". If the program is not running "clean", then everything is available
+in the $ENV{PAR_TEMP}."/inc/" dir. After packing with "-A a.lst", I can read
+some.dat with a standard filehandle:
+
+ my $file = $ENV{PAR_TEMP}."/inc/deep/dir/a_new_name.dat";
+ open FH, "<$file";
+ print while (<FH>);
+ close FH;
+
+If the program is running "clean", the inc/ dir is not available, but
+$PAR::LibCache{$ENV{PAR_PROGNAME}} is a zip file handle to the PAR zip. Using
+the a.lst to pack some.dat with example3.pl, it can be read with Archive::Zip
+functions:
+
+ C:\Par>pp -o example3.exe example3.pl -A a.lst
+
+ C:\Par>example3.exe
+ comma, separated, values
+ some, other, values
+
+ C:\Par>
+
+Note that $fh in example3.pl is not really a file handle, but a zip object
+with pointers into the zip file. It doesn't need to be closed after use.
+
+The Archive::Zip method will, of course, work even if there is an inc/ dir,
+but you pay twice to have it extracted. If you need to package really large
+data with the program, running "clean" and reading direct from the zip is a
+way to avoid extracting the whole file in advance and taking up disk space.
+
+----------
+
+And last, if the file is small and you just want to slurp it into a variable,
+PAR provides a shortcut function, read_file().
+
+ C:\Par>pp -c -o example4.exe example4.pl -A a.lst
+
+ C:\Par>example4.exe
+ qwertyuiop
+ asdfghjkl
+ zxcvbnm
+ C:\Par>
+
+PAR::read_file() will locate the file in any PAR file currently known. That
+includes the executable itself and any PAR/zip/executable given as arguments
+to PAR.pm:
+
+ use PAR qw( foo.par data.zip pp_packaged.exe );
+
+Note that "use PAR;" was not needed in example4.pl because it was already
+loaded by the frontend. Run by itself, example4.pl produces an undefined
+function error.
+
+----------
+
+If you need to make your PAR executables smaller, the -z option can be used to
+squeeze them a little more. By default, zlib compresses to level 6 on a 0 to 9
+scale. Using "pp -z 9" will do maximum compression. This will have a small
+impact on startup speed. However, this affects only the zip portion and not
+the modules that the frontend needs to do the unpacking.
+
+For Win32, UPX is available (http://upx.sourceforge.net) to squash the
+frontend code. More can be done by applying UPX to dll's prior to PAR packing.
+
+The -X option will exclude all the files contained in another zip or par or
+PAR executable file. If you have several PAR executables that are running on
+the same machine and use some of the same modules, you can exclude the common
+modules and put them in a separate PAR file that they all "use". For example,
+if I create a small script, common.pl:
+
+ use Tk;
+ use LWP;
+
+and package it with:
+
+ pp -p -o common.par common.pl
+
+I can compile scripts with:
+
+ pp -X common.par -o my_app.exe my_app.pl
+ pp -X common.par -o my_app2.exe my_app2.pl
+
+and ship common.par along with my_app.exe or my_app2.exe. The executables will
+not contain any of the Tk or LWP modules found in common.par, and will require
+common.par to run. One executable can also be made to depend on another:
+
+ pp -o main_app.exe main_app.pl
+ pp -X main_app.exe -o supporting_app.exe supporting_app.pl
+
+The supporting_app.exe will require main_app.exe to be present and will not
+contain any modules already in main_app.exe.
+
+The "pare" utility in contrib/pare/ can be used to do the same as -X to
+already compiled PAR executables.
+
+----------
+
+I hope all this helps. If you discover any errors in this doc or some
+radically different behaviour on another OS, let me know :)
+
+Alan Stewart
+astewart1 at cox.net
+
+P.S. This doc is in the public domain.
+
+
+#####################################################################
+Listing: example1.pl
+#####################################################################
+#!perl
+
+print "My temp dir is $ENV{PAR_TEMP}\n";
+print "I was extracted as $ENV{PAR_0}\n";
+
+#####################################################################
+Listing: example2.pl
+#####################################################################
+#!perl
+use strict;
+
+print "My temp dir is $ENV{PAR_TEMP}\n";
+print "I was extracted as $ENV{PAR_0}\n";
+
+#####################################################################
+Listing: some.dat
+#####################################################################
+comma, separated, values
+some, other, values
+
+#####################################################################
+Listing: more.dat
+#####################################################################
+qwertyuiop
+asdfghjkl
+zxcvbnm
+
+#####################################################################
+Listing: a.lst
+#####################################################################
+some.dat;deep/dir/a_new_name.dat
+more.dat;real/deep/dir/more.dat
+
+#####################################################################
+Listing: example3.pl
+#####################################################################
+#!perl
+use strict;
+
+use Archive::Zip;
+use Archive::Zip::MemberRead;
+
+my $zip = $PAR::LibCache{$ENV{PAR_PROGNAME}};
+my $fh = new Archive::Zip::MemberRead($zip, "deep/dir/a_new_name.dat");
+my $line;
+while (defined($line = $fh->getline())) {
+ print "$line\n";
+}
+
+#####################################################################
+Listing: example4.pl
+#####################################################################
+#!perl
+use strict;
+
+my $more_dat = PAR::read_file("real/deep/dir/more.dat");
+print $more_dat;
+
+#####################################################################
Added: packages/libpar-perl/branches/upstream/current/contrib/docs/who_am_i.txt
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/docs/who_am_i.txt 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/docs/who_am_i.txt 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,586 @@
+
+Who am I? What am I? Where am I? What else is there?
+
+#####################################################################
+This is a description of how a Perl program packaged with pp can find it's
+name, what kind of PAR package it is, where it's temp directories are, and
+what else there is in a PAR environment.
+
+Caveats up front: The following screens snips are from WinXP, ActiveState
+Perl 5.8.4 (build 810) and PAR 0.85. There are only a few Windows specifics,
+like the prompt and .exe file extensions, but the rest should apply to Linux as
+well. The program listings are shown at the bottom of this doc and will run
+anywhere.
+
+4 August 2004 - Revision 1
+#####################################################################
+
+The PAR packager "pp" can produce four kinds of PAR packages: PAR files (a
+modified zip file), standalone Perl files (plain text), standalone binaries
+with the Perl lib bundled, and binaries without the Perl lib. In addition, a
+developer may be testing the original Perl program before packaging, but with
+PAR related code included. And lastly, each version might be running "clean"
+or not.
+
+----------
+
+Let's package program1.pl in each of those ways and see what it shows about
+itself. In each case, I'll produce a package called "demo.xxx", where only the
+extension is different. I'll start running "clean":
+
+ C:\Par>set PAR_GLOBAL_CLEAN=1
+
+and I'll give three dummy args "a", "b", and "c" just to see them pass thru.
+
+----------
+
+First the original program1.pl unpackaged:
+
+ C:\Par>copy program1.pl demo.pl
+ 1 file(s) copied.
+
+ C:\Par>perl demo.pl a b c
+ My basename is demo
+ $0 = demo.pl
+ My args are: a b c
+ My @INC is: c:/Perl/lib c:/Perl/site/lib .
+
+ I am NOT a PAR package
+ I am running as '$^X $0 @ARGV'
+ c:\Perl\bin\perl.exe demo.pl a b c
+
+ PAR environment:
+ PAR_GLOBAL_CLEAN=1
+
+ C:\Par>
+
+The only thing not typical Perl here is the PAR environment variable I set, but
+it has no effect, since this is not a PAR package.
+
+----------
+
+Next is program1.pl packaged as a standalone binary executable, Perl lib not
+bundled:
+
+ C:\Par>pp -d -o demo.exe program1.pl
+
+ C:\Par>demo.exe a b c
+ My basename is demo
+ $0 = demo.exe
+ My args are: a b c
+ My @INC is: CODE(0xdb6a80) c:/Perl/lib c:/Perl/site/lib .
+
+ I am a PAR package
+ I am a binary file
+ I am running as '$0 @ARGV'
+ demo.exe a b c
+
+ My temp dir is
+ c:\temp\par-astewart\temp-1560
+ and it will be deleted after the script finishes
+ A copy of this script was extracted as
+ C:\temp\par-astewart\temp-1560\QY7snBlZYa
+
+ PAR environment:
+ PAR_0=C:\temp\par-astewart\temp-1560\QY7snBlZYa
+ PAR_CLEAN=1
+ PAR_GLOBAL_CLEAN=1
+ PAR_INITIALIZED=2
+ PAR_PROGNAME=.\demo.exe
+ PAR_TEMP=c:\temp\par-astewart\temp-1560
+
+ C:\Par>
+
+What's new? The basename is the same (demo), but $0 is now the executable name
+and there is a PAR environment variable PAR_PROGNAME that is almost the same
+as $0. If I had run it as "c:\Par\demo.exe", they would have been exactly the
+same.
+
+There is a code ref in @INC. That's the PAR hook to load the bundled modules
+from the temp dir, instead of the installed Perl lib dirs. It comes first, but
+if a module failed to get bundled into demo.exe, it might still be found thru
+the remaining installed lib dirs.
+
+Demo.exe knows it's a PAR package because there is a %PAR::LibCache and it
+contains a key that matches it's own name. That's the line:
+
+ { no warnings; $is_a_PAR = defined $PAR::LibCache{$ENV{PAR_PROGNAME}}}
+
+in program1.pl. The "no warnings" avoids undef complaints if it's not a PAR
+package. The value of $PAR::LibCache{$ENV{PAR_PROGNAME}} is a zip handle and
+could be used to directly access the PAR inside demo.exe with Archive::Zip
+functions.
+
+There is a PAR temp dir created, made up of the environment variable TEMP plus
+"par-" plus my login name plus "temp-" plus the pid of demo.exe. And the whole
+string is in PAR_TEMP. Because it's based on the pid, it will be different
+each time demo.exe runs.
+
+We get this style of temp dir because PAR_CLEAN=1 during demo.exe and that's
+because PAR_GLOBAL_CLEAN=1. It would also have been so if we packaged demo.exe
+with "pp -C". And because it's "clean", the temp dir will be deleted when
+demo.exe successfully finishes. If demo.exe crashes, it won't be deleted.
+
+PAR_0 gives us the name of a copy of program1.pl that was extracted into the
+temp dir. That's useful for a program that wants to open itself as a file,
+perhaps to read __DATA__ sections.
+
+PAR_INITIALIZED is an internal state variable that is of no use to the
+program. It's used by the binary frontend. It should always equal 2.
+
+----------
+
+Let's run the same demo.exe again except, not "clean":
+
+ C:\Par>set PAR_GLOBAL_CLEAN=0
+
+ C:\Par>demo.exe
+ My basename is demo
+ $0 = demo.exe
+ My args are: a b c
+ My @INC is: c:\temp\par-astewart\cache-1d17637b82735e7e0e52c193b4fdd54e
+ 7ddba73c/inc/lib c:\temp\par-astewart\cache-1d17637b82735e7e0e52c193b4f
+ dd54e7ddba73c/inc CODE(0xdd1968) c:/Perl/lib c:/Perl/site/lib .
+
+ I am a PAR package
+ I am a binary file
+ I am running as '$0 @ARGV'
+ demo.exe a b c
+
+ My temp dir is
+ c:\temp\par-astewart\cache-1d17637b82735e7e0e52c193b4fdd54e7ddb
+ a73c
+ and it will NOT be deleted after the script finishes
+ A copy of this script was extracted as
+ C:\temp\par-astewart\cache-1d17637b82735e7e0e52c193b4fdd54e7ddb
+ a73c\d2f130a4.pl
+
+ PAR environment:
+ PAR_0=C:\temp\par-astewart\cache-1d17637b82735e7e0e52c193b4fdd54e7ddba7
+ 3c\d2f130a4.pl
+ PAR_CLEAN=0
+ PAR_GLOBAL_CLEAN=0
+ PAR_INITIALIZED=2
+ PAR_PROGNAME=.\demo.exe
+ PAR_TEMP=c:\temp\par-astewart\cache-1d17637b82735e7e0e52c193b4fdd54e7dd
+ ba73c
+
+ C:\Par>
+
+Three things happened. First, the temp dir is really long! It's
+made up of TEMP plus "par-" plus my login name plus "cache-" plus an SHA1 160
+bit hash of the demo.exe file. And it won't be deleted at the end of demo.exe.
+The next time demo.exe runs, it will be re-used and extraction will not be
+re-done. All because PAR_CLEAN=0 while demo.exe is running. The temp dir will
+only change if demo.exe is modified and re-packaged, creating a new SHA1 hash
+value.
+
+ at INC also has two new values in it. Because demo.exe is not running "clean",
+all of the source files were extracted from the PAR into an "inc/" dir
+inside the temp dir. This is to facilitate modules that parse other modules.
+If you use such parsing modules, you can't run "clean". Shared libs are not
+extracted here - they are in the base temp dir, whether "clean" or not
+"clean".
+
+I set PAR_GLOBAL_CLEAN=0 which will force not "clean" even if I had packaged
+demo.exe with "pp -C". If I had undefined PAR_GLOBAL_CLEAN, then it would
+depend on the use of "-C" to set PAR_CLEAN.
+
+----------
+
+Let's go "clean" again, to avoid those long dir names, and bundle the Perl lib
+into the package:
+
+ C:\Par>set PAR_GLOBAL_CLEAN=1
+
+ C:\Par>pp -o demo.exe program1.pl
+
+ C:\Par>demo.exe a b c
+ My basename is demo
+ $0 = C:\Par\demo.exe
+ My args are: a b c
+ My @INC is: CODE(0xdb6d44) .
+
+ I am a PAR package
+ I am a binary file
+ I am running as '$0 @ARGV'
+ C:\Par\demo.exe a b c
+
+ My temp dir is
+ c:\temp\par-astewart\temp-1668
+ and it will be deleted after the script finishes
+ A copy of this script was extracted as
+ C:\temp\par-astewart\temp-1668\sXVehq3Yl0
+
+ PAR environment:
+ PAR_0=C:\temp\par-astewart\temp-1668\sXVehq3Yl0
+ PAR_ARGC=4
+ PAR_ARGV_0=demo.exe
+ PAR_ARGV_1=a
+ PAR_ARGV_2=b
+ PAR_ARGV_3=c
+ PAR_CLEAN=1
+ PAR_GLOBAL_CLEAN=1
+ PAR_INITIALIZED=2
+ PAR_PROGNAME=C:\Par\demo.exe
+ PAR_SPAWNED=1
+ PAR_TEMP=c:\temp\par-astewart\temp-1668
+
+A few more changes. $PAR_PROGNAME and $0 have full pathnames regardless of how
+I launch them. When a non-dependant PAR package runs, there is a two stage
+binary frontend: first the executable demo.exe that I ran, then a second
+demo.exe that is extracted to the temp dir and run as a child of the first. If
+you look at the process list while demo.exe runs, you'll see two processes
+with the same name. In the previous example, there was only the second
+process.
+
+You can see the first process telling the second that is a child
+(PAR_SPAWNED=1) and passing the command line args as environment variables
+(PAR_ARGC and PAR_ARGV_x).
+
+But what happened to the installed Perl lib paths in @INC ? This is a Windows
+effect. Because perl58.dll was bundled, extracted into temp and loaded from
+there, it could not find the installed lib dirs. In Linux, the lib dirs are
+coded into the shared lib and would appear in @INC even after moving the
+executable to another machine. So if all the modules you need are bundled in
+the PAR package, invalid Linux lib paths in @INC might be a problem. If you
+want to make sure that only bundled modules are used, add this to the top of
+your program:
+
+ BEGIN {
+ my @refinc = grep { ref } @INC;
+ @INC = @refinc if @refinc;
+ }
+
+If there is a PAR code hook in @INC, then the other fixed paths are removed.
+
+----------
+
+Now for a standalone Perl script.
+
+ C:\Par>pp -P -o demo.pl program1.pl
+
+ C:\Par>perl demo.pl a b c
+ My basename is demo
+ $0 = demo.pl
+ My args are: a b c
+ My @INC is: CODE(0x1cb4efc) c:/Perl/lib c:/Perl/site/lib .
+
+ I am a PAR package
+ I am a Perl script
+ I am running as '$^X $0 @ARGV'
+ c:\Perl\bin\perl.exe demo.pl a b c
+
+ My temp dir is
+ c:\temp\par-astewart\temp-1376
+ and it will be deleted after the script finishes
+ A copy of this script was extracted as
+ C:\temp\par-astewart\temp-1376\GinF3AxRux
+
+ PAR environment:
+ PAR_0=C:\temp\par-astewart\temp-1376\GinF3AxRux
+ PAR_CLEAN=1
+ PAR_GLOBAL_CLEAN=1
+ PAR_INITIALIZED=2
+ PAR_PROGNAME=.\demo.pl
+ PAR_TEMP=c:\temp\par-astewart\temp-1376
+
+ C:\Par>
+
+Looks a lot like "pp -d -o demo.exe program1.pl". The frontend is plain text
+Perl, no shared lib bundled. Using "-T $0" works because it doesn't check far
+enough into the file to see zip binary stuff in the back.
+
+Since this is Perl script, it can be run as an argument to $^X, or rely on the
+shebang line in Linux, or associate it with the perl.exe in Windows.
+
+An advantage to standalone Perl scripts over binary executables is that they
+can be made multi-arch and run on different OSes by packing the XS portions
+for each architecture. A binary executable is unique to the OS.
+
+----------
+
+The last form of a PAR package is a PAR file.
+
+ C:\Par>pp -p -o demo.par program1.pl
+
+ C:\Par>perl -MPAR demo.par a b c
+ My basename is demo
+ $0 = demo.par
+ My args are: a b c
+ My @INC is: C:\temp\par-astewart\cache-7a335837542a9519464f5484d8b281dd
+ f0a727ca/inc/lib C:\temp\par-astewart\cache-7a335837542a9519464f5484d8b
+ 281ddf0a727ca/inc CODE(0x1890848) c:/Perl/lib c:/Perl/site/lib .
+
+ I am a PAR package
+ I am a binary file
+ I am running as '$^X -MPAR $0 @ARGV'
+ c:\Perl\bin\perl.exe -MPAR demo.par a b c
+
+ My temp dir is
+ C:\temp\par-astewart\cache-7a335837542a9519464f5484d8b281ddf0a7
+ 27ca
+ and it will NOT be deleted after the script finishes
+ A copy of this script was extracted as
+ C:\temp\par-astewart\cache-7a335837542a9519464f5484d8b281ddf0a7
+ 27ca\d2f130a4.pl
+
+ PAR environment:
+ PAR_0=C:\temp\par-astewart\cache-7a335837542a9519464f5484d8b281ddf0a727
+ ca\d2f130a4.pl
+ PAR_GLOBAL_CLEAN=1
+ PAR_PROGNAME=demo.par
+ PAR_TEMP=C:\temp\par-astewart\cache-7a335837542a9519464f5484d8b281ddf0a
+ 727ca
+
+ C:\Par>
+
+This ran much like the standalone script, except invoking "-MPAR". But why
+didn't it run clean when PAR_GLOBAL_CLEAN=1 ? Because there is no frontend,
+binary or Perl, and therefore no way to clean up when the script finishes. If
+you need to run from a .par file and you need to clean up, you'll have to do
+it yourself.
+
+----------
+
+So far the temp dir has been based on the current value of $ENV{TEMP}. What if
+we want the temp dir to be some specific place for our application, regardless
+of system values ?
+
+ C:\Par>set PAR_GLOBAL_TEMP=c:\Par\temp
+
+ C:\Par>demo.exe a b c
+ My basename is demo
+ $0 = C:\Par\demo.exe
+ My args are: a b c
+ My @INC is: c:\Par\temp/inc/lib c:\Par\temp/inc CODE(0xdb2718) .
+
+ I am a PAR package
+ I am a binary file
+ I am running as '$0 @ARGV'
+ C:\Par\demo.exe a b c
+
+ My temp dir is
+ c:\Par\temp
+ and it will NOT be deleted after the script finishes
+ A copy of this script was extracted as
+ C:\Par\temp\d2f130a4.pl
+
+ PAR environment:
+ PAR_0=C:\Par\temp\d2f130a4.pl
+ PAR_ARGC=4
+ PAR_ARGV_0=demo.exe
+ PAR_ARGV_1=a
+ PAR_ARGV_2=b
+ PAR_ARGV_3=c
+ PAR_GLOBAL_CLEAN=1
+ PAR_GLOBAL_TEMP=c:\Par\temp
+ PAR_INITIALIZED=2
+ PAR_PROGNAME=C:\Par\demo.exe
+ PAR_SPAWNED=1
+ PAR_TEMP=c:\Par\temp
+
+ C:\Par>
+
+PAR_TEMP is set to PAR_GLOBAL_TEMP, but PAR_GLOBAL_CLEAN is overidden. If you
+chose a fixed temp dir, you also clean up after yourself. There is currently
+no way to define a fixed temp dir inside the PAR package, and since temp dir
+creation is done before the script runs, PAR_GLOBAL_TEMP must be set before
+running the PAR package.
+
+----------
+
+What about PAR packages with multiple scripts inside? First, a binary
+executable with two scripts inside. I'll package program2.pl and program3.pl
+(see listings below).
+
+ C:\Par>pp -o demo.exe program2.pl program3.pl
+
+ C:\Par>demo.exe a b c
+ Can't open perl script "demo": No such file or directory at script/main
+ .pl line 5.
+
+ C:\Par>
+
+What went wrong ? If there had been only one script inside, demo.exe would
+have run it. Since there is more than one, it determines the script name from
+it's own name.
+
+ C:\Par>copy demo.exe program2.exe
+ 1 file(s) copied.
+
+ C:\Par>copy demo.exe program3.exe
+ 1 file(s) copied.
+
+ C:\Par>program2.exe a b c
+ This is program2
+ My args are: a b c
+
+ C:\Par>program3.exe a b c
+ This is program3
+ My args are: a b c
+
+ C:\Par>
+
+----------
+
+And a PAR file with the same two programs:
+
+ C:\Par>pp -p -o demo.par program2.pl program3.pl
+
+ C:\Par>perl -MPAR demo.par program2 a b c
+ This is program2
+ My args are: a b c
+
+ C:\Par>perl -MPAR demo.par program3 a b c
+ This is program3
+ My args are: a b c
+
+ C:\Par>
+
+The names "program2" and "program3" are not passed as args. The value of $0 is
+"demo.par". I don't know of a way to get the command line script name.
+
+----------
+
+One last Windows user warning !! If you have a PAR package calling another PAR
+package with system() or exec(), beware of mixing dependant packages made with
+"pp -d" and non-dependant packages without "-d". One wants to use the
+perl5x.dll from the installed path and the other wants to use the perl5x.dll
+bundled in the package and loading from the temp dir. However, when one calls
+the other, Windows wants to use the perl5x.dll already in memory for the
+second one. Bad things can happen, since the Perl interpreter doesn't get
+initialized as expected. If you must mix, then wipe out the local PAR
+environment yourself before calling the other package, as program4.pl does.
+You may still see some peculiarities, such as:
+
+ C:\Par>set PAR_GLOBAL_TEMP=
+
+ C:\Par>pp -o program4.exe program4.pl
+
+ C:\Par>pp -d -o program5.exe program5.pl
+
+ C:\Par>program4.exe
+ This is program4
+ My @INC = CODE(0xdb6380) .
+ This is program5
+ My @INC = CODE(0xdb7134) .
+
+Even though program5.pl was packaged as "-d", it's @INC indicates that it is
+using the perl5x.dll in memory from program4.pl and therefore can't locate the
+installed lib dirs. I recommend not mixing package types !
+
+----------
+
+I hope all this helps. Package program1.pl in a variety of ways on your system
+and see what you get. If you discover any errors in this doc or some
+radically different behaviour on another OS, let me know :)
+
+Alan Stewart
+astewart1 at cox.net
+
+P.S. This doc is in the public domain.
+
+
+#####################################################################
+Listing: program1.pl
+#####################################################################
+#!perl
+use strict;
+use warnings;
+use File::Basename;
+
+my $basename = basename($0, qw( .par .pl .exe ));
+print "My basename is $basename\n\$0 = $0\n";
+print "My args are: @ARGV\n";
+print "My \@INC is: @INC\n";
+print "\n";
+
+my $is_a_PAR;
+{ no warnings; $is_a_PAR = defined $PAR::LibCache{$ENV{PAR_PROGNAME}}}
+
+if ($is_a_PAR) {
+ print "I am a PAR package\n";
+ my $is_text = -T $0;
+ print $is_text ? "I am a Perl script\n" : "I am a binary file\n";
+
+ if ($0 =~ /\.par/) {
+ print "I am running as '\$^X -MPAR \$0 \@ARGV'\n";
+ print "\t$^X -MPAR $0 @ARGV\n"
+ }
+ elsif ($0 =~ /\.pl$/) {
+ print "I am running as '\$^X \$0 \@ARGV'\n";
+ print "\t$^X $0 @ARGV\n";
+ }
+ elsif ($0 =~ /\.exe/) {
+ print "I am running as '\$0 \@ARGV'\n";
+ print "\t$0 @ARGV\n";
+ }
+ else {
+ if ($is_text) {
+ print "I am running as '\$^X \$0 \@ARGV'\n";
+ print "\t$^X $0 @ARGV\n";
+ }
+ else {
+ print "I am running as '\$0 \@ARGV'/n";
+ print "\t$0 @ARGV/n";
+ }
+ }
+ print "\n";
+ print "My temp dir is \n\t$ENV{PAR_TEMP}\n";
+ print "\tand it will ", $ENV{PAR_CLEAN} ? "" : "NOT ";
+ print "be deleted after the script finishes\n";
+ print "A copy of this script was extracted as \n\t$ENV{PAR_0}\n";
+}
+else {
+ print "I am NOT a PAR package\n";
+ print "I am running as '\$^X \$0 \@ARGV'\n";
+ print "\t$^X $0 @ARGV\n";
+}
+
+print "\n";
+print "PAR environment:\n";
+for (sort keys %ENV) {
+ print "$_=$ENV{$_}\n" if /^PAR_/;
+}
+
+
+#####################################################################
+## Listing: program2.pl
+#####################################################################
+#!perl
+
+print "This is program2\n";
+print "My args are: @ARGV\n";
+
+
+#####################################################################
+## Listing: program3.pl
+#####################################################################
+#!perl
+
+print "This is program3\n";
+print "My args are: @ARGV\n";
+
+
+#####################################################################
+## Listing: program4.pl
+#####################################################################
+#!perl
+
+print "This is program4\n";
+print "My \@INC = @INC\n";
+for (keys %ENV) {delete $ENV{$_} if /^PAR_(?!GLOBAL)/}
+system "program5.exe";
+
+
+#####################################################################
+## Listing: program5.pl
+#####################################################################
+#!perl
+
+print "This is program5\n";
+print "My \@INC = @INC\n";
+
+
+#####################################################################
\ No newline at end of file
Added: packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,488 @@
+#!perl -w
+use strict;
+
+our $VERSION = '2.2';
+
+use Tk;
+use Tk::ROText;
+use Tk::LabFrame;
+use Tk::Pane;
+use Tk::Balloon;
+use Tk::HistEntry;
+use Tk::NumEntry;
+
+use Cwd;
+use FindBin;
+use File::Spec;
+use Data::Dumper;
+use Pod::Simple::Text;
+
+use PAR::Packer;
+my $optref = PAR::Packer::OPTIONS;
+
+our ( @opts, @type, @def, @chkd, @value );
+our ( $source_file, $output_file, $log_file_ref, %hist_refs );
+
+my $mw = MainWindow->new( -title => "gpp $VERSION - gui for pp" );
+my $default_size = '500x500'; # for $mw, $hw and $lw
+$mw->geometry($default_size);
+$mw->minsize( 250, 250 );
+$mw->setPalette('cornsilk3');
+$mw->optionAdd( '*font' => 'Courier 10' );
+my $entry_font_color = 'blue';
+my $balloon_font = 'Courier 8';
+my $balloon_color = 'yellow';
+my $dots_font = 'Courier 5';
+my $pl_types = [ [ 'pp source', [ '.par', '.pl', '.ptk', '.pm' ] ], [ 'All files', '*' ] ];
+my $gpp_types = [ [ 'gpp options', ['.gpp'] ], [ 'All files', '*' ] ];
+my $default_gpp_ext = '.gpp';
+
+my $pp = find_pp();
+if ( !$pp ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "Can't find pp !!",
+ -type => 'OK'
+ );
+ exit(1);
+}
+if ( !open PP, "<$pp" ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "Can't open $pp: $!",
+ -type => 'OK'
+ );
+ exit(1);
+}
+my $pp_text;
+{
+ undef $/;
+ $pp_text = <PP>;
+}
+close PP;
+
+ at opts = sort {
+ lc( substr( $a, 0, index( $a, '|' ) ) ) cmp lc( substr( $b, 0, index( $b, '|' ) ) )
+ || $a cmp $b
+} keys %$optref;
+for (@opts) { push @def, $$optref{$_} }
+
+# parse option specifiers
+for ( 0 .. $#opts ) {
+ my ($short) = ( $opts[$_] =~ /([^|]+)/ );
+ $type[$_] = '';
+ $type[$_] = $1 if $opts[$_] =~ /([=:].*)/;
+ $opts[$_] = $short;
+ $chkd[$_] = 0;
+ $value[$_] = 0 if $type[$_] =~ /i/;
+ $value[$_] = '' if $type[$_] =~ /[fs]/;
+ $log_file_ref = \$value[$_] if $opts[$_] eq 'L';
+}
+
+my $f = $mw->Frame( -borderwidth => 5 )->pack( -expand => 1, -fill => 'both' );
+
+my $fb = $f->Frame()->pack( -fill => 'x' );
+my $fb1 = $fb->Frame()->pack( -side => 'left', -expand => 'y', -fill => 'x' );
+$fb1->Button( -text => 'Pack', -command => sub { run_pp() } )->pack( -expand => 1, -fill => 'x' );
+$fb1->Button( -text => 'View Log', -command => sub { view_log() } )
+ ->pack( -expand => 1, -fill => 'x' );
+my $fb2 = $fb->Frame()->pack( -side => 'left', -expand => 'y', -fill => 'x' );
+$fb2->Button( -text => 'Open Opts',
+ -command => sub { open_opts(); }
+ )->pack( -expand => 1, -fill => 'x' );
+$fb2->Button( -text => 'Save Opts',
+ -command => sub { save_opts(); }
+ )->pack( -expand => 1, -fill => 'x' );
+my $fb3 = $fb->Frame()->pack( -side => 'left', -expand => 'y', -fill => 'x' );
+$fb3->Button( -text => 'Exit', -command => sub { save_hist() } )
+ ->pack( -expand => 1, -fill => 'x' );
+$fb3->Button( -text => 'Help', -command => sub { help() } )->pack( -expand => 1, -fill => 'x' );
+
+my $ff = $f->Frame( -borderwidth => 5, )->pack( -fill => 'x' );
+my $fn = $ff->Frame()->pack( -side => 'left' );
+$fn->Label( -text => 'Source File:' )->pack( -anchor => 'e' );
+$fn->Label( -text => 'Output File:' )->pack( -anchor => 'e' );
+my $fe = $ff->Frame()->pack( -side => 'left', -expand => 1, -fill => 'x' );
+my $source_entry = $fe->HistEntry( -textvariable => \$source_file,
+ -width => 1,
+ -fg => $entry_font_color,
+ -selectbackground => $entry_font_color,
+ -dup => 0,
+ -case => 0, # works opposite of pod
+ -match => 1,
+ -limit => 10,
+ -command => sub { }
+ )->pack( -expand => 1, -fill => 'x' );
+$source_entry->Subwidget('slistbox')->configure( -bg => 'white' );
+my $output_entry = $fe->HistEntry( -textvariable => \$output_file,
+ -width => 1,
+ -fg => $entry_font_color,
+ -selectbackground => $entry_font_color,
+ -dup => 0,
+ -case => 0, # works opposite of pod
+ -match => 1,
+ -limit => 10,
+ -command => sub { }
+ )->pack( -expand => 1, -fill => 'x' );
+$output_entry->Subwidget('slistbox')->configure( -bg => 'white' );
+my $fg = $ff->Frame()->pack( -side => 'left', -fill => 'y' );
+$fg->Button(
+ -text => '...',
+ -font => $dots_font,
+ -command => sub {
+ my $file = $mw->getOpenFile( -filetypes => $pl_types );
+ if ($file) {
+ $source_file = $file;
+ $source_file = '"' . $source_file . '"' if $source_file =~ / / and $^O =~ /win32/i;
+ $source_entry->xview('end');
+ $source_entry->historyAdd();
+ }
+ }
+)->pack(-expand => 'y', -fill => 'y');
+$fg->Button(
+ -text => '...',
+ -font => $dots_font,
+ -command => sub {
+ my $file = $mw->getSaveFile();
+ if ($file) {
+ $output_file = $file;
+ $output_file = '"' . $output_file . '"' if $output_file =~ / / and $^O =~ /win32/i;
+ $output_entry->xview('end');
+ $output_entry->historyAdd();
+ }
+ }
+)->pack(-expand => 'y', -fill => 'y');
+
+my $fo =
+ $f->LabFrame( -label => 'Options', -labelside => 'acrosstop' )
+ ->pack( -expand => 1, -fill => 'both' );
+my $p = $fo->Scrolled( 'Pane',
+ -scrollbars => 'osw',
+ -sticky => 'we',
+ )->pack( -expand => 1, -fill => 'both' );
+for ( 0 .. $#opts ) {
+ next if $opts[$_] =~ /^[oh]$/;
+
+ my $fp = $p->Frame()->pack( -expand => 'y', -fill => 'both' );
+ my $c = $fp->Checkbutton( -text => $opts[$_],
+ -variable => \$chkd[$_],
+ -selectcolor => 'white'
+ )->pack( -side => 'left' );
+ $fp->Balloon( -bg => $balloon_color, -font => $balloon_font )
+ ->attach( $c, -balloonmsg => $def[$_] );
+ if ( $type[$_] =~ /[@%]/ ) {
+ if ( $type[$_] =~ /=/ ) {
+ $fp->Label( -text => '+' )->pack( -side => 'left' );
+ }
+ else {
+ $fp->Label( -text => '*' )->pack( -side => 'left' );
+ }
+ }
+ else {
+ $fp->Label( -text => ' ' )->pack( -side => 'left' );
+ }
+ my $he;
+ if ( $type[$_] =~ /[fs]/ ) {
+ $he = $fp->HistEntry( -textvariable => \$value[$_],
+ -width => 1,
+ -fg => $entry_font_color,
+ -selectbackground => $entry_font_color,
+ -dup => 0,
+ -case => 0, # works opposite of pod
+ -match => 1,
+ -limit => 10,
+ -command => sub { },
+ )->pack( -side => 'left', -expand => 'y', -fill => 'x' );
+ $he->Subwidget('slistbox')->configure( -bg => 'white' );
+ $hist_refs{ $opts[$_] } = $he;
+ }
+ if ( $type[$_] =~ /f/ ) {
+ $he->Subwidget('entry')->configure( -validate => 'key' );
+ $he->Subwidget('entry')->configure(
+ -validatecommand => sub {
+ $_[0] =~ /^[+-]?\.?$| # starting entry
+ ^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d*))?$ # continuing entry
+ /x; # not validated if the entry ever actually finishes
+ }
+ );
+ }
+ if ( $type[$_] =~ /i/ ) {
+ $fp->NumEntry( -textvariable => \$value[$_],
+ -width => 5,
+ -fg => $entry_font_color,
+ -selectbackground => $entry_font_color,
+ )->pack( -side => 'left' );
+ }
+}
+
+my ( $hw, $hwt ); # help toplevel/text
+my ( $lw, $lwt ); # view log toplevel/text
+$mw->waitVisibility;
+
+open_opts( $ARGV[0] ) if $ARGV[0];
+my $gpp_history = $ENV{HOME} || $ENV{HOMEPATH} || $FindBin::Bin;
+$gpp_history .= '/.gpp.history';
+open_hist();
+
+$source_entry->focus;
+MainLoop;
+
+sub find_pp {
+ my $pp = 'pp';
+ $pp .= '.bat' if $^O =~ /win32/i;
+ return File::Spec->catfile( cwd(), $pp ) if -e $pp;
+ my @path = File::Spec->path();
+ for (@path) {
+ my $full_name = File::Spec->catfile( $_, $pp );
+ return $full_name if -e $full_name;
+ }
+ return undef;
+}
+
+sub open_opts {
+ my $opts_file = shift;
+ if ( !$opts_file ) {
+ $opts_file = $mw->getOpenFile( -filetype => $gpp_types );
+ }
+ return if !$opts_file;
+ my ( $save_chkd, $save_value );
+ if ( !open OH, "<$opts_file" ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$opts_file: $!",
+ -type => 'OK'
+ );
+ return;
+ }
+ my $opts_dump;
+ {
+ undef $/;
+ $opts_dump = <OH>;
+ }
+ close OH;
+ if ( $opts_dump !~ /\$save_chkd\s*=.*?\$save_value\s*=/s ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$opts_file: Not a gpp option file !!",
+ -type => 'OK'
+ );
+ return;
+ }
+ eval $opts_dump;
+ if ($@) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$opts_file: $@",
+ -type => 'OK'
+ );
+ return;
+ }
+ for ( 0 .. $#opts ) {
+ if ( exists $save_chkd->{ $opts[$_] } ) {
+ $chkd[$_] = $save_chkd->{ $opts[$_] };
+ $value[$_] = $save_value->{ $opts[$_] };
+ }
+ }
+} ## end sub open_opts
+
+sub save_opts {
+ my $opts_file =
+ $mw->getSaveFile( -filetypes => $gpp_types, -defaultextension => $default_gpp_ext );
+ return if !$opts_file;
+ my ( %save_chkd, %save_value );
+ for ( 0 .. $#opts ) {
+ $save_chkd{ $opts[$_] } = $chkd[$_];
+ $save_value{ $opts[$_] } = $value[$_];
+ }
+ if ( !open OH, ">$opts_file" ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$opts_file: $!",
+ -type => 'OK'
+ );
+ return;
+ }
+ print OH Data::Dumper->Dump( [ $source_file, $output_file, \%save_chkd, \%save_value ],
+ [qw( source_file output_file save_chkd save_value )] );
+ close OH;
+}
+
+sub open_hist {
+ return if !-e $gpp_history;
+ my ( $source_hist, $output_hist, $opts_hist );
+ if ( !open HH, "<$gpp_history" ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$gpp_history: $!",
+ -type => 'OK'
+ );
+ return;
+ }
+ my $hist_dump;
+ {
+ undef $/;
+ $hist_dump = <HH>;
+ }
+ close HH;
+ if ( $hist_dump !~ /\$source_hist\s*=.*?\$output_hist\s*=/s ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$gpp_history: Not a gpp history file !!",
+ -type => 'OK'
+ );
+ return;
+ }
+ eval $hist_dump;
+ if ($@) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$gpp_history: $@",
+ -type => 'OK'
+ );
+ return;
+ }
+ $source_entry->history($source_hist);
+ $output_entry->history($output_hist);
+ for ( 0 .. $#opts ) {
+ if ( exists $opts_hist->{ $opts[$_] } ) {
+ $hist_refs{ $opts[$_] }->history( $opts_hist->{ $opts[$_] } );
+ }
+ }
+} ## end sub open_hist
+
+sub save_hist {
+ if ( !open HH, ">$gpp_history" ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$gpp_history: $!",
+ -type => 'OK'
+ );
+ return;
+ }
+ my ( $source_hist, $output_hist );
+ $source_hist = [ $source_entry->history() ];
+ $output_hist = [ $output_entry->history() ];
+ for ( keys %hist_refs ) {
+ $hist_refs{$_} = [ $hist_refs{$_}->history() ];
+ }
+ print HH Data::Dumper->Dump( [ $source_hist, $output_hist, \%hist_refs ],
+ [qw( source_hist output_hist opts_hist )] );
+ close HH;
+ exit();
+}
+
+sub view_log {
+ my $file = $$log_file_ref;
+ $file =~ s/^"(.*)"$/$1/;
+ return if !$file;
+ if ( !open LH, "<$file" ) {
+ $mw->messageBox( -title => 'Error',
+ -icon => 'error',
+ -message => "$file: $!",
+ -type => 'OK'
+ );
+ return;
+ }
+ my $log_text;
+ {
+ undef $/;
+ $log_text = <LH>;
+ }
+ close LH;
+ if ( !Exists($lw) ) {
+ $lw = $mw->Toplevel( -title => 'Log file' );
+ my ( $x, $y ) = ( $mw->geometry() =~ /^\d+x\d+\+(\d+)\+(\d+)/ );
+ $lw->geometry( $default_size . '+' . ( $x + 20 ) . '+' . ( $y + 20 ) );
+ $lw->minsize( 200, 30 );
+ my $fb = $lw->Frame()->pack( -fill => 'x' );
+ $fb->Button( -text => 'Close', -command => sub { $lw->withdraw() } )
+ ->pack( -side => 'left', -expand => 'y', -fill => 'x' );
+ $fb->Button( -text => 'Clear Log file',
+ -command => sub { open LH, ">$file"; close LH; $lw->withdraw() }
+ )->pack( -side => 'right' );
+ $lwt = $lw->Scrolled( "Text",
+ -scrollbars => 'osw',
+ -wrap => 'none',
+ -height => 1,
+ -width => 1
+ )->pack( -expand => 1, -fill => 'both' );
+ $lwt->insert( 'end', $log_text );
+ $lw->focus();
+ }
+ else {
+ $lwt->delete( '0.0', 'end' );
+ $lwt->insert( 'end', $log_text );
+ $lw->deiconify();
+ $lw->raise();
+ $lw->focus();
+ }
+} ## end sub view_log
+
+sub help {
+ if ( !Exists($hw) ) {
+ $hw = $mw->Toplevel( -title => 'Help for pp' );
+ my ( $x, $y ) = ( $mw->geometry() =~ /^\d+x\d+\+(\d+)\+(\d+)/ );
+ $hw->geometry( $default_size . '+' . ( $x + 40 ) . '+' . ( $y + 40 ) );
+ $hw->minsize( 100, 30 );
+ $hw->Button( -text => 'Close', -command => sub { $hw->withdraw } )->pack( -fill => 'x' );
+ my $parser = Pod::Simple::Text->new();
+ my $pod;
+ $parser->output_string( \$pod );
+ $parser->parse_string_document($pp_text);
+ $hwt = $hw->Scrolled( "Text",
+ -scrollbars => 'osw',
+ -wrap => 'none',
+ -height => 1,
+ -width => 1
+ )->pack( -expand => 1, -fill => 'both' );
+ $hwt->insert( 'end', $pod );
+ $hw->focus();
+ }
+ else {
+ $hw->deiconify();
+ $hw->raise();
+ $hw->focus();
+ }
+}
+
+sub run_pp {
+ my @pp_opts = ();
+ for ( 0 .. $#opts ) {
+ if ( $chkd[$_] ) {
+ if ( ( $type[$_] eq '' ) or ( $type[$_] =~ /:/ and $value[$_] eq '' ) ) {
+ push @pp_opts, '-' . $opts[$_];
+ }
+ elsif ( $type[$_] =~ /[ifs]$/ ) {
+ push @pp_opts, '-' . $opts[$_];
+ push @pp_opts, $value[$_];
+ }
+ elsif ( $type[$_] =~ /[fs][@%]/ ) {
+ my @multi = ();
+ my $value = $value[$_];
+
+ # Look for quoted strings first, then non-blank strings,
+ # separated by spaces, commas or semicolons
+ while ( $value =~ /\G\s*((['"])[^\2]*?\2)\s*[,;]?|\G\s*([^\s,;]+)\s*[,;]?/g ) {
+ push( @multi, defined($1) ? $1 : $3 );
+ }
+ for $value (@multi) {
+ push @pp_opts, '-' . $opts[$_];
+ push @pp_opts, $value;
+ }
+ }
+ }
+ }
+ if ($output_file) {
+ push @pp_opts, '-o';
+ push @pp_opts, $output_file;
+ }
+ if ($source_file) {
+ push @pp_opts, $source_file;
+ }
+ print "$pp @pp_opts\n";
+ $mw->Busy();
+
+ system $pp, @pp_opts;
+ $mw->Unbusy();
+ print "Done.\n\n";
+} ## end sub run_pp
\ No newline at end of file
Added: packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp_readme.txt
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp_readme.txt 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/gui_pp/gpp_readme.txt 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,89 @@
+gpp - a gui for pp
+------------------
+Version 2.2
+
+Gpp provides (yet another) gui frontend to the PAR compiler - pp. The help
+display is taken from the pod in pp (or pp.bat on win32) at runtime, and
+options to pp are "use"ed from Packer.pm, so new options in later PAR versions
+should appear automatically in gpp. Gpp looks for pp (or pp.bat) first in the
+current directory, then in the environment variable PATH.
+
+Options are displayed in a scrolling window, with a checkbox next to each to
+enable it. Options that take an integer value have an up/down counter next to
+them. Options that take a string or non-integer number have an entrybox with a
+pulldown history window. Each option checkbox has a popup hint with the pp
+short description.
+
+Only the following options are expected to be supported by pp and are treated
+specially by gpp:
+ -h
+The "Help" button displays the pp pod and -h doesn't appear in the list.
+ -o <output file>
+The output file has an entry box of it's own and -o doesn't appear in the list,
+ -L <logfile>
+The "View Log" button displays the contents of the file shown next to "L" in
+the option list. It does not need to be checked to view. While viewing the log
+file, "Clear Log File" will set that file to zero length. When pp runs, it
+appends to the log file.
+
+The [...] buttons will browse for source or output files. On win32, files
+returned from the file browser that contain spaces are auto-quoted in the
+entrybox.
+
+For options with a pulldown history, the <Enter> key enters the current value
+into the history list. Browsed files are auto-entered. Duplicates are not be
+saved. Auto-completion from the history is enabled and case sensitive. The
+histories are saved on "Exit" in .gpp.history in the $ENV{HOME} dir or
+$ENV{HOMEPATH} dir or the path of gpp, and restored on startup.
+
+Options which can have multiple values, have a * (zero or more required) or a +
+(one or more required) next to the entrybox. When pp is run, the displayed
+value is broken apart and repeated with the option flag as many times as
+needed. Strings which contain spaces must be quoted. Quoted strings or
+strings-without-spaces can be separated by spaces, commas or semicolons, i.e.
+if the M option value is:
+ "one two" three, four; five six
+the pp command would contain:
+ -M "one two" -M three -M four -M five -M six
+
+The current values of the source file, output file, all option checkboxes and
+values can be saved to a file with "Save Opts". The default file extension is
+".gpp". Saved options are (re)loaded with "Open Opts". All values are saved,
+but a .gpp file could be hand editted to remove some values, so the resulting
+file could be loaded as a partial "default", without changing those values.
+The format is ordinary Perl. Gpp accepts an option file as an optional
+parameter on the command line.
+
+The pp command that is assembled by "Pack" is echoed in the console window,
+before executing pp.
+
+I am a Win32 ActivePerl user, so here is how I set it up.
+------------------
+Place gpp in the directory C:\ActivePerl\bin and then do:
+ pl2bat gpp
+ ftype gppfile="C:\ActivePerl\bin\gpp.bat" "%1"
+ assoc .gpp=gppfile
+or use some user friendly tool (like freeware WAssociate) instead of
+ftype/assoc.
+
+Edit the gpp.bat file to add this line near the top, right after "@echo off":
+ title gpp - Pack output
+so the console windows will have a meaningful title.
+
+Run gpp, select all the default options you normally use and "Save Opts"
+to C:\ActivePerl\bin\default.gpp. Create a desktop icon for:
+ "C:\ActivePerl\bin\gpp.bat" "C:\ActivePerl\bin\default.gpp"
+and change the icon to the one in C:\ActivePerl\bin\parl.exe (a camel).
+
+Now the desktop camel is the default startup, and a .gpp file can be d-clicked
+like a project file.
+------------------
+
+Gpp fonts, colors, browser file types and window sizes are located near the top
+of the gpp script for your tweaking convenience :)
+
+Gpp is free and carries no license or guarantee. It is placed in the public
+domain. Do whatever you want to do with it.
+
+Alan Stewart
+astewart1 at cox.net
\ No newline at end of file
Added: packages/libpar-perl/branches/upstream/current/contrib/pare/pare
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/pare/pare 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/pare/pare 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,163 @@
+#!perl -w
+use strict;
+
+use Archive::Zip qw ( :ERROR_CODES );
+use IO::File;
+use File::Basename;
+use Getopt::Std;
+
+my $VERSION = '1.1';
+my %opt;
+getopt( 'lu', \%opt );
+my @files = @ARGV;
+
+if ( !$opt{u} or !@files ) {
+ print <<".";
+Pare version $VERSION - pare down PAR file sizes by removing files found
+in another PAR and making the reduced PAR "use" the other PAR.
+
+Usage: pare [-l <logfile>] -u <usedfile> <reducedfiles> . . .
+.
+
+ exit;
+}
+
+my $lh;
+if ( $opt{l} ) {
+ my $mode = -f $opt{l} ? '>>' : '>';
+ open $lh, "$mode$opt{l}" or die "Can't open log file $opt{l}: $!\n";
+}
+else {
+ open $lh, ">&STDOUT";
+}
+print $lh <<".";
+-----------------------------------
+Common files in $opt{u} removed from:
+ @files
+-----------------------------------
+.
+
+for (@files) {
+ remove( $_, $opt{u} );
+}
+
+close $lh;
+
+sub remove {
+ my ( $par, $dep_par ) = @_;
+
+ my ( $loader, $buf, $cache_name );
+
+ my $fh = IO::File->new( $par, 'r' ) or die "Can't open $par: $!\n";
+ binmode($fh);
+ my $th = IO::File->new_tmpfile() or die "Can't open temp file: $!\n";
+ binmode($th);
+ select( ( select($th), $| = 1 )[0] );
+
+ $loader = 0;
+ read $fh, $buf, 4;
+ if ( $buf ne "PK\003\004" ) {
+ seek $fh, -8, 2;
+ read $fh, $buf, 8;
+ if ($buf ne "\nPAR.pm\n") {
+ die "File $par doesn't look like a zip or PAR file!\n";
+ }
+
+ seek $fh, -12, 2;
+ read $fh, $buf, 4;
+ seek $fh, -12 - unpack( "N", $buf ), 2;
+ $loader = tell $fh;
+
+ seek $fh, -18, 2;
+ read $fh, $buf, 6;
+ if ($buf eq "\0CACHE") {
+ seek $fh, -58, 2;
+ read $fh, $cache_name, 41;
+ }
+
+ seek $fh, 0, 0;
+ read $fh, $buf, $loader;
+ print $th $buf;
+
+ read $fh, $buf, 4;
+ while ( $buf eq "FILE" ) {
+ print $th $buf;
+
+ # file name
+ read $fh, $buf, 4;
+ print $th $buf;
+ read $fh, $buf, unpack( "N", $buf );
+ print $th $buf;
+
+ # file contents
+ read $fh, $buf, 4;
+ print $th $buf;
+ read $fh, $buf, unpack( "N", $buf );
+ print $th $buf;
+
+ read $fh, $buf, 4;
+ }
+
+ if ($buf ne "PK\003\004") {
+ die "Can't find start of zip in $par\n";
+ }
+ seek $fh, -4, 1;
+
+ }
+
+ my $par_zip = Archive::Zip->new();
+ $par_zip->readFromFileHandle($fh, $par) == AZ_OK or die "Can't read zip in $par\n";
+ my $manifest = $par_zip->contents('MANIFEST');
+ die "Can't find MANIFEST in $par\n" if !$manifest;
+ my $main_pl = $par_zip->contents('script/main.pl');
+ die "Can't find main.pl in $par\n" if !$main_pl;
+ my $dep_zip = Archive::Zip->new($dep_par);
+ die "Can't find or read $dep_par\n" if !$dep_zip;
+
+ print $lh "$par depends on $dep_par for:\n";
+ my $base_par = basename($dep_par);
+ my $used = 'use PAR qw(';
+ if ( $main_pl =~ /^\Q$used/ ) {
+ if ( $main_pl !~ /$base_par/ ) {
+ $main_pl =~ s/^\Q$used/$used $base_par/;
+ }
+ }
+ else {
+ $main_pl = "use PAR qw( $base_par );\n$main_pl";
+ }
+
+ for ( $dep_zip->memberNames() ) {
+ if ( $par_zip->memberNamed($_) ) {
+ if ( !( /MANIFEST/ or /META.yml/ or /^script\// ) ) {
+ $par_zip->removeMember($_);
+ $manifest =~ s/$_\n//;
+ print $lh " $_\n";
+ }
+ }
+ }
+ print $lh "\n";
+
+ $par_zip->contents( 'MANIFEST', $manifest );
+ $par_zip->contents( 'script/main.pl', $main_pl );
+ $par_zip->writeToFileHandle($th);
+
+ if ($loader) {
+ if ($cache_name) {
+ $th->print($cache_name, "CACHE");
+ }
+ $th->print( pack( 'N', $th->tell - $loader ) );
+ $th->print("\nPAR.pm\n");
+ }
+
+ $fh->close;
+ $fh = IO::File->new( $par, 'w' ) or die "Can't open $par for writing: $!\n";
+ binmode($fh);
+
+ seek $th, 0, 0;
+
+ while ( read( $th, $buf, 32768 ) ) {
+ print $fh $buf;
+ }
+
+ close $fh;
+} ## end sub remove
Added: packages/libpar-perl/branches/upstream/current/contrib/pare/pare_readme.txt
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/pare/pare_readme.txt 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/pare/pare_readme.txt 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,90 @@
+pare - A utility to pare down the size of PAR files
+---------------------------------------------------
+Version 1.0
+
+Usage: pare [-l <logfile>] -u <usedfile> <reducedfiles> . . .
+---------------------------------------------------
+
+Pare reduces the size of PAR file by scanning another PAR file and removing
+any matching zipped files found in the other file. Matching is on full paths.
+The matching file is removed from the MANIFEST and a:
+
+ use PAR qw( some.par );
+
+statement is added to the main.pl file, where "some.par" is the
+other PAR file.
+
+As an example, if you have a number of Tk applications, all PAR packaged, each
+PAR application has a copy of all the required Tk files. If all of these
+applications are going to live in the same directory, there is a lot of
+redundancy and you can save disk space by do this:
+
+ pp -e "use Tk;" -p -o Tk.par
+ pare -l log.txt -u Tk.par appl1.exe appl2.exe appl3.exe
+
+After that, Tk.par contains all of the basic Tk stuff, while appl1.exe,
+appl2.exe, and appl3.exe don't. All three applications will have the line:
+
+ use PAR qw( Tk.par);
+
+at the beginning of their main.pl that launches your script. Just put Tk.par
+in the same directory with the applications.
+
+---------------------------------------------------
+
+If application #3 also used LWP, you could continue reducing it with:
+
+ pp -e "use LWP;" -p -o LWP.par
+ pare -l log.txt -u LWP.par appl3.exe
+
+and application #3 would have:
+
+ use PAR qw( LWP.par Tk.par);
+
+at the beginning of its main.pl.
+
+---------------------------------------------------
+
+If you build applications that have a growing list of things in common, you
+could have a file common.pl that contained only the common "use" statements:
+
+ use Tk;
+ use LWP;
+ use This;
+ use The::Other;
+
+and pull them out of the application with:
+
+ pp -p -o common.par common.pl
+ pare -u common.par application.exe
+
+---------------------------------------------------
+
+Reduced and "use"d files can be any of the three PAR type outputs: a
+standalone executable, a standalone perl script, or a PAR (zip) file.
+
+For instance, if you have one application already shipped that is quite large,
+and you want to reduce the size of a second application that uses much of the
+same libraries, you can do:
+
+ pare -u first_app.exe second_app.exe
+
+as long as first_app.exe and second_app.exe are going to be stored at the same
+location. second_app.exe will use first_app.exe as a PAR.
+
+---------------------------------------------------
+
+Pare modifies MANIFEST and main.pl, but not the application code. Nothing in
+the script/ directory will be removed even if it matches in the other PAR file.
+Log output appends to the log file.
+
+In the case of simple zip files, pare automates the process of comparing
+and removing files that could be done with any zip tool. In the case of an
+executable or standalone script, it is also preserving the loader frontend and
+re-calculating the PAR trailer.
+
+Pare is free and carries no license or guarantee. It is placed in the public
+domain. Do whatever you want to do with it.
+
+Alan Stewart
+astewart1 at cox.net
\ No newline at end of file
Added: packages/libpar-perl/branches/upstream/current/contrib/procedural_pp/pp_old
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/procedural_pp/pp_old 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/procedural_pp/pp_old 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,1133 @@
+#!/usr/bin/perl
+
+use 5.006;
+use strict;
+use warnings;
+
+use Config;
+our ($PARL, $OrigPARL);
+
+# bootstrap ourselves on a binary-only install.
+unless (eval { require PAR; 1 }) {
+ $PARL ||= _can_run("parl$Config{_exe}") or die("Can't find par loader");
+ exec($PARL, $0, @ARGV);
+}
+
+use Archive::Zip;
+use Cwd;
+use ExtUtils::MakeMaker; # just for maybe_command()
+use File::Basename;
+use File::Spec;
+use File::Temp qw(tempfile);
+use Getopt::Long;
+use Module::ScanDeps 0.10;
+use PAR::Filter;
+
+our $VERSION = 0.05;
+$| = 1;
+
+$SIG{INT} = sub { exit() }; # exit gracefully and clean up after ourselves.
+
+sub opt(*); # imal quoting
+sub is_win32();
+sub vprint($@);
+
+our ($Options);
+our (@Input, $Output);
+our ($logfh);
+our ($par_file);
+our (@SharedLibs);
+
+my $dynperl = $Config{useshrplib} && ($Config{useshrplib} ne 'false');
+
+main();
+
+sub main {
+ parse_argv();
+ check_write($Output);
+ generate_code();
+ run_code();
+ _die("XXX: Not reached?");
+}
+
+#######################################################################
+
+sub compile_par {
+ my ($cfh, $lose);
+ my $root = '';
+ $root = "$Config{archname}/" if opt('m');
+
+ if (opt(S) || opt(p)) {
+ # We need to keep it.
+ if (opt(e) or !@Input) {
+ $par_file = "a.par";
+ } else {
+ $par_file = $Input[0];
+ # File off extension if present
+ # hold on: plx is executable; also, careful of ordering!
+ $par_file =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
+ $par_file .= ".par";
+ }
+ $par_file = $Output if opt(p) && $Output =~ /\.par\z/i;
+ $Output = $par_file if opt(p);
+ check_write($par_file);
+ } else {
+ # Don't need to keep it, be safe with a tempfile.
+ $lose = 1;
+ ($cfh, $par_file) = tempfile("ppXXXXX", SUFFIX => ".par");
+ close $cfh; # See comment just below
+ }
+ vprint 1, "Writing PAR on $par_file";
+
+ my (@modules, @data, @exclude);
+ foreach my $name (@{opt(M) || []}) {
+ _name2moddata($name, \@modules, \@data);
+ }
+ foreach my $name ('PAR', @{opt(X) || []}) {
+ _name2moddata($name, \@exclude, \@exclude);
+ }
+
+ my %map;
+ unshift @INC, @{opt(I) || []};
+ unshift @SharedLibs, map _find_shlib($_), @{opt(l) || []};
+
+ my %skip = map { $_, 1 } map Module::ScanDeps::_find_in_inc($_), @exclude;
+ my @files = ((map Module::ScanDeps::_find_in_inc($_), @modules), @Input);
+ my $scan_dispatch = (
+ opt(n) ? \&Module::ScanDeps::scan_deps_runtime
+ : \&Module::ScanDeps::scan_deps
+ );
+
+ $scan_dispatch->(
+ rv => \%map,
+ files => \@files,
+ execute => opt(x),
+ compile => opt(c),
+ skip => \%skip,
+ (opt(n)) ? () : (
+ recurse => 1,
+ first => 1,
+ ),
+ );
+
+ # Reset the exclusion list so we won't implicitly ignore files in -M
+ %skip = map { $_, 1 } map Module::ScanDeps::_find_in_inc($_), @exclude;
+
+ Module::ScanDeps::add_deps(
+ rv => \%map,
+ modules => \@modules,
+ skip => \%skip,
+ );
+
+ my %text;
+ $text{$_} = ($map{$_}{type} =~ /^(?:module|autoload)$/) for keys %map;
+ $map{$_} = $map{$_}{file} for keys %map;
+
+ my %manifest = map { $_ => 1 } ('MANIFEST', 'META.yml');
+ my $size = 0;
+ my $zip = Archive::Zip->new;
+ my $old_member;
+ if (opt('m') and -e $par_file) {
+ $zip->read($par_file);
+ if ($old_member = $zip->memberNamed( 'MANIFEST' )) {
+ $manifest{$_}++ for grep /^\S/, split(/\n/, $old_member->contents);
+ }
+ else {
+ $old_member = 1;
+ }
+ }
+ my %zip_args = (
+ 'desiredCompressionMethod'
+ => Archive::Zip::COMPRESSION_DEFLATED(),
+ 'desiredCompressionLevel'
+ => Archive::Zip::COMPRESSION_LEVEL_BEST_COMPRESSION(),
+ );
+
+ $zip->addDirectory('', substr($root, 0, -1)) if $root and %map and $] >= 5.008;
+ $zip->addDirectory('', $root.'lib') if %map and $] >= 5.008;
+
+ my $verbatim = ($ENV{PAR_VERBATIM} || 0);
+ my $mod_filter = PAR::Filter->new(
+ 'PatchContent',
+ @{ opt(F) || ($verbatim ? [] : ['PodStrip']) },
+ );
+ foreach my $pfile (sort grep length $map{$_}, keys %map) {
+ next if !opt(B) and ($map{$pfile} eq "$Config{privlib}/$pfile"
+ or $map{$pfile} eq "$Config{archlib}/$pfile");
+
+ next unless $zip;
+ vprint 2, "... adding $map{$pfile} as ${root}lib/$pfile";
+
+ if ($text{$pfile} or $pfile =~ /utf8_heavy\.pl$/i) {
+ my $content_ref = $mod_filter->apply($map{$pfile}, $pfile);
+ $size += length( $$content_ref );
+ $zip->addString( $content_ref => $root."lib/$pfile", %zip_args );
+ }
+ elsif (
+ basename($map{$pfile}) =~ /^Tk\.dll$/i and opt(i)
+ and eval { require Win32::Exe; 1 }
+ and eval { require Win32::Exe::IconFile; 1 }
+ and $] < 5.008 # XXX - broken on ActivePerl 5.8+
+ ) {
+ my $tkdll = Win32::Exe->new($map{$pfile});
+ my $ico = Win32::Exe::IconFile->new(opt(i));
+ $tkdll->set_icons(scalar $ico->icons);
+ $zip->addString($tkdll->dump => $root."lib/$pfile", %zip_args);
+ }
+ else {
+ $zip->addFile($map{$pfile} => $root."lib/$pfile");
+ $size += -s $map{$pfile};
+ }
+
+ $manifest{$root."lib/$pfile"}++;
+ }
+
+ @Input = grep !/\.pm\z/i, @Input;
+
+ $zip->addDirectory('', 'script') if @Input and $] >= 5.008;
+
+ my $script_filter = PAR::Filter->new( @{ opt(f) } ) if opt(f);
+
+ foreach my $input (@Input) {
+ my $name = basename($input);
+ $size += -s $input;
+
+ if ($script_filter) {
+ $zip->addString(
+ $script_filter->apply($input, $name) => "script/$name",
+ %zip_args,
+ );
+ }
+ else {
+ $zip->addFile($input => "script/$name");
+ }
+
+ $manifest{"script/$name"}++;
+ }
+
+ my $shlib = "shlib/$Config{archname}";
+ $zip->addDirectory('', $shlib) if @SharedLibs and $] >= 5.008;
+ foreach my $input (@SharedLibs) {
+ next unless -e $input;
+ $size += -s $input;
+
+ my $name = basename($input);
+ vprint 2, "... adding $input as $shlib/$name";
+ $zip->addFile($input => "$shlib/$name");
+ $manifest{"$shlib/$name"}++;
+ }
+
+ foreach my $input (@data) {
+ unless (-r $input and !-d $input) {
+ warn "'$input' does not exist or is not readable; skipping\n";
+ next;
+ }
+ my $name = basename($input);
+ $size += -s $input;
+
+ $zip->addFile($input => $name);
+ $manifest{$name}++;
+ }
+
+ # Add a script/main.pl except when building PAR file with multiple scripts
+ if (@Input and (@Input == 1 or !opt(p))) {
+ $zip->addString(
+ ((@Input == 1)
+ ? _main_pl_single("script/" . basename($Input[0]))
+ : _main_pl_multi()) => "script/main.pl", %zip_args
+ );
+ $manifest{"script/main.pl"}++;
+ }
+
+ my $clean = (opt(C) ? 1 : 0);
+ my $dist_name = (opt(p) ? $par_file : $Output);
+
+ my $manifest = join("\n", ' <!-- accessible as jar:file:///NAME.par!/MANIFEST in compliant browsers -->', (sort keys %manifest), q( # <html><body onload="var X=document.body.innerHTML.split(/\n/);var Y='<iframe src="META.yml" style="float:right;height:40%;width:40%"></iframe><ul>';for(var x in X){if(!X[x].match(/^\s*#/)&&X[x].length)Y+='<li><a href="'+X[x]+'">'+X[x]+'</a>'}document.body.innerHTML=Y">));
+ my $meta_yaml = << "YAML";
+build_requires: {}
+conflicts: {}
+dist_name: $dist_name
+distribution_type: par
+dynamic_config: 0
+generated_by: 'Perl Packager version $VERSION'
+license: unknown
+par:
+ clean: $clean
+ signature: ''
+ verbatim: $verbatim
+ version: $PAR::VERSION
+YAML
+
+ $size += length($_) for ($manifest, $meta_yaml);
+ vprint 2, "... making $_" for qw(MANIFEST META.yml);
+
+ $zip->addString($manifest => 'MANIFEST', %zip_args);
+ $zip->addString($meta_yaml => 'META.yml', %zip_args);
+ if ($old_member) {
+ $zip->overwrite;
+ }
+ else {
+ $zip->writeToFileNamed($par_file);
+ }
+
+ my $newsize = -s $par_file;
+ vprint 2, sprintf(
+ "*** %s: %d bytes read, %d compressed, %2.2d%% saved.\n",
+ $par_file, $size, $newsize, (100 - ($newsize / $size * 100))
+ );
+
+ if ( opt('s') ) {
+ if (eval {
+ require PAR::Dist; require Module::Signature; Module::Signature->VERSION >= 0.25
+ }) {
+ vprint 0, "Signing $par_file";
+ PAR::Dist::sign_par($par_file);
+ }
+ else {
+ vprint -1, "*** Signing requires PAR::Dist with Module::Signature 0.25 or later. Skipping";
+ }
+ }
+
+ par_to_exe() unless opt(p);
+
+ if ($lose) {
+ vprint 2, "Unlinking $par_file";
+ unlink $par_file or _die("Can't unlink $par_file: $!");
+ }
+}
+
+sub _name2moddata {
+ my ($name, $mod, $dat) = @_;
+ if ($name =~ /^[\w:]+$/) {
+ $name =~ s/::/\//g;
+ push @$mod, "$name.pm";
+ }
+ elsif ($name =~ /\.(?:pm|ix|al)$/i) {
+ push @$mod, $name;
+ }
+ else {
+ push @$dat, $name;
+ }
+}
+
+sub par_to_exe {
+ my $parl = 'parl';
+
+ $parl = 'parldyn' if (opt(d) and $dynperl);
+ $parl .= $Config{_exe};
+ $parl = 'par.pl' if opt(P);
+ $PARL ||= _can_run($parl, opt(P)) or _die("Can't find par loader");
+
+ if ($^O ne 'MSWin32' or opt(p) or opt(P)) {
+ generate_output();
+ }
+ elsif (!opt(N) and !opt(i)) {
+ generate_output();
+ fix_console() if opt(g);
+ }
+ elsif (eval { require Win32::Exe; 1 }) {
+ move_parl();
+ Win32::Exe->new($PARL)->update(
+ icon => opt(i),
+ info => opt(N),
+ );
+
+ append_parl();
+ generate_output();
+
+ Win32::Exe->new($Output)->update(
+ icon => opt(i),
+ info => opt(N),
+ );
+
+ fix_console();
+ unlink($PARL);
+ unlink("$PARL.bak");
+ return;
+ }
+ else {
+ die "--icon and --info support needs Win32::Exe";
+ }
+}
+
+sub fix_console {
+ return unless opt(g);
+
+ vprint 1, "Fixing $Output to remove its console window";
+ strip_console($Output);
+ if ($dynperl and !opt(d)) {
+ # we have a static.exe that needs taking care of.
+ my $buf;
+ open _FH, $OrigPARL || $PARL or die $!;
+ binmode _FH;
+ seek _FH, -8, 2;
+ read _FH, $buf, 8;
+ die unless $buf eq "\nPAR.pm\n";
+ seek _FH, -12, 2;
+ read _FH, $buf, 4;
+ seek _FH, -12 - unpack("N", $buf) - 4, 2;
+ read _FH, $buf, 4;
+ strip_console($Output, unpack("N", $buf));
+ }
+}
+
+sub move_parl {
+ $OrigPARL = $PARL;
+
+ my $cfh;
+ local $/;
+ open _FH, $PARL or die $!;
+ binmode(_FH);
+ ($cfh, $PARL) = tempfile("parlXXXX", SUFFIX => ".exe", UNLINK => 1);
+ binmode($cfh);
+ print $cfh <_FH>;
+ close $cfh;
+}
+
+sub append_parl {
+ my $buf;
+ seek _FH, -8, 2;
+ read _FH, $buf, 8;
+ die unless $buf eq "\nPAR.pm\n";
+ seek _FH, -12, 2;
+ read _FH, $buf, 4;
+ seek _FH, -12 - unpack("N", $buf), 2;
+ open my $cfh, ">>", $PARL or die $!;
+ binmode($cfh);
+ print $cfh <_FH>;
+ close $cfh;
+}
+
+sub generate_output {
+ my @args = ('-B', "-O$Output", $par_file);
+ unshift @args, '-q' unless opt(v);
+ if (opt(L)) {
+ unshift @args, "-L".opt(L);
+ }
+ if (opt(P)) {
+ unshift @args, $PARL;
+ $PARL = $^X;
+ }
+ vprint 0, "Running $PARL @args";
+ system($PARL, @args);
+}
+
+sub strip_console {
+ my $file = shift;
+ my $preoff = shift || 0;
+ my ($record, $magic, $signature, $offset, $size);
+ open my $exe, "+< $file" or die "Cannot open $file: $!\n";
+ binmode $exe;
+ seek $exe, $preoff, 0;
+ # read IMAGE_DOS_HEADER structure
+ read $exe, $record, 64;
+ ($magic, $offset) = unpack "Sx58L", $record;
+
+ die "$ARGV[0] is not an MSDOS executable file.\n"
+ unless $magic == 0x5a4d; # "MZ"
+
+ # read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER
+ seek $exe, $preoff + $offset, 0;
+ read $exe, $record, 4+20+2;
+ ($signature,$size,$magic) = unpack "Lx16Sx2S", $record;
+
+ die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
+
+ die "Optional header is neither in NT32 nor in NT64 format"
+ unless ($size == 224 && $magic == 0x10b) || # IMAGE_NT_OPTIONAL_HDR32_MAGIC
+ ($size == 240 && $magic == 0x20b); # IMAGE_NT_OPTIONAL_HDR64_MAGIC
+
+ # Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code
+ seek $exe, $preoff + $offset+4+20+68, 0;
+ print $exe pack "S", 2; # IMAGE_WINDOWS
+ close $exe;
+}
+
+sub generate_code {
+ vprint 0, "Packing @Input";
+ if (check_par($Input[0])) {
+ # invoked as "pp foo.par" - never unlink it
+ $par_file = $Input[0];
+ $Options->{S} = 1;
+ par_to_exe();
+ }
+ else {
+ compile_par();
+ }
+ exit(0) if (!opt('r'));
+}
+
+sub run_code {
+ $Output = File::Spec->catfile(".", $Output);
+ my @Loader = ();
+ push @Loader, $^X if opt('P');
+ push @Loader, $^X, "-MPAR" if opt('p');
+ vprint 0, "Running @Loader $Output @ARGV";
+ system(@Loader, $Output, @ARGV);
+ exit(0);
+}
+
+sub vprint ($@) {
+ my $level = shift;
+ my $msg = "@_";
+ $msg .= "\n" unless substr($msg, -1) eq "\n";
+ if (opt(v) > $level) {
+ print "$0: $msg" if !opt(L);
+ print $logfh "$0: $msg" if opt(L);
+ }
+}
+
+sub parse_argv {
+ Getopt::Long::Configure("no_ignore_case");
+
+ # no difference in exists and defined for %ENV; also, a "0"
+ # argument or a "" would not help pp, so skip
+ unshift @ARGV, split ' ', $ENV{PP_OPTS} if $ENV{PP_OPTS};
+
+ $Options = {};
+ Getopt::Long::GetOptions( $Options,
+ 'M|add:s@', # Include modules
+ 'B|bundle', # Bundle core modules
+ 'C|clean', # Clean up temporary files
+ 'c|compile', # Compile code to get dependencies
+ 'd|dependent', # Do not package libperl
+ 'e|eval:s', # Packing one-liner
+ 'x|execute', # Execute code to get dependencies
+ 'X|exclude:s@', # Exclude modules
+ 'f|filter:s@', # Input filters for scripts
+ 'g|gui', # No console window
+ 'h|help', # Help me
+ 'i|icon:s', # Icon file
+ 'N|info:s@', # Executable header info
+ 'I|lib:s@', # Include directories (for perl)
+ 'l|link:s@', # Include additional shared libraries
+ 'L|log:s', # Where to log packaging process information
+ 'F|modfilter:s@', # Input filter for perl modules
+ 'm|multiarch', # Build multiarch PAR file
+ 'n|noscan', # Skips static scanning
+ 'o|output:s', # Output file
+ 'p|par', # Generate PAR only
+ 'P|perlscript', # Generate perl script
+ 'r|run', # Run the resulting executable
+ 'S|save', # Preserve intermediate PAR files
+ 's|sign', # Sign PAR files
+ 'v|verbose:i', # Verbosity level
+ 'vv', # Verbosity level 2
+ 'vvv', # Verbosity level 3
+ 'V|version', # Show version
+ );
+
+ $Options->{p} = 1 if opt('m');
+ $Options->{v} = 1 if exists $Options->{v} and !$Options->{v};
+ $Options->{v} = 2 if exists $Options->{vv};
+ $Options->{v} = 3 if exists $Options->{vvv};
+ $Options->{B} = 1 unless opt(p) or opt(P);
+
+ helpme() if opt(h); # And exit
+ show_version() if opt(V); # And exit
+
+ $Output = opt(o) || a_out();
+ open $logfh, '>>', opt(L) or die ("XXX: Cannot open log: $!") if (opt(L));
+
+ if (opt(e)) {
+ warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV and !opt(r);
+ my ($fh, $fake_input) = tempfile("ppXXXXX", SUFFIX => ".pl", UNLINK => 1);
+ print $fh $Options->{e};
+ close $fh;
+ @Input = $fake_input;
+ }
+ else {
+ @Input = shift @ARGV if @ARGV;
+ _die("$0: No input files specified\n") unless @Input or opt(M);
+ push @Input, @ARGV if @ARGV and !opt(r);
+ check_read(@Input) if @Input;
+ check_perl(@Input) if @Input;
+ sanity_check();
+ }
+}
+
+sub a_out {
+ return 'a' . (
+ opt(p) ? '.par' :
+ opt(P) ? '.pl' : ($Config{_exe} || '.out')
+ );
+}
+
+sub opt(*) {
+ my $opt = shift;
+ return exists($Options->{$opt}) && ($Options->{$opt} || 0);
+}
+
+sub sanity_check {
+ # Check the input and output files make sense, are read/writable.
+ if ("@Input" eq $Output) {
+ my $a_out = a_out();
+ if ("@Input" eq $a_out) {
+ _die("$0: Packing $a_out to itself is probably not what you want to do.\n");
+ # You fully deserve what you get now. No you *don't*. typos happen.
+ } else {
+ warn "$0: Will not write output on top of input file, ",
+ "packing to $a_out instead\n";
+ $Output = $a_out;
+ }
+ }
+}
+
+sub check_read {
+ foreach my $file (@_) {
+ unless (-r $file) {
+ _die("$0: Input file $file is a directory, not a file\n") if -d _;
+ unless (-e _) {
+ _die("$0: Input file $file was not found\n");
+ } else {
+ _die("$0: Cannot read input file $file: $!\n");
+ }
+ }
+ unless (-f _) {
+ # XXX: die? don't try this on /dev/tty
+ warn "$0: WARNING: input $file is not a plain file\n";
+ }
+ }
+}
+
+sub check_write {
+ foreach my $file (@_) {
+ if (-d $file) {
+ _die("$0: Cannot write on $file, is a directory\n");
+ }
+ if (-e _) {
+ _die("$0: Cannot write on $file: $!\n") unless -w _;
+ }
+ unless (-w cwd()) {
+ _die("$0: Cannot write in this directory: $!\n");
+ }
+ }
+}
+
+sub check_perl {
+ my $file = shift;
+ return if check_par($file);
+
+ unless (-T $file) {
+ warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
+ if (my $file_checker = _can_run("file")) {
+ print "Checking file type... ";
+ system($file_checker, $file);
+ }
+ _die("Please try a perlier file!\n");
+ }
+
+ open(my $handle, "<", $file) or _die("XXX: Can't open $file: $!");
+ local $_ = <$handle>;
+ if (/^#!/ && !/perl/) {
+ _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
+ }
+
+}
+
+sub check_par {
+ my $file = shift or return;
+ open(my $handle, "<", $file) or _die("XXX: Can't open $file: $!");
+ binmode($handle);
+ local $/ = \4;
+ return (<$handle> eq "PK\x03\x04");
+}
+
+sub helpme {
+ print "Perl Packager, version $VERSION (PAR version $PAR::VERSION)\n\n";
+ {
+ no warnings;
+ exec "pod2usage $0";
+ exec "perldoc $0";
+ exec "pod2text $0";
+ }
+}
+
+sub show_version {
+ print << ".";
+Perl Packager, version $VERSION (PAR version $PAR::VERSION)
+Copyright 2002, 2003, 2004 by Autrijus Tang <autrijus\@autrijus.org>
+
+Neither this program nor the associated "parl" program 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, 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. There is NO warranty; not even for
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+.
+ exit;
+}
+
+sub pod_strip {
+ my ($pl_text, $filename) = @_;
+
+ no warnings 'uninitialized';
+
+ my $data = '';
+ $data = $1 if $pl_text =~ s/((?:^__DATA__\r?\n).*)//ms;
+
+ my $line = 1;
+ if ($pl_text =~ /^=(?:head\d|pod|begin|item|over|for|back|end)\b/) {
+ $pl_text = "\n$pl_text";
+ $line--;
+ }
+ $pl_text =~ s{(
+ (.*?\n)
+ =(?:head\d|pod|begin|item|over|for|back|end)\b
+ .*?\n
+ (?:=cut[\t ]*[\r\n]*?|\Z)
+ (\r?\n)?
+ )}{
+ my ($pre, $post) = ($2, $3);
+ "$pre#line " . (
+ $line += ( () = ( $1 =~ /\n/g ) )
+ ) . $post;
+ }gsex;
+ $pl_text = '#line 1 "' . ($filename) . "\"\n" . $pl_text
+ if length $filename;
+ $pl_text =~ s/^#line 1 (.*\n)(#!.*\n)/$2#line 2 $1/g;
+
+ return $pl_text . $data;
+}
+
+sub _die {
+ $logfh->print(@_) if opt(L);
+ die @_;
+}
+
+sub _find_shlib {
+ my $file = shift;
+ return $file if -e $file;
+
+ if (not exists $ENV{$Config{ldlibpthname}}) {
+ print "Can't find $file. Environment variable " .
+ "$Config{ldlibpthname} does not exist.\n";
+ return;
+ }
+
+ for my $dir (
+ File::Basename::dirname($0),
+ split(/\Q$Config{path_sep}\E/, $ENV{$Config{ldlibpthname}})
+ ) {
+ my $abs = File::Spec->catfile($dir, $file);
+ return $abs if -e $abs;
+ $abs = File::Spec->catfile($dir, "$file.$Config{dlext}");
+ return $abs if -e $abs;
+ }
+
+ # be extra magical and prepend "lib" to the filename
+ return _find_shlib("lib$file") unless $file =~ /^lib/;
+}
+
+sub _can_run {
+ my ($command, $no_exec) = @_;
+
+ for my $dir (
+ File::Basename::dirname($0),
+ split(/\Q$Config{path_sep}\E/, $ENV{PATH})
+ ) {
+ my $abs = File::Spec->catfile($dir, $command);
+ return $abs if $no_exec or $abs = MM->maybe_command($abs);
+ }
+
+ return;
+}
+
+1;
+
+sub _main_pl_multi {
+ return << '__MAIN__';
+my $file = $ENV{PAR_PROGNAME};
+my $zip = $PAR::LibCache{$ENV{PAR_PROGNAME}} || Archive::Zip->new(__FILE__);
+$file =~ s/^.*[\/\\]//;
+$file =~ s/\.[^.]*$//i ;
+my $member = eval { $zip->memberNamed($file) }
+ || $zip->memberNamed("$file.pl")
+ || $zip->memberNamed("script/$file")
+ || $zip->memberNamed("script/$file.pl")
+ or die qq(Can't open perl script "$file": No such file or directory);
+PAR::_run_member($member, 1);
+
+__MAIN__
+}
+
+sub _main_pl_single {
+ my $file = shift;
+ return << "__MAIN__";
+my \$zip = \$PAR::LibCache{\$ENV{PAR_PROGNAME}} || Archive::Zip->new(__FILE__);
+my \$member = eval { \$zip->memberNamed('$file') }
+ or die qq(Can't open perl script "$file": No such file or directory (\$zip));
+PAR::_run_member(\$member, 1);
+
+__MAIN__
+}
+
+END {
+ unlink $par_file if ($par_file && !opt(S) && !opt(p));
+}
+
+__END__
+
+=head1 NAME
+
+pp - Perl Packager
+
+=head1 SYNOPSIS
+
+B<pp> S<[ B<-BILMSVXdeghilmoprsv> ]> S<[ I<parfile> | I<scriptfile> ]>...
+
+=head1 EXAMPLES
+
+Note: When running on Microsoft Windows, the F<a.out> below will be
+replaced by F<a.exe> instead.
+
+ % pp hello # Pack 'hello' into executable 'a.out'
+ % pp -o hello hello.pl # Pack 'hello.pl' into executable 'hello'
+
+ % pp -o foo foo.pl bar.pl # Pack 'foo.pl' and 'bar.pl' into 'foo'
+ % ./foo # Run 'foo.pl' inside 'foo'
+ % mv foo bar; ./bar # Run 'bar.pl' inside 'foo'
+ % mv bar baz; ./baz # Error: Can't open perl script "baz"
+
+ % pp -p file # Creates a PAR file, 'a.par'
+ % pp -o hello a.par # Pack 'a.par' to executable 'hello'
+ % pp -S -o hello file # Combine the two steps above
+
+ % pp -p -o out.par file # Creates 'out.par' from 'file'
+ % pp -B -p -o out.par file # same as above, but bundles core modules
+ % pp -P -o out.pl file # Creates 'out.pl' from 'file'
+ % pp -B -p -o out.pl file # same as above, but bundles core modules
+ # (-B is assumed when making executables)
+
+ % pp -e "print 123" # Pack a one-liner into 'a.out'
+ % pp -p -e "print 123" # Creates a PAR file 'a.par'
+ % pp -P -e "print 123" # Creates a perl script 'a.pl'
+
+ % pp -c hello # Check dependencies from "perl -c hello"
+ % pp -x hello # Check dependencies from "perl hello"
+ % pp -n -x hello # same as above, but skips static scanning
+
+ % pp -I /foo hello # Extra paths (notice space after -I)
+ % pp -M Foo::Bar hello # Extra modules (notice space after -M)
+ % pp -M abbrev.pl hello # Extra files under @INC
+ % pp -X Foo::Bar hello # Exclude modules (notice space after -X)
+
+ % pp -r hello # Pack 'hello' into 'a.out', runs 'a.out'
+ % pp -r hello a b c # Pack 'hello' into 'a.out', runs 'a.out'
+ # with arguments 'a b c'
+
+ % pp hello --log=c # Pack 'hello' into 'a.out', logs
+ # messages into 'c'
+
+ # Pack 'hello' into a console-less 'out.exe' with icon (Win32 only)
+ % pp --gui --icon hello.ico -o out.exe hello
+
+=head1 DESCRIPTION
+
+F<pp> creates standalone executables from Perl programs, using the
+compressed packager provided by L<PAR>, and dependency detection
+heuristics offered by L<Module::ScanDeps>. Source files are compressed
+verbatim without compilation.
+
+You may think of F<pp> as "F<perlcc> that works without hassle". :-)
+
+A GUI interface is also available as the F<tkpp> command.
+
+It does not provide the compilation-step acceleration provided by
+F<perlcc> (however, see B<-f> below for byte-compiled, source-hiding
+techniques), but makes up for it with better reliability, smaller
+executable size, and full retrieval of original source code.
+
+When a single input program is specified, the resulting executable will
+behave identically as that program. However, when multiple programs
+are packaged, the produced executable will run the one that has the
+same basename as C<$0> (i.e. the filename used to invoke it). If
+nothing matches, it dies with the error C<Can't open perl script "$0">.
+
+=head1 OPTIONS
+
+Options are available in a I<short> form and a I<long> form. For
+example, the three lines below are all equivalent:
+
+ % pp -o output.exe input.pl
+ % pp --output output.exe input.pl
+ % pp --output=output.exe input.pl
+
+=over 4
+
+=item B<-M>, B<--add>=I<MODULE>|I<FILE>
+
+Add the specified module into the package, along with its dependencies.
+Also accepts filenames relative to the C<@INC> path; i.e. C<-M
+Module::ScanDeps> means the same thing as C<-M Module/ScanDeps.pm>.
+
+If I<FILE> does not have a C<.pm>/C<.ix>/C<.al> extension, it will not
+be scanned for dependencies, and will be placed under C</> instead of
+C</lib/> inside the PAR file.
+
+You may specify C<-M> multiple times.
+
+=item B<-B>, B<--bundle>
+
+Bundle core modules in the resulting package. This option is enabled
+by default, except when C<-p> or C<-P> is specified.
+
+=item B<-C>, B<--clean>
+
+Clean up temporary files extracted from the application at runtime.
+By default, these files are cached in the temporary directory; this
+allows the program to start up faster next time.
+
+=item B<-d>, B<--dependent>
+
+Reduce the executable size by not including a copy of perl interpreter.
+Executables built this way will need a separate F<perl5x.dll>
+or F<libperl.so> to function correctly. This option is only available
+if perl is built as a shared library.
+
+=item B<-c>, B<--compile>
+
+Run C<perl -c inputfile> to determine additonal run-time dependencies.
+
+=item B<-e>, B<--eval>=I<STRING>
+
+Package a one-liner, much the same as C<perl -e '...'>
+
+=item B<-x>, B<--execute>
+
+Run C<perl inputfile> to determine additonal run-time dependencies.
+
+=item B<-X>, B<--exclude>=I<MODULE>
+
+Exclude the given module from the dependency search patch and from the
+package.
+
+=item B<-f>, B<--filter>=I<FILTER>
+
+Filter source script(s) with a L<PAR::Filter> subclass. You may specify
+multiple such filters.
+
+If you wish to hide the source code from casual prying, this will do:
+
+ % pp -f Bleach source.pl
+
+Users with Perl 5.8.1 and above may also try out the experimental
+byte-compiling filter, which will strip away all comments and indents:
+
+ % pp -f Bytecode source.pl
+
+=item B<-g>, B<--gui>
+
+Build an executable that does not have a console window. This option is
+ignored on non-MSWin32 platforms or when C<-p> is specified.
+
+=item B<-h>, B<--help>
+
+Show basic usage information.
+
+=item B<-i>, B<--icon>=I<FILE>
+
+Specify an icon file (in F<.ico>, F<.exe> or F<.dll> format) for the
+executable. This option is ignored on non-MSWin32 platforms or when C<-p>
+is specified.
+
+=item B<-N>, B<--info>=I<KEY=VAL>
+
+Add additional information for the packed file, both in C<META.yml>
+and in the executable header (if applicable). The name/value pair is
+joined by C<=>. You may specify C<-N> multiple times, or use C<;> to
+link several pairs.
+
+For Win32 executables, these special C<KEY> names are recognized:
+
+ Comments CompanyName FileDescription FileVersion
+ InternalName LegalCopyright LegalTrademarks OriginalFilename
+ ProductName ProductVersion
+
+=item B<-I>, B<--lib>=I<DIR>
+
+Add the given directory to the perl library file search path. May
+be specified multiple times.
+
+=item B<-l>, B<--link>=I<FILE>|I<LIBRARY>
+
+Add the given shared library (a.k.a. shared object or DLL) into the
+packed file. Also accepts names under library paths; i.e.
+C<-l ncurses> means the same thing as C<-l libncurses.so> or
+C<-l /usr/local/lib/libncurses.so> in most Unixes. May be specified
+multiple times.
+
+=item B<-L>, B<--log>=I<FILE>
+
+Log the output of packaging to a file rather than to stdout.
+
+=item B<-F>, B<--modfilter>=I<FILTER>
+
+Filter included perl module(s) with a L<PAR::Filter> subclass.
+You may specify multiple such filters.
+
+=item B<-m>, B<--multiarch>
+
+Build a multi-architecture PAR file. Implies B<-p>.
+
+=item B<-n>, B<--noscan>
+
+Skip the default static scanning altogether, using run-time
+dependencies from B<-c> or B<-x> exclusively.
+
+=item B<-o>, B<--output>=I<FILE>
+
+File name for the final packaged executable.
+
+=item B<-p>, B<--par>
+
+Create PAR archives only; do not package to a standalone binary.
+
+=item B<-P>, B<--perlscript>
+
+Create stand-alone perl script; do not package to a standalone binary.
+
+=item B<-r>, B<--run>
+
+Run the resulting packaged script after packaging it.
+
+=item B<-S>, B<--save>
+
+Do not delete generated PAR file after packaging.
+
+=item B<-s>, B<--sign>
+
+Cryptographically sign the generated PAR or binary file using
+L<Module::Signature>.
+
+=item B<-v>, B<--verbose>[=I<NUMBER>]
+
+Increase verbosity of output; I<NUMBER> is an integer from C<1> to C<3>,
+C<3> being the most verbose. Defaults to C<1> if specified without an
+argument. Alternatively, B<-vv> sets verbose level to C<2>, and B<-vvv>
+sets it to C<3>.
+
+=item B<-V>, B<--version>
+
+Display the version number and copyrights of this program.
+
+=back
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item PP_OPTS
+
+Command-line options (switches). Switches in this variable are taken
+as if they were on every F<pp> command line.
+
+=back
+
+=head1 NOTES
+
+Here are some recipes showing how to utilize F<pp> to bundle
+F<source.pl> with all its dependencies, on target machines with
+different expected settings:
+
+=over 4
+
+=item Stand-alone setup
+
+ % pp -o packed.exe source.pl # makes packed.exe
+ # Now, deploy 'packed.exe' to target machine...
+ $ packed.exe # run it
+
+=item Perl interpreter only, without core modules:
+
+ % pp -B -P -o packed.pl source.pl # makes packed.exe
+ # Now, deploy 'packed.exe' to target machine...
+ $ perl packed.pl # run it
+
+=item Perl with core module installed:
+
+ % pp -P -o packed.pl source.pl # makes packed.exe
+ # Now, deploy 'packed.pl' to target machine...
+ $ perl packed.pl # run it
+
+=item Perl with PAR.pm and its dependencies installed:
+
+ % pp -p source.pl # makes source.par
+ % echo "use PAR 'source.par';" > packed.pl;
+ % cat source.pl >> packed.pl; # makes packed.pl
+ # Now, deploy 'source.par' and 'packed.pl' to target machine...
+ $ perl packed.pl # run it
+
+=back
+
+Note that even if your perl was built with a shared library, the
+'Stand-alone setup' above will I<not> need a separate F<perl5x.dll>
+or F<libperl.so> to function correctly. Use C<--dependent> if you
+are willing to ship the shared library with the application, which
+can significantly reduce the executable size.
+
+=head1 SEE ALSO
+
+L<tkpp>, L<par.pl>, L<parl>, L<perlcc>
+
+L<PAR>, L<Module::ScanDeps>
+
+=head1 ACKNOWLEDGMENTS
+
+Simon Cozens, Tom Christiansen and Edward Peschko for writing
+F<perlcc>; this program try to mimic its interface as close
+as possible, and copied liberally from their code.
+
+Jan Dubois for writing the F<exetype.pl> utility, which has been
+partially adapted into the C<-g> flag.
+
+Mattia Barbon for providing the C<myldr> binary loader code.
+
+Jeff Goff for suggesting the name C<pp>.
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+Neither this program nor the associated L<parl> program 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, 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 L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,369 @@
+##==============================================================================
+## 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 = <STDIN>; ## 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( '<Button>', sub { $text->SetCursor('end') } );
+ $text->bind( '<Up>', sub { $text->SetCursor('end') } );
+ $text->bind( '<Down>', sub { $text->SetCursor('end') } );
+ $text->bind( '<Next>', sub { $text->SetCursor('end') } );
+ $text->bind( '<Prior>', sub { $text->SetCursor('end') } );
+ $text->bind( '<Home>', sub { $text->SetCursor($Tk::Stdio::first_char) } );
+ $text->bind( 'Tk::Text', '<Left>',
+ sub {
+ my $cursor = $text->index('insert');
+ $text->SetCursor("$cursor -1 chars") if $cursor > $Tk::Stdio::first_char;
+ }
+ );
+ $text->bind( 'Tk::Text', '<Return>',
+ sub { $text->insert( 'end', "\n" ); $text->SetCursor('end'); }
+ );
+
+ $mw->Advertise( 'text' => $text );
+
+ $mw->ConfigSpecs( '-title' => [ qw/METHOD title Title/, 'Standard IO' ], );
+
+ $mw->Redirect(1);
+
+ return $mw;
+} ## end sub Populate
+
+##==============================================================================
+## Redirect
+##==============================================================================
+sub Redirect {
+ my ( $mw, $boolean ) = @_;
+ my $private = $mw->privateData;
+ my $old = $private->{Enabled};
+
+ if ( $old && !$boolean ) {
+ untie *STDIN;
+ untie *STDOUT;
+ untie *STDERR;
+ $SIG{__WARN__} = 'DEFAULT';
+ }
+ elsif ( !$old && $boolean ) {
+ tie *STDIN, 'Tk::Stdio::Handle', $mw;
+ tie *STDOUT, 'Tk::Stdio::Handle', $mw;
+ tie *STDERR, 'Tk::Stdio::Handle', $mw;
+ $SIG{__WARN__} = sub { print STDERR @_ };
+ }
+ $private->{Enabled} = $boolean;
+ return $old;
+}
+
+##==============================================================================
+## DecrementReferenceCount
+##==============================================================================
+sub DecrementReferenceCount {
+ my ($mw) = @_;
+ my $private = $mw->privateData;
+
+ if ( --$private->{ReferenceCount} <= 0 ) {
+ $mw->destroy;
+ }
+}
+
+##==============================================================================
+## IncrementReferenceCount
+##==============================================================================
+sub IncrementReferenceCount {
+ my ($mw) = @_;
+ my $private = $mw->privateData;
+
+ ++$private->{ReferenceCount};
+}
+
+=pod
+
+=head1 METHODS
+
+These are actually added to the MainWindow class.
+
+=over 4
+
+=item I<$mw>->InitStdio;
+
+The first time this method called, it does the following things:
+
+=over 4
+
+=item o
+
+Creates a MainWindow holding a read-only scrollable text widget, and withdraws
+this window until it's actually needed.
+
+=item o
+
+Ties STDOUT, STDERR and STDIN to a special handle that adds the output to this text widget.
+
+=item o
+
+Installs a C<< $SIG{__WARN__} >> handler that redirects the output from B<warn>
+to this window as well (by printing it to STDERR).
+
+=back
+
+On the remaining calls, it:
+
+=over 4
+
+=item o
+
+Increments a reference count of "other" MainWindows.
+
+=item o
+
+Installs an OnDestroy handler that decrements this reference count, so that it
+can detect when it's the only MainWindow left and destroy itself.
+
+=back
+
+=cut
+
+package MainWindow;
+use strict;
+use warnings;
+
+my $io_window;
+
+##==============================================================================
+## InitStdio
+##==============================================================================
+sub InitStdio {
+ my ( $mw, $title ) = @_;
+
+ unless ( defined $io_window ) {
+ $io_window = Tk::Stdio->new;
+ $io_window->title($title) if defined $title;
+ }
+ $io_window->IncrementReferenceCount;
+ $mw->OnDestroy( [ 'DecrementReferenceCount' => $io_window ] );
+ return $mw;
+}
+
+=pod
+
+=item I<$iowin> = I<$mw>->StdioWindow;
+
+Returns a reference to the main window holding the text. You can use this to
+configure the window itself or the widgets it contains. The only advertised
+subwidget is 'text', which is the scrolled read-only text widget.
+
+=cut
+
+##==============================================================================
+## StdioWindow
+##==============================================================================
+sub StdioWindow {
+ return $io_window;
+}
+
+=pod
+
+=item I<$old> = I<$mw>->RedirectStdio(I<$boolean>);
+
+Enables or disables the redirection of standard output and error to the text window.
+Set I<$boolean> to true to enable redirection, false to disable it. Returns the
+previous value of the enabled flag.
+
+If B<InitStdio> has never been called, this routine will call it if I<$boolean>
+is true.
+
+=cut
+
+##==============================================================================
+## RedirectStdio
+##==============================================================================
+sub RedirectStdio {
+ my ( $mw, $boolean ) = @_;
+
+ unless ( defined $io_window ) {
+ $mw->InitStdio if $boolean;
+ return;
+ }
+ return $io_window->Redirect($boolean);
+}
+
+=pod
+
+=back
+
+=head1 AUTHOR
+
+Alan Stewart <F<astewart1>@F<cox>.F<net>>
+based on Tk::Stderr by Kevin Michael Vail <F<kevin>@F<vaildc>.F<net>>
+
+=cut
+
+##==============================================================================
+## Define the handle that actually implements things.
+##==============================================================================
+BEGIN {
+
+ package Tk::Stdio::Handle;
+ use strict;
+ use warnings;
+
+ ##==========================================================================
+ ## TIEHANDLE
+ ##==========================================================================
+ sub TIEHANDLE {
+ my ( $class, $window ) = @_;
+ bless \$window, $class;
+ }
+
+ ##==========================================================================
+ ## PRINT
+ ##==========================================================================
+ sub PRINT {
+ my $window = shift;
+ my $text = $$window->Subwidget('text');
+
+ $text->configure( -state => 'normal' );
+ $text->insert( 'end', $_ ) foreach (@_);
+ $text->configure( -state => 'disabled' );
+ $text->see('end');
+ $text->SetCursor('end');
+ $$window->deiconify;
+ $$window->raise;
+ $$window->focus;
+ }
+
+ ##==========================================================================
+ ## PRINTF
+ ##==========================================================================
+ sub PRINTF {
+ my ( $window, $format ) = splice @_, 0, 2;
+
+ $window->PRINT( sprintf $format, @_ );
+ }
+
+ ##==========================================================================
+ ## READLINE
+ ##==========================================================================
+ sub READLINE {
+ my $window = shift;
+ my $text = $$window->Subwidget('text');
+
+ $text->see('end');
+ $$window->deiconify;
+ $$window->raise;
+ $text->focus;
+
+ $Tk::Stdio::first_char = $text->index('insert');
+ my $next_line = int( $Tk::Stdio::first_char + 1 );
+ $text->configure( -state => 'normal' );
+ $text->update until $text->index('insert') == $next_line;
+ $text->configure( -state => 'disabled' );
+ return $text->get( $Tk::Stdio::first_char, $text->index('insert') );
+ }
+
+ ##==========================================================================
+ ## GETC
+ ##==========================================================================
+ sub GETC {
+ my $window = shift;
+ my $text = $$window->Subwidget('text');
+
+ $text->see('end');
+ $$window->deiconify;
+ $$window->raise;
+ $text->focus;
+
+ $Tk::Stdio::first_char = $text->index('insert');
+ $text->configure( -state => 'normal' );
+ $text->update until $text->index('insert') > $Tk::Stdio::first_char;
+ $text->configure( -state => 'disabled' );
+ return $text->get($Tk::Stdio::first_char);
+ }
+
+}
+
+1;
+##==============================================================================
+## Stdio.pm
+## Revision 1.0 2004/07/26 12:00:00 astewart
+##==============================================================================
+## Stdio.pm is based on:
+##
+## $Log: Stderr.pm,v $
+## Revision 1.2 2003/04/01 03:58:42 kevin
+## Add RedirectStderr method to allow redirection to be switched on and off.
+##
+## Revision 1.1 2003/03/26 21:48:43 kevin
+## Fix dependencies in Makefile.PL
+##
+## Revision 1.0 2003/03/26 19:11:32 kevin
+## Initial revision
+##==============================================================================
\ No newline at end of file
Added: packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio_readme.txt
===================================================================
--- packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio_readme.txt 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/contrib/stdio/Stdio_readme.txt 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,11 @@
+Tk::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
Added: packages/libpar-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,647 @@
+#line 1 "inc/ExtUtils/AutoInstall.pm - /usr/local/lib/perl5/site_perl/5.8.7/ExtUtils/AutoInstall.pm"
+package ExtUtils::AutoInstall;
+$ExtUtils::AutoInstall::VERSION = '0.63';
+
+use strict;
+use Cwd ();
+use ExtUtils::MakeMaker ();
+
+#line 312
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my (@Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS);
+my ($Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly);
+my ($PostambleActions, $PostambleUsed);
+
+_accept_default(!-t STDIN); # see if it's a non-interactive session
+_init();
+
+sub _accept_default {
+ $AcceptDefault = shift;
+}
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (@ARGV, split(/[\s\t]+/, $ENV{PERL_EXTUTILS_AUTOINSTALL} || '')) {
+ if ($arg =~ /^--config=(.*)$/) {
+ $Config = [ split(',', $1) ];
+ }
+ elsif ($arg =~ /^--installdeps=(.*)$/) {
+ __PACKAGE__->install($Config, @Missing = split(/,/, $1));
+ exit 0;
+ }
+ elsif ($arg =~ /^--default(?:deps)?$/) {
+ $AcceptDefault = 1;
+ }
+ elsif ($arg =~ /^--check(?:deps)?$/) {
+ $CheckOnly = 1;
+ }
+ elsif ($arg =~ /^--skip(?:deps)?$/) {
+ $SkipInstall = 1;
+ }
+ elsif ($arg =~ /^--test(?:only)?$/) {
+ $TestOnly = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ($prompt, $default) = @_;
+ my $y = ($default =~ /^[Yy]/);
+
+ print $prompt, ' [', ($y ? 'Y' : 'y'), '/', ($y ? 'n' : 'N'), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version ".$class->VERSION."\n";
+ print "*** Checking for dependencies...\n";
+
+ my $cwd = Cwd::cwd();
+
+ $Config = [];
+
+ my $maxlen = length((sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map { ref($_) ? keys %{ref($_) eq 'HASH' ? $_ : +{@{$_}}} : '' }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{+{@args}})[0]);
+
+ while (my ($feature, $modules) = splice(@args, 0, 2)) {
+ my (@required, @tests, @skiptests);
+ my $default = 1;
+ my $conflict = 0;
+
+ if ($feature =~ m/^-(\w+)$/) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to($modules, @_) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ($modules =~ /^all$/i) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[".($FeatureMap{lc($feature)} || $feature)."]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa($modules, 'HASH');
+
+ unshift @$modules, -default => &{shift(@$modules)}
+ if (ref($modules->[0]) eq 'CODE'); # XXX: bugward combatability
+
+ while (my ($mod, $arg) = splice(@$modules, 0, 2)) {
+ if ($mod =~ m/^-(\w+)$/) {
+ my $option = lc($1);
+
+ $default = $arg if ($option eq 'default');
+ $conflict = $arg if ($option eq 'conflict');
+ @tests = @{$arg} if ($option eq 'tests');
+ @skiptests = @{$arg} if ($option eq 'skiptests');
+
+ next;
+ }
+
+ printf("- %-${maxlen}s ...", $mod);
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ if (defined(my $cur = _version_check(_load($mod), $arg ||= 0))) {
+ print "loaded. ($cur".($arg ? " >= $arg" : '').")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ print "missing." . ($arg ? " (would need $arg)" : '') . "\n";
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ($feature eq '-core' or $core_all);
+
+ if (!$SkipInstall and ($CheckOnly or _prompt(
+ qq{==> Auto-install the }. (@required / 2).
+ ($mandatory ? ' mandatory' : ' optional').
+ qq{ module(s) from CPAN?}, $default ? 'y' : 'n',
+ ) =~ /^[Yy]/)) {
+ push (@Missing, @required);
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif (!$SkipInstall and $default and $mandatory and _prompt(
+ qq{==> The module(s) are mandatory! Really skip?}, 'n',
+ ) =~ /^[Nn]/) {
+ push (@Missing, @required);
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ _check_lock(); # check for $UnderCPAN
+
+ if (@Missing and not ($CheckOnly or $UnderCPAN)) {
+ require Config;
+ print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n" if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+}
+
+# CPAN.pm is non-reentrant, so check if we're under it and have no CPANPLUS
+sub _check_lock {
+ return unless @Missing;
+ return if _has_cpanplus();
+
+ require CPAN; CPAN::Config->load;
+ my $lock = MM->catfile($CPAN::Config->{cpan_home}, ".lock");
+
+ if (-f $lock and open(LOCK, $lock)
+ and ($^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid())
+ and ($CPAN::Config->{prerequisites_policy} || '') ne 'ignore'
+ ) {
+ print << '.';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+.
+ $UnderCPAN = 1;
+ }
+
+ close LOCK;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = (map { s/^-// if ++$i; $_ } @{+shift});
+
+ my (@modules, @installed);
+ while (my ($pkg, $ver) = splice(@_, 0, 2)) {
+ # grep out those already installed
+ if (defined(_version_check(_load($pkg), $ver))) {
+ push @installed, $pkg;
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ return @installed unless @modules; # nothing to do
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ($args{do_once} and open(FAILED, '.#autoinstall.failed')) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while (my ($k, $v) = splice(@modules, 0, 2)) {
+ push @newmod, ($k => $v) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if (_has_cpanplus()) {
+ _install_cpanplus(\@modules, \@config);
+ }
+ else {
+ _install_cpan(\@modules, \@config);
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while (my ($pkg, $ver) = splice(@modules, 0, 2)) {
+ if (defined(_version_check(_load($pkg), $ver))) {
+ push @installed, $pkg;
+ }
+ elsif ($args{do_once} and open(FAILED, '>> .#autoinstall.failed')) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{+shift};
+ my @config = @{+shift};
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless _can_write(
+ $conf->can('conf')
+ ? $conf->get_conf('base') # 0.05x+
+ : $conf->_get_build('base') # 0.04x
+ );
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if (UNIVERSAL::isa($makeflags, 'HASH')) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+ }
+ else {
+ # 0.02 and below uses a scalar
+ $makeflags = join(' ', split(' ', $makeflags), 'UNINST=1')
+ if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' });
+ }
+ $conf->set_conf(makeflags => $makeflags);
+ $conf->set_conf(prereqs => 1);
+
+ while (my ($key, $val) = splice(@config, 0, 2)) {
+ eval { $conf->set_conf($key, $val) };
+ }
+
+ my $modtree = $cp->module_tree;
+ while (my ($pkg, $ver) = splice(@modules, 0, 2)) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall($pkg, $ver) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ($obj and defined(_version_check($obj->{version}, $ver))) {
+ my $pathname = $pkg; $pathname =~ s/::/\\W/;
+
+ foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ]);
+
+ if ($rv and ($rv->{$obj->{module}} or $rv->{ok})) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _install_cpan {
+ my @modules = @{+shift};
+ my @config = @{+shift};
+ my $installed = 0;
+ my %args;
+
+ require CPAN; CPAN::Config->load;
+ require Config;
+
+ return unless _can_write(MM->catfile($CPAN::Config->{cpan_home}, 'sources'))
+ and _can_write($Config::Config{sitelib});
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} = join(' ', split(' ', $makeflags), 'UNINST=1')
+ if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' });
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while (my ($opt, $arg) = splice(@config, 0, 2)) {
+ ($args{$opt} = $arg, next)
+ if $opt =~ /^force$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+ while (my ($pkg, $ver) = splice(@modules, 0, 2)) {
+ MY::preinstall($pkg, $ver) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand(Module => $pkg);
+ my $success = 0;
+
+ if ($obj and defined(_version_check($obj->cpan_version, $ver))) {
+ my $pathname = $pkg; $pathname =~ s/::/\\W/;
+
+ foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) {
+ delete $INC{$inc};
+ }
+
+ $obj->force('install') if $args{force};
+
+ my $rv = $obj->install || eval {
+ $CPAN::META->instance(
+ 'CPAN::Distribution',
+ $obj->cpan_file,
+ )->{install} if $CPAN::META
+ };
+
+ if ($rv eq 'YES') {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'} or
+ _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath(Cwd::cwd());
+ my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home});
+
+ return (index($cwd, $cpan) > -1);
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return if defined(_version_check(_load($class), $ver)); # no need to upgrade
+
+ if (_prompt(
+ "==> A newer version of $class ($ver) is required. Install?", 'y'
+ ) =~ /^[Nn]/) {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install([], $class, $ver);
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir ($path, 0755) unless -e $path;
+
+ return 1 if -w $path;
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?), 'y'
+ ) =~ /^[Yy]/) {
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join(',', @Missing);
+ my $config = join(',',
+ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}
+ ) if $Config;
+
+ return unless system('sudo', $^X, $0, "--config=$config", "--installdeps=$missing");
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # class/instance doesn't matter
+ my $file = $mod;
+
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+
+ local $@;
+ return eval { require $file; $mod->VERSION } || ($@ ? undef : 0);
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+sub _version_check {
+ my ($cur, $min) = @_;
+ return unless defined $cur;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if (ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./) {
+ if ($version::VERSION or defined(_load('version'))) {
+ # use version.pm if it is installed.
+ return ((version->new($cur) >= version->new($min)) ? $cur : undef);
+ }
+ elsif ($Sort::Versions::VERSION or defined(_load('Sort::Versions'))) {
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return ((Sort::Versions::versioncmp($cur, $min) != -1) ? $cur : undef);
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n".
+ "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return ($cur >= $min ? $cur : undef);
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{$args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ($args{EXE_FILES}) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} = [
+ grep { exists $manifest->{$_} } @{$args{EXE_FILES}}
+ ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join(' ', grep {
+ !exists($DisabledTests{$_})
+ } map { glob($_) } split(/\s+/, $args{test}{TESTS}));
+
+ my $missing = join(',', @Missing);
+ my $config = join(',',
+ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}
+ ) if $Config;
+
+ $PostambleActions = (
+ $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\@\$(NOOP)"
+ );
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from ExtUtils::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+
+ return << ".";
+
+config :: installdeps
+\t\@\$(NOOP)
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+.
+
+}
+
+1;
+
+__END__
+
+#line 978
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,52 @@
+#line 1 "inc/Module/Install/AutoInstall.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/AutoInstall.pm"
+package Module::Install::AutoInstall;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ while ( @core and @_ > 1 and $_[0] =~ /^-\w+$/ ) {
+ push @core, splice(@_, 0, 2);
+ }
+
+ # We'll need ExtUtils::AutoInstall
+ $self->include('ExtUtils::AutoInstall');
+ require ExtUtils::AutoInstall;
+
+ ExtUtils::AutoInstall->import(
+ (@core ? (-core => \@core) : ()), @_, $self->features
+ );
+
+ $self->makemaker_args( ExtUtils::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ ExtUtils::AutoInstall::postamble()
+ );
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install;
+ ExtUtils::AutoInstall::do_install();
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/Base.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/Base.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/Base.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,54 @@
+#line 1 "inc/Module/Install/Base.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/Base.pm"
+package Module::Install::Base;
+
+#line 28
+
+sub new {
+ my ($class, %args) = @_;
+
+ foreach my $method (qw(call load)) {
+ *{"$class\::$method"} = sub {
+ +shift->_top->$method(@_);
+ } unless defined &{"$class\::$method"};
+ }
+
+ bless(\%args, $class);
+}
+
+#line 46
+
+sub AUTOLOAD {
+ my $self = shift;
+ goto &{$self->_top->autoload};
+}
+
+#line 57
+
+sub _top { $_[0]->{_top} }
+
+#line 68
+
+sub admin {
+ my $self = shift;
+ $self->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+}
+
+sub is_admin {
+ my $self = shift;
+ $self->admin->VERSION;
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+my $Fake;
+sub new { $Fake ||= bless(\@_, $_[0]) }
+sub AUTOLOAD {}
+sub DESTROY {}
+
+1;
+
+__END__
+
+#line 112
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/Can.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/Can.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/Can.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,38 @@
+#line 1 "inc/Module/Install/Can.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/Can.pm"
+package Module::Install::Can;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+$VERSION = '0.01';
+
+use strict;
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+
+# check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/Fetch.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/Fetch.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/Fetch.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,86 @@
+#line 1 "inc/Module/Install/Fetch.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/Fetch.pm"
+package Module::Install::Fetch;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.01';
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ($scheme eq 'http' and !eval { require LWP::Simple; 1 }) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous at example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, << ".");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+.
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/Include.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/Include.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/Include.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,10 @@
+#line 1 "inc/Module/Install/Include.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/Include.pm"
+package Module::Install::Include;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub include { +shift->admin->include(@_) };
+sub include_deps { +shift->admin->include_deps(@_) };
+sub auto_include { +shift->admin->auto_include(@_) };
+sub auto_include_deps { +shift->admin->auto_include_deps(@_) };
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/Makefile.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/Makefile.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/Makefile.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,144 @@
+#line 1 "inc/Module/Install/Makefile.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/Makefile.pm"
+package Module::Install::Makefile;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.01';
+
+use strict 'vars';
+use vars '$VERSION';
+
+use ExtUtils::MakeMaker ();
+
+sub Makefile { $_[0] }
+
+sub prompt {
+ shift;
+ goto &ExtUtils::MakeMaker::prompt;
+}
+
+sub makemaker_args {
+ my $self = shift;
+ my $args = ($self->{makemaker_args} ||= {});
+ %$args = ( %$args, @_ ) if @_;
+ $args;
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join(" ", grep length, $clean->{FILES}, @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [shift];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ my $args = $self->makemaker_args;
+
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
+ $args->{VERSION} = $self->version || $self->determine_VERSION($args);
+ $args->{NAME} =~ s/-/::/g;
+ $args->{test} = {TESTS => $self->tests};
+
+ if ($] >= 5.005) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = $self->author;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
+ $args->{NO_META} = 1;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 ) {
+ $args->{SIGN} = 1 if $self->sign;
+ }
+ delete $args->{SIGN} unless $self->is_admin;
+
+ # merge both kinds of requires into prereq_pm
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_,
+ ($self->build_requires, $self->requires) );
+
+ # merge both kinds of requires into prereq_pm
+ my $dir = ($args->{DIR} ||= []);
+ if ($self->bundles) {
+ push @$dir, map "$_->[1]", @{$self->bundles};
+ delete $prereq->{$_->[0]} for @{$self->bundles};
+ }
+
+ if (my $perl_version = $self->perl_version) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, ".
+ "but we need version >= $perl_version";
+ }
+
+ my %args = map {($_ => $args->{$_})} grep {defined($args->{$_})} keys %$args;
+
+ if ($self->admin->preop) {
+ $args{dist} = $self->admin->preop;
+ }
+
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ $self->fix_up_makefile();
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n" . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n" .
+ ($self->postamble || '');
+
+ open MAKEFILE, '< Makefile' or die $!;
+ my $makefile = do { local $/; <MAKEFILE> };
+ close MAKEFILE;
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+
+ $makefile =~ s/^(FULLPERL = .*)/$1 -Iinc/m;
+ $makefile =~ s/^(PERL = .*)/$1 -Iinc/m;
+
+ open MAKEFILE, '> Makefile' or die $!;
+ print MAKEFILE "$preamble$makefile$postamble";
+ close MAKEFILE;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 274
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/Metadata.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/Metadata.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/Metadata.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,187 @@
+#line 1 "inc/Module/Install/Metadata.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/Metadata.pm"
+package Module::Install::Metadata;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.04';
+
+use strict 'vars';
+use vars qw($VERSION);
+
+sub Meta { shift }
+
+my @scalar_keys = qw(
+ name module_name version abstract author license
+ distribution_type sign perl_version tests
+);
+my @tuple_keys = qw(build_requires requires recommends bundles);
+
+foreach my $key (@scalar_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{'values'}{$key} unless @_;
+ $self->{'values'}{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key (@tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{'values'}{$key} unless @_;
+ my @rv;
+ while (@_) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ if ($module eq 'perl') {
+ $version =~ s{^(\d+)\.(\d+)\.(\d+)}
+ {$1 + $2/1_000 + $3/1_000_000}e;
+ $self->perl_version($version);
+ next;
+ }
+ my $rv = [$module, $version];
+ push @{$self->{'values'}{$key}}, $rv;
+ push @rv, $rv;
+ }
+ return @rv;
+ };
+}
+
+sub features {
+ my $self = shift;
+ while (my ($name, $mods) = splice(@_, 0, 2)) {
+ my $count = 0;
+ push @{$self->{'values'}{'features'}}, ($name => [
+ map { (++$count % 2 and ref($_) and ($count += $#$_)) ? @$_ : $_ } @$mods
+ ] );
+ }
+ return @{$self->{'values'}{'features'}};
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{$self->{'values'}{'no_index'}{$type}}, @_ if $type;
+ return $self->{'values'}{'no_index'};
+}
+
+sub _dump {
+ my $self = shift;
+ my $package = ref($self->_top);
+ my $version = $self->_top->VERSION;
+ my %values = %{$self->{'values'}};
+
+ delete $values{sign};
+ if (my $perl_version = delete $values{perl_version}) {
+ # Always canonical to three-dot version
+ $perl_version =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2), int($3))}e
+ if $perl_version >= 5.006;
+ $values{requires} = [
+ [perl => $perl_version],
+ @{$values{requires}||[]},
+ ];
+ }
+
+ warn "No license specified, setting license = 'unknown'\n"
+ unless $values{license};
+
+ $values{license} ||= 'unknown';
+ $values{distribution_type} ||= 'module';
+ $values{name} ||= do {
+ my $name = $values{module_name};
+ $name =~ s/::/-/g;
+ $name;
+ } if $values{module_name};
+
+ if ($values{name} =~ /::/) {
+ my $name = $values{name};
+ $name =~ s/::/-/g;
+ die "Error in name(): '$values{name}' should be '$name'!\n";
+ }
+
+ my $dump = '';
+ foreach my $key (@scalar_keys) {
+ $dump .= "$key: $values{$key}\n" if exists $values{$key};
+ }
+ foreach my $key (@tuple_keys) {
+ next unless exists $values{$key};
+ $dump .= "$key:\n";
+ foreach (@{$values{$key}}) {
+ $dump .= " $_->[0]: $_->[1]\n";
+ }
+ }
+
+ if (my $no_index = $values{no_index}) {
+ push @{$no_index->{'directory'}}, 'inc';
+ require YAML;
+ local $YAML::UseHeader = 0;
+ $dump .= YAML::Dump({ no_index => $no_index});
+ }
+ else {
+ $dump .= << "META";
+no_index:
+ directory:
+ - inc
+META
+ }
+
+ $dump .= "generated_by: $package version $version\n";
+ return $dump;
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML', 0 );
+ require YAML;
+ my $data = YAML::LoadFile( 'META.yml' );
+ # Call methods explicitly in case user has already set some values.
+ while ( my ($key, $value) = each %$data ) {
+ next unless $self->can( $key );
+ if (ref $value eq 'HASH') {
+ while (my ($module, $version) = each %$value) {
+ $self->$key( $module => $version );
+ }
+ }
+ else {
+ $self->$key( $value );
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+
+ META_NOT_OURS: {
+ local *FH;
+ if (open FH, "META.yml") {
+ while (<FH>) {
+ last META_NOT_OURS if /^generated_by: Module::Install\b/;
+ }
+ return $self if -s FH;
+ }
+ }
+
+ warn "Writing META.yml\n";
+ open META, "> META.yml" or warn "Cannot write to META.yml: $!";
+ print META $self->_dump;
+ close META;
+ return $self;
+}
+
+sub version_from {
+ my ($self, $version_from) = @_;
+ require ExtUtils::MM_Unix;
+ $self->version(ExtUtils::MM_Unix->parse_version($version_from));
+}
+
+sub abstract_from {
+ my ($self, $abstract_from) = @_;
+ require ExtUtils::MM_Unix;
+ $self->abstract(
+ bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix')
+ ->parse_abstract($abstract_from)
+ );
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/PAR.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/PAR.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/PAR.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,119 @@
+#line 1 "inc/Module/Install/PAR.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/PAR.pm"
+package Module::Install::PAR;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub par_base {
+ my ($self, $base, $file) = @_;
+ my $class = ref($self);
+ my $inc_class = join('::', @{$self->_top}{qw(prefix name)});
+ my $ftp_base;
+
+ if (defined $base and length $base) {
+ if ($base =~ m!^(([A-Z])[A-Z])[-_A-Z]+\Z!) {
+ $self->{mailto} = "$base\@cpan.org";
+ $ftp_base = "ftp://ftp.cpan.org/pub/CPAN/authors/id/$2/$1/$base";
+ $base = "http://www.cpan.org/authors/id/$2/$1/$base";
+ }
+ elsif ($base !~ m!^(\w+)://!) {
+ die "Cannot recognize path '$base'; please specify an URL or CPAN ID";
+ }
+ $base .= '/' unless $base =~ m!/\Z!;
+ $ftp_base .= '/' unless $ftp_base =~ m!/\Z!;
+ }
+
+ require Config;
+ my $suffix = "$Config::Config{archname}-$Config::Config{version}.par";
+
+ unless ($file ||= $self->{file}) {
+ my $name = $self->name or return;
+ my $version = $self->version or return;
+ $name =~ s!::!-!g;
+ $self->{file} = $file = "$name-$version-$suffix";
+ }
+
+ my $perl = $^X;
+ $perl = Win32::GetShortPathName($perl)
+ if $perl =~ / / and defined &Win32::GetShortPathName;
+
+ $self->preamble(<<"END") if $base;
+# --- $class section:
+
+all ::
+\t\@$perl -M$inc_class -e \"extract_par(q($file))\"
+
+END
+
+ $self->postamble(<<"END");
+# --- $class section:
+
+$file: all test
+\t\@\$(PERL) -M$inc_class -e \"make_par(q($file))\"
+
+par :: $file
+\t\@\$(NOOP)
+
+par-upload :: $file
+\tcpan-upload -verbose $file
+
+END
+
+ $self->{url} = $base;
+ $self->{ftp_url} = $ftp_base;
+ $self->{suffix} = $suffix;
+
+ return $self;
+}
+
+sub fetch_par {
+ my ($self, $url, $file, $quiet) = @_;
+ $url = $self->{url} || $self->par_base($url)->{url};
+ $ftp_url = $self->{ftp_url};
+ $file ||= $self->{file};
+
+ return $file if -f $file or $self->get_file(
+ url => "$url$file",
+ ftp_url => "$ftp_url$file"
+ );
+
+ require Config;
+ print << "END" if $self->{mailto} and !$quiet;
+*** No installation package available for your architecture.
+However, you may wish to generate one with '$Config::Config{make} par' and send
+it to <$self->{mailto}>, so other people on the same platform
+can benefit from it.
+*** Proceeding with normal installation...
+END
+ return;
+}
+
+sub extract_par {
+ my ($self, $file) = @_;
+ return unless -f $file;
+
+ if (eval { require Archive::Zip; 1 }) {
+ my $zip = Archive::Zip->new;
+ return unless $zip->read($file) == Archive::Zip::AZ_OK()
+ and $zip->extractTree('', 'blib/') == Archive::Zip::AZ_OK();
+ }
+ elsif ($self->can_run('unzip')) {
+ return if system(unzip => $file, qw(-d blib));
+ }
+
+ local *PM_TO_BLIB;
+ open PM_TO_BLIB, '> pm_to_blib' or die $!;
+ close PM_TO_BLIB;
+}
+
+sub make_par {
+ my ($self, $file) = @_;
+ unlink $file if -f $file;
+
+ unless ( eval { require PAR::Dist; PAR::Dist->VERSION >= 0.03 } ) {
+ warn "Please install PAR::Dist 0.03 or above first.";
+ return;
+ }
+
+ return PAR::Dist::blib_to_par(dist => $file);
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE/PAR.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE/PAR.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE/PAR.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,104 @@
+#line 1 "inc/Module/Install/PRIVATE/PAR.pm - /usr/local/lib/perl5/site_perl/5.8.6/Module/Install/PRIVATE/PAR.pm"
+# $File: //member/autrijus/Module-Install-PRIVATE/lib/Module/Install/PRIVATE/PAR.pm $ $Author: autrijus $
+# $Revision: #14 $ $Change: 10724 $ $DateTime: 2004/06/02 11:57:09 $ vim: expandtab shiftwidth=4
+
+package Module::Install::PRIVATE::PAR;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+use 5.006;
+use FindBin;
+use Config ();
+
+my %no_parl = ();
+
+sub Autrijus_PAR {
+ my $self = shift;
+ my $bork = $no_parl{$^O};
+ my $cc = $self->can_cc unless $bork;
+ my $par = $self->fetch_par('', '', !$cc) unless $cc or $bork;
+ my $exe = $Config::Config{_exe};
+ my $dynperl = $Config::Config{useshrplib} && ($Config::Config{useshrplib} ne 'false');
+
+ if ($bork) {
+ warn "Binary loading known to fail on $^O; won't generate 'script/parl$exe'!\n";
+ }
+ elsif (!$par and !$cc) {
+ warn "No compiler found, won't generate 'script/parl$exe'!\n";
+ }
+
+ # XXX: this branch is currently not entered
+ if ($cc and $par) {
+ my $answer = $self->prompt(
+ "*** Pre-built PAR package found. Use it instead of recompiling [y/N]?"
+ );
+ if ($answer !~ /^[Yy]/) {
+ $self->load('preamble')->{preamble} = '';
+ $par = '';
+ }
+ }
+
+ my @bin = ("script/parl$exe", "myldr/par$exe");
+ push @bin, ("script/parldyn$exe", "myldr/static$exe") if $dynperl;
+
+ $FindBin::Bin = '.' unless -e "$FindBin::Bin/Makefile.PL";
+ my $par_exe = "$FindBin::Bin/$bin[1]";
+
+ if ($par) {
+ open my $fh, '>', $par_exe or die "Cannot write to $par_exe";
+ close $fh;
+ }
+ elsif (-f $par_exe and not -s $par_exe) {
+ unlink $par_exe;
+ }
+
+ $self->clean_files(@bin) if $par or $cc;
+
+ $self->makemaker_args(
+ MAN1PODS => {
+ 'script/par.pl' => 'blib/man1/par.pl.1',
+ 'script/pp' => 'blib/man1/pp.1',
+ 'script/tkpp' => 'blib/man1/tkpp.1',
+ ($par or $cc) ? (
+ 'script/parl.pod' => 'blib/man1/parl.1',
+ ) : (),
+ },
+ EXE_FILES => [
+ 'script/par.pl',
+ 'script/pp',
+ 'script/tkpp',
+ (!$par and $cc) ? (
+ "script/parl$exe",
+ $dynperl ? (
+ "script/parldyn$exe",
+ ) : (),
+ ) : (),
+ ],
+ DIR => [
+ (!$par and $cc) ? (
+ 'myldr'
+ ) : (),
+ ],
+ NEEDS_LINKING => 1,
+ );
+}
+
+sub Autrijus_PAR_fix {
+ my $self = shift;
+
+ my $exe = $Config::Config{_exe};
+ return unless $exe eq '.exe';
+
+ open my $in, '<', "$FindBin::Bin/Makefile" or return;
+ open my $out, '>', "$FindBin::Bin/Makefile.new" or return;
+ while (<$in>) {
+ next if /^\t\$\(FIXIN\) .*\Q$exe\E$/;
+ next if /^\@\[$/ or /^\]$/;
+ print $out $_;
+ }
+ close $out;
+ close $in;
+ unlink "$FindBin::Bin/Makefile";
+ rename "$FindBin::Bin/Makefile.new" => "$FindBin::Bin/Makefile";
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/PRIVATE.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,28 @@
+#line 1 "inc/Module/Install/PRIVATE.pm - /usr/local/lib/perl5/site_perl/5.8.6/Module/Install/PRIVATE.pm"
+# $File: //member/autrijus/Module-Install-PRIVATE/lib/Module/Install/PRIVATE.pm $ $Author: autrijus $
+# $Revision: #2 $ $Change: 5848 $ $DateTime: 2003/05/14 22:24:03 $ vim: expandtab shiftwidth=4
+
+package Module::Install::PRIVATE;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub Autrijus { $_[0] }
+
+sub write {
+ my ($self, $name) = @_;
+
+ $self->author('Autrijus Tang (autrijus at autrijus.org)');
+ $self->par_base('AUTRIJUS');
+ $self->name($name ||= $self->name);
+
+ my $method = "Autrijus_$name";
+ $self->$method;
+}
+
+sub fix {
+ my $self = shift;
+ $name = $self->name;
+ my $method = "Autrijus_${name}_fix";
+ $self->$method;
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/Win32.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/Win32.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/Win32.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,63 @@
+#line 1 "inc/Module/Install/Win32.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/Win32.pm"
+package Module::Install::Win32;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.02';
+
+use strict;
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ $^O eq 'MSWin32' and
+ !$self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ if (!$rv) {
+ die << '.';
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+.
+ }
+}
+
+1;
+
+__END__
+
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,36 @@
+#line 1 "inc/Module/Install/WriteAll.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install/WriteAll.pm"
+package Module::Install::WriteAll;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->Meta->write if $args{meta};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ if ($0 =~ /Build.PL$/i) {
+ $self->Build->write;
+ }
+ else {
+ $self->check_nmake if $args{check_nmake};
+ $self->makemaker_args( PL_FILES => {} )
+ unless $self->makemaker_args->{'PL_FILES'};
+
+ if ($args{inline}) {
+ $self->Inline->write;
+ }
+ else {
+ $self->Makefile->write;
+ }
+ }
+}
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Module/Install.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Module/Install.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Module/Install.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,169 @@
+#line 1 "inc/Module/Install.pm - /usr/local/lib/perl5/site_perl/5.8.7/Module/Install.pm"
+package Module::Install;
+$VERSION = '0.39';
+
+die << "." unless $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'};
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+.
+
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+ at inc::Module::Install::ISA = 'Module::Install';
+*inc::Module::Install::VERSION = *VERSION;
+
+#line 130
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+
+ if (not -f $self->{file}) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} =
+ "$self->{name}::$self->{dispatch}"->new(_top => $self);
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ *{caller(0) . "::AUTOLOAD"} = $self->autoload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+}
+
+#line 157
+
+sub autoload {
+ my $self = shift;
+ my $caller = caller;
+
+ my $cwd = Cwd::cwd();
+ my $sym = "$caller\::AUTOLOAD";
+
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if (my $code = $sym->{$pwd}) {
+ goto &$code unless $cwd eq $pwd; # delegate back to parent dirs
+ }
+ $$sym =~ /([^:]+)$/ or die "Cannot autoload $caller";
+ unshift @_, ($self, $1);
+ goto &{$self->can('call')} unless uc($1) eq $1;
+ };
+}
+
+#line 182
+
+sub new {
+ my ($class, %args) = @_;
+
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= '.author';
+ $args{bundle} ||= 'inc/BUNDLES';
+
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+
+ unless ($args{path}) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{prefix}/$args{path}.pm";
+
+ bless(\%args, $class);
+}
+
+#line 211
+
+sub call {
+ my $self = shift;
+ my $method = shift;
+ my $obj = $self->load($method) or return;
+
+ unshift @_, $obj;
+ goto &{$obj->can($method)};
+}
+
+#line 226
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die << "END";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+#line 256
+
+sub load_extensions {
+ my ($self, $path, $top_obj) = @_;
+
+ unshift @INC, $self->{prefix}
+ unless grep { $_ eq $self->{prefix} } @INC;
+
+ local @INC = ($path, @INC);
+ foreach my $rv ($self->find_extensions($path)) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ eval { require $file; 1 } or (warn($@), next);
+ $self->{pathnames}{$pkg} = delete $INC{$file};
+ push @{$self->{extensions}}, $pkg->new( _top => $top_obj );
+ }
+}
+
+#line 280
+
+sub find_extensions {
+ my ($self, $path) = @_;
+ my @found;
+
+ File::Find::find(sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ return if $1 eq $self->{dispatch};
+
+ $file = "$self->{path}/$1.pm";
+ my $pkg = "$self->{name}::$1"; $pkg =~ s!/!::!g;
+ push @found, [$file, $pkg];
+ }, $path) if -d $path;
+
+ @found;
+}
+
+1;
+
+__END__
+
+#line 618
Added: packages/libpar-perl/branches/upstream/current/inc/Test/Builder.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Test/Builder.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Test/Builder.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,1026 @@
+#line 1 "inc/Test/Builder.pm - /usr/local/lib/perl5/site_perl/5.8.6/Test/Builder.pm"
+package Test::Builder;
+
+use 5.004;
+
+# $^C was only introduced in 5.005-ish. We do this to prevent
+# use of uninitialized value warnings in older perls.
+$^C ||= 0;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.30';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
+
+# Make Test::Builder thread-safe for ithreads.
+BEGIN {
+ use Config;
+ # Load threads::shared when threads are turned on
+ if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
+ require threads::shared;
+
+ # Hack around YET ANOTHER threads::shared bug. It would
+ # occassionally forget the contents of the variable when sharing it.
+ # So we first copy the data, then share, then put our copy back.
+ *share = sub (\[$@%]) {
+ my $type = ref $_[0];
+ my $data;
+
+ if( $type eq 'HASH' ) {
+ %$data = %{$_[0]};
+ }
+ elsif( $type eq 'ARRAY' ) {
+ @$data = @{$_[0]};
+ }
+ elsif( $type eq 'SCALAR' ) {
+ $$data = ${$_[0]};
+ }
+ else {
+ die "Unknown type: ".$type;
+ }
+
+ $_[0] = &threads::shared::share($_[0]);
+
+ if( $type eq 'HASH' ) {
+ %{$_[0]} = %$data;
+ }
+ elsif( $type eq 'ARRAY' ) {
+ @{$_[0]} = @$data;
+ }
+ elsif( $type eq 'SCALAR' ) {
+ ${$_[0]} = $$data;
+ }
+ else {
+ die "Unknown type: ".$type;
+ }
+
+ return $_[0];
+ };
+ }
+ # 5.8.0's threads::shared is busted when threads are off.
+ # We emulate it here.
+ else {
+ *share = sub { return $_[0] };
+ *lock = sub { 0 };
+ }
+}
+
+
+#line 128
+
+my $Test = Test::Builder->new;
+sub new {
+ my($class) = shift;
+ $Test ||= $class->create;
+ return $Test;
+}
+
+
+#line 150
+
+sub create {
+ my $class = shift;
+
+ my $self = bless {}, $class;
+ $self->reset;
+
+ return $self;
+}
+
+#line 169
+
+use vars qw($Level);
+
+sub reset {
+ my ($self) = @_;
+
+ # We leave this a global because it has to be localized and localizing
+ # hash keys is just asking for pain. Also, it was documented.
+ $Level = 1;
+
+ $self->{Test_Died} = 0;
+ $self->{Have_Plan} = 0;
+ $self->{No_Plan} = 0;
+ $self->{Original_Pid} = $$;
+
+ share($self->{Curr_Test});
+ $self->{Curr_Test} = 0;
+ $self->{Test_Results} = &share([]);
+
+ $self->{Exported_To} = undef;
+ $self->{Expected_Tests} = 0;
+
+ $self->{Skip_All} = 0;
+
+ $self->{Use_Nums} = 1;
+
+ $self->{No_Header} = 0;
+ $self->{No_Ending} = 0;
+
+ $self->_dup_stdhandles unless $^C;
+
+ return undef;
+}
+
+#line 221
+
+sub exported_to {
+ my($self, $pack) = @_;
+
+ if( defined $pack ) {
+ $self->{Exported_To} = $pack;
+ }
+ return $self->{Exported_To};
+}
+
+#line 243
+
+sub plan {
+ my($self, $cmd, $arg) = @_;
+
+ return unless $cmd;
+
+ if( $self->{Have_Plan} ) {
+ die sprintf "You tried to plan twice! Second plan at %s line %d\n",
+ ($self->caller)[1,2];
+ }
+
+ if( $cmd eq 'no_plan' ) {
+ $self->no_plan;
+ }
+ elsif( $cmd eq 'skip_all' ) {
+ return $self->skip_all($arg);
+ }
+ elsif( $cmd eq 'tests' ) {
+ if( $arg ) {
+ return $self->expected_tests($arg);
+ }
+ elsif( !defined $arg ) {
+ die "Got an undefined number of tests. Looks like you tried to ".
+ "say how many tests you plan to run but made a mistake.\n";
+ }
+ elsif( !$arg ) {
+ die "You said to run 0 tests! You've got to run something.\n";
+ }
+ }
+ else {
+ require Carp;
+ my @args = grep { defined } ($cmd, $arg);
+ Carp::croak("plan() doesn't understand @args");
+ }
+
+ return 1;
+}
+
+#line 290
+
+sub expected_tests {
+ my $self = shift;
+ my($max) = @_;
+
+ if( @_ ) {
+ die "Number of tests must be a postive integer. You gave it '$max'.\n"
+ unless $max =~ /^\+?\d+$/ and $max > 0;
+
+ $self->{Expected_Tests} = $max;
+ $self->{Have_Plan} = 1;
+
+ $self->_print("1..$max\n") unless $self->no_header;
+ }
+ return $self->{Expected_Tests};
+}
+
+
+#line 315
+
+sub no_plan {
+ my $self = shift;
+
+ $self->{No_Plan} = 1;
+ $self->{Have_Plan} = 1;
+}
+
+#line 330
+
+sub has_plan {
+ my $self = shift;
+
+ return($self->{Expected_Tests}) if $self->{Expected_Tests};
+ return('no_plan') if $self->{No_Plan};
+ return(undef);
+};
+
+
+#line 348
+
+sub skip_all {
+ my($self, $reason) = @_;
+
+ my $out = "1..0";
+ $out .= " # Skip $reason" if $reason;
+ $out .= "\n";
+
+ $self->{Skip_All} = 1;
+
+ $self->_print($out) unless $self->no_header;
+ exit(0);
+}
+
+#line 381
+
+sub ok {
+ my($self, $test, $name) = @_;
+
+ # $test might contain an object which we don't want to accidentally
+ # store, so we turn it into a boolean.
+ $test = $test ? 1 : 0;
+
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
+ }
+
+ lock $self->{Curr_Test};
+ $self->{Curr_Test}++;
+
+ # In case $name is a string overloaded object, force it to stringify.
+ $self->_unoverload(\$name);
+
+ $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
+ You named your test '$name'. You shouldn't use numbers for your test names.
+ Very confusing.
+ERR
+
+ my($pack, $file, $line) = $self->caller;
+
+ my $todo = $self->todo($pack);
+ $self->_unoverload(\$todo);
+
+ my $out;
+ my $result = &share({});
+
+ unless( $test ) {
+ $out .= "not ";
+ @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
+ }
+ else {
+ @$result{ 'ok', 'actual_ok' } = ( 1, $test );
+ }
+
+ $out .= "ok";
+ $out .= " $self->{Curr_Test}" if $self->use_numbers;
+
+ if( defined $name ) {
+ $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
+ $out .= " - $name";
+ $result->{name} = $name;
+ }
+ else {
+ $result->{name} = '';
+ }
+
+ if( $todo ) {
+ $out .= " # TODO $todo";
+ $result->{reason} = $todo;
+ $result->{type} = 'todo';
+ }
+ else {
+ $result->{reason} = '';
+ $result->{type} = '';
+ }
+
+ $self->{Test_Results}[$self->{Curr_Test}-1] = $result;
+ $out .= "\n";
+
+ $self->_print($out);
+
+ unless( $test ) {
+ my $msg = $todo ? "Failed (TODO)" : "Failed";
+ $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
+ $self->diag(" $msg test ($file at line $line)\n");
+ }
+
+ return $test ? 1 : 0;
+}
+
+
+sub _unoverload {
+ my $self = shift;
+
+ local($@,$!);
+
+ eval { require overload } || return;
+
+ foreach my $thing (@_) {
+ eval {
+ if( defined $$thing ) {
+ if( my $string_meth = overload::Method($$thing, '""') ) {
+ $$thing = $$thing->$string_meth();
+ }
+ }
+ };
+ }
+}
+
+
+#line 492
+
+sub is_eq {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, 'eq', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'eq', $expect, $name);
+}
+
+sub is_num {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, '==', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '==', $expect, $name);
+}
+
+sub _is_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ foreach my $val (\$got, \$expect) {
+ if( defined $$val ) {
+ if( $type eq 'eq' ) {
+ # quote and force string context
+ $$val = "'$$val'"
+ }
+ else {
+ # force numeric context
+ $$val = $$val+0;
+ }
+ }
+ else {
+ $$val = 'undef';
+ }
+ }
+
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
+ got: %s
+ expected: %s
+DIAGNOSTIC
+
+}
+
+#line 566
+
+sub isnt_eq {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'ne', $dont_expect, $name);
+}
+
+sub isnt_num {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag($got, '!=', $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '!=', $dont_expect, $name);
+}
+
+
+#line 618
+
+sub like {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '=~', $name);
+}
+
+sub unlike {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '!~', $name);
+}
+
+#line 659
+
+
+sub maybe_regex {
+ my ($self, $regex) = @_;
+ my $usable_regex = undef;
+
+ return $usable_regex unless defined $regex;
+
+ my($re, $opts);
+
+ # Check for qr/foo/
+ if( ref $regex eq 'Regexp' ) {
+ $usable_regex = $regex;
+ }
+ # Check for '/foo/' or 'm,foo,'
+ elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
+ (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
+ )
+ {
+ $usable_regex = length $opts ? "(?$opts)$re" : $re;
+ }
+
+ return $usable_regex;
+};
+
+sub _regex_ok {
+ my($self, $this, $regex, $cmp, $name) = @_;
+
+ local $Level = $Level + 1;
+
+ my $ok = 0;
+ my $usable_regex = $self->maybe_regex($regex);
+ unless (defined $usable_regex) {
+ $ok = $self->ok( 0, $name );
+ $self->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ {
+ local $^W = 0;
+ my $test = $this =~ /$usable_regex/ ? 1 : 0;
+ $test = !$test if $cmp eq '!~';
+ $ok = $self->ok( $test, $name );
+ }
+
+ unless( $ok ) {
+ $this = defined $this ? "'$this'" : 'undef';
+ my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+ $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
+ %s
+ %13s '%s'
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+#line 726
+
+sub cmp_ok {
+ my($self, $got, $type, $expect, $name) = @_;
+
+ my $test;
+ {
+ local $^W = 0;
+ local($@,$!); # don't interfere with $@
+ # eval() sometimes resets $!
+ $test = eval "\$got $type \$expect";
+ }
+ local $Level = $Level + 1;
+ my $ok = $self->ok($test, $name);
+
+ unless( $ok ) {
+ if( $type =~ /^(eq|==)$/ ) {
+ $self->_is_diag($got, $type, $expect);
+ }
+ else {
+ $self->_cmp_diag($got, $type, $expect);
+ }
+ }
+ return $ok;
+}
+
+sub _cmp_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ $got = defined $got ? "'$got'" : 'undef';
+ $expect = defined $expect ? "'$expect'" : 'undef';
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
+ %s
+ %s
+ %s
+DIAGNOSTIC
+}
+
+#line 774
+
+sub BAILOUT {
+ my($self, $reason) = @_;
+
+ $self->_print("Bail out! $reason");
+ exit 255;
+}
+
+#line 790
+
+sub skip {
+ my($self, $why) = @_;
+ $why ||= '';
+ $self->_unoverload(\$why);
+
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($self->{Curr_Test});
+ $self->{Curr_Test}++;
+
+ $self->{Test_Results}[$self->{Curr_Test}-1] = &share({
+ 'ok' => 1,
+ actual_ok => 1,
+ name => '',
+ type => 'skip',
+ reason => $why,
+ });
+
+ my $out = "ok";
+ $out .= " $self->{Curr_Test}" if $self->use_numbers;
+ $out .= " # skip";
+ $out .= " $why" if length $why;
+ $out .= "\n";
+
+ $self->_print($out);
+
+ return 1;
+}
+
+
+#line 835
+
+sub todo_skip {
+ my($self, $why) = @_;
+ $why ||= '';
+
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($self->{Curr_Test});
+ $self->{Curr_Test}++;
+
+ $self->{Test_Results}[$self->{Curr_Test}-1] = &share({
+ 'ok' => 1,
+ actual_ok => 0,
+ name => '',
+ type => 'todo_skip',
+ reason => $why,
+ });
+
+ my $out = "not ok";
+ $out .= " $self->{Curr_Test}" if $self->use_numbers;
+ $out .= " # TODO & SKIP $why\n";
+
+ $self->_print($out);
+
+ return 1;
+}
+
+
+#line 906
+
+sub level {
+ my($self, $level) = @_;
+
+ if( defined $level ) {
+ $Level = $level;
+ }
+ return $Level;
+}
+
+
+#line 941
+
+sub use_numbers {
+ my($self, $use_nums) = @_;
+
+ if( defined $use_nums ) {
+ $self->{Use_Nums} = $use_nums;
+ }
+ return $self->{Use_Nums};
+}
+
+#line 967
+
+sub no_header {
+ my($self, $no_header) = @_;
+
+ if( defined $no_header ) {
+ $self->{No_Header} = $no_header;
+ }
+ return $self->{No_Header};
+}
+
+sub no_ending {
+ my($self, $no_ending) = @_;
+
+ if( defined $no_ending ) {
+ $self->{No_Ending} = $no_ending;
+ }
+ return $self->{No_Ending};
+}
+
+
+#line 1023
+
+sub diag {
+ my($self, @msgs) = @_;
+ return unless @msgs;
+
+ # Prevent printing headers when compiling (i.e. -c)
+ return if $^C;
+
+ # Smash args together like print does.
+ # Convert undef to 'undef' so its readable.
+ my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
+
+ # Escape each line with a #.
+ $msg =~ s/^/# /gm;
+
+ # Stick a newline on the end if it needs it.
+ $msg .= "\n" unless $msg =~ /\n\Z/;
+
+ local $Level = $Level + 1;
+ $self->_print_diag($msg);
+
+ return 0;
+}
+
+#line 1058
+
+sub _print {
+ my($self, @msgs) = @_;
+
+ # Prevent printing headers when only compiling. Mostly for when
+ # tests are deparsed with B::Deparse
+ return if $^C;
+
+ my $msg = join '', @msgs;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->output;
+
+ # Escape each line after the first with a # so we don't
+ # confuse Test::Harness.
+ $msg =~ s/\n(.)/\n# $1/sg;
+
+ # Stick a newline on the end if it needs it.
+ $msg .= "\n" unless $msg =~ /\n\Z/;
+
+ print $fh $msg;
+}
+
+
+#line 1089
+
+sub _print_diag {
+ my $self = shift;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->todo ? $self->todo_output : $self->failure_output;
+ print $fh @_;
+}
+
+#line 1126
+
+sub output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $self->{Out_FH} = _new_fh($fh);
+ }
+ return $self->{Out_FH};
+}
+
+sub failure_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $self->{Fail_FH} = _new_fh($fh);
+ }
+ return $self->{Fail_FH};
+}
+
+sub todo_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $self->{Todo_FH} = _new_fh($fh);
+ }
+ return $self->{Todo_FH};
+}
+
+
+sub _new_fh {
+ my($file_or_fh) = shift;
+
+ my $fh;
+ if( _is_fh($file_or_fh) ) {
+ $fh = $file_or_fh;
+ }
+ else {
+ $fh = do { local *FH };
+ open $fh, ">$file_or_fh" or
+ die "Can't open test output log $file_or_fh: $!";
+ _autoflush($fh);
+ }
+
+ return $fh;
+}
+
+
+sub _is_fh {
+ my $maybe_fh = shift;
+
+ return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
+
+ return UNIVERSAL::isa($maybe_fh, 'GLOB') ||
+ UNIVERSAL::isa($maybe_fh, 'IO::Handle') ||
+
+ # 5.5.4's tied() and can() doesn't like getting undef
+ UNIVERSAL::can((tied($maybe_fh) || ''), 'TIEHANDLE');
+}
+
+
+sub _autoflush {
+ my($fh) = shift;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+}
+
+
+sub _dup_stdhandles {
+ my $self = shift;
+
+ $self->_open_testhandles;
+
+ # Set everything to unbuffered else plain prints to STDOUT will
+ # come out in the wrong order from our own prints.
+ _autoflush(\*TESTOUT);
+ _autoflush(\*STDOUT);
+ _autoflush(\*TESTERR);
+ _autoflush(\*STDERR);
+
+ $self->output(\*TESTOUT);
+ $self->failure_output(\*TESTERR);
+ $self->todo_output(\*TESTOUT);
+}
+
+
+my $Opened_Testhandles = 0;
+sub _open_testhandles {
+ return if $Opened_Testhandles;
+ # We dup STDOUT and STDERR so people can change them in their
+ # test suites while still getting normal test output.
+ open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
+ open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
+ $Opened_Testhandles = 1;
+}
+
+
+#line 1243
+
+sub current_test {
+ my($self, $num) = @_;
+
+ lock($self->{Curr_Test});
+ if( defined $num ) {
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("Can't change the current test number without a plan!");
+ }
+
+ $self->{Curr_Test} = $num;
+
+ # If the test counter is being pushed forward fill in the details.
+ my $test_results = $self->{Test_Results};
+ if( $num > @$test_results ) {
+ my $start = @$test_results ? @$test_results : 0;
+ for ($start..$num-1) {
+ $test_results->[$_] = &share({
+ 'ok' => 1,
+ actual_ok => undef,
+ reason => 'incrementing test number',
+ type => 'unknown',
+ name => undef
+ });
+ }
+ }
+ # If backward, wipe history. Its their funeral.
+ elsif( $num < @$test_results ) {
+ $#{$test_results} = $num - 1;
+ }
+ }
+ return $self->{Curr_Test};
+}
+
+
+#line 1289
+
+sub summary {
+ my($self) = shift;
+
+ return map { $_->{'ok'} } @{ $self->{Test_Results} };
+}
+
+#line 1344
+
+sub details {
+ my $self = shift;
+ return @{ $self->{Test_Results} };
+}
+
+#line 1369
+
+sub todo {
+ my($self, $pack) = @_;
+
+ $pack = $pack || $self->exported_to || $self->caller($Level);
+ return 0 unless $pack;
+
+ no strict 'refs';
+ return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
+ : 0;
+}
+
+#line 1390
+
+sub caller {
+ my($self, $height) = @_;
+ $height ||= 0;
+
+ my @caller = CORE::caller($self->level + $height + 1);
+ return wantarray ? @caller : $caller[0];
+}
+
+#line 1402
+
+#line 1416
+
+#'#
+sub _sanity_check {
+ my $self = shift;
+
+ _whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!');
+ _whoa(!$self->{Have_Plan} and $self->{Curr_Test},
+ 'Somehow your tests ran without a plan!');
+ _whoa($self->{Curr_Test} != @{ $self->{Test_Results} },
+ 'Somehow you got a different number of results than tests ran!');
+}
+
+#line 1437
+
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+#line 1458
+
+sub _my_exit {
+ $? = $_[0];
+
+ return 1;
+}
+
+
+#line 1471
+
+$SIG{__DIE__} = sub {
+ # We don't want to muck with death in an eval, but $^S isn't
+ # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
+ # with it. Instead, we use caller. This also means it runs under
+ # 5.004!
+ my $in_eval = 0;
+ for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
+ $in_eval = 1 if $sub =~ /^\(eval\)/;
+ }
+ $Test->{Test_Died} = 1 unless $in_eval;
+};
+
+sub _ending {
+ my $self = shift;
+
+ $self->_sanity_check();
+
+ # Don't bother with an ending if this is a forked copy. Only the parent
+ # should do the ending.
+ # Exit if plan() was never called. This is so "require Test::Simple"
+ # doesn't puke.
+ if( ($self->{Original_Pid} != $$) or
+ (!$self->{Have_Plan} && !$self->{Test_Died}) )
+ {
+ _my_exit($?);
+ return;
+ }
+
+ # Figure out if we passed or failed and print helpful messages.
+ my $test_results = $self->{Test_Results};
+ if( @$test_results ) {
+ # The plan? We have no plan.
+ if( $self->{No_Plan} ) {
+ $self->_print("1..$self->{Curr_Test}\n") unless $self->no_header;
+ $self->{Expected_Tests} = $self->{Curr_Test};
+ }
+
+ # Auto-extended arrays and elements which aren't explicitly
+ # filled in with a shared reference will puke under 5.8.0
+ # ithreads. So we have to fill them in by hand. :(
+ my $empty_result = &share({});
+ for my $idx ( 0..$self->{Expected_Tests}-1 ) {
+ $test_results->[$idx] = $empty_result
+ unless defined $test_results->[$idx];
+ }
+
+ my $num_failed = grep !$_->{'ok'},
+ @{$test_results}[0..$self->{Expected_Tests}-1];
+ $num_failed += abs($self->{Expected_Tests} - @$test_results);
+
+ if( $self->{Curr_Test} < $self->{Expected_Tests} ) {
+ my $s = $self->{Expected_Tests} == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you planned $self->{Expected_Tests} test$s but only ran $self->{Curr_Test}.
+FAIL
+ }
+ elsif( $self->{Curr_Test} > $self->{Expected_Tests} ) {
+ my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
+ my $s = $self->{Expected_Tests} == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you planned $self->{Expected_Tests} test$s but ran $num_extra extra.
+FAIL
+ }
+ elsif ( $num_failed ) {
+ my $s = $num_failed == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you failed $num_failed test$s of $self->{Expected_Tests}.
+FAIL
+ }
+
+ if( $self->{Test_Died} ) {
+ $self->diag(<<"FAIL");
+Looks like your test died just after $self->{Curr_Test}.
+FAIL
+
+ _my_exit( 255 ) && return;
+ }
+
+ _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
+ }
+ elsif ( $self->{Skip_All} ) {
+ _my_exit( 0 ) && return;
+ }
+ elsif ( $self->{Test_Died} ) {
+ $self->diag(<<'FAIL');
+Looks like your test died before it could output anything.
+FAIL
+ _my_exit( 255 ) && return;
+ }
+ else {
+ $self->diag("No tests run!\n");
+ _my_exit( 255 ) && return;
+ }
+}
+
+END {
+ $Test->_ending if defined $Test and !$Test->no_ending;
+}
+
+#line 1624
+
+1;
Added: packages/libpar-perl/branches/upstream/current/inc/Test/More.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/inc/Test/More.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/inc/Test/More.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,651 @@
+#line 1 "inc/Test/More.pm - /usr/local/lib/perl5/site_perl/5.8.6/Test/More.pm"
+package Test::More;
+
+use 5.004;
+
+use strict;
+use Test::Builder;
+
+
+# Can't use Carp because it might cause use_ok() to accidentally succeed
+# even though the module being used forgot to use Carp. Yes, this
+# actually happened.
+sub _carp {
+ my($file, $line) = (caller(1))[1,2];
+ warn @_, " at $file line $line\n";
+}
+
+
+
+require Exporter;
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
+$VERSION = '0.60';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
+
+ at ISA = qw(Exporter);
+ at EXPORT = qw(ok use_ok require_ok
+ is isnt like unlike is_deeply
+ cmp_ok
+ skip todo todo_skip
+ pass fail
+ eq_array eq_hash eq_set
+ $TODO
+ plan
+ can_ok isa_ok
+ diag
+ );
+
+my $Test = Test::Builder->new;
+my $Show_Diag = 1;
+
+
+# 5.004's Exporter doesn't have export_to_level.
+sub _export_to_level
+{
+ my $pkg = shift;
+ my $level = shift;
+ (undef) = shift; # redundant arg
+ my $callpkg = caller($level);
+ $pkg->export($callpkg, @_);
+}
+
+
+#line 173
+
+sub plan {
+ my(@plan) = @_;
+
+ my $idx = 0;
+ my @cleaned_plan;
+ while( $idx <= $#plan ) {
+ my $item = $plan[$idx];
+
+ if( $item eq 'no_diag' ) {
+ $Show_Diag = 0;
+ }
+ else {
+ push @cleaned_plan, $item;
+ }
+
+ $idx++;
+ }
+
+ $Test->plan(@cleaned_plan);
+}
+
+sub import {
+ my($class) = shift;
+
+ my $caller = caller;
+
+ $Test->exported_to($caller);
+
+ my $idx = 0;
+ my @plan;
+ my @imports;
+ while( $idx <= $#_ ) {
+ my $item = $_[$idx];
+
+ if( $item eq 'import' ) {
+ push @imports, @{$_[$idx+1]};
+ $idx++;
+ }
+ else {
+ push @plan, $item;
+ }
+
+ $idx++;
+ }
+
+ plan(@plan);
+
+ __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+}
+
+
+#line 291
+
+sub ok ($;$) {
+ my($test, $name) = @_;
+ $Test->ok($test, $name);
+}
+
+#line 355
+
+sub is ($$;$) {
+ $Test->is_eq(@_);
+}
+
+sub isnt ($$;$) {
+ $Test->isnt_eq(@_);
+}
+
+*isn't = \&isnt;
+
+
+#line 396
+
+sub like ($$;$) {
+ $Test->like(@_);
+}
+
+
+#line 410
+
+sub unlike ($$;$) {
+ $Test->unlike(@_);
+}
+
+
+#line 448
+
+sub cmp_ok($$$;$) {
+ $Test->cmp_ok(@_);
+}
+
+
+#line 482
+
+sub can_ok ($@) {
+ my($proto, @methods) = @_;
+ my $class = ref $proto || $proto;
+
+ unless( @methods ) {
+ my $ok = $Test->ok( 0, "$class->can(...)" );
+ $Test->diag(' can_ok() called with no methods');
+ return $ok;
+ }
+
+ my @nok = ();
+ foreach my $method (@methods) {
+ local($!, $@); # don't interfere with caller's $@
+ # eval sometimes resets $!
+ eval { $proto->can($method) } || push @nok, $method;
+ }
+
+ my $name;
+ $name = @methods == 1 ? "$class->can('$methods[0]')"
+ : "$class->can(...)";
+
+ my $ok = $Test->ok( !@nok, $name );
+
+ $Test->diag(map " $class->can('$_') failed\n", @nok);
+
+ return $ok;
+}
+
+#line 539
+
+sub isa_ok ($$;$) {
+ my($object, $class, $obj_name) = @_;
+
+ my $diag;
+ $obj_name = 'The object' unless defined $obj_name;
+ my $name = "$obj_name isa $class";
+ if( !defined $object ) {
+ $diag = "$obj_name isn't defined";
+ }
+ elsif( !ref $object ) {
+ $diag = "$obj_name isn't a reference";
+ }
+ else {
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ local($@, $!); # eval sometimes resets $!
+ my $rslt = eval { $object->isa($class) };
+ if( $@ ) {
+ if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+ if( !UNIVERSAL::isa($object, $class) ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ } else {
+ die <<WHOA;
+WHOA! I tried to call ->isa on your object and got some weird error.
+This should never happen. Please contact the author immediately.
+Here's the error.
+$@
+WHOA
+ }
+ }
+ elsif( !$rslt ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ }
+
+
+
+ my $ok;
+ if( $diag ) {
+ $ok = $Test->ok( 0, $name );
+ $Test->diag(" $diag\n");
+ }
+ else {
+ $ok = $Test->ok( 1, $name );
+ }
+
+ return $ok;
+}
+
+
+#line 608
+
+sub pass (;$) {
+ $Test->ok(1, @_);
+}
+
+sub fail (;$) {
+ $Test->ok(0, @_);
+}
+
+#line 661
+
+sub diag {
+ return unless $Show_Diag;
+ $Test->diag(@_);
+}
+
+
+#line 717
+
+sub use_ok ($;@) {
+ my($module, @imports) = @_;
+ @imports = () unless @imports;
+
+ my($pack,$filename,$line) = caller;
+
+ local($@,$!); # eval sometimes interferes with $!
+
+ if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+ # probably a version check. Perl needs to see the bare number
+ # for it to work with non-Exporter based modules.
+ eval <<USE;
+package $pack;
+use $module $imports[0];
+USE
+ }
+ else {
+ eval <<USE;
+package $pack;
+use $module \@imports;
+USE
+ }
+
+ my $ok = $Test->ok( !$@, "use $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $@ =~ s{^BEGIN failed--compilation aborted at .*$}
+ {BEGIN failed--compilation aborted at $filename line $line.}m;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to use '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+#line 765
+
+sub require_ok ($) {
+ my($module) = shift;
+
+ my $pack = caller;
+
+ # Try to deterine if we've been given a module name or file.
+ # Module names must be barewords, files not.
+ $module = qq['$module'] unless _is_module_name($module);
+
+ local($!, $@); # eval sometimes interferes with $!
+ eval <<REQUIRE;
+package $pack;
+require $module;
+REQUIRE
+
+ my $ok = $Test->ok( !$@, "require $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to require '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+
+sub _is_module_name {
+ my $module = shift;
+
+ # Module names start with a letter.
+ # End with an alphanumeric.
+ # The rest is an alphanumeric or ::
+ $module =~ s/\b::\b//g;
+ $module =~ /^[a-zA-Z]\w*$/;
+}
+
+#line 866
+
+#'#
+sub skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "skip() needs to know \$how_many tests are in the block"
+ unless $Test->has_plan eq 'no_plan';
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->skip($why);
+ }
+
+ local $^W = 0;
+ last SKIP;
+}
+
+
+#line 947
+
+sub todo_skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "todo_skip() needs to know \$how_many tests are in the block"
+ unless $Test->has_plan eq 'no_plan';
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->todo_skip($why);
+ }
+
+ local $^W = 0;
+ last TODO;
+}
+
+#line 1003
+
+use vars qw(@Data_Stack %Refs_Seen);
+my $DNE = bless [], 'Does::Not::Exist';
+sub is_deeply {
+ unless( @_ == 2 or @_ == 3 ) {
+ my $msg = <<WARNING;
+is_deeply() takes two or three args, you gave %d.
+This usually means you passed an array or hash instead
+of a reference to it
+WARNING
+ chop $msg; # clip off newline so carp() will put in line/file
+
+ _carp sprintf $msg, scalar @_;
+
+ return $Test->ok(0);
+ }
+
+ my($this, $that, $name) = @_;
+
+ my $ok;
+ if( !ref $this and !ref $that ) { # neither is a reference
+ $ok = $Test->is_eq($this, $that, $name);
+ }
+ elsif( !ref $this xor !ref $that ) { # one's a reference, one isn't
+ $ok = $Test->ok(0, $name);
+ $Test->diag( _format_stack({ vals => [ $this, $that ] }) );
+ }
+ else { # both references
+ local @Data_Stack = ();
+ if( _deep_check($this, $that) ) {
+ $ok = $Test->ok(1, $name);
+ }
+ else {
+ $ok = $Test->ok(0, $name);
+ $Test->diag(_format_stack(@Data_Stack));
+ }
+ }
+
+ return $ok;
+}
+
+sub _format_stack {
+ my(@Stack) = @_;
+
+ my $var = '$FOO';
+ my $did_arrow = 0;
+ foreach my $entry (@Stack) {
+ my $type = $entry->{type} || '';
+ my $idx = $entry->{'idx'};
+ if( $type eq 'HASH' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "{$idx}";
+ }
+ elsif( $type eq 'ARRAY' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "[$idx]";
+ }
+ elsif( $type eq 'REF' ) {
+ $var = "\${$var}";
+ }
+ }
+
+ my @vals = @{$Stack[-1]{vals}}[0,1];
+ my @vars = ();
+ ($vars[0] = $var) =~ s/\$FOO/ \$got/;
+ ($vars[1] = $var) =~ s/\$FOO/\$expected/;
+
+ my $out = "Structures begin differing at:\n";
+ foreach my $idx (0..$#vals) {
+ my $val = $vals[$idx];
+ $vals[$idx] = !defined $val ? 'undef' :
+ $val eq $DNE ? "Does not exist" :
+ ref $val ? "$val" :
+ "'$val'";
+ }
+
+ $out .= "$vars[0] = $vals[0]\n";
+ $out .= "$vars[1] = $vals[1]\n";
+
+ $out =~ s/^/ /msg;
+ return $out;
+}
+
+
+sub _type {
+ my $thing = shift;
+
+ return '' if !ref $thing;
+
+ for my $type (qw(ARRAY HASH REF SCALAR GLOB Regexp)) {
+ return $type if UNIVERSAL::isa($thing, $type);
+ }
+
+ return '';
+}
+
+
+#line 1127
+
+#'#
+sub eq_array {
+ local @Data_Stack;
+ _deep_check(@_);
+}
+
+sub _eq_array {
+ my($a1, $a2) = @_;
+
+ if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) {
+ warn "eq_array passed a non-array ref";
+ return 0;
+ }
+
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+ for (0..$max) {
+ my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
+ my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+
+ push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
+ $ok = _deep_check($e1,$e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+sub _deep_check {
+ my($e1, $e2) = @_;
+ my $ok = 0;
+
+ # Effectively turn %Refs_Seen into a stack. This avoids picking up
+ # the same referenced used twice (such as [\$a, \$a]) to be considered
+ # circular.
+ local %Refs_Seen = %Refs_Seen;
+
+ {
+ # Quiet uninitialized value warnings when comparing undefs.
+ local $^W = 0;
+
+ $Test->_unoverload(\$e1, \$e2);
+
+ # Either they're both references or both not.
+ my $same_ref = !(!ref $e1 xor !ref $e2);
+ my $not_ref = (!ref $e1 and !ref $e2);
+
+ if( defined $e1 xor defined $e2 ) {
+ $ok = 0;
+ }
+ elsif ( $e1 == $DNE xor $e2 == $DNE ) {
+ $ok = 0;
+ }
+ elsif ( $same_ref and ($e1 eq $e2) ) {
+ $ok = 1;
+ }
+ elsif ( $not_ref ) {
+ push @Data_Stack, { type => '', vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ else {
+ if( $Refs_Seen{$e1} ) {
+ return $Refs_Seen{$e1} eq $e2;
+ }
+ else {
+ $Refs_Seen{$e1} = "$e2";
+ }
+
+ my $type = _type($e1);
+ $type = 'DIFFERENT' unless _type($e2) eq $type;
+
+ if( $type eq 'DIFFERENT' ) {
+ push @Data_Stack, { type => $type, vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ elsif( $type eq 'ARRAY' ) {
+ $ok = _eq_array($e1, $e2);
+ }
+ elsif( $type eq 'HASH' ) {
+ $ok = _eq_hash($e1, $e2);
+ }
+ elsif( $type eq 'REF' ) {
+ push @Data_Stack, { type => $type, vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ elsif( $type eq 'SCALAR' ) {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ else {
+ _whoa(1, "No type in _deep_check");
+ }
+ }
+ }
+
+ return $ok;
+}
+
+
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+
+#line 1252
+
+sub eq_hash {
+ local @Data_Stack;
+ return _deep_check(@_);
+}
+
+sub _eq_hash {
+ my($a1, $a2) = @_;
+
+ if( grep !_type($_) eq 'HASH', $a1, $a2 ) {
+ warn "eq_hash passed a non-hash ref";
+ return 0;
+ }
+
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+ foreach my $k (keys %$bigger) {
+ my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
+ my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+
+ push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
+ $ok = _deep_check($e1, $e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+#line 1304
+
+sub eq_set {
+ my($a1, $a2) = @_;
+ return 0 unless @$a1 == @$a2;
+
+ # There's faster ways to do this, but this is easiest.
+ local $^W = 0;
+
+ # We must make sure that references are treated neutrally. It really
+ # doesn't matter how we sort them, as long as both arrays are sorted
+ # with the same algorithm.
+ # Have to inline the sort routine due to a threading/sort bug.
+ # See [rt.cpan.org 6782]
+ return eq_array(
+ [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a1],
+ [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a2]
+ );
+}
+
+#line 1347
+
+sub builder {
+ return Test::Builder->new;
+}
+
+#line 1489
+
+1;
Added: packages/libpar-perl/branches/upstream/current/lib/App/Packer/PAR.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/App/Packer/PAR.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/App/Packer/PAR.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,213 @@
+package App::Packer::PAR;
+
+use strict;
+use vars qw($VERSION);
+use Config;
+
+$VERSION = '0.13';
+
+sub new {
+ my ($type, %args) = @_;
+
+ my $class = ref $type || $type;
+ my $self = bless {}, $class;
+
+ # apply default values for frontend/backend
+ $args{frontend} ||= 'App::Packer::Frontend::ModuleInfo';
+ $args{backend} ||= 'App::Packer::Backend::DemoPack';
+
+ # automatically require default frontend/backend
+ if ($args{frontend} eq 'App::Packer::Frontend::ModuleInfo') {
+ require App::Packer::Frontend::ModuleInfo;
+ }
+ else {
+ _require($args{frontend});
+ }
+
+ if ($args{backend} eq 'App::Packer::Backend::DemoPack') {
+ require App::Packer::Backend::DemoPack;
+ }
+ else {
+ _require($args{backend});
+ }
+
+ my $fe = $self->{FRONTEND} =
+ ($args{frontend}->can('new')) ? $args{frontend}->new : $args{frontend};
+
+ my $be = $self->{BACKEND} =
+ ($args{backend}->can('new')) ? $args{backend}->new : $args{backend};
+
+ $self->_set_args(%args);
+ $self->_set_options(%args);
+
+ $be->set_front($fe) if ($be->can('set_front'));
+
+ return $self;
+}
+
+sub _set_options {
+ my ($self, %args) = @_;
+
+ my $fe = $self->frontend;
+ my $be = $self->backend;
+
+ my $frontopts = $args{frontopts} || $args{opts} || undef;
+ my $backopts = $args{backopts} || $args{opts} || undef;
+
+ $fe->set_options(%$frontopts) if ($fe->can('set_options') and $frontopts);
+ $be->set_options(%$backopts) if ($be->can('set_options') and $backopts);
+}
+
+sub _set_args {
+ my ($self, %args) = @_;
+
+ my $fe = $self->frontend;
+ my $be = $self->backend;
+
+ my $frontargs = $args{frontargs} || $args{args} || undef;
+ my $backargs = $args{backargs} || $args{args} || undef;
+
+ return if (!$frontargs and !$backargs);
+
+ $fe->set_args(@$frontargs) if ($fe->can('set_args') and $frontargs);
+ $be->set_args(@$backargs) if ($be->can('set_args') and $backargs);
+}
+
+sub set_file {
+ my $self = shift;
+ my $file = shift;
+
+ warn("File not found '$file'"), return unless -f $file;
+
+ $self->backend->set_file($file);
+
+ return 1;
+}
+
+sub go {
+ my ($self) = @_;
+
+ my $fe = $self->frontend;
+ my $be = $self->backend;
+
+ $fe->go if $fe->can('go');
+ $be->go if $be->can('go');
+}
+
+sub generate_pack {
+ my ($self, %opt) = @_;
+
+ my $be = $self->backend;
+ $be->generate_pack(%opt);
+}
+
+sub run_pack {
+ my ($self, %opt) = @_;
+
+ my $be = $self->backend;
+ $be->run_pack(%opt);
+}
+
+sub add_manifest {
+ my ($self) = @_;
+
+ my $be = $self->backend;
+ return $be->add_manifest;
+}
+
+sub pack_manifest {
+ my ($self) = @_;
+
+ my $be = $self->backend;
+ return $be->pack_manifest;
+}
+
+sub write {
+ my $self = shift;
+ my $exe = shift;
+ my $ret = 1;
+
+ # attach exe extension
+ $exe .= $Config{_exe} unless $exe =~ m/$Config{_exe}$/i;
+
+ # write file
+ $self->frontend->calculate_info;
+ my $files = $self->frontend->get_files;
+ $ret &= $files ? 1 : 0;
+ $ret &= $self->backend->set_files(%$files);
+ $ret &= $self->backend->write($exe);
+
+ chmod 0755, $exe if $ret;
+
+ $ret ? return $exe : return;
+}
+
+sub set_options {
+ my $self = shift;
+ my %args = @_;
+
+ if (exists $args{frontend}) {
+ $self->frontend->set_options(%{ $args{frontend} });
+ }
+
+ if (exists $args{backend}) {
+ $self->backend->set_options(%{ $args{backend} });
+ }
+}
+
+sub add_back_options {
+ my ($self, %opt) = @_;
+ $self->backend->add_options(%opt);
+}
+
+sub add_front_options {
+ my ($self, %opt) = @_;
+ $self->frontend->add_options(%opt);
+}
+
+sub frontend { $_[0]->{FRONTEND} or die "No frontend available" }
+sub backend { $_[0]->{BACKEND} or die "No backend available" }
+
+sub _require {
+ my ($text) = @_;
+ $text =~ s{::}{/}g;
+ require "$text.pm";
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+App::Packer::PAR - Pack applications in a single executable file
+
+=head1 DESCRIPTION
+
+This module is a modified version of B<App::Packer>, temporarily shipped
+with B<PAR> until it is merged into newer versions of B<App::Packer>.
+
+=head1 SEE ALSO
+
+See L<App::Packer> for the programming interface.
+
+=head1 AUTHOR
+
+Code modifications by Edward S. Peschko. This documentation by Autrijus Tang.
+
+Based on the work of Mattia Barbon E<lt>mbarbon at dsi.unive.itE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2004, 2005 by Edward S. Peschko, Autrijus Tang and Mattia Barbon.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+# local variables:
+# mode: cperl
+# end:
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/FAQ.pod
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/FAQ.pod 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/FAQ.pod 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,222 @@
+=head1 NAME
+
+PAR::FAQ - Frequently Asked Questions about PAR
+
+=head1 SYNOPSIS
+
+This is the Frequently Asked Questions list for the Perl Archive Toolkit.
+You can edit this document at L<http://par.perl.org/?FAQ> online.
+
+=head1 DESCRIPTION
+
+=head2 How do I make a F<.par> file for my CPAN module along with the F<.tar.gz> file?
+
+Do this in the module directory:
+
+ % make clean
+ % parl -p
+
+You may also digitally sign the generated F<.par> file:
+
+ % parl -s
+
+B<PAR::Dist> expects to find your F<MANIFEST> in the current directory, and
+uses B<Module::Signature> to (optionally) sign the newly generated PAR.
+
+The F<.par> file can be uploaded to CPAN along with your module's F<.tar.gz> file.
+Users of your module can then install from CPAN with a single command:
+
+ % parl -i cpan://PAUSEID/DISTNAME-0.01
+
+Where C<PAUSEID> is your PAUSE ID, and C<DISTNAME> is your module's distribution
+name (eg. C<Acme-FooBar>).
+
+=head2 If I try to compile my wxGlade generated script, it doesn't run. What's wrong?
+
+Comment out the line that starts with C<unless (caller)>, and compile it again.
+Note that this is considered a bug; clearing the caller stack is a development
+in progress.
+
+=head2 I get a C<link error: /usr/bin/ld: cannot find -lperl> during the C<make> step of the installation on Debian. What's wrong?
+
+You need to install the B<libperl-dev> package.
+
+Alternatively, create a symbolic link from F<libperl.so.5.6.1> to
+F<libperl.so> in F</usr/lib>:
+
+ % cd /usr/lib; ln -s libperl.so.5.6.1 libperl.so
+
+and re-run the C<make> step of the installation.
+
+=head2 I specify a F<.ico> file with C<--icon> for Win32, but the icon is still the black and white camel. What's wrong?
+
+Unlike Perl2EXE, which can use a standard 16-color bitmap as an application
+icon, PAR requires a true Windows icon file. Download a trial version of
+Microangelo (L<http://www.microangelo.us/>) and use that to create your F<.ico>
+file.
+
+The latest Netpbm tools at L<http://netpbm.sourceforge.net/> has
+B<ppmtowinicon>, which can tack a pbm and convert it to a windows icon. It is
+open source and has win32 ports.
+
+=head2 I added a directory to my PAR file using C<zip -r> or winzip, and then generated an executable from this PAR file, and the executable failed to run (IO error: reading header signature :..). What's wrong?
+
+As pointed out by Alan Stewart, zip adds a directory entry for the new
+directory, and it causes the PAR executable to fail.
+
+Just use this :
+
+ zip -r -D hello.par my_dir/
+
+or the B<Archive::Zip::addTree> as follows :
+
+ $zip->addTree( $root, $dest, sub { -f } )
+
+PAR version 0.81 and above supports adding whole directories with C<pp -A>,
+so you do not normally need to add directories this way.
+
+=head2 On what platforms can I run PAR? On what platforms will the resulting executable run?
+
+Win32 (with VC++ or MinGW), FreeBSD, NetBSD, Linux, MacOSX, Cygwin, AIX,
+Solaris, HP-UX, Tru64.
+
+The resulting executable will run on any platforms that supports the binary
+format of the generating platform.
+
+=head2 How do I extract my script out of packed executable?
+
+In other words, "I did a C<pp foo.pl> and I lost F<foo.pl>, how do I get it
+back?".
+
+The answer is to just use unzip/winzip/winrar/whatever to decompress the
+executable, treating it like a normal Zip file. You may need to rename the
+executable into a F<.zip> extension first.
+
+=head2 Can PAR completly hide my source code?
+
+Not completely, but possible to a degree. PAR supports an input filter
+mechanism via C<pp -f> and C<pp -F> (see L<PAR::Filter>), which can be used
+to implement source obfuscators (or even product activation schemes).
+
+But if you are looking for 100% bulletproof way of hiding source code, it is
+not possible with any language. Learning Perl, 3rd Edition has this answer to
+offer (quoted with permission from Randal Schwartz):
+
+ If you're wishing for an opaque binary, though, we have to tell
+ you that they don't exist. If someone can install and run your
+ program, they can turn it back into source code. Granted, this
+ won't necessarily be the same source that you started with, but
+ it will be some kind of source code. The real way to keep your
+ secret algorithm a secret is, alas, to apply the proper number
+ of attorneys; they can write a license that says "you can do
+ this with the code, but you can't do that. And if you break our
+ rules, we've got the proper number of attorneys to ensure that
+ you'll regret it."
+
+=head2 Perl Tk tips
+
+On Microsoft Windows, start your script with
+
+ use strict;
+ use Encode::Unicode;
+ use Tk;
+
+Some widgets use xbm bitmaps which don't get picked up by PAR. The error is:
+
+ couldn't read bitmap file "": No such file or directory at Tk/Widget.pm line 203
+ error reading bitmap file "" at Tk/Widget.pm line 205.
+
+Fix is to find the missing xbm files (C<perl -V> tells you where to start
+looking), copy them to the script directory, and add them to the executable:
+
+ pp -a cbxarrow.xbm -a arrowdownwin.xbm -o test test.pl
+
+=head2 Under Win32, a pp packed executable has trouble executing other perl scripts or pp packed executable.
+
+Note that this problem should only happen if the perl version of both programs
+are binary-incompatible.
+
+When running on a Win32 system, if a perl script is packed with pp and invokes
+another Perl script or pp packed executable, either with C<system()> or backticks,
+the invoked program runs with the copy of F<perl5x.dll> already loaded into
+memory.
+
+If the calling executable was packed with C<pp -d>, the F<perl5x.dll> is the one
+from the installed perl bin directory. Otherwise, it is the one packed with the
+executable.
+
+The F<perl5x.dll> from the bin dir knows the C<@INC> paths for the installed
+libraries; the one in the executable does not. Because of this, a program
+packed without C<-d> calling a program with packed with C<-d> or calling
+F<perl.exe> to run a plain Perl script may fail. This is a Win32 limitation.
+
+=head2 How do I make a F<.exe> that runs with no console window under Windows?
+
+Use the C<pp --gui> option, like this:
+
+ % pp --gui -o file.exe file.pl
+
+=head2 How do I change the Icon of the generated F<.exe> file under Windows?
+
+Use the C<pp --icon> option, like this:
+
+ % pp --icon "c:\path\to\MyIcon.ico" -o file.exe file.pl
+
+=head2 On Windows XP, C<pp> crashes saying that C<par.exe has encountered a problem>
+
+This bug has been be fixed. The following answer applies to PAR 0.76 and earlier:
+
+You may be able to escape this problem by setting some executables to Windows
+95 compatibility mode. Specifically, find F<parl.exe> (probably in
+F<C:\perl\5.8.0\bin>) using Windows Explorer, and right-click on it and choose
+C<Properties>. Choose the "Compatibility" tab and tick the box for C<Run this
+program with compatibility mode for> and check that the dropdown shows C<Windows
+95>. Then click OK.
+
+Now you can hopefully run pp as normal to generate an EXE. Before you can run
+the generated EXE, you'll need to set its compatibility mode too, in the same
+way as you did for F<parl.exe>.
+
+=head2 Problem with B<Win32::Perms> and F<Perms.DLL>
+
+This bug has been be fixed. The following answer applies to PAR 0.79 and earlier:
+
+With a script F<my.pl> using B<Win32::Perms>, running C<pp -o my.exe my.pl> may
+produce this:
+
+ Can't locate loadable object for module Win32::Perms in @INC (@INC
+ contains: CODE(0xb97eec) CODE(0xc8a99c) .) at ../blib/lib/PAR/Heavy.pm
+ line 78
+
+In fact the dll is F<Perms.DLL> wit DLL in capital letters. That's the problem.
+The bootstrap function of PAR in the Dynaloader module fails
+looking for F<Perms.dll> in the table of dlls which contains only F<Perms.DLL>.
+
+And so the solution is just rename F<Perms.DLL> to F<Perms.dll> and do
+C<pp -o my.exe my.pl> again... and everything goes right!
+
+
+=head1 SEE ALSO
+
+L<PAR>, L<PAR::Tutorial>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This document is free documentation; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bleach.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bleach.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bleach.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,56 @@
+package PAR::Filter::Bleach;
+
+use strict;
+use base 'PAR::Filter';
+
+=head1 NAME
+
+PAR::Filter::Bleach - Bleach filter
+
+=head1 SYNOPSIS
+
+ PAR::Filter::Bleach->apply(\$code); # transforms $code
+
+=head1 DESCRIPTION
+
+This filter removes all the unsightly printable characters from
+your source file, using an algorithm similar to Damian Conway's
+L<Acme::Bleach>.
+
+=cut
+
+sub apply {
+ my $ref = $_[1];
+
+ $$ref = unpack("b*", $$ref);
+ $$ref =~ tr/01/ \t/;
+ $$ref =~ s/(.{9})/$1\n/g;
+ $$ref = q($_=<<'';y;\r\n;;d;$_=pack'b*',$_;eval;$@&&die$@)."\n$$ref\n\n";
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR::Filter>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bytecode.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bytecode.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Bytecode.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,85 @@
+package PAR::Filter::Bytecode;
+
+use strict;
+use base 'PAR::Filter';
+use File::Temp ();
+
+=head1 NAME
+
+PAR::Filter::Bytecode - Bytecode filter
+
+=head1 SYNOPSIS
+
+ PAR::Filter::Bytecode->apply(\$code); # transforms $code
+
+=head1 DESCRIPTION
+
+This filter uses L<B::Bytecode> to turn the script into comment-free,
+architecture-specific Perl bytecode, and uses L<ByteLoader> to load
+back on execution.
+
+For L<pp> users, please add an extra B<-M> option, like this:
+
+ pp -f Bytecode -M ByteLoader
+
+Otherwise, the implicit dependency on ByteLoader will not be detected.
+
+=head1 CAVEATS
+
+This backend exhibits all bugs listed in L<B::Bytecode>, and then some.
+
+Bytecode support is considered to be extremely fragile on Perl versions
+earlier than 5.8.1, and is still far from robust (as of this writing).
+
+=cut
+
+sub apply {
+ my $ref = $_[1];
+
+ my ($fh, $in_file) = File::Temp::tempfile();
+ print $fh $$ref;
+ close $fh;
+
+ my $out_file = File::Temp::tmpnam();
+ system($^X, "-MO=Bytecode,-H,-k,-o$out_file", $in_file);
+ unless (-e $out_file) {
+ warn "Cannot transform $in_file to $out_file: $! ($?)\n";
+ return;
+ }
+
+ unlink($in_file);
+
+ open my $fh, '<', $out_file or die $!;
+ local $/;
+ $$ref = <$fh>;
+ close $fh;
+
+ unlink($out_file);
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR::Filter>, L<B::Bytecode>, L<ByteLoader>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Obfuscate.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Obfuscate.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/Obfuscate.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,68 @@
+package PAR::Filter::Obfuscate;
+
+use strict;
+use base 'PAR::Filter';
+use File::Temp ();
+
+=head1 NAME
+
+PAR::Filter::Obfuscate - Obfuscating filter
+
+=head1 SYNOPSIS
+
+ PAR::Filter::Obfuscate->apply(\$code); # transforms $code
+
+=head1 DESCRIPTION
+
+This filter uses L<B::Deobfuscate> (available separately from CPAN) to
+turn the script into comment-free, architecture-independent Perl code
+with mangled variable names.
+
+=head1 CAVEATS
+
+A harmless message will be displayed during C<pp>:
+
+ /tmp/8ycSoLaSI1 syntax OK
+
+Please just ignore it. :-)
+
+=cut
+
+sub apply {
+ my $ref = $_[1];
+
+ my ($fh, $in_file) = File::Temp::tempfile();
+ print $fh $$ref;
+ close $fh;
+
+ require B::Deobfuscate;
+ $$ref = `$^X -MO=Deobfuscate $in_file`;
+ warn "Cannot transform $in_file$! ($?)\n" if $?;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR::Filter>, L<B::Deobfuscate>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PatchContent.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PatchContent.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PatchContent.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,122 @@
+package PAR::Filter::PatchContent;
+
+use strict;
+use base 'PAR::Filter';
+
+=head1 NAME
+
+PAR::Filter::PatchContent - Content patcher
+
+=head1 SYNOPSIS
+
+ # transforms $code
+ PAR::Filter::PatchContent->apply(\$code, $filename, $name);
+
+=head1 DESCRIPTION
+
+This filter fixes PAR-incompatible modules; F<pp> applies it to modules
+by default.
+
+=cut
+
+sub PATCH_CONTENT () { +{
+ map { ref($_) ? $_ : lc($_) }
+ 'Pod/Usage.pm' => [
+ ' = $0' =>
+ ' = $ENV{PAR_0} || $0',
+ ],
+ 'Tk.pm' => [
+ 'foreach $dir (@INC)' =>
+ 'if (my $member = PAR::unpar($0, $file, 1)) {
+ $file =~ s![/\\\\]!_!g;
+ return PAR::Heavy::_dl_extract($member,$file,$file);
+ }
+ if (my $member = PAR::unpar($0, my $name = $_[1], 1)) {
+ $name =~ s![/\\\\]!_!g;
+ return PAR::Heavy::_dl_extract($member,$name,$name);
+ }
+ foreach $dir (@INC)',
+ ],
+ 'Tk/Widget.pm' => [
+ 'if (defined($name=$INC{"$pkg.pm"}))' =>
+ 'if (defined($name=$INC{"$pkg.pm"}) and !ref($name) and $name !~ m!^/loader/!)',
+ ],
+ 'Win32/API/Type.pm' => [
+ 'INIT ' => '',
+ ],
+ 'Win32/SystemInfo.pm' => [
+ '$dll .= "cpuspd.dll";' =>
+ '$dll = "lib/Win32/cpuspd.dll";
+ if (my $member = PAR::unpar($0, $dll, 1)) {
+ $dll = PAR::Heavy::_dl_extract($member,"cpuspd.dll","cpuspd.dll");
+ $dll =~ s!\\\\!/!g;
+ } else { die $! }',
+ ],
+ 'SQL/Parser.pm' => [
+ 'my @dialects;' =>
+ 'my @dialects = ();
+ foreach my $member ( $PAR::LastAccessedPAR->members ) {
+ next unless $member->fileName =~ m!\bSQL/Dialects/([^/]+)\.pm$!;
+ push @dialects, $1;
+ }
+ ',
+ ],
+ 'XSLoader.pm' => [
+ 'goto retry unless $module and defined &dl_load_file;' =>
+ 'goto retry;',
+ ],
+ 'diagnostics.pm' => [
+ 'CONFIG: ' => 'CONFIG: if (0) ',
+ 'if (eof(POD_DIAG)) ' => 'if (0 and eof(POD_DIAG)) ',
+ 'close POD_DIAG' => '# close POD_DIAG',
+ 'while (<POD_DIAG>) ' =>
+ 'for(map "$_\\n\\n", split/\\r?\\n(?:\\r?\\n)*/,
+ PAR::read_file("lib/Pod/perldiag.pod") ||
+ PAR::read_file("lib/pod/perldiag.pod")
+ ) ',
+ ],
+ 'utf8_heavy.pl' => [
+ '$list ||= eval { $caller->$type(); }'
+ => '$list = eval { $caller->$type(); }',
+ '|| croak("Can\'t find $encoding character property definition via $caller->$type or $file.pl")'
+ => '|| croak("Can\'t find $encoding character property definition via $caller->$type or $file.pl") unless $list;'
+ ],
+} };
+
+sub apply {
+ my ($class, $ref, $filename, $name) = @_;
+ { use bytes; $$ref =~ s/^\xEF\xBB\xBF//; } # remove utf8 BOM
+
+ my @rule = @{PATCH_CONTENT->{lc($name)}||[]} or return $$ref;
+ while (my ($from, $to) = splice(@rule, 0, 2)) {
+ $$ref =~ s/\Q$from\E/$to/g;
+ }
+ return $$ref;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR::Filter>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PodStrip.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PodStrip.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Filter/PodStrip.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,79 @@
+package PAR::Filter::PodStrip;
+
+use strict;
+use base 'PAR::Filter';
+
+=head1 NAME
+
+PAR::Filter::PodStrip - POD-stripping filter
+
+=head1 SYNOPSIS
+
+ # transforms $code
+ PAR::Filter::PodStrip->apply(\$code, $filename, $name);
+
+=head1 DESCRIPTION
+
+This filter strips away all POD sections, but preserves the original
+file name and line numbers via the C<#line> directive.
+
+=cut
+
+sub apply {
+ my ($class, $ref, $filename, $name) = @_;
+
+ no warnings 'uninitialized';
+
+ my $data = '';
+ $data = $1 if $$ref =~ s/((?:^__DATA__\r?\n).*)//ms;
+
+ my $line = 1;
+ if ($$ref =~ /^=(?:head\d|pod|begin|item|over|for|back|end|cut)\b/) {
+ $$ref = "\n$$ref";
+ $line--;
+ }
+ $$ref =~ s{(
+ (.*?\n)
+ (?:=(?:head\d|pod|begin|item|over|for|back|end)\b
+ .*?\n)
+ (?:=cut[\t ]*[\r\n]*?|\Z)
+ (\r?\n)?
+ )}{
+ my ($pre, $post) = ($2, $3);
+ "$pre#line " . (
+ $line += ( () = ( $1 =~ /\n/g ) )
+ ) . $post;
+ }gsex;
+
+ $$ref = '#line 1 "' . ($filename) . "\"\n" . $$ref
+ if length $filename;
+ $$ref =~ s/^#line 1 (.*\n)(#!.*\n)/$2#line 2 $1/g;
+ $$ref .= $data;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR::Filter>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Filter.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Filter.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Filter.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,99 @@
+package PAR::Filter;
+$PAR::Filter::VERSION = '0.02';
+
+=head1 NAME
+
+PAR::Filter - Input filter for PAR
+
+=head1 SYNOPSIS
+
+ $code = 'use strict; print "Hello, World!\n";';
+ $ref = PAR::Filter->new('PodStrip', 'Bleach')->apply(\$code);
+ print $code; # pod-stripped and obfuscated code
+ print $$ref; # same thing
+
+ $ref = PAR::Filter->new('PodStrip', 'Bleach')->apply('file.pl');
+ print $$ref; # same thing, applied to file.pl
+
+=head1 DESCRIPTION
+
+Starting with PAR 0.76, C<pp -f> takes a filter name, like C<Bleach>, and
+invokes this module to transform the programs with L<PAR::Filter::Bleach>.
+Similarily, C<pp -F Bleach> applies the B<Bleach> filter to all included
+modules.
+
+It is possible to pass in multiple such filters, which are applied in turn.
+
+The output of each such filter is expected be semantically equivalent to the
+input, although possibly obfuscated.
+
+The default list of filters include:
+
+=over 4
+
+=item * L<PAR::Filter::Bleach>
+
+The archetypical obfuscating filter.
+
+=item * L<PAR::Filter::Bytecode>
+
+Use L<B::Bytecode> to strip away indents and comments.
+
+=item * L<PAR::Filter::Obfuscate>
+
+Use L<B::Deobfuscate> to strip away indents and comments, as well as mangling
+variable names.
+
+=item * L<PAR::Filter::PatchContent>
+
+Fix PAR-incompatible modules, applied to modules by default.
+
+=item * L<PAR::Filter::PodStrip>
+
+Strip away POD sections, applied to modules by default.
+
+=back
+
+=cut
+
+sub new {
+ my $class = shift;
+ require "PAR/Filter/$_.pm" foreach @_;
+ bless(\@_, $class);
+}
+
+sub apply {
+ my ($self, $ref, $name) = @_;
+ my $filename = $name || '-e';
+
+ if (!ref $ref) {
+ $name ||= $filename = $ref;
+ local $/;
+ open my $fh, $ref or die $!;
+ binmode($fh);
+ my $content = <$fh>;
+ $ref = \$content;
+ return $ref unless length($content);
+ }
+
+ "PAR::Filter::$_"->new->apply( $ref, $filename, $name ) foreach @$self;
+
+ return $ref;
+}
+
+1;
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Heavy.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Heavy.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Heavy.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,178 @@
+package PAR::Heavy;
+$PAR::Heavy::VERSION = '0.08';
+
+=head1 NAME
+
+PAR::Heavy - PAR guts
+
+=head1 SYNOPSIS
+
+(internal use only)
+
+=head1 DESCRIPTION
+
+No user-serviceable parts inside.
+
+=cut
+
+########################################################################
+# Dynamic inclusion of XS modules
+
+my ($bootstrap, $dl_findfile); # Caches for code references
+my ($dlext); # Cache for $Config{dlext}
+my ($cache_key); # The current file to find
+my $is_insensitive_fs = (
+ -s $0
+ and (-s lc($0) || -1) == (-s uc($0) || -1)
+ and (-s lc($0) || -1) == -s $0
+);
+
+# Adds pre-hooks to Dynaloader's key methods
+sub _init_dynaloader {
+ return if $bootstrap;
+ return unless eval { require DynaLoader; DynaLoader::dl_findfile(); 1 };
+
+ $bootstrap = \&DynaLoader::bootstrap;
+ $dl_findfile = \&DynaLoader::dl_findfile;
+
+ local $^W;
+ *{'DynaLoader::dl_expandspec'} = sub { return };
+ *{'DynaLoader::bootstrap'} = \&_bootstrap;
+ *{'DynaLoader::dl_findfile'} = \&_dl_findfile;
+}
+
+# Return the cached location of .dll inside PAR first, if possible.
+sub _dl_findfile {
+ return $FullCache{$cache_key} if exists $FullCache{$cache_key};
+ if ($is_insensitive_fs) {
+ # We have a case-insensitive filesystem...
+ my ($key) = grep { lc($_) eq lc($cache_key) } keys %FullCache;
+ return $FullCache{$key} if defined $key;
+ }
+ return $dl_findfile->(@_);
+}
+
+# Find and extract .dll from PAR files for a given dynamic module.
+sub _bootstrap {
+ my (@args) = @_;
+ my ($module) = $args[0] or return;
+
+ my @modparts = split(/::/, $module);
+ my $modfname = $modparts[-1];
+
+ $modfname = &DynaLoader::mod2fname(\@modparts)
+ if defined &DynaLoader::mod2fname;
+
+ if (($^O eq 'NetWare') && (length($modfname) > 8)) {
+ $modfname = substr($modfname, 0, 8);
+ }
+
+ # XXX: Multi-platform .dll support in PARs needs better than $Config.
+ $dlext ||= do {
+ require Config;
+ (defined %Config::Config) ? $Config::Config{dlext} : '';
+ };
+
+ my $modpname = join((($^O eq 'MacOS') ? ':' : '/'), @modparts);
+ my $file = $cache_key = "auto/$modpname/$modfname.$dlext";
+
+ if ($FullCache{$file}) {
+ local $DynaLoader::do_expand = 1;
+ return $bootstrap->(@args);
+ }
+
+ my $member;
+ $member = PAR::find_par(undef, $file, 1) if defined &PAR::find_par;
+ return $bootstrap->(@args) unless $member;
+
+ $FullCache{$file} = _dl_extract($member, $file);
+
+ # Now extract all associated shared objs in the same auto/ dir
+ my $first = $member->fileName;
+ my $pat = $first;
+ $pat =~ s{[^/]*$}{};
+ if ($PAR::LastAccessedPAR) {
+ foreach my $member ( $PAR::LastAccessedPAR->members ) {
+ next if $member->isDirectory;
+
+ my $name = $member->fileName;
+ next if $name eq $first;
+ next unless $name =~ m{^/?\Q$pat\E\/[^/]?\.\Q$dlext\E[^/]*$};
+ $name =~ s{.*/}{};
+ _dl_extract($member, $file, $name);
+ }
+ }
+
+ local $DynaLoader::do_expand = 1;
+ return $bootstrap->(@args);
+}
+
+sub _dl_extract {
+ my ($member, $file, $name) = @_;
+
+ require File::Spec;
+ require File::Temp;
+
+ my ($fh, $filename);
+
+ # fix borked tempdir from earlier versions
+ if ($ENV{PAR_TEMP} and -e $ENV{PAR_TEMP} and !-d $ENV{PAR_TEMP}) {
+ unlink($ENV{PAR_TEMP});
+ mkdir($ENV{PAR_TEMP}, 0755);
+ }
+
+ if ($ENV{PAR_CLEAN} and !$name) {
+ ($fh, $filename) = File::Temp::tempfile(
+ DIR => ($ENV{PAR_TEMP} || File::Spec->tmpdir),
+ SUFFIX => ".$dlext",
+ UNLINK => ($^O ne 'MSWin32'),
+ );
+ }
+ else {
+ $filename = File::Spec->catfile(
+ ($ENV{PAR_TEMP} || File::Spec->tmpdir),
+ ($name || ($member->crc32String . ".$dlext"))
+ );
+
+ open $fh, '>', $filename or die $!
+ unless -r $filename and -e $filename
+ and -s $filename == $member->uncompressedSize;
+ }
+
+ if ($fh) {
+ binmode($fh);
+ $member->extractToFileHandle($fh);
+ close $fh;
+ chmod 0755, $filename;
+ }
+
+ return $filename;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004, 2005 by Autrijus Tang
+E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Packer.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Packer.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Packer.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,1490 @@
+package PAR::Packer;
+$PAR::Packer::VERSION = '0.12';
+
+use 5.006;
+use strict;
+use warnings;
+
+=head1 NAME
+
+PAR::Packer - App::Packer backend for making PAR files
+
+=head1 DESCRIPTION
+
+This module implements the B<App::Packer::Backend> interface, for generating
+stand-alone executables, perl scripts and PAR files.
+
+Currently, this module is used by the command line tool B<pp> internally, as
+well as by the contributed F<contrib/gui_pp/gpp> program. Improvements on
+documenting the API will be most appreciated.
+
+=cut
+
+use Config;
+use Archive::Zip ();
+use Cwd ();
+use ExtUtils::MakeMaker ();
+use File::Basename ();
+use File::Find ();
+use File::Spec ();
+use File::Temp ();
+use Module::ScanDeps ();
+use PAR ();
+use PAR::Filter ();
+
+use constant OPTIONS => {
+ 'a|addfile:s@' => 'Additional files to pack',
+ 'A|addlist:s@' => 'File containing list of additional files to pack',
+ 'B|bundle' => 'Bundle core modules',
+ 'C|clean', => 'Clean up temporary files',
+ 'c|compile' => 'Compile code to get dependencies',
+ 'd|dependent' => 'Do not include libperl',
+ 'e|eval:s' => 'Packing one-liner',
+ 'x|execute' => 'Execute code to get dependencies',
+ 'X|exclude:s@' => 'Exclude modules',
+ 'f|filter:s@' => 'Input filters for scripts',
+ 'g|gui' => 'No console window',
+ 'i|icon:s' => 'Icon file',
+ 'N|info:s@' => 'Executable header info',
+ 'I|lib:s@' => 'Include directories (for perl)',
+ 'l|link:s@' => 'Include additional shared libraries',
+ 'L|log:s' => 'Where to log packaging process information',
+ 'F|modfilter:s@' => 'Input filter for perl modules',
+ 'M|module|add:s@'=> 'Include modules',
+ 'm|multiarch' => 'Build PAR file for multiple architectures',
+ 'n|noscan' => 'Skips static scanning',
+ 'o|output:s' => 'Output file',
+ 'p|par' => 'Generate PAR file',
+ 'P|perlscript' => 'Generate perl script',
+ 'r|run' => 'Run the resulting executable',
+ 'S|save' => 'Preserve intermediate PAR files',
+ 's|sign' => 'Sign PAR files',
+ 'T|tempcache:s' => 'Temp cache name',
+ 'v|verbose:i' => 'Verbosity level',
+ 'vv|verbose2', => 'Verbosity level 2',
+ 'vvv|verbose3', => 'Verbosity level 3',
+ 'z|compress:i' => 'Compression level',
+};
+
+my $ValidOptions = {};
+my $LongToShort = { map { /^(\w+)\|(\w+)/ ? ($1, $2) : () } keys %{+OPTIONS} };
+my $ShortToLong = { reverse %$LongToShort };
+my $PerlExtensionRegex = qr/\.(?:al|ix|p(?:lx|l|h|m))\z/i;
+my (%dep_zips, %dep_zip_files);
+
+sub options { sort keys %{+OPTIONS} }
+
+sub new {
+ my ($class, $args, $opt, $frontend) = @_;
+
+ $SIG{INT} = sub { exit() } if (!$SIG{INT});
+
+ # exit gracefully and clean up after ourselves.
+ # note.. in constructor because of conflict.
+
+ $ENV{PAR_RUN} = 1;
+ my $self = bless {}, $class;
+
+ $self->set_args($args) if ($args);
+ $self->set_options($opt) if ($opt);
+ $self->set_front($frontend) if ($frontend);
+
+ return ($self);
+}
+
+sub set_options {
+ my ($self, %opt) = @_;
+
+ $self->{options} = \%opt;
+ $self->_translate_options($self->{options});
+
+ $self->{parl} ||= $self->_can_run("parl$Config{_exe}")
+ or die("Can't find par loader");
+ $self->{dynperl} ||=
+ $Config{useshrplib} && ($Config{useshrplib} ne 'false');
+ $self->{script_name} = $opt{script_name} || $0;
+}
+
+sub add_options {
+ my ($self, %opts) = @_;
+
+ my $opt = $self->{options};
+ %$opt = (%$opt, %opts);
+
+ $self->_translate_options($opt);
+}
+
+sub _translate_options {
+ my ($self, $opt) = @_;
+
+ $self->_create_valid_hash($self->OPTIONS, $ValidOptions);
+
+ foreach my $key (keys(%$opt)) {
+ my $value = $opt->{$key};
+
+ if (!$ValidOptions->{$key}) {
+ $self->_warn("'$key' is not a valid option!\n");
+ $self->_show_usage;
+ }
+ else {
+ $opt->{$key} = $value;
+ my $other = $LongToShort->{$key} || $ShortToLong->{$key};
+ $opt->{$other} = $value;
+ }
+ }
+}
+
+sub add_args {
+ my ($self, @arg) = @_;
+ push(@{ $self->{args} }, @arg);
+}
+
+sub set_args {
+ my ($self, @args) = @_;
+ $self->{args} = \@args;
+}
+
+sub set_front {
+ my ($self, $frontend) = @_;
+
+ my $opt = $self->{options};
+ $self->{frontend} = $frontend || $opt->{frontend};
+}
+
+sub _check_read {
+ my ($self, @files) = @_;
+
+ foreach my $file (@files) {
+ unless (-r $file) {
+ $self->_die("Input file $file is a directory, not a file\n")
+ if (-d _);
+ unless (-e _) {
+ $self->_die("Input file $file was not found\n");
+ }
+ else {
+ $self->_die("Cannot read input file $file: $!\n");
+ }
+ }
+ unless (-f _) {
+ # XXX: die? don't try this on /dev/tty
+ $self->_warn("Input $file is not a plain file\n");
+ }
+ }
+}
+
+sub _check_write {
+ my ($self, @files) = @_;
+
+ foreach my $file (@files) {
+ if (-d $file) {
+ $self->_die("Cannot write on $file, is a directory\n");
+ }
+ if (-e _) {
+ $self->_die("Cannot write on $file: $!\n") unless -w _;
+ }
+ unless (-w Cwd::cwd()) {
+ $self->_die("Cannot write in this directory: $!\n");
+ }
+ }
+}
+
+sub _check_perl {
+ my ($self, $file) = @_;
+ return if ($self->_check_par($file));
+
+ unless (-T $file) {
+ $self->_warn("Binary '$file' sure doesn't smell like perl source!\n");
+
+ if (my $file_checker = $self->_can_run("file")) {
+ $self->_vprint(0, "Checking file type... ");
+ system($file_checker, $file);
+ }
+ $self->_die("Please try a perlier file!\n");
+ }
+
+ my $handle = $self->_open($file);
+
+ local $/ = "\n";
+ local $_ = readline($handle);
+ if (/^#!/ and !/perl/) {
+ $self->_die("$file is a ", /^#!\s*(\S+)/, " script, not perl\n");
+ }
+}
+
+sub _sanity_check {
+ my ($self) = @_;
+
+ my $input = $self->{input};
+ my $output = $self->{output};
+
+ # Check the input and output files make sense, are read/writable.
+ if ("@$input" eq $output) {
+ my $a_out = $self->_a_out();
+
+ if ("@$input" eq $a_out) {
+ $self->_die("Packing $a_out to itself is probably not what you want to do.\n");
+ }
+ else {
+ $self->_warn(
+ "Will not write output on top of input file, ",
+ "packing to $a_out instead\n"
+ );
+ $self->{output} = $a_out;
+ }
+ }
+}
+
+sub _a_out {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+
+ return 'a' . (
+ $opt->{p} ? '.par'
+ : $opt->{P} ? '.pl'
+ : ($Config{_exe} || '.out')
+ );
+}
+
+sub _parse_opts {
+ my ($self) = @_;
+
+ my $args = $self->{args};
+ my $opt = $self->{options};
+
+ $self->_verify_opts($opt);
+ $opt->{L} = (defined($opt->{L})) ? $opt->{L} : '';
+ $opt->{p} = 1 if ($opt->{m});
+ $opt->{v} = (defined($opt->{v})) ? ($opt->{v} || 1) : 0;
+ $opt->{v} = 2 if ($opt->{vv});
+ $opt->{v} = 3 if ($opt->{vvv});
+ $opt->{B} = 1 unless ($opt->{p} || $opt->{P});
+ $opt->{z} = (defined($opt->{z})) ? $opt->{z} : Archive::Zip::COMPRESSION_LEVEL_DEFAULT;
+ $opt->{z} = Archive::Zip::COMPRESSION_LEVEL_DEFAULT if $opt->{z} < 0;
+ $opt->{z} = 9 if $opt->{z} > 9;
+
+ $self->{output} = $opt->{o} || $self->_a_out();
+ $opt->{o} = $opt->{o} || $self->_a_out();
+ $self->{script_name} = $self->{script_name} || $opt->{script_name} || $0;
+
+ $self->{logfh} = $self->_open('>>', $opt->{L})
+ if length $opt->{L};
+
+ if ($opt->{e}) {
+ $self->_warn("Using -e 'code' as input file, ignoring @$args\n")
+ if (@$args and !$opt->{r});
+
+ my ($fh, $fake_input) =
+ File::Temp::tempfile("ppXXXXX", SUFFIX => ".pl", UNLINK => 1);
+
+ print $fh $opt->{e};
+ close $fh;
+ $self->{input} = [$fake_input];
+ }
+ else {
+ $self->{input} ||= [];
+
+ push(@{ $self->{input} }, shift @$args) if (@$args);
+
+ push(@{ $self->{input} }, @$args) if (@$args and !$opt->{r});
+ my $in = $self->{input};
+
+ $self->_check_read(@$in) if (@$in);
+ $self->_check_perl(@$in) if (@$in);
+ $self->_sanity_check();
+ }
+}
+
+sub _verify_opts {
+ my ($self, $opt) = @_;
+
+ $self->_create_valid_hash($self->OPTIONS, $ValidOptions);
+
+ my $show_usage = 0;
+ foreach my $key (keys(%$opt)) {
+ if (!$ValidOptions->{$key}) {
+ $self->_warn("'$key' is not a valid option!\n");
+ $show_usage = 1;
+ }
+ }
+
+ $self->_show_usage() if ($show_usage);
+}
+
+sub _create_valid_hash {
+ my ($self, $hashin, $hashout) = @_;
+
+ return () if (%$hashout);
+
+ foreach my $key (keys(%$hashin)) {
+ my (@keys) = ($key =~ /\|/) ? ($key =~ /(?<!:)(\w+)/g) : ($key);
+ @{$hashout}{@keys} = ($hashin->{$key}) x @keys;
+ }
+}
+
+sub _show_usage {
+ my ($self) = @_;
+
+ foreach my $key ($self->options) {
+ print STDERR "\n$key"
+ . " " x (20 - length($key))
+ . $self->OPTIONS->{$key} . "\n";
+ }
+ print STDERR "\n\n";
+}
+
+sub go {
+ my ($self) = @_;
+
+ local $| = 1;
+ $self->_parse_opts();
+
+ my $opt = $self->{options};
+
+ $self->_setup_run();
+ $self->generate_pack({ nosetup => 1 });
+ $self->run_pack({ nosetup => 1 }) if ($opt->{r});
+}
+
+sub _setup_run {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $args = $self->{args};
+ my $output = $self->{output};
+
+ $self->_die("No input files specified\n")
+ unless @{ $self->{input} } or $opt->{M};
+
+ $self->_check_write($output);
+}
+
+sub generate_pack {
+ my ($self, $config) = @_;
+
+ $config ||= {};
+ $self->_parse_opts() if (!$config->{nosetup});
+ $self->_setup_run() if (!$config->{nosetup});
+
+ my $input = $self->{input};
+ my $opt = $self->{options};
+
+ $self->_vprint(0, "Packing @$input");
+
+ if ($self->_check_par($input->[0])) {
+ # invoked as "pp foo.par" - never unlink it
+ $self->{par_file} = $input->[0];
+ $opt->{S} = 1;
+ $self->_par_to_exe();
+ }
+ else {
+ $self->_compile_par();
+ }
+}
+
+sub run_pack {
+ my ($self, $config) = @_;
+
+ $config ||= {};
+
+ $self->_parse_opts() if (!$config->{nosetup});
+ $self->_setup_run() if (!$config->{nosetup});
+
+ my $opt = $self->{options};
+ my $output = $self->{output};
+ my $args = $self->{args};
+
+ $output = File::Spec->catfile(".", $output);
+
+ my @loader = ();
+ push(@loader, $^X) if ($opt->{P});
+ push(@loader, $^X, "-MPAR") if ($opt->{p});
+ $self->_vprint(0, "Running @loader $output @$args");
+ system(@loader, $output, @$args);
+ exit(0);
+}
+
+sub _compile_par {
+ my ($self) = @_;
+
+ my @SharedLibs;
+ local (@INC) = @INC;
+
+ my $lose = $self->{pack_attrib}{lose};
+ my $opt = $self->{options};
+
+ my $par_file = $self->get_par_file();
+
+ $self->_add_pack_manifest();
+ $self->_add_add_manifest();
+ $self->_make_manifest();
+ $self->_write_zip();
+
+ $self->_sign_par() if ($opt->{s});
+ $self->_par_to_exe() unless ($opt->{p});
+
+ if ($lose) {
+ $self->_vprint(2, "Unlinking $par_file");
+ unlink $par_file or $self->_die("Can't unlink $par_file: $!");
+ }
+}
+
+sub _write_zip {
+ my ($self) = @_;
+
+ my $old_member = $self->{pack_attrib}{old_member};
+ my $oldsize = $self->{pack_attrib}{old_size};
+ my $par_file = $self->{par_file};
+ my $add_manifest = $self->add_manifest();
+
+ my $zip = $self->{zip};
+
+ if ($old_member) {
+ $zip->overwrite();
+ }
+ else {
+ $zip->writeToFileNamed($par_file);
+ }
+
+ my $newsize = -s $par_file;
+ $self->_vprint(
+ 2,
+ sprintf( "*** %s: %d bytes read, %d compressed, %2.2d%% saved.\n",
+ $par_file, $oldsize,
+ $newsize, (100 - ($newsize / $oldsize * 100))
+ )
+ );
+}
+
+sub _sign_par {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $par_file = $self->{par_file};
+
+ if (eval {
+ require PAR::Dist;
+ require Module::Signature;
+ Module::Signature->VERSION >= 0.25;
+ }
+ )
+ {
+ $self->_vprint(0, "Signing $par_file");
+ PAR::Dist::sign_par($par_file);
+ }
+ else {
+ $self->_vprint(-1,
+"*** Signing requires PAR::Dist with Module::Signature 0.25 or later. Skipping"
+ );
+ }
+}
+
+sub _add_add_manifest {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $add_manifest = $self->add_manifest_hash();
+ my $par_file = $self->{par_file};
+
+ $self->_vprint(1, "Writing extra files to $par_file") if (%$add_manifest);
+ $self->{zip} ||= Archive::Zip->new;
+ my $zip = $self->{zip};
+
+ my $in;
+ foreach $in (sort keys(%$add_manifest)) {
+ my $value = $add_manifest->{$in};
+ $self->_add_file($zip, $in, $value);
+ }
+}
+
+sub _make_manifest {
+ my ($self) = @_;
+
+ my $full_manifest = $self->{full_manifest};
+
+ my $opt = $self->{options};
+ my $par_file = $self->{par_file};
+ my $output = $self->{output};
+
+ my $clean = ($opt->{C} ? 1 : 0);
+ my $dist_name = ($opt->{p} ? $par_file : $output);
+ my $verbatim = ($ENV{PAR_VERBATIM} || 0);
+
+ my $manifest = join("\n",
+' <!-- accessible as jar:file:///NAME.par!/MANIFEST in compliant browsers -->',
+ (sort keys %$full_manifest),
+q( # <html><body onload="var X=document.body.innerHTML.split(/\n/);var Y='<iframe src="META.yml" style="float:right;height:40%;width:40%"></iframe><ul>';for(var x in X){if(!X[x].match(/^\s*#/)&&X[x].length)Y+='<li><a href="'+X[x]+'">'+X[x]+'</a>'}document.body.innerHTML=Y">)
+ );
+
+ my ($class, $version) = (ref($self), $self->VERSION);
+ my $meta_yaml = << "YAML";
+build_requires: {}
+conflicts: {}
+dist_name: $dist_name
+distribution_type: par
+dynamic_config: 0
+generated_by: '$class version $version
+license: unknown
+par:
+ clean: $clean
+ signature: ''
+ verbatim: $verbatim
+ version: $PAR::VERSION
+YAML
+
+ my $zip = $self->{zip};
+
+ if (keys %dep_zips) {
+ $self->_vprint(2, "... updating main.pl");
+ my $dep_list = join ' ', keys %dep_zips;
+ my $main_pl = $zip->contents('script/main.pl');
+ $main_pl = "use PAR qw( $dep_list );\n$main_pl";
+ $zip->contents( 'script/main.pl', $main_pl );
+ $dep_list = join ', ', keys %dep_zips;
+ $self->_vprint(0, "$self->{output} will require $dep_list at runtime");
+
+ $manifest =~ s/$_\n// for (keys %dep_zip_files);
+ }
+
+ $self->_vprint(2, "... updating $_") for qw(MANIFEST META.yml);
+ $zip->contents( 'MANIFEST', $manifest );
+ $zip->contents( 'META.yml', $meta_yaml );
+}
+
+sub get_par_file {
+ my ($self) = @_;
+
+ return ($self->{par_file}) if ($self->{par_file});
+
+ my $input = $self->{input};
+ my $output = $self->{output};
+
+ my $par_file;
+ my $cfh;
+
+ my $opt = $self->{options};
+
+ if ($opt->{S} or $opt->{p}) {
+ # We need to keep it.
+
+ if ($opt->{e} or !@$input) {
+ $par_file = "a.par";
+ }
+ else {
+ $par_file = $input->[0];
+
+ # File off extension if present
+ $par_file =~ s/$PerlExtensionRegex//;
+ $par_file .= ".par";
+ }
+
+ $par_file = $output if $opt->{p} and $output =~ /\.par\z/i;
+ $output = $par_file if $opt->{p};
+
+ $self->_check_write($par_file);
+ }
+ else {
+ # Don't need to keep it, be safe with a tempfile.
+
+ $self->{pack_attrib}{lose} = 1;
+ ($cfh, $par_file) = File::Temp::tempfile("ppXXXXX", SUFFIX => ".par");
+ close $cfh; # See comment just below
+ }
+ $self->{par_file} = $par_file;
+ return ($par_file);
+}
+
+sub set_par_file {
+ my ($self, $file) = @_;
+
+ $self->{par_file} = $file;
+ $self->_check_write($file);
+}
+
+sub pack_manifest_hash {
+ my ($self) = @_;
+
+ my @SharedLibs;
+ return ($self->{pack_manifest}) if ($self->{pack_manifest});
+
+ $self->{pack_manifest} ||= {};
+ $self->{full_manifest} ||= {};
+ my $full_manifest = $self->{full_manifest};
+ my $dep_manifest = $self->{pack_manifest};
+
+ my $sn = $self->{script_name};
+ my $fe = $self->{frontend};
+
+ my $opt = $self->{options};
+ my $input = $self->{input};
+ my $output = $self->{output};
+
+ my $root = '';
+ $root = "$Config{archname}/" if ($opt->{m});
+ $self->{pack_attrib}{root} = '';
+
+ my $par_file = $self->{par_file};
+ my (@modules, @data, @exclude);
+
+ foreach my $name (@{ $opt->{M} || [] }) {
+ $self->_name2moddata($name, \@modules, \@data);
+ }
+
+ foreach my $name ('PAR', @{ $opt->{X} || [] }) {
+ if (-f $name and my $dep_zip = Archive::Zip->new($name)) {
+ for ($dep_zip->memberNames()) {
+ next if ( /MANIFEST/ or /META.yml/ or /^script\// );
+ $dep_zip_files{$_} ||= $name;
+ }
+ }
+ else {
+ $self->_name2moddata($name, \@exclude, \@exclude);
+ }
+ }
+
+ my %map;
+
+ unshift(@INC, @{ $opt->{I} || [] });
+ unshift(@SharedLibs, map $self->_find_shlib($_, $sn), @{ $opt->{l} || [] });
+
+ my $inc_find = $self->_obj_function($fe, '_find_in_inc');
+
+ my %skip = map { $_, 1 } map &$inc_find($_), @exclude;
+ if ($^O eq 'MSWin32') {
+ %skip = (%skip, map { s{\\}{/}g; lc($_), 1 } @SharedLibs);
+ }
+ else {
+ %skip = (%skip, map { $_, 1 } @SharedLibs);
+ }
+ my @files = (map (&$inc_find($_), @modules), @$input);
+
+ my $scan_dispatch =
+ $opt->{n}
+ ? $self->_obj_function($fe, 'scan_deps_runtime')
+ : $self->_obj_function($fe, 'scan_deps');
+
+ $scan_dispatch->(
+ rv => \%map,
+ files => \@files,
+ execute => $opt->{x},
+ compile => $opt->{c},
+ skip => \%skip,
+ ($opt->{n}) ? () : (
+ recurse => 1,
+ first => 1,
+ ),
+ );
+
+ %skip = map { $_, 1 } map &$inc_find($_), @exclude;
+ %skip = (%skip, map { $_, 1 } @SharedLibs);
+
+ my $add_deps = $self->_obj_function($fe, 'add_deps');
+
+ &$add_deps(
+ rv => \%map,
+ modules => \@modules,
+ skip => \%skip,
+ );
+
+ my %text;
+
+ $text{$_} = ($map{$_}{type} =~ /^(?:module|autoload)$/) for keys %map;
+ $map{$_} = $map{$_}{file} for keys %map;
+
+ $self->{pack_attrib}{text} = \%text;
+ $self->{pack_attrib}{map} = \%map;
+ $self->{pack_attrib}{shared_libs} = \@SharedLibs;
+
+ my $size = 0;
+ my $old_member;
+
+ if ($opt->{'m'} and -e $par_file) {
+ my $tmpzip = Archive::Zip->new();
+ $tmpzip->read($par_file);
+
+ if ($old_member = $tmpzip->memberNamed('MANIFEST')) {
+ $full_manifest->{$_} = [ file => $_ ]
+ for (grep /^\S/, split(/\n/, $old_member->contents));
+ $dep_manifest->{$_} = [ file => $_ ]
+ for (grep /^\S/, split(/\n/, $old_member->contents));
+ }
+ else {
+ $old_member = 1;
+ }
+ $self->{pack_attrib}{old_member} = $old_member;
+ }
+
+ my $verbatim = ($ENV{PAR_VERBATIM} || 0);
+
+ my $mod_filter =
+ PAR::Filter->new('PatchContent',
+ @{ $opt->{F} || ($verbatim ? [] : ['PodStrip']) },
+ );
+
+ foreach my $pfile (sort grep length $map{$_}, keys %map) {
+ (my $privlib = $Config{privlib}) =~ s{\\}{/}g;
+ (my $archlib = $Config{archlib}) =~ s{\\}{/}g;
+ next if !$opt->{B} and (
+ ($map{$pfile} eq "$privlib/$pfile") or
+ ($map{$pfile} eq "$archlib/$pfile")
+ );
+
+ $self->_vprint(2, "... adding $map{$pfile} as ${root}lib/$pfile");
+
+ if ($text{$pfile} or $pfile =~ /utf8_heavy\.pl$/i) {
+ my $content_ref = $mod_filter->apply($map{$pfile}, $pfile);
+
+ $full_manifest->{ $root . "lib/$pfile" } =
+ [ string => $content_ref ];
+ $dep_manifest->{ $root . "lib/$pfile" } =
+ [ string => $content_ref ];
+ }
+ elsif (
+ File::Basename::basename($map{$pfile}) =~ /^Tk\.dll$/i and $opt->{i}
+ and eval { require Win32::Exe; 1 }
+ and eval { require Win32::Exe::IconFile; 1 }
+ and 0 # XXX - broken on larger icon files - XXX
+ ) {
+ my $tkdll = Win32::Exe->new($map{$pfile});
+ my $ico = Win32::Exe::IconFile->new($opt->{i});
+ $tkdll->set_icons(scalar $ico->icons);
+
+ $full_manifest->{ $root . "lib/$pfile" } =
+ [ string => $tkdll->dump ];
+ $dep_manifest->{ $root . "lib/$pfile" } =
+ [ string => $tkdll->dump ];
+ }
+ else {
+ $full_manifest->{ $root . "lib/$pfile" } =
+ [ file => $map{$pfile} ];
+ $dep_manifest->{ $root . "lib/$pfile" } =
+ [ file => $map{$pfile} ];
+ }
+ }
+
+ my $script_filter;
+ $script_filter = PAR::Filter->new(@{ $opt->{f} }) if ($opt->{f});
+
+ my $in;
+ foreach my $in (@$input) {
+ my $name = File::Basename::basename($in);
+
+ if ($script_filter) {
+ my $string = $script_filter->apply($in, $name);
+
+ $full_manifest->{"script/$name"} = [ string => $string ];
+ $dep_manifest->{"script/$name"} = [ string => $string ];
+ }
+ else {
+ $full_manifest->{"script/$name"} = [ file => $in ];
+ $dep_manifest->{"script/$name"} = [ file => $in ];
+ }
+ }
+
+ my $shlib = "shlib/$Config{archname}";
+
+ foreach my $in (@SharedLibs) {
+ next unless -e $in;
+ my $name = File::Basename::basename($in);
+
+ $dep_manifest->{"$shlib/$name"} = [ file => $in ];
+ $full_manifest->{"$shlib/$name"} = [ file => $in ];
+ }
+
+ foreach my $in (@data) {
+ unless (-r $in and !-d $in) {
+ $self->_warn("'$in' does not exist or is not readable; skipping\n");
+ next;
+ }
+ $full_manifest->{$in} = [ file => $in ];
+ $dep_manifest->{$in} = [ file => $in ];
+ }
+
+ if (@$input and (@$input == 1 or !$opt->{p})) {
+ my $string =
+ (@$input == 1)
+ ? $self->_main_pl_single("script/" . File::Basename::basename($input->[0]))
+ : $self->_main_pl_multi();
+
+ $full_manifest->{"script/main.pl"} = [ string => $string ];
+ $dep_manifest->{"script/main.pl"} = [ string => $string ];
+ }
+
+ $full_manifest->{'MANIFEST'} = [ string => "<<placeholder>>" ];
+ $full_manifest->{'META.yml'} = [ string => "<<placeholder>>" ];
+
+ $dep_manifest->{'MANIFEST'} = [ string => "<<placeholder>>" ];
+ $dep_manifest->{'META.yml'} = [ string => "<<placeholder>>" ];
+
+ return ($dep_manifest);
+}
+
+sub full_manifest_hash {
+ my ($self) = @_;
+
+ $self->pack_manifest_hash();
+ return ($self->{full_manifest});
+}
+
+sub full_manifest {
+ my ($self) = @_;
+
+ $self->pack_manifest_hash();
+ my $mh = $self->{full_manifest};
+ return ([ sort keys(%$mh) ]);
+}
+
+sub add_manifest_hash {
+ my ($self) = @_;
+ return ($self->{add_manifest}) if ($self->{add_manifest});
+ my $mh = $self->{add_manifest} = {};
+
+ my $ma = $self->_add_manifest();
+
+ my $elt;
+
+ foreach $elt (@$ma) {
+ my ($file, $alias) = @$elt;
+
+ if (!-e $file) {
+ $self->_warn("Cannot find file or directory $file for packing\n");
+ }
+ elsif (!-r _) {
+ $self->_warn("Cannot read file or directory $file for packing\n");
+ }
+ elsif (-d _) {
+ my ($files, $aliases) = $self->_expand_dir(@$elt);
+ while (@$files) {
+ $mh->{ shift(@$aliases) } = [ file => shift(@$files) ];
+ }
+ }
+ else {
+ $mh->{ $alias } = [ file => $file ];
+ }
+ }
+ return ($mh);
+}
+
+sub _add_manifest {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $return = [];
+ my $files = [];
+ my $lists = [];
+
+ $files = $opt->{a} if ($opt->{a});
+ $lists = $opt->{A} if ($opt->{A});
+
+ local $/ = "\n";
+ foreach my $list (@$lists) {
+ my $fh = $self->_open('<', $list, 'text');
+ while (my $line = <$fh>) {
+ chomp($line);
+ push(@$files, $line);
+ }
+ }
+
+ foreach my $file (grep length, @$files) {
+ $file =~ s{\\}{/}g;
+
+ if ($file =~ /;/) {
+ push(@$return, [ split(/;/, $file) ]);
+ }
+ else {
+ my $alias = $file;
+ $alias =~ s{^[a-zA-Z]:}{} if $^O eq 'MSWin32';
+ $alias =~ s{^/}{};
+ push(@$return, [ $file, $alias ]);
+ }
+ }
+ return ($return);
+}
+
+sub add_manifest {
+ my ($self) = @_;
+ my $mh = $self->add_manifest_hash();
+
+ my @ma = sort keys(%$mh);
+ return (\@ma);
+}
+
+sub _add_pack_manifest {
+ my ($self) = @_;
+
+ my $par_file = $self->{par_file};
+ my $opt = $self->{options};
+
+ $self->{zip} ||= Archive::Zip->new;
+ my $zip = $self->{zip};
+
+ my $input = $self->{input};
+
+ $self->_vprint(1, "Writing PAR on $par_file");
+
+ $zip->read($par_file) if ($opt->{'m'} and -e $par_file);
+
+ my $pack_manifest = $self->pack_manifest_hash();
+
+ my $map = $self->{pack_attrib}{map};
+ my $root = $self->{pack_attrib}{root};
+ my $shared_libs = $self->{pack_attrib}{shared_libs};
+
+ $zip->addDirectory('', substr($root, 0, -1))->unixFileAttributes(0755)
+ if ($root and %$map and $] >= 5.008);
+ $zip->addDirectory('', $root . 'lib')->unixFileAttributes(0755) if (%$map and $] >= 5.008);
+
+ my $shlib = "shlib/$Config{archname}";
+ $zip->addDirectory('', $shlib)->unixFileAttributes(0755) if (@$shared_libs and $] >= 5.008);
+
+ my @tmp_input = @$input;
+ @tmp_input = grep !/\.pm\z/i, @tmp_input;
+
+ $zip->addDirectory('', 'script')->unixFileAttributes(0755) if (@tmp_input and $] >= 5.008);
+
+ my $in;
+ foreach $in (sort keys(%$pack_manifest)) {
+ my $value = $pack_manifest->{$in};
+ $self->_add_file($zip, $in, $value);
+ }
+
+}
+
+sub dep_files {
+ my ($self) = @_;
+
+ my $dm = $self->{dep_manifest};
+ return ([ keys(%$dm) ]) if ($dm);
+
+}
+
+sub _add_file {
+ my ($self, $zip, $in, $value, $manifest) = @_;
+
+ my $level = $self->{options}->{z};
+ my $method = $level ? Archive::Zip::COMPRESSION_DEFLATED
+ : Archive::Zip::COMPRESSION_STORED;
+ my $oldsize = $self->{pack_attrib}{old_size};
+ my $full_manifest = $self->{full_manifest};
+
+ if ($value->[0] eq 'file') {
+ my $fn = $value->[1];
+
+ if (-d $fn) {
+ my ($files, $aliases) = $self->_expand_dir($fn, $in);
+
+ $self->_vprint(1, "... adding $fn as $in\n");
+
+ while (@$files) {
+ my $file = shift @$files;
+ my $alias = shift @$aliases;
+
+ if (exists $dep_zip_files{$alias}) {
+ $dep_zips{$dep_zip_files{$alias}}++;
+ next;
+ }
+ $self->_vprint(1, "... adding $file as $alias\n");
+
+ $full_manifest->{ $alias } = [ file => $file ];
+ $manifest->{ $alias } = [ file => $file ];
+
+ $oldsize += -s $file;
+ $zip->addFile($file, $alias);
+ $zip->memberNamed($alias)->desiredCompressionMethod($method);
+ $zip->memberNamed($alias)->desiredCompressionLevel($level);
+ }
+ }
+ elsif (-e $fn and -r $fn) {
+ if (exists $dep_zip_files{$in}) {
+ $dep_zips{$dep_zip_files{$in}}++;
+ return;
+ }
+ $self->_vprint(1, "... adding $fn as $in\n");
+
+ $oldsize += -s $fn;
+ $zip->addFile($fn => $in);
+ $zip->memberNamed($in)->desiredCompressionMethod($method);
+ $zip->memberNamed($in)->desiredCompressionLevel($level);
+ }
+ }
+ else {
+ if (exists $dep_zip_files{$in}) {
+ $dep_zips{$dep_zip_files{$in}}++;
+ return;
+ }
+ my $str = $value->[1];
+ $oldsize += length($str);
+
+ $self->_vprint(1, "... adding <string> as $in");
+ $zip->addString($str => $in)->unixFileAttributes(0644);
+ $zip->memberNamed($in)->desiredCompressionMethod($method);
+ $zip->memberNamed($in)->desiredCompressionLevel($level);
+ }
+
+ $self->{pack_attrib}{old_size} = $oldsize;
+}
+
+sub _expand_dir {
+ my ($self, $fn, $in) = @_;
+ my (@return, @alias_return);
+
+ File::Find::find(
+ {
+ wanted => sub { push(@return, $File::Find::name) if -f },
+ follow_fast => ( ($^O eq 'MSWin32') ? 0 : 1 ),
+ },
+ $fn
+ );
+
+ @alias_return = @return;
+ s/^\Q$fn\E/$in/ for @alias_return;
+
+ return (\@return, \@alias_return);
+}
+
+sub _die {
+ my ($self, @args) = @_;
+ $self->_log(@args);
+
+ my $sn = $self->{script_name};
+ die "$sn: ", @args;
+}
+
+sub _warn {
+ my ($self, @args) = @_;
+ $self->_log(@args);
+
+ my $sn = $self->{script_name};
+ warn "$sn: ", @args;
+}
+
+sub _log {
+ my ($self, @args) = @_;
+
+ my $opt = $self->{options};
+ my $logfh = $self->{logfh};
+ my $sn = $self->{script_name};
+
+ $logfh->print("$sn: ", @args) if ($opt->{L});
+}
+
+sub _name2moddata {
+ my ($self, $name, $mod, $dat) = @_;
+
+ if ($name =~ /^[\w:]+$/) {
+ $name =~ s/::/\//g;
+ push @$mod, "$name.pm";
+ }
+ elsif ($name =~ /$PerlExtensionRegex/) {
+ push @$mod, $name;
+ }
+ else {
+
+ if (!-e $name) {
+ $self->_warn( "-M or -X option file not found: $name\n" );
+ }
+ else {
+ $self->_warn(
+ "Using -M to add non-library files is deprecated; ",
+ "try -a instead\n",
+ ) if $mod != $dat;
+ push @$dat, $name;
+ }
+ }
+}
+
+sub _par_to_exe {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $output = $self->{output};
+ my $dynperl = $self->{dynperl};
+ my $par_file = $self->{par_file};
+
+ my $parl = 'parl';
+ my $buf;
+
+ $parl = 'parldyn' if ($opt->{d} and $dynperl);
+ $parl .= $Config{_exe};
+
+ $parl = 'par.pl' if ($opt->{P});
+ $self->{parl} = $self->_can_run($parl, $opt->{P})
+ or $self->_die("Can't find par loader");
+
+ if ($^O ne 'MSWin32' or $opt->{p} or $opt->{P}) {
+ $self->_generate_output();
+ }
+ elsif (!$opt->{N} and !$opt->{i}) {
+ $self->_generate_output();
+ $self->_fix_console() if $opt->{g};
+ }
+ elsif (eval { require Win32::Exe; 1 }) {
+ $self->_move_parl();
+ Win32::Exe->new($self->{parl})->update(
+ icon => $opt->{i},
+ info => $opt->{N},
+ );
+
+ $self->_append_parl();
+ $self->_generate_output();
+
+ Win32::Exe->new($output)->update(
+ icon => $opt->{i},
+ info => $opt->{N},
+ );
+
+ $self->_fix_console();
+ unlink($self->{parl});
+ unlink("$self->{parl}.bak");
+ return;
+ }
+ else {
+ $self->_die("--icon and --info support needs Win32::Exe");
+ }
+}
+
+sub _fix_console {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $output = $self->{output};
+ my $dynperl = $self->{dynperl};
+
+ return unless $opt->{g};
+
+ $self->_vprint(1, "Fixing $output to remove its console window");
+ $self->_strip_console($output);
+
+ if ($dynperl and !$opt->{d}) {
+ # we have a static.exe that needs taking care of.
+ my $buf;
+ my $fh = $self->_open($self->{orig_parl} || $self->{parl});
+ seek $fh, -8, 2;
+ read $fh, $buf, 8;
+ die unless $buf eq "\nPAR.pm\n";
+ seek $fh, -12, 2;
+ read $fh, $buf, 4;
+ seek $fh, -12 - unpack("N", $buf) - 4, 2;
+ read $fh, $buf, 4;
+ close $fh;
+ $self->_strip_console($output, unpack("N", $buf));
+ }
+}
+
+sub _move_parl {
+ my ($self) = @_;
+
+ $self->{orig_parl} = $self->{parl};
+
+ my $cfh;
+ my $fh = $self->_open($self->{parl});
+ ($cfh, $self->{parl}) = File::Temp::tempfile(
+ "parlXXXX",
+ SUFFIX => ".exe",
+ UNLINK => 1,
+ );
+ binmode($cfh);
+
+ local $/;
+ print $cfh readline($fh);
+ close $cfh;
+
+ $self->{fh} = $fh;
+}
+
+sub _append_parl {
+ my ($self) = @_;
+
+ my $fh = delete $self->{fh};
+
+ my $buf;
+ seek $fh, -8, 2;
+ read $fh, $buf, 8;
+ die unless $buf eq "\nPAR.pm\n";
+ seek $fh, -12, 2;
+ read $fh, $buf, 4;
+ seek $fh, -12 - unpack("N", $buf), 2;
+
+ local $/;
+ my $cfh = $self->_open('>>', $self->{parl});
+ print $cfh readline($fh);
+ close $cfh;
+}
+
+sub _generate_output {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $output = $self->{output};
+ my $par_file = $self->{par_file};
+
+ my @args = ('-B', "-O$output", $par_file);
+ unshift @args, '-q' unless $opt->{v} > 0;
+ if ($opt->{L}) {
+ unshift @args, "-L".$opt->{L};
+ }
+ if ($opt->{T}) {
+ unshift @args, "-T".$opt->{T};
+ }
+ if ($opt->{P}) {
+ unshift @args, $self->{parl};
+ $self->{parl} = $^X;
+ }
+ $self->_vprint(0, "Running $self->{parl} @args");
+ system($self->{parl}, @args);
+}
+
+sub _strip_console {
+ my $self = shift;
+ my $file = shift;
+ my $preoff = shift || 0;
+
+ my ($record, $magic, $signature, $offset, $size);
+
+ my $exe = $self->_open('+<', $file);
+ binmode $exe;
+ seek $exe, $preoff, 0;
+
+ # read IMAGE_DOS_HEADER structure
+ read $exe, $record, 64;
+ ($magic, $offset) = unpack "Sx58L", $record;
+
+ die "$file is not an MSDOS executable file.\n"
+ unless $magic == 0x5a4d; # "MZ"
+
+ # read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER
+ seek $exe, $preoff + $offset, 0;
+ read $exe, $record, 4 + 20 + 2;
+
+ ($signature, $size, $magic) = unpack "Lx16Sx2S", $record;
+
+ die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
+
+ die "Optional header is neither in NT32 nor in NT64 format"
+ unless ($size == 224 && $magic == 0x10b) # IMAGE_NT_OPTIONAL_HDR32_MAGIC
+ ||
+ ($size == 240 && $magic == 0x20b); # IMAGE_NT_OPTIONAL_HDR64_MAGIC
+
+ # Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code
+ seek $exe, $preoff + $offset + 4 + 20 + 68, 0;
+ print $exe pack "S", 2; # IMAGE_WINDOWS
+ close $exe;
+}
+
+sub _obj_function {
+ my ($self, $module_or_class, $func_name) = @_;
+
+ my $func;
+ if (ref($module_or_class)) {
+ $func = $module_or_class->can($func_name);
+ die "SYSTEM ERROR: $func_name does not exist in $module_or_class\n"
+ if (!$func);
+
+ if (%$module_or_class) {
+ # hack because Module::ScanDeps isn't really object.
+ return sub { $func->($module_or_class, @_) };
+ }
+ else {
+ return ($func);
+ }
+ }
+ else {
+ $func = $module_or_class->can($func_name);
+ return ($func);
+ }
+}
+
+sub _vprint {
+ my ($self, $level, $msg) = @_;
+
+ my $opt = $self->{options};
+ my $logfh = $self->{logfh};
+
+ $msg .= "\n" unless substr($msg, -1) eq "\n";
+
+ my $verb = $ENV{PAR_VERBOSE} || 0;
+ if ($opt->{v} > $level or $verb > $level) {
+ if ($opt->{L}) {
+ print $logfh "$0: $msg";
+ }
+ else {
+ print "$0: $msg";
+ }
+ }
+}
+
+sub _check_par {
+ my ($self, $file) = @_;
+
+ local $/ = \4;
+ my $handle = $self->_open($file);
+ return (readline($handle) eq "PK\x03\x04");
+}
+
+# _chase_lib - find the runtime link of a shared library
+# Logic based on info found at the following sites:
+# http://lists.debian.org/lsb-spec/1999/05/msg00011.html
+# http://docs.sun.com/app/docs/doc/806-0641/6j9vuqujh?a=view#chapter5-97360
+sub _chase_lib {
+ my ($self, $file) = @_;
+
+ while ($Config::Config{d_symlink} and -l $file) {
+ if ($file =~ /^(.*?\.\Q$Config{dlext}\E\.\d+)\..*/) {
+ return $1 if -e $1;
+ }
+
+ return $file if $file =~ /\.\Q$Config{dlext}\E\.\d+$/;
+
+ my $dir = File::Basename::dirname($file);
+ $file = readlink($file);
+
+ unless (File::Spec->file_name_is_absolute($file)) {
+ $file = File::Spec->rel2abs($file, $dir);
+ }
+ }
+
+ if ($file =~ /^(.*?\.\Q$Config{dlext}\E\.\d+)\..*/) {
+ return $1 if -e $1;
+ }
+
+ return $file;
+}
+
+sub _find_shlib {
+ my ($self, $file, $script_name) = @_;
+
+ if ($^O eq 'MSWin32') {
+ if ($file !~ /^[a-z]:/i) {
+ my $cwd = Cwd::cwd().'/';
+ $cwd =~ s{/.*}{} if $file =~ m{^[\\/]};
+ $file = $cwd.$file;
+ }
+ }
+
+ return $self->_chase_lib($file) if -e $file;
+
+ my $libpthname;
+ if ($^O eq 'MSWin32') {
+ $libpthname = exists $ENV{PATH} ? $ENV{PATH} : undef;
+ }
+ else {
+ $libpthname = exists $ENV{ $Config{ldlibpthname} }
+ ? $ENV{ $Config{ldlibpthname} } : undef;
+ }
+ if (not defined $libpthname) {
+ print "Can't find $file. Environment variable "
+ . ($^O eq 'MSWin32' ? 'PATH' : $Config{ldlibpthname})
+ . " does not exist.\n";
+ return;
+ }
+
+ $file = File::Basename::basename($file);
+ for my $dir (File::Basename::dirname($0),
+ split(/\Q$Config{path_sep}\E/, $libpthname))
+ {
+ my $abs = File::Spec->catfile($dir, $file);
+ return $self->_chase_lib($abs) if -e $abs;
+ $abs = File::Spec->catfile($dir, "$file.$Config{dlext}");
+ return $self->_chase_lib($abs) if -e $abs;
+ }
+
+ # be extra magical and prepend "lib" to the filename
+ return if $^O eq 'MSWin32';
+ return $self->_find_shlib("lib$file", $script_name) unless $file =~ /^lib/;
+}
+
+sub _can_run {
+ my ($self, $command, $no_exec) = @_;
+
+ for my $dir (File::Basename::dirname($0),
+ split(/\Q$Config{path_sep}\E/, $ENV{PATH}))
+ {
+ my $abs = File::Spec->catfile($dir, $command);
+ return $abs if $no_exec or $abs = MM->maybe_command($abs);
+ }
+ return;
+}
+
+sub _main_pl_multi {
+ my ($self) = @_;
+ return << '__MAIN__';
+my $file = $ENV{PAR_PROGNAME};
+my $zip = $PAR::LibCache{$ENV{PAR_PROGNAME}} || Archive::Zip->new(__FILE__);
+$file =~ s/^.*[\/\\]//;
+$file =~ s/\.[^.]*$//i ;
+my $member = eval { $zip->memberNamed($file) }
+ || $zip->memberNamed("$file.pl")
+ || $zip->memberNamed("script/$file")
+ || $zip->memberNamed("script/$file.pl")
+ or die qq(Can't open perl script "$file": No such file or directory);
+PAR::_run_member($member, 1);
+
+__MAIN__
+}
+
+sub _open {
+ my ($self, $mode, $file, $is_text) = @_;
+ ($mode, $file) = ('<', $mode) if @_ < 3;
+ open(my $fh, $mode, $file) or $self->_die(
+ "Cannot open $file for ",
+ (($mode =~ '>') ? 'writing' : 'reading'),
+ ": $!",
+ );
+ binmode($fh) unless $is_text;
+ return $fh;
+}
+
+sub _main_pl_single {
+ my ($self, $file) = @_;
+ return << "__MAIN__";
+my \$zip = \$PAR::LibCache{\$ENV{PAR_PROGNAME}} || Archive::Zip->new(__FILE__);
+my \$member = eval { \$zip->memberNamed('$file') }
+ or die qq(Can't open perl script "$file": No such file or directory (\$zip));
+PAR::_run_member(\$member, 1);
+
+__MAIN__
+}
+
+sub DESTROY {
+ my ($self) = @_;
+
+ my $par_file = $self->{par_file};
+ my $opt = $self->{options};
+
+ unlink $par_file if ($par_file and !$opt->{S} and !$opt->{p});
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR>, L<pp>
+
+L<App::Packer>, L<App::Packer::Backend>
+
+=head1 ACKNOWLEDGMENTS
+
+Mattia Barbon for taking the first step in refactoring B<pp> into
+B<App::Packer::Backend::PAR>, and Edward S. Peschko for continuing
+the work that eventually became this module.
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR/Tutorial.pod
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR/Tutorial.pod 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR/Tutorial.pod 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,1122 @@
+=head1 NAME
+
+PAR::Tutorial - Cross-Platform Packaging and Deployment with PAR
+
+=head1 SYNOPSIS
+
+This is a tutorial on PAR, first appeared at the 7th Perl Conference.
+The HTML version of this tutorial is available online as
+L<http://aut.dyndns.org/par-tutorial/>.
+
+=head1 DESCRIPTION
+
+=head2 On Deploying Perl Applications
+
+ % sshnuke.pl 10.2.2.2 -rootpw="Z1ON0101"
+ Perl v5.6.1 required--this is only v5.6.0, stopped at sshnuke.pl line 1.
+ BEGIN failed--compilation aborted at sshnuke.pl line 1.
+
+=over 4
+
+=item * Q: "Help! I can't run your program!"
+
+=item * A1: Install Perl & C<perl -MCPAN -e'install(...)'>
+
+=over 4
+
+=item * How do we know which modules are needed?
+
+=item * New versions of CPAN modules may break C<sshnuke.pl>
+
+=back
+
+=item * A2: Install Perl & C<tar zxf my_perllib.tgz>
+
+=over 4
+
+=item * Possibly overwriting existing modules; not cross-platform at all
+
+=back
+
+=item * A3: Use the executable generated by C<perlcc sshnuke.pl>
+
+=over 4
+
+=item * Impossible to debug; C<perlcc> usually does not work anyway
+
+=back
+
+=back
+
+
+
+=head2 PAR, the Perl Archive Toolkit
+
+=over 4
+
+=item * Do what JAR (Java Archive) does for Perl
+
+=over 4
+
+=item * Aggregates modules, scripts and other files into a Zip file
+
+=item * Easy to generate, update and extract
+
+=item * Version consistency: solves forward-compatibility problems
+
+=item * Developed by community: C<par at perl.org>
+
+=back
+
+=item * PAR files can be packed into self-contained scripts
+
+=over 4
+
+=item * Automatically scans perl script for dependencies
+
+=item * Bundles all necessary 3rd-party modules with it
+
+=item * Requires only core Perl to run on the target machine
+
+=item * PAR also comes with C<pp>, the Perl Packager:
+
+ % pp -o sshnuke.exe sshnuke.pl # stand-alone executable!
+
+=back
+
+=back
+
+
+
+=head2 Simple Packaging
+
+=over 4
+
+=item * PAR files are just Zip files with modules in it
+
+=item * Any Zip tools can generate them:
+
+ % zip foo.par Hello.pm World.pm # pack two modules
+ % zip -r bar.par lib/ # grab all modules in lib/
+
+=item * To load modules from PAR files:
+
+ use PAR;
+ use lib "foo.par"; # the .par part is optional
+ use Hello;
+
+=item * This also works:
+
+ use PAR "/home/mylibs/*.par"; # put all of them into @INC
+ use Hello;
+
+=back
+
+
+
+=head2 PAR Loaders
+
+=over 4
+
+=item * Use C<par.pl> to run files inside a PAR archive:
+
+ % par.pl foo.par # looks for 'main.pl' by default
+ % par.pl foo.par test.pl # runs script/test.pl in foo.par
+
+=item * Same thing, with the stand-alone C<parl> or C<parl.exe>:
+
+ % parl foo.par # no perl or PAR.pm needed!
+ % parl foo.par test.pl # ditto
+
+=item * The PAR loader can prepend itself to a PAR file:
+
+=over 4
+
+=item * C<-b> bundles non-core modules needed by C<PAR.pm>:
+
+ % par.pl -b -O./foo.pl foo.par # self-contained script
+
+=item * C<-B> bundles core modules in addition to C<-b>:
+
+ % parl -B -O./foo.exe foo.par # self-contained binary
+
+=back
+
+=back
+
+
+
+=head2 Dependency Scanning
+
+=over 4
+
+=item * Recursively scan dependencies with C<scandeps.pl>:
+
+ % scandeps.pl sshnuke.pl
+ # Legend: [C]ore [X]ternal [S]ubmodule [?]NotOnCPAN
+ 'Crypt::SSLeay' => '0', # X #
+ 'Net::HTTP' => '0', # #
+ 'Crypt::SSLeay::X509' => '0', # S # Crypt::SSLeay
+ 'Net::HTTP::Methods' => '0', # S # Net::HTTP
+ 'Compress::Zlib' => '0', # X # Net::HTTP::Methods
+
+=item * Scan an one-liner, list all involved files:
+
+ % scandeps.pl -V -e "use Dynaloader;"
+ ...
+ # auto/DynaLoader/dl_findfile.al [autoload]
+ # auto/DynaLoader/extralibs.ld [autoload]
+ # auto/File/Glob/Glob.bs [data]
+ # auto/File/Glob/Glob.so [shared]
+ ...
+
+=back
+
+
+
+=head2 Perl Packager: C<pp>
+
+=over 4
+
+=item * Combines scanning, zipping and loader-embedding:
+
+ % pp -o out.exe src.pl # self-contained .exe
+ % out.exe # runs anywhere on the same OS
+
+=item * Bundle additional modules:
+
+ % pp -o out.exe -M CGI src.pl # pack CGI + its dependencies, too
+
+=item * Pack one-liners:
+
+ % pp -o out.exe -e 'print "Hi!"' # turns one-liner into executable
+
+
+=item * Generate PAR files instead of executables:
+
+ % pp -p src.pl # makes 'source.par'
+ % pp -B -p src.pl # include core modules
+
+=back
+
+
+
+=head2 How it works
+
+=over 4
+
+=item * Command-line options are almost identical to C<perlcc>'s
+
+=over 4
+
+=item * Also supports C<gcc>-style long options:
+
+ % pp --gui --verbose --output=out.exe src.pl
+
+=back
+
+=item * Small initial overhead; no runtime overhead
+
+=item * Dependencies are POD-stripped before packing
+
+=item * Loads modules directly into memory on demand
+
+=item * Shared libraries (DLLs) are extracted with File::Temp
+
+=item * Works on Perl 5.6.0 or above
+
+=item * Tested on Win32 (VC++ and MinGW), FreeBSD, NetBSD, Linux, MacOSX, Cygwin, AIX, Solaris, HP-UX, Tru64...
+
+=back
+
+
+
+=head2 Aggregating multiple programs
+
+=over 4
+
+=item * A common question:
+
+ > I have used pp to make several standalone applications which work
+ > great, the only problem is that for each executable that I make, I am
+ > assuming the parl.exe is somehow bundled into the resulting exe.
+
+=item * The obvious workaround:
+
+ You can ship parl.exe by itself, along with .par files built
+ by "pp -p", and run those PAR files by associating them to parl.exe.
+
+=item * On platforms that have C<ln>, there is a better solution:
+
+ % pp --output=a.out a.pl b.pl # two scripts in one!
+ % ln a.out b.out # symlink also works
+ % ./a.out # runs a.pl
+ % ./b.out # runs b.pl
+
+=back
+
+
+
+=head2 Cross-platform Packages
+
+=over 4
+
+=item * Of course, there is no cross-platform binary format
+
+=item * Pure-perl PAR packages are cross-platform by default
+
+=over 4
+
+=item * However, XS modules are specific to Perl version and platform
+
+=item * Multiple versions of a XS module can co-exist in a PAR file
+
+=back
+
+=item * Suppose we need C<out.par> on both Win32 and Finix:
+
+ C:\> pp --multiarch --output=out.par src.pl
+ ...copy src.pl and out.par to a Finix machine...
+ % pp --multiarch --output=out.par src.pl
+
+=item * Now it works on both platforms:
+
+ % parl out.par # runs src.pl
+ % perl -MPAR=out.par -e '...' # uses modules inside out.par
+
+=back
+
+
+
+=head2 The Anatomy of a PAR file
+
+=over 4
+
+=item * Modules can reside in several directories:
+
+ / # casual packaging only
+ /lib/ # standard location
+ /arch/ # for creating from blib/
+ /i386-freebsd/ # i.e. $Config{archname}
+ /5.8.0/ # i.e. Perl version number
+ /5.8.0/i386-freebsd/ # combination of the two above
+
+=item * Scripts are stored in one of the two locations:
+
+ / # casual packaging only
+ /script/ # standard location
+
+=item * Shared libraries may be architecture- or perl-version-specific:
+
+ /shlib/(5.8.0/)?(i386-freebsd/)?
+
+=item * PAR files may recursively contain other PAR files:
+
+ /par/(5.8.0/)?(i386-freebsd/)?
+
+=back
+
+
+
+=head2 Special files
+
+=over 4
+
+=item * MANIFEST
+
+=over 4
+
+=item * Index of all files inside PAR
+
+=item * Can be parsed with C<ExtUtils::Manifest>
+
+=back
+
+=item * META.yml
+
+=over 4
+
+=item * Dependency, license, runtime options
+
+=item * Can be parsed with C<YAML>
+
+=back
+
+=item * SIGNATURE
+
+=over 4
+
+=item * OpenPGP-signed digital signature
+
+=item * Can be parsed and verified with C<Module::Signature>
+
+=back
+
+=back
+
+
+
+=head2 Advantages over perlcc, PerlApp and Perl2exe
+
+=over 4
+
+=item * This is not meant to be a flame
+
+=over 4
+
+=item * All three maintainers have contributed to PAR directly; I'm grateful
+
+=back
+
+=item * perlcc
+
+=over 4
+
+=item * "The code generated in this way is not guaranteed to work... Use for production purposes is strongly discouraged." (from perldoc perlcc)
+
+=item * I<Guaranteed to not work> is more like it
+
+=back
+
+=item * PerlApp / Perl2exe
+
+=over 4
+
+=item * Expensive: Need to pay for each upgrade
+
+=item * Non-portable: Only available for limited platforms
+
+=item * Proprietary: Cannot extend its features or fix bugs
+
+=item * Obfuscated: Vendor and black-hats can see your code, but you can't
+
+=item * Inflexible: Does not work with existing Perl installations
+
+=back
+
+=back
+
+
+
+=head2 MANIFEST: Best viewed with Mozilla
+
+=over 4
+
+=item * The URL of C<MANIFEST> inside C</home/autrijus/foo.par>:
+
+ jar:file:///home/autrijus/foo.par!/MANIFEST
+
+=item * Open it in a Gecko browser (e.g. Netscape 6+) with Javascript enabled:
+
+=item * No needed to unzip anything; just click on files to view them
+
+=back
+
+
+
+=head2 META.yml: Metadata galore
+
+=over 4
+
+=item * Static, machine-readable distribution metadata
+
+=over 4
+
+=item * Supported by C<Module::Build>, C<ExtUtils::MakeMaker>, C<Module::Install>
+
+=back
+
+=item * A typical C<pp>-generated C<META.yml> looks like this:
+
+ build_requires: {}
+ conflicts: {}
+ dist_name: out.par
+ distribution_type: par
+ dynamic_config: 0
+ generated_by: 'Perl Packager version 0.03'
+ license: unknown
+ par:
+ clean: 0
+ signature: ''
+ verbatim: 0
+ version: 0.68
+
+=item * The C<par:> settings controls its runtime behavior
+
+=back
+
+
+
+=head2 SIGNATURE: Signing and verifying packages
+
+=over 4
+
+=item * OpenPGP clear-signed manifest with SHA1 digests
+
+=over 4
+
+=item * Supported by C<Module::Signature>, C<CPANPLUS> and C<Module::Build>
+
+=back
+
+=item * A typical C<SIGNATURE> looks like this:
+
+ -----BEGIN PGP SIGNED MESSAGE-----
+ Hash: SHA1
+
+ SHA1 8a014cd6d0f6775552a01d1e6354a69eb6826046 AUTHORS
+ ...
+ -----BEGIN PGP SIGNATURE-----
+ ...
+ -----END PGP SIGNATURE-----
+
+=item * Use C<pp> and C<cpansign> to work with signatures:
+
+ % pp -s -o foo.par bar.pl # make and sign foo.par from bar.pl
+ % cpansign -s foo.par # sign this PAR file
+ % cpansign -v foo.par # verify this PAR file
+
+=back
+
+
+
+=head2 Perl Servlets with Apache::PAR
+
+=over 4
+
+=item * Framework for self-contained Web applications
+
+=over 4
+
+=item * Similar to Java's "Web Application Archive" (WAR) files
+
+=item * Works with mod_perl 1.x or 2.x
+
+=back
+
+=item * A complete web application inside a C<.par> file
+
+=over 4
+
+=item * Apache configuration, static files, Perl modules...
+
+=item * Supports Static, Registry and PerlRun handlers
+
+=item * Can also load all PARs under a directory
+
+=back
+
+=item * One additional special file: C<web.conf>
+
+ Alias /myapp/cgi-perl/ ##PARFILE##/
+ <Location /myapp/cgi-perl>
+ Options +ExecCGI
+ SetHandler perl-script
+ PerlHandler Apache::PAR::Registry
+ </Location>
+
+=back
+
+
+
+=head2 Hon Dah, A-par-che!
+
+=over 4
+
+=item * First, make a C<hondah.par> from an one-liner:
+
+ # use the "web.conf" from the previous slide
+ % pp -p -o hondah.par -e 'print "Hon Dah!\n"' \
+ --add web.conf
+ % chmod a+x hondah.par
+
+=item * Add this to C<httpd.conf>, then restart apache:
+
+ <IfDefine MODPERL2>
+ PerlModule Apache2
+ </IfDefine>
+ PerlAddVar PARInclude /home/autrijus/hondah.par
+ PerlModule Apache::PAR
+
+=item * Test it out:
+
+ % GET http://localhost/myapp/cgi-perl/main.pl
+ Hon Dah!
+
+=item * Instant one-liner web application that works!
+
+=back
+
+
+
+=head2 On-demand library fetching
+
+=over 4
+
+=item * With LWP installed, your can use remote PAR files:
+
+ use PAR;
+ use lib 'http://aut.dyndns.org/par/DBI-latest.par';
+ use DBI; # always up to date!
+
+=item * Modules are now cached under C<$ENV{PAR_GLOBAL_TEMP}>
+
+=item * Auto-updates with C<LWP::Simple::mirror>
+
+=over 4
+
+=item * Download only if modified
+
+=item * Safe for offline use after the first time
+
+=item * May use C<SIGNATURE> to prevent DNS-spoofing
+
+=back
+
+=item * Makes large-scale deployment a breeze
+
+=over 4
+
+=item * Upgrades from a central location
+
+=item * No installers needed
+
+=back
+
+=back
+
+
+
+=head2 Code Obfuscation
+
+=over 4
+
+=item * Also known as I<source-hiding> techniques
+
+=over 4
+
+=item * It is I<not> encryption
+
+=item * Offered by PerlApp, Perl2Exe, Stunnix...
+
+=back
+
+=item * Usually easy to defeat
+
+=over 4
+
+=item * Take optree dump from memory, feed to C<B::Deparse>
+
+=item * If you just want to stop a casual C<grep>, "deflate" already works
+
+=back
+
+=item * PAR now supports pluggable I<input filters> with C<pp -f>
+
+=over 4
+
+=item * Bundled examples: Bleach, PodStrip and PatchContent
+
+=item * True encryption using C<Crypt::*>
+
+=item * Or even _product activation_ over the internet
+
+=back
+
+=item * Alternatively, just keep core logic in your server and use RPC
+
+=back
+
+
+
+=head2 Accessing packed files
+
+=over 4
+
+=item * To get the host archive from a packed program:
+
+ my $zip = PAR::par_handle($0); # an Archive::Zip object
+ my $content = $zip->contents('MANIFEST');
+
+=item * Same thing, but with C<read_file()>:
+
+ my $content = PAR::read_file('MANIFEST');
+
+=item * Loaded PAR files are stored in C<%PAR::LibCache>:
+
+ use PAR '/home/mylibs/*.par';
+ while (my ($filename, $zip) = each %PAR::LibCache) {
+ print "[$filename - MANIFEST]\n";
+ print $zip->contents('MANIFEST');
+ }
+
+=back
+
+
+
+=head2 Packing GUI applications
+
+=over 4
+
+=item * GUI toolkits often need to link with shared libraries:
+
+ # search for libncurses under library paths and pack it
+ % pp -l ncurses curses_app.pl # same for Tk, Wx, Gtk, Qt...
+
+=item * Use C<pp --gui> on Win32 to eliminate the console window:
+
+ # pack 'src.pl' into a console-less 'out.exe' (Win32 only)
+ % pp --gui -o out.exe src.pl
+
+=item * "Can't locate Foo/Widget/Bar.pm in @INC"?
+
+=over 4
+
+=item * Some toolkits (notably Tk) autoloads modules without C<use> or C<require>
+
+=item * Hence C<pp> and C<Module::ScanDeps> may fail to detect them
+
+=item * Tk problems mostly fixed by now, but other toolkits may still break
+
+=item * You can work around it with C<pp -M> or an explicit C<require>
+
+=item * Or better, send a short test-case to C<par at perl.org> so we can fix it
+
+=back
+
+=back
+
+
+
+=head2 Precompiled CPAN distributions
+
+=over 4
+
+=item * Installing XS extensions from CPAN was difficult
+
+=over 4
+
+=item * Some platforms do not come with a compiler (Win32, MacOSX...)
+
+=item * Some headers or libraries may be missing
+
+=item * PAR.pm itself used to suffer from both problems
+
+=back
+
+=item * ...but not anymore -- C<Module::Install> to the rescue!
+
+ # same old Makefile.PL, with a few changes
+ use inc::Module::Install; # was "use ExtUtils::MakeMaker;"
+ WriteMakefile( ... ); # same as the original
+ check_nmake(); # make sure the user have nmake
+ par_base('AUTRIJUS'); # your CPAN ID or a URL
+ fetch_par() unless can_cc(); # use precompiled PAR only if necessary
+
+=item * Users will not notice anything, except now it works
+
+=over 4
+
+=item * Of course, you still need to type C<make par> and upload the precompiled package
+
+=item * PAR users can also install it directly with C<parl -i>
+
+=back
+
+=back
+
+
+
+=head2 Platform-specific Tips
+
+=over 4
+
+=item * Win32 and other icon-savvy platforms
+
+=over 4
+
+=item * Needs 3rd-party tools to add icons to C<pp>-generated executables
+
+=item * PE Header manipulation in Perl -- volunteers wanted!
+
+=back
+
+=item * Linux and other libc-based platforms
+
+=over 4
+
+=item * Try to avoid running C<pp> on a bleeding-edge version of the OS
+
+=item * Older versions with an earlier libc won't work with new ones
+
+=back
+
+=item * Solaris and other zlib-lacking platforms (but not Win32)
+
+=over 4
+
+=item * You need a static-linked C<Compress::Zlib> before installing PAR
+
+=item * In the future, PAR may depend on C<Compress::Zlib::Static> instead
+
+=back
+
+=item * Any platform with limited bandwidth or disk space
+
+=over 4
+
+=item * Use UPX to minimize the executable size
+
+=back
+
+=back
+
+
+
+=head2 Thank you!
+
+=over 4
+
+=item * Additional resources
+
+=over 4
+
+=item * Mailing list: C<par at perl.org>
+
+=item * Subscribe: Send a blank email to C<par-subscribe at perl.org>
+
+=item * List archive: L<http://nntp.x.perl.org/group/perl.par>
+
+=item * PAR::Intro: L<http://search.cpan.org/dist/PAR/lib/PAR/Intro.pod>
+
+=item * Apache::PAR: L<http://search.cpan.org/dist/Apache-PAR/>
+
+=item * Module::Install: L<http://search.cpan.org/dist/Module-Install/>
+
+=back
+
+=item * Any questions?
+
+=back
+
+
+
+=head2 Bonus Slides: PAR Internals
+
+
+
+=head2 Overview of PAR.pm's Implementation
+
+=over 4
+
+=item * Here begins the scary part
+
+=over 4
+
+=item * Grues, Dragons and Jabberwocks abound...
+
+=item * You are going to learn weird things about Perl internals
+
+=back
+
+=item * PAR invokes four areas of Perl arcana:
+
+=over 4
+
+=item * @INC code references
+
+=item * On-the-fly source filtering
+
+=item * Overriding C<DynaLoader::bootstrap()> to handle XS modules
+
+=item * Making self-bootstrapping binary executables
+
+=back
+
+=item * The first two only works on 5.6 or later
+
+=over 4
+
+=item * DynaLoader and C<%INC> are there since Perl 5 was born
+
+=item * PAR currently needs 5.6, but a 5.005 port is possible
+
+=back
+
+=back
+
+
+
+=head2 Code References in @INC
+
+=over 4
+
+=item * On 1999-07-19, Ken Fox submitted a patch to P5P
+
+=over 4
+
+=item * To _enable using remote modules_ by putting hooks in @INC
+
+=item * It's accepted to come in Perl 5.6, but undocumented until 5.8
+
+=item * Type C<perldoc -f require> to read the nitty-gritty details
+
+=back
+
+=item * Coderefs in @INC may return a fh, or undef to 'pass':
+
+ push @INC, sub {
+ my ($coderef, $filename) = @_; # $coderef is \&my_sub
+ open my $fh, "wget ftp://example.com/$filename |";
+ return $fh; # using remote modules, indeed!
+ };
+
+=item * Perl 5.8 let you open a file handle to a string, so we just use that:
+
+ open my $fh, '<', \($zip->memberNamed($filename)->contents);
+ return $fh;
+
+=item * But Perl 5.6 does not have that, and I don't want to use temp files...
+
+=back
+
+
+
+=head2 Source Filtering without Filter::* Modules
+
+=over 4
+
+=item * ... Undocumented features to the rescue!
+
+=over 4
+
+=item * It turns out that @INC hooks can return B<two> values
+
+=item * The first is still the file handle
+
+=item * The second is a code reference for line-by-line source filtering!
+
+=back
+
+=item * This is how C<Acme::use::strict::with::pride> works:
+
+ # Force all modules used to use strict and warnings
+ open my $fh, "<", $filename or return;
+ my @lines = ("use strict; use warnings;\n", "#line 1 \"$full\"\n");
+ return ($fh, sub {
+ return 0 unless @lines;
+ push @lines, $_; $_ = shift @lines; return length $_;
+ });
+
+=back
+
+
+
+=head2 Source Filtering without Filter::* Modules (cont.)
+
+=over 4
+
+=item * But we don't really have a filehandle for anything
+
+=item * Another undocumented feature saves the day!
+
+=item * We can actually omit the first return value altogether:
+
+ # Return all contents line-by-line from the file inside PAR
+ my @lines = split(
+ /(?<=\n)/,
+ $zip->memberNamed($filename)->contents
+ );
+ return (sub {
+ $_ = shift(@lines);
+ return length $_;
+ });
+
+=back
+
+
+
+=head2 Overriding DynaLoader::bootstrap
+
+=over 4
+
+=item * XS modules have dynamically loaded libraries
+
+=over 4
+
+=item * They cannot be loaded as part of a zip file, so we extract them out
+
+=item * Must intercept DynaLoader's library-finding process
+
+=back
+
+=item * Module names are passed to C<bootstrap> for XS loading
+
+=over 4
+
+=item * During the process, it calls C<dl_findfile> to locate the file
+
+=item * So we install pre-hooks around both functions
+
+=back
+
+=item * Our C<_bootstrap> just checks if the library is in PARs
+
+=over 4
+
+=item * If yes, extract it to a C<File::Temp> temp file
+
+=over 4
+
+=item * The file will be automatically cleaned up when the program ends
+
+=back
+
+=item * It then pass the arguments to the original C<bootstrap>
+
+=item * Finally, our C<dl_findfile> intercepts known filenames and return it
+
+=back
+
+=back
+
+
+
+=head2 Anatomy of a Self-Contained PAR executable
+
+=over 4
+
+=item * The par script ($0) itself
+
+=over 4
+
+=item * May be in plain-text or native executable format
+
+=back
+
+=item * Any number of embedded files
+
+=over 4
+
+=item * Typically used to bootstrap PAR's various dependencies
+
+=item * Each section begins with the magic string "FILE"
+
+=item * Length of filename in pack('N') format and the filename (auto/.../)
+
+=item * File length in pack('N') and the file's content (not compressed)
+
+=back
+
+=item * One PAR file
+
+=over 4
+
+=item * Just a regular zip file with the magic string C<"PK\003\004">
+
+=back
+
+=item * Ending section
+
+=over 4
+
+=item * A pack('N') number of the total length of FILE and PAR sections
+
+=item * Finally, there must be a 8-bytes magic string: C<"\012PAR.pm\012">
+
+=back
+
+=back
+
+
+
+=head2 Self-Bootstrapping Tricks
+
+=over 4
+
+=item * All we can expect is a working perl interpreter
+
+=over 4
+
+=item * The self-contained script *must not* use any modules at all
+
+=item * But to process PAR files, we need XS modules like Compress::Zlib
+
+=back
+
+=item * Answer: bundle all modules + libraries used by PAR.pm
+
+=over 4
+
+=item * That's what the C<FILE> section in the previous slide is for
+
+=item * Load modules to memory, and write object files to disk
+
+=item * Then use a local C<@INC> hook to load them on demand
+
+=back
+
+=item * Minimizing the amount of temporary files
+
+=over 4
+
+=item * First, try to load PerlIO::scalar and File::Temp
+
+=item * Set up an END hook to unlink all temp files up to this point
+
+=item * Load other bundled files, and look in the compressed PAR section
+
+=item * This can be much easier with a pure-perl C<inflate()>; patches welcome!
+
+=back
+
+=back
+
+
+
+=head2 Thank you (again)!
+
+=over 4
+
+=item * Any questions, I<please>?
+
+=back
+
+
+=cut
+
+
+=head1 SEE ALSO
+
+L<http://www.autrijus.org/par-tutorial/>
+
+L<http://www.autrijus.org/par-intro/> (English version)
+
+L<http://www.autrijus.org/par-intro.zh/> (Chinese version)
+
+L<PAR>, L<pp>, L<par.pl>, L<parl>
+
+L<ex::lib::zip>, L<Acme::use::strict::with::pride>
+
+L<App::Packer>, L<Apache::PAR>, L<CPANPLUS>, L<Module::Install>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This document is free documentation; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/lib/PAR.pm
===================================================================
--- packages/libpar-perl/branches/upstream/current/lib/PAR.pm 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/lib/PAR.pm 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,618 @@
+package PAR;
+$PAR::VERSION = '0.90';
+
+use 5.006;
+use strict;
+use warnings;
+use Config '%Config';
+
+=head1 NAME
+
+PAR - Perl Archive Toolkit
+
+=head1 VERSION
+
+This document describes version 0.90 of PAR, released November 25, 2005.
+
+=head1 SYNOPSIS
+
+(If you want to make an executable that contains all module, scripts and
+data files, please consult the bundled L<pp> utility instead.)
+
+Following examples assume a F<foo.par> file in Zip format; support for
+compressed tar (F<*.tgz>/F<*.tbz2>) format is under consideration.
+
+To use F<Hello.pm> from F<./foo.par>:
+
+ % perl -MPAR=./foo.par -MHello
+ % perl -MPAR=./foo -MHello # the .par part is optional
+
+Same thing, but search F<foo.par> in the C<@INC>;
+
+ % perl -MPAR -Ifoo.par -MHello
+ % perl -MPAR -Ifoo -MHello # ditto
+
+Following paths inside the PAR file are searched:
+
+ /lib/
+ /arch/
+ /i386-freebsd/ # i.e. $Config{archname}
+ /5.8.0/ # i.e. $Config{version}
+ /5.8.0/i386-freebsd/ # both of the above
+ /
+
+PAR files may also (recursively) contain other PAR files.
+All files under following paths will be considered as PAR
+files and searched as well:
+
+ /par/i386-freebsd/ # i.e. $Config{archname}
+ /par/5.8.0/ # i.e. $Config{version}
+ /par/5.8.0/i386-freebsd/ # both of the above
+ /par/
+
+Run F<script/test.pl> or F<test.pl> from F<foo.par>:
+
+ % perl -MPAR foo.par test.pl # only when $0 ends in '.par'
+
+However, if the F<.par> archive contains either F<script/main.pl> or
+F<main.pl>, then it is used instead:
+
+ % perl -MPAR foo.par test.pl # runs main.pl; @ARGV is 'test.pl'
+
+Use in a program:
+
+ use PAR 'foo.par';
+ use Hello; # reads within foo.par
+
+ # PAR::read_file() returns a file inside any loaded PARs
+ my $conf = PAR::read_file('data/MyConfig.yaml');
+
+ # PAR::par_handle() returns an Archive::Zip handle
+ my $zip = PAR::par_handle('foo.par')
+ my $src = $zip->memberNamed('lib/Hello.pm')->contents;
+
+You can also use wildcard characters:
+
+ use PAR '/home/foo/*.par'; # loads all PAR files in that directory
+
+=head1 DESCRIPTION
+
+This module lets you easily bundle a typical F<blib/> tree into a zip
+file, called a Perl Archive, or C<PAR>.
+
+It supports loading XS modules by overriding B<DynaLoader> bootstrapping
+methods; it writes shared object file to a temporary file at the time it
+is needed.
+
+To generate a F<.par> file, all you have to do is compress the modules
+under F<arch/> and F<lib/>, e.g.:
+
+ % perl Makefile.PL
+ % make
+ % cd blib
+ % zip -r mymodule.par arch/ lib/
+
+Afterward, you can just use F<mymodule.par> anywhere in your C<@INC>,
+use B<PAR>, and it will Just Work.
+
+For convenience, you can set the C<PERL5OPT> environment variable to
+C<-MPAR> to enable C<PAR> processing globally (the overhead is small
+if not used); setting it to C<-MPAR=/path/to/mylib.par> will load a
+specific PAR file. Alternatively, consider using the F<par.pl> utility
+bundled with this module, or using the self-contained F<parl> utility
+on machines without PAR.pm installed.
+
+Note that self-containing scripts and executables created with F<par.pl>
+and F<pp> may also be used as F<.par> archives:
+
+ % pp -o packed.exe source.pl # generate packed.exe
+ % perl -MPAR=packed.exe other.pl # this also works
+ % perl -MPAR -Ipacked.exe other.pl # ditto
+
+Please see L</SYNOPSIS> for most typical use cases.
+
+=head1 NOTES
+
+Settings in F<META.yml> packed inside the PAR file may affect PAR's
+operation. For example, F<pp> provides the C<-C> (C<--clean>) option
+to control the default behavior of temporary file creation.
+
+Currently, F<pp>-generated PAR files may attach four PAR-specific
+attributes in F<META.yml>:
+
+ par:
+ clean: 0 # default value of PAR_CLEAN
+ signature: '' # key ID of the SIGNATURE file
+ verbatim: 0 # was packed prerequisite's PODs preserved?
+ version: x.xx # PAR.pm version that generated this PAR
+
+User-defined environment variables, like I<PAR_CLEAN>, always
+overrides the ones set in F<META.yml>. The algorithm for generating
+caching/temporary directory is as follows:
+
+=over 4
+
+=item *
+
+If I<PAR_GLOBAL_TEMP> is specified, use it as the cache directory for
+extracted libraries, and do not clean it up after execution.
+
+=item *
+
+If I<PAR_GLOBAL_TEMP> is not set, but I<PAR_CLEAN> is specified, set
+I<PAR_GLOBAL_TEMP> to C<I<TEMP>\par-I<USER>\temp-I<PID>\>, cleaning it
+after execution.
+
+=item *
+
+If both are not set, use C<I<TEMP>\par-I<USER>\temp-I<MTIME>\>
+as the I<PAR_GLOBAL_TEMP>, reusing any existing files inside. I<MTIME>
+is the last-modified timestamp of the program.
+
+=back
+
+=cut
+
+use vars qw(@PAR_INC); # explicitly stated PAR library files
+use vars qw(%PAR_INC); # sets {$par}{$file} for require'd modules
+use vars qw(@LibCache %LibCache); # I really miss pseudohash.
+use vars qw($LastAccessedPAR $LastTempFile);
+
+my $ver = $Config{version};
+my $arch = $Config{archname};
+my $progname = $ENV{PAR_PROGNAME} || $0;
+my $is_insensitive_fs = (
+ -s $progname
+ and (-s lc($progname) || -1) == (-s uc($progname) || -1)
+ and (-s lc($progname) || -1) == -s $progname
+);
+my $par_temp;
+
+sub import {
+ my $class = shift;
+
+ _set_progname();
+ _set_par_temp();
+
+ $progname = $ENV{PAR_PROGNAME} ||= $0;
+ $is_insensitive_fs = (-s $progname and (-s lc($progname) || -1) == (-s uc($progname) || -1));
+
+ foreach my $par (@_) {
+ if ($par =~ /[?*{}\[\]]/) {
+ require File::Glob;
+ foreach my $matched (File::Glob::glob($par)) {
+ push @PAR_INC, unpar($matched, undef, undef, 1);
+ }
+ next;
+ }
+
+ push @PAR_INC, unpar($par, undef, undef, 1);
+ }
+
+ return if $PAR::__import;
+ local $PAR::__import = 1;
+
+ unshift @INC, \&find_par unless grep { $_ eq \&find_par } @INC;
+
+ require PAR::Heavy;
+ PAR::Heavy::_init_dynaloader();
+
+ if (unpar($progname)) {
+ # XXX - handle META.yml here!
+ push @PAR_INC, unpar($progname, undef, undef, 1);
+
+ _extract_inc($progname) unless $ENV{PAR_CLEAN};
+
+ my $zip = $LibCache{$progname};
+ my $member = _first_member( $zip,
+ "script/main.pl",
+ "main.pl",
+ );
+
+ # finally take $ARGV[0] as the hint for file to run
+ if (defined $ARGV[0] and !$member) {
+ $member = _first_member( $zip,
+ "script/$ARGV[0]",
+ "script/$ARGV[0].pl",
+ $ARGV[0],
+ "$ARGV[0].pl",
+ ) or die qq(Can't open perl script "$ARGV[0]": No such file or directory);
+ shift @ARGV;
+ }
+ elsif (!$member) {
+ die "Usage: $0 script_file_name.\n";
+ }
+
+ _run_member($member);
+ }
+}
+
+sub _first_member {
+ my $zip = shift;
+ my %names = map { ( $_->fileName => $_ ) } $zip->members;
+ my %lc_names = map { ( lc($_->fileName) => $_ ) } $zip->members;
+ foreach my $name (@_) {
+ return $names{$name} if $names{$name};
+ return $lc_names{lc($name)} if $is_insensitive_fs and $lc_names{lc($name)};
+ }
+ return;
+}
+
+sub _run_member {
+ my $member = shift;
+ my $clear_stack = shift;
+ my ($fh, $is_new, $filename) = _tempfile($member->crc32String . ".pl");
+
+ if ($is_new) {
+ my $file = $member->fileName;
+ print $fh "package main; shift \@INC;\n";
+ if (defined &Internals::PAR::CLEARSTACK and $clear_stack) {
+ print $fh "Internals::PAR::CLEARSTACK();\n";
+ }
+ print $fh "#line 1 \"$file\"\n";
+ $member->extractToFileHandle($fh);
+ seek ($fh, 0, 0);
+ }
+
+ unshift @INC, sub { $fh };
+
+ $ENV{PAR_0} = $filename; # for Pod::Usage
+ { do 'main';
+ CORE::exit($1) if ($@ =~/^_TK_EXIT_\((\d+)\)/);
+ die $@ if $@;
+ exit;
+ }
+}
+
+sub _extract_inc {
+ my $file = shift;
+ my $inc = "$par_temp/inc";
+ my $dlext = do {
+ require Config;
+ (defined %Config::Config) ? $Config::Config{dlext} : '';
+ };
+
+ if (!-d $inc) {
+ for (1 .. 10) { mkdir("$inc.lock", 0755) and last; sleep 1 }
+
+ open my $fh, '<', $file or die "Cannot find '$file': $!";
+ binmode($fh);
+ bless($fh, 'IO::File');
+
+ my $zip = Archive::Zip->new;
+ ( $zip->readFromFileHandle($fh, $file) == Archive::Zip::AZ_OK() )
+ or die "Read '$file' error: $!";
+
+ for ( $zip->memberNames() ) {
+ next if m{\.\Q$dlext\E[^/]*$};
+ s{^/}{};
+ $zip->extractMember($_, "$inc/" . $_);
+ }
+ rmdir("$inc.lock");
+ }
+
+ unshift @INC, grep -d, map join('/', $inc, @$_),
+ [ 'lib' ], [ 'arch' ], [ $arch ], [ $ver ], [ $ver, $arch ], [];
+}
+
+sub find_par {
+ my ($self, $file, $member_only) = @_;
+
+ my $scheme;
+ foreach (@PAR_INC ? @PAR_INC : @INC) {
+ my $path = $_;
+ if ($[ < 5.008001) {
+ # reassemble from "perl -Ischeme://path" autosplitting
+ $path = "$scheme:$path" if !@PAR_INC
+ and $path and $path =~ m!//!
+ and $scheme and $scheme =~ /^\w+$/;
+ $scheme = $path;
+ }
+ my $rv = unpar($path, $file, $member_only, 1) or next;
+ $PAR_INC{$path}{$file} = 1;
+ $INC{$file} = $LastTempFile if (lc($file) =~ /^(?!tk).*\.pm$/);
+ return $rv;
+ }
+
+ return;
+}
+
+sub reload_libs {
+ my @par_files = @_;
+ @par_files = sort keys %LibCache unless @par_files;
+
+ foreach my $par (@par_files) {
+ my $inc_ref = $PAR_INC{$par} or next;
+ delete $LibCache{$par};
+ foreach my $file (sort keys %$inc_ref) {
+ delete $INC{$file};
+ require $file;
+ }
+ }
+}
+
+sub read_file {
+ my $file = pop;
+
+ foreach my $zip (@LibCache) {
+ my $member = _first_member($zip, $file) or next;
+ return scalar $member->contents;
+ }
+
+ return;
+}
+
+sub par_handle {
+ my $par = pop;
+ return $LibCache{$par};
+}
+
+my %escapes;
+sub unpar {
+ my ($par, $file, $member_only, $allow_other_ext) = @_;
+ my $zip = $LibCache{$par};
+ my @rv = $par;
+
+ return if $PAR::__unpar;
+ local $PAR::__unpar = 1;
+
+ unless ($zip) {
+ if ($par =~ m!^\w+://!) {
+ require File::Spec;
+ require LWP::Simple;
+
+ # reflector support
+ $par .= "pm=$file" if $par =~ /[?&;]/;
+
+ $ENV{PAR_CACHE} ||= '_par';
+ mkdir $ENV{PAR_CACHE}, 0777;
+ if (!-d $ENV{PAR_CACHE}) {
+ $ENV{PAR_CACHE} = File::Spec->catdir(File::Spec->tmpdir, 'par');
+ mkdir $ENV{PAR_CACHE}, 0777;
+ return unless -d $ENV{PAR_CACHE};
+ }
+
+ my $file = $par;
+ if (!%escapes) {
+ $escapes{chr($_)} = sprintf("%%%02X", $_) for 0..255;
+ }
+ {
+ use bytes;
+ $file =~ s/([^\w\.])/$escapes{$1}/g;
+ }
+ $file = File::Spec->catfile( $ENV{PAR_CACHE}, $file);
+ LWP::Simple::mirror( $par, $file );
+ return unless -e $file;
+ $par = $file;
+ }
+ elsif (ref($par) eq 'SCALAR') {
+ my ($fh) = _tempfile();
+ print $fh $$par;
+ $par = $fh;
+ }
+ elsif (!(($allow_other_ext or $par =~ /\.par\z/i) and -f $par)) {
+ $par .= ".par";
+ return unless -f $par;
+ }
+
+ require Archive::Zip;
+ $zip = Archive::Zip->new;
+
+ my @file;
+ if (!ref $par) {
+ @file = $par;
+
+ open my $fh, '<', $par;
+ binmode($fh);
+
+ $par = $fh;
+ bless($par, 'IO::File');
+ }
+
+ Archive::Zip::setErrorHandler(sub {});
+ my $rv = $zip->readFromFileHandle($par, @file);
+ Archive::Zip::setErrorHandler(undef);
+ return unless $rv == Archive::Zip::AZ_OK();
+
+ push @LibCache, $zip;
+ $LibCache{$_[0]} = $zip;
+
+ foreach my $member ( $zip->membersMatching(
+ "^par/(?:$Config{version}/)?(?:$Config{archname}/)?"
+ ) ) {
+ next if $member->isDirectory;
+ my $content = $member->contents();
+ next unless $content =~ /^PK\003\004/;
+ push @rv, unpar(\$content, undef, undef, 1);
+ }
+ }
+
+ $LastAccessedPAR = $zip;
+
+ return @rv unless defined $file;
+
+ my $member = _first_member($zip,
+ "lib/$file",
+ "arch/$file",
+ "$arch/$file",
+ "$ver/$file",
+ "$ver/$arch/$file",
+ $file,
+ ) or return;
+
+ return $member if $member_only;
+
+ my ($fh, $is_new);
+ ($fh, $is_new, $LastTempFile) = _tempfile($member->crc32String . ".pm");
+ die "Bad Things Happened..." unless $fh;
+
+ if ($is_new) {
+ $member->extractToFileHandle($fh);
+ seek ($fh, 0, 0);
+ }
+
+ return $fh;
+}
+
+# The C version of this code appears in myldr/mktmpdir.c
+sub _set_par_temp {
+ if ($ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/) {
+ $par_temp = $1;
+ return;
+ }
+
+ require File::Spec;
+
+ foreach my $path (
+ (map $ENV{$_}, qw( TMPDIR TEMP TMP )),
+ qw( C:\\TEMP /tmp . )
+ ) {
+ next unless $path and -d $path and -w $path;
+ my $username = defined(&Win32::LoginName)
+ ? &Win32::LoginName()
+ : $ENV{USERNAME} || $ENV{USER} || 'SYSTEM';
+ $username =~ s/\W/_/g;
+
+ my $stmpdir = File::Spec->catdir($path, "par-$username");
+ mkdir $stmpdir, 0755;
+ if (!$ENV{PAR_CLEAN} and my $mtime = (stat($progname))[9]) {
+ my $ctx = eval { require Digest::SHA; Digest::SHA->new(1) }
+ || eval { require Digest::SHA1; Digest::SHA1->new }
+ || eval { require Digest::MD5; Digest::MD5->new };
+
+ if ($ctx and open(my $fh, "<$progname")) {
+ binmode($fh);
+ $ctx->addfile($fh);
+ close($fh);
+ }
+
+ $stmpdir = File::Spec->catdir(
+ $stmpdir,
+ "cache-" . ( $ctx ? $ctx->hexdigest : $mtime )
+ );
+ }
+ else {
+ $ENV{PAR_CLEAN} = 1;
+ $stmpdir = File::Spec->catdir($stmpdir, "temp-$$");
+ }
+
+ $ENV{PAR_TEMP} = $stmpdir;
+ mkdir $stmpdir, 0755;
+ last;
+ }
+
+ $par_temp = $1 if $ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/;
+}
+
+sub _tempfile {
+ my ($fh, $filename);
+ if ($ENV{PAR_CLEAN} or !@_) {
+ require File::Temp;
+
+ if (defined &File::Temp::tempfile) {
+ # under Win32, the file is created with O_TEMPORARY,
+ # and will be deleted by the C runtime; having File::Temp
+ # delete it has the only effect of giving ugly warnings
+ ($fh, $filename) = File::Temp::tempfile(
+ DIR => $par_temp,
+ UNLINK => ($^O ne 'MSWin32'),
+ ) or die "Cannot create temporary file: $!";
+ binmode($fh);
+ return ($fh, 1, $filename);
+ }
+ }
+
+ require File::Spec;
+
+ # untainting tempfile path
+ local $_ = File::Spec->catfile( $par_temp, $_[0] );
+ /^(.+)$/ and $filename = $1;
+
+ if (-r $filename) {
+ open $fh, '<', $filename or die $!;
+ binmode($fh);
+ return ($fh, 0, $filename);
+ }
+
+ open $fh, '+>', $filename or die $!;
+ binmode($fh);
+ return ($fh, 1, $filename);
+}
+
+sub _set_progname {
+ require File::Spec;
+
+ if ($ENV{PAR_PROGNAME} and $ENV{PAR_PROGNAME} =~ /(.+)/) {
+ $progname = $1;
+ }
+ $progname ||= $0;
+
+ if (( () = File::Spec->splitdir($progname) ) > 1 or !$ENV{PAR_PROGNAME}) {
+ if (open my $fh, $progname) {
+ return if -s $fh;
+ }
+ if (-s "$progname$Config{_exe}") {
+ $progname .= $Config{_exe};
+ return;
+ }
+ }
+
+ foreach my $dir (split /\Q$Config{path_sep}\E/, $ENV{PATH}) {
+ next if exists $ENV{PAR_TEMP} and $dir eq $ENV{PAR_TEMP};
+ my $name = File::Spec->catfile($dir, "$progname$Config{_exe}");
+ if (-s $name) { $progname = $name; last }
+ $name = File::Spec->catfile($dir, "$progname");
+ if (-s $name) { $progname = $name; last }
+ }
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR::Tutorial>, L<PAR::FAQ>
+
+L<par.pl>, L<parl>, L<pp>
+
+L<Archive::Zip>, L<perlfunc/require>
+
+L<ex::lib::zip>, L<Acme::use::strict::with::pride>
+
+=head1 ACKNOWLEDGMENTS
+
+Nicholas Clark for pointing out the mad source filter hook within the
+(also mad) coderef C<@INC> hook, as well as (even madder) tricks one
+can play with PerlIO to avoid source filtering.
+
+Ton Hospel for convincing me to ditch the C<Filter::Simple>
+implementation.
+
+Uri Guttman for suggesting C<read_file> and C<par_handle> interfaces.
+
+Antti Lankila for making me implement the self-contained executable
+options via C<par.pl -O>.
+
+See the F<AUTHORS> file in the distribution for a list of people who
+have sent helpful patches, ideas or comments.
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004, 2005 by Autrijus Tang
+E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: packages/libpar-perl/branches/upstream/current/myldr/Makefile.PL
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/Makefile.PL 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/Makefile.PL 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,234 @@
+#!/usr/bin/perl -w
+# Copyright 2002, 2003, 2004, 2005 by Autrijus 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 Config;
+use File::Spec;
+use ExtUtils::Embed;
+use DynaLoader;
+use File::Basename;
+
+xsinit(undef);
+
+my $debug = $ENV{DEBUG};
+my $chunk_size = 30000;
+my $perl = $^X;
+my $exe = $Config{_exe};
+my $link_exe = (($^O eq 'os2' and $Config{ldflags} =~ /-Zexe/) ? '' : $exe);
+my $o = $Config{obj_ext};
+my $gccversion = $Config{gccversion};
+my $pccflags = ccopts();
+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)$/);
+
+my $f2c = File::Spec->catfile('.', "file2c.pl");
+my $par_pl = File::Spec->catfile('..', 'script', "par.pl");
+my $par_exe = File::Spec->catfile('.', "par$exe");
+my $par_exe_link = File::Spec->catfile('.', "par$link_exe");
+my $static_exe = File::Spec->catfile('.', "static$exe");
+my $static_exe_link = File::Spec->catfile('.', "static$link_exe");
+my $parl_exe = File::Spec->catfile('..', 'script', "parl$exe");
+my $parldyn_exe = File::Spec->catfile('..', 'script', "parldyn$exe");
+my $lib_path = join(' ', map qq(-I"$_"), @INC);
+
+my( $out, $ccdebug, $lddebug, $warn, $rm, $mv, $res, $long_literal );
+
+if( $cc =~ m/^cl\b/i ) {
+ $out = '-out:';
+ $ccdebug = $debug ? '-Zi -Zm1000 ' : '-Zm1000 ';
+ $lddebug = $debug ? '-debug ' : '-release ';
+ $warn = $debug ? '-W3' : '';
+ $res = 'win32.obj';
+ $long_literal = 0;
+} elsif ($cc =~ m/^gcc\b/i or ($cc =~ m/^cc\b/i and $gccversion)) {
+ $out = '--output ';
+ $ccdebug = $debug ? '-g ' : '';
+ $lddebug = ($debug or $^O eq 'darwin') ? '' : '-s ';
+ $warn = $debug ? '-Wall -Wno-comments ' : '';
+ $res = ($^O =~ /^(?:MSWin|cygwin)/) ? 'win32.coff' : '';
+ $long_literal = 1;
+} else {
+ $out = '-o ';
+ $ccdebug = '';
+ $lddebug = '';
+ $warn = '';
+ $res = '';
+ $long_literal = 0; # better safe than sorry
+}
+
+
+my $cflags = "$ccdebug$warn$pccflags";
+my $ldflags = "$lddebug$pldflags";
+my $static_ldflags = $ldflags;
+
+$static_ldflags =~ s/\s+-lperl\s+/ /g;
+
+my $libperl;
+
+if ($dynperl and $^O eq 'os2') {
+ $libperl = OS2::DLLname();
+}
+elsif ($dynperl) {
+ 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}/;
+
+ my @paths = (
+ $Config{bin},
+ File::Spec->catdir($Config{'archlibexp'}, 'CORE'),
+ split(/\Q$Config{path_sep}\E/, $ENV{$Config{ldlibpthname}} || ''),
+ split(/ /, $Config{libpth}),
+ );
+
+ if ($libperl = DynaLoader::dl_findfile("-lperl")) {
+ if (-l $libperl) {
+ my $realpath = readlink($libperl);
+ if (!File::Spec->file_name_is_absolute($realpath)) {
+ $realpath = File::Spec->rel2abs(
+ File::Spec->catfile(
+ dirname($libperl) => $realpath
+ )
+ );
+ }
+ $libperl = $realpath;
+ }
+ @paths = () if $libperl and -e $libperl;
+ }
+
+ foreach my $path (@paths) {
+ $libperl = File::Spec->catfile($path, $file);
+ last if -e $libperl;
+
+ # for MinGW
+ $libperl = File::Spec->catfile($path, $1) if $file =~ /^lib(.+)/;
+ last if -e $libperl;
+
+ # for Cygwin
+ $libperl = File::Spec->catfile($path, $file.$Config{_a});
+ last if -e $libperl;
+ }
+
+ # die "Can't find $file in (@paths) -- please contact the author!"
+ # unless -e $libperl;
+ undef $dynperl if !-e $libperl;
+}
+else {
+ $ldflags = $static_ldflags;
+}
+
+my $par = (($dynperl && $^O ne 'os2') ? $static_exe : $par_exe);
+my $all = ($dynperl ? "$parl_exe $parldyn_exe" : $parl_exe);
+
+$perl = Win32::GetShortPathName($perl)
+ if $perl =~ / / and defined &Win32::GetShortPathName;
+
+print "Writing Makefile for the par$exe program\n";
+
+open OUT, "> Makefile" or die "open 'Makefile': $!";
+
+$rm = $^O eq 'MSWin32' ? '$(PERL) -MExtUtils::Command -e rm_f' : 'rm -f';
+$mv = $^O eq 'MSWin32' ? '$(PERL) -MExtUtils::Command -e mv' : 'mv';
+
+# XXX - Commented out this chunk (rt.cpan #16075)
+# not sure what the condition was testing against - disabled for now.
+# if (-e $par_exe and not -s $par_exe) {
+# print OUT "all ::\n\t$^X -e1\n";
+# }
+# else {
+ print OUT << "EOT";
+# AUTOGENERATED, DO NOT EDIT, RERUN Makefile.PL
+
+RM=$rm
+MV=$mv
+PERL=$perl
+LD=$ld
+CC=$cc
+CFLAGS=$cflags
+LDFLAGS=$Config{ldflags}
+PERL_LDFLAGS=$ldflags
+STATIC_LDFLAGS=$static_ldflags
+NOOP=\$(PERL) -e1
+
+OBJECTS=main$o my_par_pl$o $res
+
+.c$o:
+ \$(CC) -c \$(CFLAGS) \$<
+
+all: $all
+
+clean:
+ -\$(RM) my_*.c
+ -\$(RM) main$o my_par_pl$o static$o
+ -\$(RM) sha1$o sha1.c
+ -\$(RM) *.opt *.pdb perlxsi.c
+ \$(MV) Makefile Makefile.old
+
+realclean: clean
+ -\$(RM) $par_exe
+ -\$(RM) $parl_exe
+ -\$(RM) $static_exe
+ -\$(RM) Makefile Makefile.old
+
+distclean: clean
+ -\$(RM) $par_exe
+ -\$(RM) $parl_exe
+ -\$(RM) $static_exe
+ -\$(RM) Makefile Makefile.old
+
+$par_exe: sha1$o \$(OBJECTS) my_par_pl$o
+ \$(LD) \$(OBJECTS) \$(PERL_LDFLAGS) $out$par_exe_link
+
+my_par_pl.c: $par_pl
+ \$(PERL) $f2c $par_pl \$@ load_me_2 $long_literal
+
+$parl_exe: $par
+ $par $lib_path -I../myldr/.. -I../blib/lib -q -B -O\$@
+
+disttest:
+ -\$(NOOP)
+
+test:
+ -\$(NOOP)
+
+.DEFAULT:
+ -\$(NOOP)
+
+.SUFFIXES: $o
+
+sha1.c: sha1.c.PL
+ \$(PERL) sha1.c.PL sha1.c
+
+EOT
+
+ print OUT << "EOT" if $dynperl;
+
+$parldyn_exe: $par_exe
+ $par_exe -I../myldr/.. -I../blib/lib $lib_path -q -B -O\$@
+
+$static_exe: sha1$o my_perl.c my_par.c static$o
+ \$(LD) static$o \$(STATIC_LDFLAGS) $res $out$static_exe_link
+ \$(PERL) parlsig.pl $static_exe $par_exe $dynperl $chunk_size
+
+my_perl.c:
+ \$(PERL) $f2c $libperl \$@ load_me_0 $long_literal $chunk_size
+
+my_par.c: $par_exe
+ \$(PERL) $f2c $par_exe \$@ load_me_1 $long_literal $chunk_size
+
+EOT
+# }
+
+# local variables:
+# mode: cperl
+# end:
Added: packages/libpar-perl/branches/upstream/current/myldr/env.c
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/env.c 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/env.c 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,157 @@
+/*
+ * 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 <stdlib.h>
+#include <string.h>
+
+/*
+ * __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 char *name;
+ int *offset;
+{
+ extern char **environ;
+ register int len;
+ register 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 char *value;
+{
+ extern char **environ;
+ static int alloced = 0; /* if allocated space before */
+ register char *c;
+ unsigned int l_value, 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);
+}
+
+/*
+ * unsetenv(name) --
+ * Delete environmental variable "name".
+ */
+static void
+par_unsetenv(name)
+ const char *name;
+{
+ 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;
+}
Added: packages/libpar-perl/branches/upstream/current/myldr/file2c.pl
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/file2c.pl 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/file2c.pl 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,127 @@
+#!/usr/bin/perl -w
+
+# Copyright (c) 2002 Mattia Barbon.
+# Copyright (c) 2002 Autrijus Tang.
+# This package is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use File::Basename;
+use PAR::Filter::PodStrip;
+
+my $give_help = 0;
+my $pl_file = shift;
+my $c_file = shift;
+my $c_var = shift;
+my $long_literal = shift;
+my $chunk_size = shift;
+
+$give_help ||= ( !defined $pl_file or
+ !defined $c_file or
+ !defined $c_var );
+$pl_file ||= '';
+$c_file ||= '';
+$give_help ||= !-e $pl_file;
+if( $give_help ) {
+ print <<EOT;
+Usage: $0 file.pl file.c c_variable
+EOT
+
+ exit 1;
+}
+
+open IN, "< $pl_file" or die "open '$pl_file': $!";
+open OUT, "> $c_file" or die "open '$c_file': $!";
+binmode IN; binmode OUT;
+
+# read perl file
+undef $/;
+my $pl_text = <IN>;
+close IN;
+
+PAR::Filter::PodStrip->new->apply(\$pl_text)
+ if -e $pl_file and $pl_file =~ /\.p[lm]/i;
+
+# make a c-array
+
+print OUT "const char * name_$c_var = \"" . basename($pl_file) . "\";\n";
+
+if (!$chunk_size) {
+ print_chunk($pl_text, '');
+ print OUT "#define WRITE_$c_var(i) write(i, $c_var, (size_t)size_$c_var);\n";
+}
+else {
+ my $chunk_count = int(length($pl_text) / $chunk_size) + 1;
+ print OUT "unsigned long size_$c_var = " . length($pl_text) . ";\n";
+
+ for (1 .. $chunk_count) {
+ print_chunk( substr($pl_text, ($_ - 1) * $chunk_size, $chunk_size), "_$_" );
+ }
+
+ print OUT "#define WRITE_$c_var(i)";
+ for (1 .. $chunk_count) {
+ print OUT " write(i, ${c_var}_$_, (size_t)size_${c_var}_$_);";
+ }
+ print OUT "\n";
+}
+close OUT;
+
+sub print_chunk {
+ my $text = reverse($_[0]);
+ my $suffix = $_[1];
+
+ print OUT "unsigned long size_$c_var$suffix = " . length($text) . ";\n";
+ print OUT "const char $c_var$suffix\[" . (length($text) + 1) . "] = ";
+ print OUT $long_literal ? '"' : '{';
+
+ my $i;
+ for (1 .. length($text)) {
+ if ($long_literal) {
+ print OUT sprintf '\%03o', ord(chop($text));
+ }
+ else {
+ print OUT sprintf "'\\%03o',", ord(chop($text));
+ print OUT "\n" unless $i++ % 16;
+ }
+ }
+
+ print OUT $long_literal ? "\";\n" : "0\n};\n";
+}
+
+sub pod_strip {
+ my ($pl_text, $filename) = @_;
+
+ local $^W;
+
+ my $data = '';
+ $data = $1 if $pl_text =~ s/((?:^__DATA__\r?\n).*)//ms;
+
+ my $line = 1;
+ if ($pl_text =~ /^=(?:head\d|pod|begin|item|over|for|back|end)\b/) {
+ $pl_text = "\n$pl_text";
+ $line--;
+ }
+ $pl_text =~ s{(
+ (.*?\n)
+ =(?:head\d|pod|begin|item|over|for|back|end)\b
+ .*?\n
+ (?:=cut[\t ]*[\r\n]*?|\Z)
+ (\r?\n)?
+ )}{
+ my ($pre, $post) = ($2, $3);
+ "$pre#line " . (
+ $line += ( () = ( $1 =~ /\n/g ) )
+ ) . $post;
+ }gsex;
+ $pl_text = '#line 1 "' . ($filename) . "\"\n" . $pl_text
+ if length $filename;
+ $pl_text =~ s/^#line 1 (.*\n)(#!.*\n)/$2#line 2 $1/g;
+
+ return $pl_text . $data;
+}
+
+# local variables:
+# mode: cperl
+# end:
Added: packages/libpar-perl/branches/upstream/current/myldr/internals.c
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/internals.c 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/internals.c 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,114 @@
+static void par_redo_stack (pTHX_ void *data) {
+ PUSHEVAL((&cxstack[0]) , "", Nullgv);
+}
+
+XS(XS_Internals_PAR_CLEARSTACK) {
+ dounwind(-1);
+ SAVEDESTRUCTOR_X(par_redo_stack, 0);
+}
+
+XS(XS_Internals_PAR_BOOT) {
+ GV* tmpgv;
+ AV* tmpav;
+ SV** svp;
+ int i;
+ int ok = 0;
+ char *buf;
+
+ TAINT;
+
+ if (!(buf = par_getenv("PAR_INITIALIZED")) || buf[0] != '1' || buf[1] != '\0') {
+ par_init_env();
+ }
+
+ 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++) {
+ 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 */
+ if ( ( stmpdir = par_getenv("PAR_TEMP") ) ) {
+ sv_setpv(GvSV(tmpgv), fakeargv[0]);
+ }
+ else {
+#ifdef HAS_PROCSELFEXE
+ S_procself_val(aTHX_ GvSV(tmpgv), fakeargv[0]);
+#else
+#ifdef OS2
+ sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
+#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 and later perl versions no longer copies 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
+ }
+
+ TAINT_NOT;
+
+ /* PL_main_cv = PL_compcv; */
+ PL_compcv = 0;
+
+ /* create temporary PAR directory */
+ stmpdir = par_getenv("PAR_TEMP");
+ if ( stmpdir == NULL ) {
+ stmpdir = par_mktmpdir( fakeargv );
+#ifndef WIN32
+ i = execvp(SvPV_nolen(GvSV(tmpgv)), fakeargv);
+ croak("%s: execution of %s failed - aborting with %i.\n", fakeargv[0], SvPV_nolen(GvSV(tmpgv)), i);
+ return;
+#endif
+ }
+
+ i = PerlDir_mkdir(stmpdir, 0755);
+ if ( (i != 0) && (i != EEXIST) && (i != -1) ) {
+ croak("%s: creation of private temporary subdirectory %s failed - aborting with %i.\n", fakeargv[0], stmpdir, i);
+ return;
+ }
+}
+
+static void par_xs_init(pTHX)
+{
+ xs_init(aTHX);
+ newXSproto("Internals::PAR::BOOT", XS_Internals_PAR_BOOT, "", "");
+#ifdef PAR_CLEARSTACK
+ newXSproto("Internals::PAR::CLEARSTACK", XS_Internals_PAR_CLEARSTACK, "", "");
+#endif
+}
Added: packages/libpar-perl/branches/upstream/current/myldr/main.c
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/main.c 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/main.c 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,147 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "perlxsi.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;
+extern char * name_load_me_2;
+extern unsigned long size_load_me_2;
+extern char load_me_2[];
+
+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;
+
+#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 ALLOW_PERL_OPTIONS
+#define EXTRA_OPTIONS 3
+#else
+#define EXTRA_OPTIONS 4
+#endif /* ALLOW_PERL_OPTIONS */
+ New(666, fakeargv, argc + EXTRA_OPTIONS + 1, char *);
+
+ fakeargv[0] = argv[0];
+ fakeargv[1] = "-e";
+ fakeargv[2] = load_me_2;
+ options_count = 3;
+
+#ifndef ALLOW_PERL_OPTIONS
+ fakeargv[options_count] = "--";
+ ++options_count;
+#endif /* ALLOW_PERL_OPTIONS */
+
+ for (i = 1; i < argc; i++)
+ fakeargv[i + options_count - 1] = argv[i];
+ fakeargv[argc + options_count - 1] = 0;
+
+ exitstatus = perl_parse(my_perl, par_xs_init, argc + options_count - 1,
+ fakeargv, (char **)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;
+}
Added: packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.c
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.c 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.c 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,288 @@
+#include "mktmpdir.h"
+
+#define PAR_TEMP "PAR_TEMP"
+
+#ifdef O_BINARY
+# define OPEN_O_BINARY O_BINARY
+#else
+# define OPEN_O_BINARY 0
+#endif
+
+void par_setup_libpath( const char * stmpdir )
+{
+ const char *key = NULL , *val = NULL;
+ int i;
+ const char *ld_path_keys[6] = {
+ "LD_LIBRARY_PATH", "LIBPATH", "LIBRARY_PATH",
+ "PATH", "DYLD_LIBRARY_PATH", ""
+ };
+ char *ld_path_env;
+ for ( i = 0 ; strlen(key = ld_path_keys[i]) > 0 ; i++ ) {
+ if ( ((val = (char *)par_getenv(key)) == NULL) || (strlen(val) == 0) ) {
+ par_setenv(key, stmpdir);
+ }
+ else if(!strstr(val, stmpdir)) {
+ ld_path_env = (char *)malloc(
+ strlen(stmpdir) +
+ strlen(path_sep) +
+ strlen(val) + 2
+ );
+ sprintf(
+ ld_path_env,
+ "%s%s%s",
+ stmpdir, path_sep, val
+ );
+ par_setenv(key, ld_path_env);
+ }
+ }
+}
+
+char *par_mktmpdir ( char **argv ) {
+ int i;
+ char *c;
+ const char *tmpdir = NULL;
+ const char *key = NULL , *val = NULL;
+
+ const char *temp_dirs[4] = { "C:\\TEMP", "/tmp", ".", "" };
+ const char *temp_keys[4] = { "TMPDIR", "TEMP", "TMP", "" };
+ const char *user_keys[3] = { "USER", "USERNAME", "" };
+
+ const char *subdirbuf_prefix = "par-";
+ const char *subdirbuf_suffix = "";
+
+ char *progname = NULL, *username = NULL;
+ char *stmpdir;
+ int f, j, k;
+ char sha1[41];
+ SHA_INFO sha_info;
+ unsigned char buf[32768];
+ unsigned char sha_data[20];
+
+#ifndef PL_statbuf
+struct stat PL_statbuf;
+#endif
+
+ if ( (val = (char *)par_getenv(PAR_TEMP)) && strlen(val) ) {
+ par_setup_libpath(val);
+ return strdup(val);
+ }
+
+#ifdef WIN32
+ {
+ DWORD buflen = MAXPATHLEN;
+ username = (char *)malloc(MAXPATHLEN);
+ GetUserName((LPTSTR)username, &buflen);
+ }
+#endif
+
+ for ( i = 0 ; username == NULL && strlen(key = user_keys[i]) > 0 ; i++ ) {
+ if ( (val = (char *)par_getenv(key)) ) {
+ username = strdup(val);
+ }
+ }
+
+ if ( username == NULL ) {
+ username = "SYSTEM";
+ }
+ else {
+ /* replace all non-alphanumeric letters with '_' */
+ for ( c = username ; *c != '\0' ; c++ ) {
+ if ( !isalnum(*c) ) {
+ *c = '_';
+ }
+ }
+ }
+
+ for ( i = 0 ; tmpdir == NULL && strlen(key = temp_keys[i]) > 0 ; i++ ) {
+ if ( (val = (char *)par_getenv(key)) &&
+ par_lstat(val, &PL_statbuf) == 0 &&
+ ( S_ISDIR(PL_statbuf.st_mode) ||
+ S_ISLNK(PL_statbuf.st_mode) ) &&
+ access(val, W_OK) == 0 ) {
+ tmpdir = strdup(val);
+ }
+ }
+
+ for ( i = 0 ; tmpdir == NULL && strlen(val = temp_dirs[i]) > 0 ; i++ ) {
+ if ( par_lstat(val, &PL_statbuf) == 0 &&
+ ( S_ISDIR(PL_statbuf.st_mode) ||
+ S_ISLNK(PL_statbuf.st_mode) ) &&
+ access(val, W_OK) == 0 ) {
+ tmpdir = strdup(val);
+ }
+ }
+
+ /* "$TEMP/par-$USER" */
+ stmpdir = malloc(
+ strlen(tmpdir) +
+ strlen(subdirbuf_prefix) +
+ strlen(username) +
+ strlen(subdirbuf_suffix) + 1024
+ );
+ sprintf(stmpdir, "%s%s%s%s", tmpdir, dir_sep, subdirbuf_prefix, username);
+ my_mkdir(stmpdir, 0755);
+
+ /* Doesn't really work - XXX */
+ progname = par_findprog(argv[0], strdup(val));
+ if (progname == NULL) progname = argv[0];
+
+ 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",
+ stmpdir, dir_sep, buf, subdirbuf_suffix
+ );
+ }
+ else {
+ /* "$TEMP/par-$USER/cache-$SHA1" */
+ 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] );
+ }
+ sprintf(
+ stmpdir,
+ "%s%scache-%s%s",
+ stmpdir, dir_sep, sha1, subdirbuf_suffix
+ );
+ }
+ }
+ else {
+ /* "$TEMP/par-$USER/temp-$PID" */
+
+ par_setenv("PAR_CLEAN", "1");
+ sprintf(
+ stmpdir,
+ "%s%stemp-%u%s",
+ stmpdir, dir_sep, getpid(), subdirbuf_suffix
+ );
+ }
+
+ /* set dynamic loading path */
+ par_setenv(PAR_TEMP, stmpdir);
+
+ par_setup_libpath( stmpdir );
+
+ return(stmpdir);
+}
+
+
+#ifdef WIN32
+void par_rmtmpdir ( char *stmpdir, int recurse ) {
+ struct _finddata_t cur_file;
+ char *subsubdir = malloc(strlen(stmpdir) + 258);
+ char *slashdot;
+ long hFile;
+ int tries = 0;
+ HMODULE dll;
+
+ if ((stmpdir == NULL) || !strlen(stmpdir)) return;
+
+ sprintf(subsubdir, "%s\\*.*", stmpdir);
+ hFile = _findfirst( subsubdir, &cur_file );
+ if ( hFile == -1 ) return;
+
+ 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) && recurse) {
+ par_rmtmpdir( subsubdir, 1 );
+ }
+ /* if (!(cur_file.attrib & _A_SUBDIR)) fprintf(stderr, "unlinking %s\n", subsubdir); */
+ else {
+ dll = GetModuleHandle(cur_file.name);
+ tries = 0;
+ while ( _unlink(subsubdir) && ( tries++ < 10 ) ) {
+ if ( dll ) FreeLibrary(dll);
+ };
+ }
+ }
+ while ( _findnext( hFile, &cur_file ) == 0 ) {
+ 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) && recurse) {
+ par_rmtmpdir( subsubdir, 1 );
+ }
+ /* if (!(cur_file.attrib & _A_SUBDIR)) fprintf(stderr, "unlinking %s\n", subsubdir); */
+ else {
+ dll = GetModuleHandle(cur_file.name);
+ tries = 0;
+ while ( _unlink(subsubdir) && ( tries++ < 10 ) ) {
+ if ( dll ) FreeLibrary(dll);
+ };
+ }
+ }
+ }
+
+ _findclose(hFile);
+ _rmdir(stmpdir);
+}
+
+#else
+void par_rmtmpdir ( char *stmpdir, int recurse ) {
+ DIR *partmp_dirp;
+ Direntry_t *dp;
+ char *subsubdir;
+ struct stat stbuf;
+
+ /* remove temporary PAR directory */
+ partmp_dirp = opendir(stmpdir);
+
+ if ( partmp_dirp == NULL ) return;
+
+ /* fprintf(stderr, "%s: removing private temporary subdirectory %s.\n", argv[0], stmpdir); */
+ while ( ( dp = readdir(partmp_dirp) ) != NULL ) {
+ if ( strcmp (dp->d_name, ".") != 0 && strcmp (dp->d_name, "..") != 0 )
+ {
+ subsubdir = malloc(strlen(stmpdir) + strlen(dp->d_name) + 2);
+ sprintf(subsubdir, "%s/%s", stmpdir, dp->d_name);
+ if (stat(subsubdir, &stbuf) != -1 && S_ISDIR(stbuf.st_mode) && recurse) {
+ par_rmtmpdir(subsubdir, 1);
+ }
+ else {
+ unlink(subsubdir);
+ }
+ free(subsubdir);
+ subsubdir = NULL;
+ }
+ }
+
+ closedir(partmp_dirp);
+ if (stmpdir) 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, 1);
+ par_rmtmpdir(dirname, 0);
+ }
+ }
+}
Added: packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.h
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.h 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/mktmpdir.h 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,76 @@
+#include <ctype.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#ifdef WIN32
+# include <direct.h>
+# define Direntry_t struct direct
+# include <windows.h>
+#else
+# include <dirent.h>
+# define Direntry_t struct dirent
+# include <unistd.h>
+#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 <process.h>
+# define my_mkdir(file, mode) _mkdir(file)
+#else
+# define my_mkdir(file, mode) mkdir(file,mode)
+#endif
+
+#include "utils.c"
+#include "sha1.c"
Added: packages/libpar-perl/branches/upstream/current/myldr/parlsig.pl
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/parlsig.pl 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/parlsig.pl 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,20 @@
+use strict;
+
+my ($parl_exe, $par_exe, $dynperl, $chunk_size) = @ARGV;
+exit unless $dynperl;
+
+local $/;
+open _FH, $par_exe or die $!;
+binmode _FH;
+my $input_exe = <_FH>;
+close _FH;
+open _FH, $parl_exe or die $!;
+binmode _FH;
+my $output_exe = <_FH>;
+close _FH;
+my $offset = rindex($output_exe, substr($input_exe, 0, $chunk_size));
+die "Impossible: Can't find $par_exe inside $parl_exe" if $offset == -1;
+open _FH, '>>', $parl_exe or die $!;
+binmode _FH;
+print _FH pack('N', $offset);
+close _FH;
Added: packages/libpar-perl/branches/upstream/current/myldr/sha1.c.PL
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/sha1.c.PL 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/sha1.c.PL 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,339 @@
+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 <uh at alumni.caltech edu> */
+/* 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 <string.h>
+
+/* 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 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))
+typedef unsigned long ULONG; /* 32-or-more-bit quantity */
+# endif
+#endif
+
+#define SHA_BLOCKSIZE 64
+#define SHA_DIGESTSIZE 20
+
+typedef struct {
+ ULONG digest[5]; /* message digest */
+ 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;
+ 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(ULONG) == 4); */
+ for (i = 0; i < 16; ++i) {
+ T = *((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(ULONG) == 4); */
+ for (i = 0; i < 16; ++i) {
+ T = *((ULONG *) dp);
+ dp += 4;
+ W[i] = T32(T);
+ }
+#endif
+
+#if BYTEORDER == 0x12345678
+#define SWAP_DONE
+ /* assert(sizeof(ULONG) == 8); */
+ for (i = 0; i < 16; i += 2) {
+ T = *((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(ULONG) == 8); */
+ for (i = 0; i < 16; i += 2) {
+ T = *((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;
+ ULONG clo;
+
+ clo = T32(sha_info->count_lo + ((ULONG) count << 3));
+ if (clo < sha_info->count_lo) {
+ ++sha_info->count_hi;
+ }
+ sha_info->count_lo = clo;
+ sha_info->count_hi += (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;
+ 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;
Added: packages/libpar-perl/branches/upstream/current/myldr/static.c
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/static.c 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/static.c 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,111 @@
+#undef PL_statbuf
+#undef readdir
+
+#include "mktmpdir.c"
+#include "my_perl.c"
+#include "my_par.c"
+
+/*
+extern char * name_load_me_0;
+extern char * name_load_me_1;
+extern unsigned long size_load_me_0;
+extern unsigned long size_load_me_1;
+extern char load_me_0[];
+extern char load_me_1[];
+*/
+
+char *my_file;
+
+int my_mkfile (char* argv0, char* stmpdir, const char* name, unsigned long size) {
+ int i;
+#ifndef PL_statbuf
+ struct stat PL_statbuf;
+#endif
+
+ my_file = (char *)malloc(strlen(stmpdir) + strlen(name) + 5);
+ sprintf(my_file, "%s/%s", stmpdir, name);
+
+ if ( par_lstat(my_file, &PL_statbuf) == 0 ) {
+ if ( (unsigned long)PL_statbuf.st_size == size ) return -2;
+ }
+
+ i = open(my_file, O_CREAT | O_WRONLY | OPEN_O_BINARY);
+
+ if (i == -1) {
+ fprintf(stderr, "%s: creation of %s failed - aborting with %i.\n", argv0, my_file, errno);
+ return 0;
+ }
+
+ return i;
+}
+
+int main ( int argc, char **argv, char **env )
+{
+ int i;
+ char *stmpdir;
+ char *buf = (char *)malloc(MAXPATHLEN);
+#ifdef WIN32
+typedef BOOL (WINAPI *pALLOW)(DWORD);
+ HINSTANCE hinstLib;
+ pALLOW ProcAdd;
+#ifndef ASFW_ANY
+#define ASFW_ANY -1
+#endif
+#endif
+
+ par_init_env();
+ par_mktmpdir( argv );
+
+ stmpdir = (char *)par_getenv("PAR_TEMP");
+ if ( stmpdir != NULL ) {
+ i = my_mkdir(stmpdir, 0755);
+ if ( (i != 0) && (i != EEXIST) && (i != -1) ) {
+ fprintf(stderr, "%s: creation of private temporary subdirectory %s failed - aborting with %i.\n", argv[0], stmpdir, errno);
+ return 2;
+ }
+ }
+
+ i = my_mkfile( argv[0], stmpdir, name_load_me_0, size_load_me_0 );
+ if ( !i ) return 2;
+ if ( i != -2 ) {
+ WRITE_load_me_0(i);
+ close(i); chmod(my_file, 0755);
+ }
+
+ my_file = par_basename(par_findprog(argv[0], strdup(par_getenv("PATH"))));
+
+ i = my_mkfile( argv[0], stmpdir, my_file, size_load_me_1 );
+ if ( !i ) return 2;
+ if ( i != -2 ) {
+ WRITE_load_me_1(i);
+ close(i); chmod(my_file, 0755);
+ }
+
+ sprintf(buf, "%i", argc);
+ par_setenv("PAR_ARGC", buf);
+ for (i = 0; i < argc; i++) {
+ buf = (char *)malloc(strlen(argv[i]) + 14);
+ sprintf(buf, "PAR_ARGV_%i", i);
+ par_setenv(buf, argv[i]);
+ }
+
+#ifdef WIN32
+ hinstLib = LoadLibrary("user32");
+ if (hinstLib != NULL) {
+ ProcAdd = (pALLOW) GetProcAddress(hinstLib, "AllowSetForegroundWindow");
+ if (ProcAdd != NULL)
+ {
+ (ProcAdd)(ASFW_ANY);
+ }
+ }
+
+ par_setenv("PAR_SPAWNED", "1");
+ i = spawnvpe(P_WAIT, my_file, (const char* const*)argv, (const char* const*)environ);
+#else
+ execvp(my_file, argv);
+ return 2;
+#endif
+
+ par_cleanup(stmpdir);
+ return i;
+}
Added: packages/libpar-perl/branches/upstream/current/myldr/utils.c
===================================================================
--- packages/libpar-perl/branches/upstream/current/myldr/utils.c 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/myldr/utils.c 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,178 @@
+/*
+ * Copyright (c) 1997 Todd C. Miller <Todd.Miller at courtesan.com>
+ *
+ * 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 <io.h>
+#else
+# include <fcntl.h>
+#endif
+#include <stdio.h>
+
+#include "env.c"
+
+char *par_findprog(char *prog, char *path) {
+ char *p, filename[MAXPATHLEN];
+ int proglen, plen;
+ char *par_temp = par_getenv("PAR_TEMP");
+
+#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);
+ }
+
+ 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;
+
+ 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");
+ par_unsetenv("PAR_ARGC");
+ par_unsetenv("PAR_ARGV_0");
+
+ if ( (buf = par_getenv("PAR_GLOBAL_DEBUG")) != NULL ) {
+ par_setenv("PAR_DEBUG", 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;
+}
Added: packages/libpar-perl/branches/upstream/current/myldr/win32.coff
===================================================================
(Binary files differ)
Property changes on: packages/libpar-perl/branches/upstream/current/myldr/win32.coff
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: packages/libpar-perl/branches/upstream/current/myldr/win32.obj
===================================================================
(Binary files differ)
Property changes on: packages/libpar-perl/branches/upstream/current/myldr/win32.obj
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: packages/libpar-perl/branches/upstream/current/myldr/win32.res
===================================================================
(Binary files differ)
Property changes on: packages/libpar-perl/branches/upstream/current/myldr/win32.res
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: packages/libpar-perl/branches/upstream/current/package/parl.nsi
===================================================================
--- packages/libpar-perl/branches/upstream/current/package/parl.nsi 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/package/parl.nsi 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,22 @@
+SetCompressor 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
Added: packages/libpar-perl/branches/upstream/current/script/par.pl
===================================================================
--- packages/libpar-perl/branches/upstream/current/script/par.pl 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/script/par.pl 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,885 @@
+#!/usr/local/bin/perl
+
+package __par_pl;
+
+# --- This script must not use any modules at compile time ---
+# use strict;
+
+=head1 NAME
+
+par.pl - Make and run Perl Archives
+
+=head1 SYNOPSIS
+
+(Please see L<pp> for convenient ways to make self-contained
+executables, scripts or PAR archives from perl programs.)
+
+To make a I<PAR distribution> from a CPAN module distribution:
+
+ % par.pl -p # make a PAR dist under the current path
+ % par.pl -p Foo-0.01 # assume unpacked CPAN dist in Foo-0.01/
+
+To manipulate a I<PAR distribution>:
+
+ % par.pl -i Foo-0.01-i386-freebsd-5.8.0.par # install
+ % par.pl -i http://foo.com/Foo-0.01 # auto-appends archname + perlver
+ % par.pl -i cpan://AUTRIJUS/PAR-0.74 # uses CPAN author directory
+ % par.pl -u Foo-0.01-i386-freebsd-5.8.0.par # uninstall
+ % par.pl -s Foo-0.01-i386-freebsd-5.8.0.par # sign
+ % par.pl -v Foo-0.01-i386-freebsd-5.8.0.par # verify
+
+To use F<Hello.pm> from F<./foo.par>:
+
+ % par.pl -A./foo.par -MHello
+ % par.pl -A./foo -MHello # the .par part is optional
+
+Same thing, but search F<foo.par> in the F<@INC>;
+
+ % par.pl -Ifoo.par -MHello
+ % par.pl -Ifoo -MHello # ditto
+
+Run F<test.pl> or F<script/test.pl> from F<foo.par>:
+
+ % par.pl foo.par test.pl # looks for 'main.pl' by default,
+ # otherwise run 'test.pl'
+
+To make a self-containing script containing a PAR file :
+
+ % par.pl -O./foo.pl foo.par
+ % ./foo.pl test.pl # same as above
+
+To embed the necessary non-core modules and shared objects for PAR's
+execution (like C<Zlib>, C<IO>, C<Cwd>, etc), use the B<-b> flag:
+
+ % par.pl -b -O./foo.pl foo.par
+ % ./foo.pl test.pl # runs anywhere with core modules installed
+
+If you also wish to embed I<core> modules along, use the B<-B> flag
+instead:
+
+ % par.pl -B -O./foo.pl foo.par
+ % ./foo.pl test.pl # runs anywhere with the perl interpreter
+
+This is particularly useful when making stand-alone binary
+executables; see L<pp> for details.
+
+=head1 DESCRIPTION
+
+This stand-alone command offers roughly the same feature as C<perl
+-MPAR>, except that it takes the pre-loaded F<.par> files via
+C<-Afoo.par> instead of C<-MPAR=foo.par>.
+
+Additionally, it lets you convert a CPAN distribution to a PAR
+distribution, as well as manipulate such distributions. For more
+information about PAR distributions, see L<PAR::Dist>.
+
+=head2 Binary PAR loader (L<parl>)
+
+If you have a C compiler, or a pre-built binary package of B<PAR> is
+available for your platform, a binary version of B<par.pl> will also be
+automatically installed as B<parl>. You can use it to run F<.par> files:
+
+ # runs script/run.pl in archive, uses its lib/* as libraries
+ % parl myapp.par run.pl # runs run.pl or script/run.pl in myapp.par
+ % parl otherapp.pl # also runs normal perl scripts
+
+However, if the F<.par> archive contains either F<main.pl> or
+F<script/main.pl>, it is used instead:
+
+ % parl myapp.par run.pl # runs main.pl, with 'run.pl' as @ARGV
+
+Finally, the C<-O> option makes a stand-alone binary executable from a
+PAR file:
+
+ % parl -B -Omyapp myapp.par
+ % ./myapp # run it anywhere without perl binaries
+
+With the C<--par-options> flag, generated binaries can act as C<parl>
+to pack new binaries:
+
+ % ./myapp --par-options -Omyap2 myapp.par # identical to ./myapp
+ % ./myapp --par-options -Omyap3 myap3.par # now with different PAR
+
+=head2 Stand-alone executable format
+
+The format for the stand-alone executable is simply concatenating the
+following elements:
+
+=over 4
+
+=item * The executable itself
+
+Either in plain-text (F<par.pl>) or native executable format (F<parl>
+or F<parl.exe>).
+
+=item * Any number of embedded files
+
+These are typically used for bootstrapping PAR's various XS dependencies.
+Each section contains:
+
+=over 4
+
+=item The magic string "C<FILE>"
+
+=item Length of file name in C<pack('N')> format plus 9
+
+=item 8 bytes of hex-encoded CRC32 of file content
+
+=item A single slash ("C</>")
+
+=item The file name (without path)
+
+=item File length in C<pack('N')> format
+
+=item The file's content (not compressed)
+
+=back
+
+=item * One PAR file
+
+This is just a zip file beginning with the magic string "C<PK\003\004>".
+
+=item * Ending section
+
+A pack('N') number of the total length of FILE and PAR sections,
+followed by a 8-bytes magic string: "C<\012PAR.pm\012>".
+
+=back
+
+=cut
+
+my ($par_temp, $progname, @tmpfile);
+END { if ($ENV{PAR_CLEAN}) {
+ unlink @tmpfile;
+ rmdir $par_temp;
+ $par_temp =~ s{[^\\/]*[\\/]?$}{};
+ rmdir $par_temp;
+} }
+
+BEGIN {
+ Internals::PAR::BOOT() if defined &Internals::PAR::BOOT;
+
+ eval {
+
+_par_init_env();
+
+if (exists $ENV{PAR_ARGV_0} and $ENV{PAR_ARGV_0} ) {
+ @ARGV = map $ENV{"PAR_ARGV_$_"}, (1 .. $ENV{PAR_ARGC} - 1);
+ $0 = $ENV{PAR_ARGV_0};
+}
+else {
+ for (keys %ENV) {
+ delete $ENV{$_} if /^PAR_ARGV_/;
+ }
+}
+
+my $quiet = !$ENV{PAR_DEBUG};
+
+# fix $progname if invoked from PATH
+my %Config = (
+ path_sep => ($^O =~ /^MSWin/ ? ';' : ':'),
+ _exe => ($^O =~ /^(?:MSWin|OS2|cygwin)/ ? '.exe' : ''),
+ _delim => ($^O =~ /^MSWin|OS2/ ? '\\' : '/'),
+);
+
+_set_progname();
+_set_par_temp();
+
+# Magic string checking and extracting bundled modules {{{
+my ($start_pos, $data_pos);
+{
+ local $SIG{__WARN__} = sub {};
+
+ # Check file type, get start of data section {{{
+ open _FH, '<', $progname or last;
+ binmode(_FH);
+
+ my $buf;
+ seek _FH, -8, 2;
+ read _FH, $buf, 8;
+ last unless $buf eq "\nPAR.pm\n";
+
+ seek _FH, -12, 2;
+ read _FH, $buf, 4;
+ seek _FH, -12 - unpack("N", $buf), 2;
+ read _FH, $buf, 4;
+
+ $data_pos = (tell _FH) - 4;
+ # }}}
+
+ # Extracting each file into memory {{{
+ my %require_list;
+ while ($buf eq "FILE") {
+ read _FH, $buf, 4;
+ read _FH, $buf, unpack("N", $buf);
+
+ my $fullname = $buf;
+ outs(qq(Unpacking file "$fullname"...));
+ my $crc = ( $fullname =~ s|^([a-f\d]{8})/|| ) ? $1 : undef;
+ my ($basename, $ext) = ($buf =~ m|(?:.*/)?(.*)(\..*)|);
+
+ read _FH, $buf, 4;
+ read _FH, $buf, unpack("N", $buf);
+
+ if (defined($ext) and $ext !~ /\.(?:pm|pl|ix|al)$/i) {
+ my ($out, $filename) = _tempfile($ext, $crc);
+ if ($out) {
+ binmode($out);
+ print $out $buf;
+ close $out;
+ chmod 0755, $filename;
+ }
+ $PAR::Heavy::FullCache{$fullname} = $filename;
+ $PAR::Heavy::FullCache{$filename} = $fullname;
+ }
+ elsif ( $fullname =~ m|^/?shlib/| and defined $ENV{PAR_TEMP} ) {
+ # should be moved to _tempfile()
+ my $filename = "$ENV{PAR_TEMP}/$basename$ext";
+ outs("SHLIB: $filename\n");
+ open my $out, '>', $filename or die $!;
+ binmode($out);
+ print $out $buf;
+ close $out;
+ }
+ else {
+ $require_list{$fullname} =
+ $PAR::Heavy::ModuleCache{$fullname} = {
+ buf => $buf,
+ crc => $crc,
+ name => $fullname,
+ };
+ }
+ read _FH, $buf, 4;
+ }
+ # }}}
+
+ local @INC = (sub {
+ my ($self, $module) = @_;
+
+ return if ref $module or !$module;
+
+ my $filename = delete $require_list{$module} || do {
+ my $key;
+ foreach (keys %require_list) {
+ next unless /\Q$module\E$/;
+ $key = $_; last;
+ }
+ delete $require_list{$key} if defined($key);
+ } or return;
+
+ $INC{$module} = "/loader/$filename/$module";
+
+ if ($ENV{PAR_CLEAN} and defined(&IO::File::new)) {
+ my $fh = IO::File->new_tmpfile or die $!;
+ binmode($fh);
+ print $fh $filename->{buf};
+ seek($fh, 0, 0);
+ return $fh;
+ }
+ else {
+ my ($out, $name) = _tempfile('.pm', $filename->{crc});
+ if ($out) {
+ binmode($out);
+ print $out $filename->{buf};
+ close $out;
+ }
+ open my $fh, '<', $name or die $!;
+ binmode($fh);
+ return $fh;
+ }
+
+ die "Bootstrapping failed: cannot find $module!\n";
+ }, @INC);
+ # }}}
+
+ # Now load all bundled files {{{
+
+ # initialize shared object processing
+ require XSLoader;
+ require PAR::Heavy;
+ require Carp::Heavy;
+ require Exporter::Heavy;
+ PAR::Heavy::_init_dynaloader();
+
+ # now let's try getting helper modules from within
+ require IO::File;
+
+ # load rest of the group in
+ while (my $filename = (sort keys %require_list)[0]) {
+ #local $INC{'Cwd.pm'} = __FILE__ if $^O ne 'MSWin32';
+ require $filename unless $INC{$filename} or $filename =~ /BSDPAN/;
+ delete $require_list{$filename};
+ }
+
+ # }}}
+
+ last unless $buf eq "PK\003\004";
+ $start_pos = (tell _FH) - 4;
+}
+# }}}
+
+# Argument processing {{{
+my @par_args;
+my ($out, $bundle, $logfh, $cache_name);
+
+$quiet = 0 unless $ENV{PAR_DEBUG};
+
+# Don't swallow arguments for compiled executables without --par-options
+if (!$start_pos or ($ARGV[0] eq '--par-options' && shift)) {
+ my %dist_cmd = qw(
+ p blib_to_par
+ i install_par
+ u uninstall_par
+ s sign_par
+ v verify_par
+ );
+ while (@ARGV) {
+ $ARGV[0] =~ /^-([AIMOBLbqpiusTv])(.*)/ or last;
+
+ if ($1 eq 'I') {
+ unshift @INC, $2;
+ }
+ elsif ($1 eq 'M') {
+ eval "use $2";
+ }
+ elsif ($1 eq 'A') {
+ unshift @par_args, $2;
+ }
+ elsif ($1 eq 'O') {
+ $out = $2;
+ }
+ elsif ($1 eq 'b') {
+ $bundle = 'site';
+ }
+ elsif ($1 eq 'B') {
+ $bundle = 'all';
+ }
+ elsif ($1 eq 'q') {
+ $quiet = 1;
+ }
+ elsif ($1 eq 'L') {
+ open $logfh, ">>", $2 or die "XXX: Cannot open log: $!";
+ }
+ elsif ($1 eq 'T') {
+ $cache_name = $2;
+ }
+
+ shift(@ARGV);
+
+ if (my $cmd = $dist_cmd{$1}) {
+ delete $ENV{'PAR_TEMP'};
+ init_inc();
+ require PAR::Dist;
+ &{"PAR::Dist::$cmd"}() unless @ARGV;
+ &{"PAR::Dist::$cmd"}($_) for @ARGV;
+ exit;
+ }
+ }
+}
+
+# XXX -- add --par-debug support!
+
+# }}}
+
+# Output mode (-O) handling {{{
+if ($out) {
+ {
+ #local $INC{'Cwd.pm'} = __FILE__ if $^O ne 'MSWin32';
+ require IO::File;
+ require Archive::Zip;
+ }
+
+
+ my $par = shift(@ARGV);
+ my $zip;
+
+
+ if (defined $par) {
+ open my $fh, '<', $par or die "Cannot find '$par': $!";
+ binmode($fh);
+ bless($fh, 'IO::File');
+
+ $zip = Archive::Zip->new;
+ ( $zip->readFromFileHandle($fh, $par) == Archive::Zip::AZ_OK() )
+ or die "Read '$par' error: $!";
+ }
+
+
+ my %env = do {
+ if ($zip and my $meta = $zip->contents('META.yml')) {
+ $meta =~ s/.*^par:$//ms;
+ $meta =~ s/^\S.*//ms;
+ $meta =~ /^ ([^:]+): (.+)$/mg;
+ }
+ };
+
+ # Open input and output files {{{
+ local $/ = \4;
+
+ if (defined $par) {
+ open PAR, '<', $par or die "$!: $par";
+ binmode(PAR);
+ die "$par is not a PAR file" unless <PAR> eq "PK\003\004";
+ }
+
+ my $fh = IO::File->new(
+ $out,
+ IO::File::O_CREAT() | IO::File::O_WRONLY() | IO::File::O_TRUNC(),
+ 0777,
+ ) or die $!;
+ binmode($fh);
+
+ $/ = (defined $data_pos) ? \$data_pos : undef;
+ seek _FH, 0, 0;
+ my $loader = scalar <_FH>;
+ if (!$ENV{PAR_VERBATIM} and $loader =~ /^(?:#!|\@rem)/) {
+ require PAR::Filter::PodStrip;
+ PAR::Filter::PodStrip->new->apply(\$loader, $0)
+ }
+ foreach my $key (sort keys %env) {
+ my $val = $env{$key} or next;
+ $val = eval $val if $val =~ /^['"]/;
+ my $magic = "__ENV_PAR_" . uc($key) . "__";
+ my $set = "PAR_" . uc($key) . "=$val";
+ $loader =~ s{$magic( +)}{
+ $magic . $set . (' ' x (length($1) - length($set)))
+ }eg;
+ }
+ $fh->print($loader);
+ $/ = undef;
+ # }}}
+
+ # Write bundled modules {{{
+ if ($bundle) {
+ require PAR::Heavy;
+ PAR::Heavy::_init_dynaloader();
+ init_inc();
+ require_modules();
+
+ my @inc = sort {
+ length($b) <=> length($a)
+ } grep {
+ !/BSDPAN/
+ } grep {
+ ($bundle ne 'site') or
+ ($_ ne $Config::Config{archlibexp} and
+ $_ ne $Config::Config{privlibexp});
+ } @INC;
+
+ if ($Config{_delim} eq '\\') { s{\\}{/}g for @inc }
+
+ my %files;
+ /^_<(.+)$/ and $files{$1}++ for keys %::;
+ $files{$_}++ for values %INC;
+
+ my $lib_ext = $Config::Config{lib_ext};
+ my %written;
+
+ foreach (sort keys %files) {
+ my ($name, $file);
+
+ foreach my $dir (@inc) {
+ if ($name = $PAR::Heavy::FullCache{$_}) {
+ $file = $_;
+ last;
+ }
+ elsif (/^(\Q$dir\E\/(.*[^Cc]))\Z/i) {
+ ($file, $name) = ($1, $2);
+ last;
+ }
+ elsif (m!^/loader/[^/]+/(.*[^Cc])\Z!) {
+ if (my $ref = $PAR::Heavy::ModuleCache{$1}) {
+ ($file, $name) = ($ref, $1);
+ last;
+ }
+ elsif (-f "$dir/$1") {
+ ($file, $name) = ("$dir/$1", $1);
+ last;
+ }
+ }
+ }
+
+ next unless defined $name and not $written{$name}++;
+ next if !ref($file) and $file =~ /\.\Q$lib_ext\E$/;
+ outs( join "",
+ qq(Packing "), ref $file ? $file->{name} : $file,
+ qq("...)
+ );
+
+ my $content;
+ if (ref($file)) {
+ $content = $file->{buf};
+ }
+ else {
+ open FILE, '<', $file or die "Can't open $file: $!";
+ binmode(FILE);
+ $content = <FILE>;
+ close FILE;
+
+ PAR::Filter::PodStrip->new->apply(\$content, $file)
+ if !$ENV{PAR_VERBATIM} and $name =~ /\.(?:pm|ix|al)$/i;
+
+ # Do not let XSLoader pick up auto/* from environment
+ $content =~ s/goto +retry +unless +.*/goto retry;/
+ if lc($name) eq lc("XSLoader.pm");
+ }
+
+ outs(qq(Written as "$name"));
+ $fh->print("FILE");
+ $fh->print(pack('N', length($name) + 9));
+ $fh->print(sprintf(
+ "%08x/%s", Archive::Zip::computeCRC32($content), $name
+ ));
+ $fh->print(pack('N', length($content)));
+ $fh->print($content);
+ }
+ }
+ # }}}
+
+ # Now write out the PAR and magic strings {{{
+ $zip->writeToFileHandle($fh) if $zip;
+
+ $cache_name = substr $cache_name, 0, 40;
+ if (!$cache_name and my $mtime = (stat($out))[9]) {
+ my $ctx = eval { require Digest::SHA; Digest::SHA->new(1) }
+ || eval { require Digest::SHA1; Digest::SHA1->new }
+ || eval { require Digest::MD5; Digest::MD5->new };
+
+ if ($ctx and open(my $fh, "<", $out)) {
+ binmode($fh);
+ $ctx->addfile($fh);
+ close($fh);
+ }
+
+ $cache_name = $ctx ? $ctx->hexdigest : $mtime;
+ }
+ $cache_name .= "\0" x (41 - length $cache_name);
+ $cache_name .= "CACHE";
+ $fh->print($cache_name);
+ $fh->print(pack('N', $fh->tell - length($loader)));
+ $fh->print("\nPAR.pm\n");
+ $fh->close;
+ chmod 0755, $out;
+ # }}}
+
+ exit;
+}
+# }}}
+
+# Prepare $progname into PAR file cache {{{
+{
+ last unless defined $start_pos;
+
+ _fix_progname();
+
+ # Now load the PAR file and put it into PAR::LibCache {{{
+ require PAR;
+ PAR::Heavy::_init_dynaloader();
+
+
+ {
+ #local $INC{'Cwd.pm'} = __FILE__ if $^O ne 'MSWin32';
+ require File::Find;
+ require Archive::Zip;
+ }
+ my $zip = Archive::Zip->new;
+ my $fh = IO::File->new;
+ $fh->fdopen(fileno(_FH), 'r') or die "$!: $@";
+ $zip->readFromFileHandle($fh, $progname) == Archive::Zip::AZ_OK() or die "$!: $@";
+
+ push @PAR::LibCache, $zip;
+ $PAR::LibCache{$progname} = $zip;
+
+ $quiet = !$ENV{PAR_DEBUG};
+ outs(qq(\$ENV{PAR_TEMP} = "$ENV{PAR_TEMP}"));
+
+ foreach my $member ( $zip->members ) {
+ next if $member->isDirectory or !$ENV{PAR_TEMP};
+ my $member_name = $member->fileName;
+ next unless $member_name =~ m{
+ ^
+ /?shlib/
+ (?:$Config::Config{version}/)?
+ (?:$Config::Config{archname}/)?
+ ([^/]+)
+ $
+ }x;
+ my $extract_name = $1;
+ my $dest_name = File::Spec->catfile($ENV{PAR_TEMP}, $extract_name);
+ $member->extractToFileNamed($dest_name);
+ outs(qq(Extracting "$member_name" to "$dest_name"));
+ }
+ # }}}
+}
+# }}}
+
+# If there's no main.pl to run, show usage {{{
+unless ($PAR::LibCache{$progname}) {
+ die << "." unless @ARGV;
+Usage: $0 [ -Alib.par ] [ -Idir ] [ -Mmodule ] [ src.par ] [ program.pl ]
+ $0 [ -B|-b ] [-Ooutfile] src.par
+.
+ $ENV{PAR_PROGNAME} = $progname = $0 = shift(@ARGV);
+}
+# }}}
+
+sub require_modules {
+ #local $INC{'Cwd.pm'} = __FILE__ if $^O ne 'MSWin32';
+
+ require lib;
+ require DynaLoader;
+ require integer;
+ require strict;
+ require warnings;
+ require vars;
+ require Carp;
+ require Carp::Heavy;
+ require Exporter::Heavy;
+ require Exporter;
+ require Fcntl;
+ require File::Temp;
+ require File::Spec;
+ require XSLoader;
+ require Config;
+ require IO::Handle;
+ require IO::File;
+ require Compress::Zlib;
+ require Archive::Zip;
+ require PAR;
+ require PAR::Heavy;
+ require PAR::Dist;
+ require PAR::Filter::PodStrip;
+}
+
+# The C version of this code appears in myldr/mktmpdir.c
+sub _set_par_temp {
+ if ($ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/) {
+ $par_temp = $1;
+ return;
+ }
+
+ foreach my $path (
+ (map $ENV{$_}, qw( TMPDIR TEMP TMP )),
+ qw( C:\\TEMP /tmp . )
+ ) {
+ next unless $path and -d $path and -w $path;
+ my $username = defined(&Win32::LoginName)
+ ? &Win32::LoginName()
+ : $ENV{USERNAME} || $ENV{USER} || 'SYSTEM';
+ $username =~ s/\W/_/g;
+
+ my $stmpdir = "$path$Config{_delim}par-$username";
+ mkdir $stmpdir, 0755;
+ if (!$ENV{PAR_CLEAN} and my $mtime = (stat($progname))[9]) {
+ open (my $fh, "<". $progname);
+ seek $fh, -18, 2;
+ sysread $fh, my $buf, 6;
+ if ($buf eq "\0CACHE") {
+ seek $fh, -58, 2;
+ sysread $fh, $buf, 41;
+ $buf =~ s/\0//g;
+ $stmpdir .= "$Config{_delim}cache-" . $buf;
+ }
+ else {
+ my $ctx = eval { require Digest::SHA; Digest::SHA->new(1) }
+ || eval { require Digest::SHA1; Digest::SHA1->new }
+ || eval { require Digest::MD5; Digest::MD5->new };
+
+ if ($ctx and open(my $fh, "<", $progname)) {
+ binmode($fh);
+ $ctx->addfile($fh);
+ close($fh);
+ }
+
+ $stmpdir .= "$Config{_delim}cache-" . ( $ctx ? $ctx->hexdigest : $mtime );
+ }
+ close($fh);
+ }
+ else {
+ $ENV{PAR_CLEAN} = 1;
+ $stmpdir .= "$Config{_delim}temp-$$";
+ }
+
+ $ENV{PAR_TEMP} = $stmpdir;
+ mkdir $stmpdir, 0755;
+ last;
+ }
+
+ $par_temp = $1 if $ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/;
+}
+
+sub _tempfile {
+ my ($ext, $crc) = @_;
+ my ($fh, $filename);
+
+ $filename = "$par_temp/$crc$ext";
+
+ if ($ENV{PAR_CLEAN}) {
+ unlink $filename if -e $filename;
+ push @tmpfile, $filename;
+ }
+ else {
+ return (undef, $filename) if (-r $filename);
+ }
+
+ open $fh, '>', $filename or die $!;
+ binmode($fh);
+ return($fh, $filename);
+}
+
+sub _set_progname {
+ if ($ENV{PAR_PROGNAME} and $ENV{PAR_PROGNAME} =~ /(.+)/) {
+ $progname = $1;
+ }
+
+ $progname ||= $0;
+
+ if ($ENV{PAR_TEMP} and index($progname, $ENV{PAR_TEMP}) >= 0) {
+ $progname = substr($progname, rindex($progname, $Config{_delim}) + 1);
+ }
+
+ if (!$ENV{PAR_PROGNAME} or index($progname, $Config{_delim}) >= 0) {
+ if (open my $fh, '<', $progname) {
+ return if -s $fh;
+ }
+ if (-s "$progname$Config{_exe}") {
+ $progname .= $Config{_exe};
+ return;
+ }
+ }
+
+ foreach my $dir (split /\Q$Config{path_sep}\E/, $ENV{PATH}) {
+ next if exists $ENV{PAR_TEMP} and $dir eq $ENV{PAR_TEMP};
+ $dir =~ s/\Q$Config{_delim}\E$//;
+ (($progname = "$dir$Config{_delim}$progname$Config{_exe}"), last)
+ if -s "$dir$Config{_delim}$progname$Config{_exe}";
+ (($progname = "$dir$Config{_delim}$progname"), last)
+ if -s "$dir$Config{_delim}$progname";
+ }
+}
+
+sub _fix_progname {
+ $0 = $progname ||= $ENV{PAR_PROGNAME};
+ if (index($progname, $Config{_delim}) < 0) {
+ $progname = ".$Config{_delim}$progname";
+ }
+
+ # XXX - hack to make PWD work
+ my $pwd = (defined &Win32::GetCwd) ? Win32::GetCwd() : $ENV{PWD};
+ $pwd = `pwd` if !defined $pwd;
+ chomp($pwd);
+ $progname =~ s/^(?=\.\.?\Q$Config{_delim}\E)/$pwd$Config{_delim}/;
+
+ $ENV{PAR_PROGNAME} = $progname;
+}
+
+sub _par_init_env {
+ if ( $ENV{PAR_INITIALIZED}++ == 1 ) {
+ return;
+ } else {
+ $ENV{PAR_INITIALIZED} = 2;
+ }
+
+ for (qw( SPAWNED TEMP CLEAN DEBUG CACHE PROGNAME ARGC ARGV_0 ) ) {
+ delete $ENV{'PAR_'.$_};
+ }
+ for (qw/ TEMP CLEAN DEBUG /) {
+ $ENV{'PAR_'.$_} = $ENV{'PAR_GLOBAL_'.$_} if exists $ENV{'PAR_GLOBAL_'.$_};
+ }
+
+ my $par_clean = "__ENV_PAR_CLEAN__ ";
+
+ if ($ENV{PAR_TEMP}) {
+ delete $ENV{PAR_CLEAN};
+ }
+ elsif (!exists $ENV{PAR_GLOBAL_CLEAN}) {
+ my $value = substr($par_clean, 12 + length("CLEAN"));
+ $ENV{PAR_CLEAN} = $1 if $value =~ /^PAR_CLEAN=(\S+)/;
+ }
+}
+
+sub outs {
+ return if $quiet;
+ if ($logfh) {
+ print $logfh "@_\n";
+ }
+ else {
+ print "@_\n";
+ }
+}
+
+sub init_inc {
+ require Config;
+ push @INC, grep defined, map $Config::Config{$_}, qw(
+ archlibexp privlibexp sitearchexp sitelibexp
+ vendorarchexp vendorlibexp
+ );
+}
+
+########################################################################
+# The main package for script execution
+
+package main;
+
+require PAR;
+unshift @INC, \&PAR::find_par;
+PAR->import(@par_args);
+
+die qq(Can't open perl script "$progname": No such file or directory\n)
+ unless -e $progname;
+
+do $progname;
+CORE::exit($1) if ($@ =~/^_TK_EXIT_\((\d+)\)/);
+die $@ if $@;
+
+};
+
+$::__ERROR = $@ if $@;
+}
+
+CORE::exit($1) if ($::__ERROR =~/^_TK_EXIT_\((\d+)\)/);
+die $::__ERROR if $::__ERROR;
+
+1;
+
+=head1 SEE ALSO
+
+L<PAR>, L<PAR::Dist>, L<parl>, L<pp>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004, 2005 by Autrijus Tang
+E<lt>autrijus at autrijus.orgE<gt>.
+
+Neither this program nor the associated L<parl> program 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, 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 L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+__END__
Property changes on: packages/libpar-perl/branches/upstream/current/script/par.pl
___________________________________________________________________
Name: svn:executable
+
Added: packages/libpar-perl/branches/upstream/current/script/parl.pod
===================================================================
--- packages/libpar-perl/branches/upstream/current/script/parl.pod 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/script/parl.pod 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,132 @@
+=head1 NAME
+
+parl - Binary PAR Loader
+
+=head1 SYNOPSIS
+
+(Please see L<pp> for convenient ways to make self-contained
+executables, scripts or PAR archives from perl programs.)
+
+To make a I<PAR distribution> from a CPAN module distribution:
+
+ % parl -p # make a PAR dist under the current path
+ % parl -p Foo-0.01 # assume unpacked CPAN dist in Foo-0.01/
+
+To manipulate a I<PAR distribution>:
+
+ % parl -i Foo-0.01-i386-freebsd-5.8.0.par # install
+ % parl -i http://foo.com/Foo-0.01 # auto-appends archname + perlver
+ % parl -i cpan://AUTRIJUS/PAR-0.74 # uses CPAN author directory
+ % parl -u Foo-0.01-i386-freebsd-5.8.0.par # uninstall
+ % parl -s Foo-0.01-i386-freebsd-5.8.0.par # sign
+ % parl -v Foo-0.01-i386-freebsd-5.8.0.par # verify
+
+To use F<Hello.pm> from F<./foo.par>:
+
+ % parl -A./foo.par -MHello
+ % parl -A./foo -MHello # the .par part is optional
+
+Same thing, but search F<foo.par> in the F<@INC>;
+
+ % parl -Ifoo.par -MHello
+ % parl -Ifoo -MHello # ditto
+
+Run F<test.pl> or F<script/test.pl> from F<foo.par>:
+
+ % parl foo.par test.pl # looks for 'main.pl' by default,
+ # otherwise run 'test.pl'
+
+To make a self-containing executable containing a PAR file :
+
+ % parl -O./foo foo.par
+ % ./foo test.pl # same as above
+
+To embed the necessary non-core modules and shared objects for PAR's
+execution (like C<Zlib>, C<IO>, C<Cwd>, etc), use the B<-b> flag:
+
+ % parl -b -O./foo foo.par
+ % ./foo test.pl # runs anywhere with core modules installed
+
+If you also wish to embed I<core> modules along, use the B<-B> flag
+instead:
+
+ % parl -B -O./foo foo.par
+ % ./foo test.pl # runs anywhere with the perl interpreter
+
+This is particularly useful when making stand-alone binary
+executables; see L<pp> for details.
+
+=head1 DESCRIPTION
+
+This stand-alone command offers roughly the same feature as C<perl
+-MPAR>, except that it takes the pre-loaded F<.par> files via
+C<-Afoo.par> instead of C<-MPAR=foo.par>.
+
+Additionally, it lets you convert a CPAN distribution to a PAR
+distribution, as well as manipulate such distributions. For more
+information about PAR distributions, see L<PAR::Dist>.
+
+You can use it to run F<.par> files:
+
+ # runs script/run.pl in archive, uses its lib/* as libraries
+ % parl myapp.par run.pl # runs run.pl or script/run.pl in myapp.par
+ % parl otherapp.pl # also runs normal perl scripts
+
+However, if the F<.par> archive contains either F<main.pl> or
+F<script/main.pl>, it is used instead:
+
+ % parl myapp.par run.pl # runs main.pl, with 'run.pl' as @ARGV
+
+Finally, the C<-O> option makes a stand-alone binary executable from a
+PAR file:
+
+ % parl -B -Omyapp myapp.par
+ % ./myapp # run it anywhere without perl binaries
+
+With the C<--par-options> flag, generated binaries can act as C<parl>
+to pack new binaries:
+
+ % ./myapp --par-options -Omyap2 myapp.par # identical to ./myapp
+ % ./myapp --par-options -Omyap3 myap3.par # now with different PAR
+
+For an explanation of stand-alone executable format, please see L<par.pl>.
+
+=head1 SEE ALSO
+
+L<PAR>, L<PAR::Dist>, L<par.pl>, L<pp>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004, 2005 by Autrijus Tang
+E<lt>autrijus at autrijus.orgE<gt>.
+
+Neither this program nor the associated L<pp> program 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, 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 L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Property changes on: packages/libpar-perl/branches/upstream/current/script/parl.pod
___________________________________________________________________
Name: svn:executable
+
Added: packages/libpar-perl/branches/upstream/current/script/pp
===================================================================
--- packages/libpar-perl/branches/upstream/current/script/pp 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/script/pp 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,454 @@
+#!/usr/bin/perl
+
+use 5.006;
+use PAR ();
+use PAR::Packer ();
+use Module::ScanDeps ();
+use App::Packer::PAR ();
+use Getopt::Long qw(:config no_ignore_case);
+
+*VERSION = *PAR::Packer::VERSION;
+
+unshift(@ARGV, split / +/, $ENV{PP_OPTS}) if $ENV{PP_OPTS};
+
+my %opt;
+GetOptions( \%opt, PAR::Packer->options, 'h|help', 'V|version' );
+&help if $opt{h};
+&version if $opt{V};
+
+App::Packer::PAR->new(
+ frontend => 'Module::ScanDeps',
+ backend => 'PAR::Packer',
+ frontopts => \%opt,
+ backopts => \%opt,
+ args => \@ARGV,
+)->go;
+
+sub help {
+ print "Perl Packager, version $VERSION (PAR version $PAR::VERSION)\n\n";
+ {
+ no warnings;
+ exec "perldoc $0";
+ exec "pod2text $0";
+ }
+ &version;
+}
+
+sub version {
+ print << ".";
+Perl Packager, version $VERSION (PAR version $PAR::VERSION)
+Copyright 2002, 2003, 2004, 2005 by Autrijus Tang <autrijus\@autrijus.org>
+
+Neither this program nor the associated "parl" program 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, 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. There is NO warranty; not even for
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+.
+ exit;
+}
+
+__END__
+
+=head1 NAME
+
+pp - Perl Packager
+
+=head1 SYNOPSIS
+
+B<pp> S<[ B<-BILMTSVXdeghilmoprsvz> ]> S<[ I<parfile> | I<scriptfile> ]>...
+
+=head1 EXAMPLES
+
+Note: When running on Microsoft Windows, the F<a.out> below will be
+replaced by F<a.exe> instead.
+
+ % pp hello # Pack 'hello' into executable 'a.out'
+ % pp -o hello hello.pl # Pack 'hello.pl' into executable 'hello'
+
+ % pp -o foo foo.pl bar.pl # Pack 'foo.pl' and 'bar.pl' into 'foo'
+ % ./foo # Run 'foo.pl' inside 'foo'
+ % mv foo bar; ./bar # Run 'bar.pl' inside 'foo'
+ % mv bar baz; ./baz # Error: Can't open perl script "baz"
+
+ % pp -p file # Creates a PAR file, 'a.par'
+ % pp -o hello a.par # Pack 'a.par' to executable 'hello'
+ % pp -S -o hello file # Combine the two steps above
+
+ % pp -p -o out.par file # Creates 'out.par' from 'file'
+ % pp -B -p -o out.par file # same as above, but bundles core modules
+ % pp -P -o out.pl file # Creates 'out.pl' from 'file'
+ % pp -B -p -o out.pl file # same as above, but bundles core modules
+ # (-B is assumed when making executables)
+
+ % pp -e "print 123" # Pack a one-liner into 'a.out'
+ % pp -p -e "print 123" # Creates a PAR file 'a.par'
+ % pp -P -e "print 123" # Creates a perl script 'a.pl'
+
+ % pp -c hello # Check dependencies from "perl -c hello"
+ % pp -x hello # Check dependencies from "perl hello"
+ % pp -n -x hello # same as above, but skips static scanning
+
+ % pp -I /foo hello # Extra include paths
+ % pp -M Foo::Bar hello # Extra modules in the include path
+ % pp -M abbrev.pl hello # Extra libraries in the include path
+ % pp -X Foo::Bar hello # Exclude modules
+ % pp -a data.txt hello # Additional data files
+
+ % pp -r hello # Pack 'hello' into 'a.out', runs 'a.out'
+ % pp -r hello a b c # Pack 'hello' into 'a.out', runs 'a.out'
+ # with arguments 'a b c'
+
+ % pp hello --log=c # Pack 'hello' into 'a.out', logs
+ # messages into 'c'
+
+ # Pack 'hello' into a console-less 'out.exe' with icon (Win32 only)
+ % pp --gui --icon hello.ico -o out.exe hello
+
+=head1 DESCRIPTION
+
+F<pp> creates standalone executables from Perl programs, using the
+compressed packager provided by L<PAR>, and dependency detection
+heuristics offered by L<Module::ScanDeps>. Source files are compressed
+verbatim without compilation.
+
+You may think of F<pp> as "F<perlcc> that works without hassle". :-)
+
+A GUI interface is also available as the F<tkpp> command.
+
+It does not provide the compilation-step acceleration provided by
+F<perlcc> (however, see B<-f> below for byte-compiled, source-hiding
+techniques), but makes up for it with better reliability, smaller
+executable size, and full retrieval of original source code.
+
+When a single input program is specified, the resulting executable will
+behave identically as that program. However, when multiple programs
+are packaged, the produced executable will run the one that has the
+same basename as C<$0> (i.e. the filename used to invoke it). If
+nothing matches, it dies with the error C<Can't open perl script "$0">.
+
+=head1 OPTIONS
+
+Options are available in a I<short> form and a I<long> form. For
+example, the three lines below are all equivalent:
+
+ % pp -o output.exe input.pl
+ % pp --output output.exe input.pl
+ % pp --output=output.exe input.pl
+
+=over 4
+
+=item B<-a>, B<--addfile>=I<FILE>|I<DIR>
+
+Add an extra file into the package. If the file is a directory, recursively
+add all files inside that directory, with links turned into actual files.
+
+By default, files are placed under C</> inside the package with their
+original names. You may override this by appending the target filename
+after a C<;>, like this:
+
+ % pp -a "old_filename.txt;new_filename.txt"
+ % pp -a "old_dirname;new_dirname"
+
+You may specify C<-a> multiple times.
+
+=item B<-A>, B<--addlist>=I<FILE>
+
+Read a list of file/directory names from I<FILE>, adding them into the
+package. Each line in I<FILE> is taken as an argument to B<-a> above.
+
+You may specify C<-A> multiple times.
+
+=item B<-B>, B<--bundle>
+
+Bundle core modules in the resulting package. This option is enabled
+by default, except when C<-p> or C<-P> is specified.
+
+=item B<-C>, B<--clean>
+
+Clean up temporary files extracted from the application at runtime.
+By default, these files are cached in the temporary directory; this
+allows the program to start up faster next time.
+
+=item B<-c>, B<--compile>
+
+Run C<perl -c inputfile> to determine additonal run-time dependencies.
+
+=item B<-d>, B<--dependent>
+
+Reduce the executable size by not including a copy of perl interpreter.
+Executables built this way will need a separate F<perl5x.dll>
+or F<libperl.so> to function correctly. This option is only available
+if perl is built as a shared library.
+
+=item B<-e>, B<--eval>=I<STRING>
+
+Package a one-liner, much the same as C<perl -e '...'>
+
+=item B<-x>, B<--execute>
+
+Run C<perl inputfile> to determine additonal run-time dependencies.
+
+=item B<-X>, B<--exclude>=I<MODULE>
+
+Exclude the given module from the dependency search path and from the
+package. If the given file is a zip or par or par executable, all the files
+in the given file (except MANIFEST, META.yml and script/*) will be
+excluded and the output file will "use" the given file at runtime.
+
+=item B<-f>, B<--filter>=I<FILTER>
+
+Filter source script(s) with a L<PAR::Filter> subclass. You may specify
+multiple such filters.
+
+If you wish to hide the source code from casual prying, this will do:
+
+ % pp -f Bleach source.pl
+
+Users with Perl 5.8.1 and above may also try out the experimental
+byte-compiling filter, which will strip away all comments and indents:
+
+ % pp -f Bytecode source.pl
+
+=item B<-g>, B<--gui>
+
+Build an executable that does not have a console window. This option is
+ignored on non-MSWin32 platforms or when C<-p> is specified.
+
+=item B<-h>, B<--help>
+
+Show basic usage information.
+
+=item B<-i>, B<--icon>=I<FILE>
+
+Specify an icon file (in F<.ico>, F<.exe> or F<.dll> format) for the
+executable. This option is ignored on non-MSWin32 platforms or when C<-p>
+is specified.
+
+=item B<-N>, B<--info>=I<KEY=VAL>
+
+Add additional information for the packed file, both in C<META.yml>
+and in the executable header (if applicable). The name/value pair is
+joined by C<=>. You may specify C<-N> multiple times, or use C<;> to
+link several pairs.
+
+For Win32 executables, these special C<KEY> names are recognized:
+
+ Comments CompanyName FileDescription FileVersion
+ InternalName LegalCopyright LegalTrademarks OriginalFilename
+ ProductName ProductVersion
+
+=item B<-I>, B<--lib>=I<DIR>
+
+Add the given directory to the perl library file search path. May
+be specified multiple times.
+
+=item B<-l>, B<--link>=I<FILE>|I<LIBRARY>
+
+Add the given shared library (a.k.a. shared object or DLL) into the
+packed file. Also accepts names under library paths; i.e.
+C<-l ncurses> means the same thing as C<-l libncurses.so> or
+C<-l /usr/local/lib/libncurses.so> in most Unixes. May be specified
+multiple times.
+
+=item B<-L>, B<--log>=I<FILE>
+
+Log the output of packaging to a file rather than to stdout.
+
+=item B<-F>, B<--modfilter>=I<FILTER>
+
+Filter included perl module(s) with a L<PAR::Filter> subclass.
+You may specify multiple such filters.
+
+=item B<-M>, B<--module>=I<MODULE>
+
+Add the specified module into the package, along with its dependencies.
+Also accepts filenames relative to the C<@INC> path; i.e. C<-M
+Module::ScanDeps> means the same thing as C<-M Module/ScanDeps.pm>.
+
+If I<MODULE> has an extension that is not C<.pm>/C<.ix>/C<.al>, it will not
+be scanned for dependencies, and will be placed under C</> instead of
+C</lib/> inside the PAR file. This use is deprecated -- consider using
+the B<-a> option instead.
+
+You may specify C<-M> multiple times.
+
+=item B<-m>, B<--multiarch>
+
+Build a multi-architecture PAR file. Implies B<-p>.
+
+=item B<-n>, B<--noscan>
+
+Skip the default static scanning altogether, using run-time
+dependencies from B<-c> or B<-x> exclusively.
+
+=item B<-o>, B<--output>=I<FILE>
+
+File name for the final packaged executable.
+
+=item B<-p>, B<--par>
+
+Create PAR archives only; do not package to a standalone binary.
+
+=item B<-P>, B<--perlscript>
+
+Create stand-alone perl script; do not package to a standalone binary.
+
+=item B<-r>, B<--run>
+
+Run the resulting packaged script after packaging it.
+
+=item B<-S>, B<--save>
+
+Do not delete generated PAR file after packaging.
+
+=item B<-s>, B<--sign>
+
+Cryptographically sign the generated PAR or binary file using
+L<Module::Signature>.
+
+=item B<-T>, B<--tempcache>
+
+Set the program unique part of the cache directory name that is used
+if the program is run without -C. If not set, a hash of the executable
+is used.
+
+=item B<-v>, B<--verbose>[=I<NUMBER>]
+
+Increase verbosity of output; I<NUMBER> is an integer from C<1> to C<3>,
+C<3> being the most verbose. Defaults to C<1> if specified without an
+argument. Alternatively, B<-vv> sets verbose level to C<2>, and B<-vvv>
+sets it to C<3>.
+
+=item B<-V>, B<--version>
+
+Display the version number and copyrights of this program.
+
+=item B<-z>, B<--compress>=I<NUMBER>
+
+Set zip compression level; I<NUMBER> is an integer from C<0> to C<9>,
+C<0> = no compression, C<9> = max compression. Defaults to C<6> if
+B<-z> is not used.
+
+=back
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item PP_OPTS
+
+Command-line options (switches). Switches in this variable are taken
+as if they were on every F<pp> command line.
+
+=back
+
+=head1 NOTES
+
+Here are some recipes showing how to utilize F<pp> to bundle
+F<source.pl> with all its dependencies, on target machines with
+different expected settings:
+
+=over 4
+
+=item Stand-alone setup
+
+ % pp -o packed.exe source.pl # makes packed.exe
+ # Now, deploy 'packed.exe' to target machine...
+ $ packed.exe # run it
+
+=item Perl interpreter only, without core modules:
+
+ % pp -B -P -o packed.pl source.pl # makes packed.exe
+ # Now, deploy 'packed.exe' to target machine...
+ $ perl packed.pl # run it
+
+=item Perl with core module installed:
+
+ % pp -P -o packed.pl source.pl # makes packed.exe
+ # Now, deploy 'packed.pl' to target machine...
+ $ perl packed.pl # run it
+
+=item Perl with PAR.pm and its dependencies installed:
+
+ % pp -p source.pl # makes source.par
+ % echo "use PAR 'source.par';" > packed.pl;
+ % cat source.pl >> packed.pl; # makes packed.pl
+ # Now, deploy 'source.par' and 'packed.pl' to target machine...
+ $ perl packed.pl # run it
+
+=back
+
+Note that even if your perl was built with a shared library, the
+'Stand-alone setup' above will I<not> need a separate F<perl5x.dll>
+or F<libperl.so> to function correctly. Use C<--dependent> if you
+are willing to ship the shared library with the application, which
+can significantly reduce the executable size.
+
+=head1 SEE ALSO
+
+L<tkpp>, L<par.pl>, L<parl>, L<perlcc>
+
+L<PAR>, L<PAR::Packer>, L<Module::ScanDeps>
+
+=head1 ACKNOWLEDGMENTS
+
+Simon Cozens, Tom Christiansen and Edward Peschko for writing
+F<perlcc>; this program try to mimic its interface as close
+as possible, and copied liberally from their code.
+
+Jan Dubois for writing the F<exetype.pl> utility, which has been
+partially adapted into the C<-g> flag.
+
+Mattia Barbon for providing the C<myldr> binary loader code.
+
+Jeff Goff for suggesting the name C<pp>.
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+L<http://par.perl.org/> is the official PAR website. You can write
+to the mailing list at E<lt>par at perl.orgE<gt>, or send an empty mail to
+E<lt>par-subscribe at perl.orgE<gt> to participate in the discussion.
+
+Please submit bug reports to E<lt>bug-par at rt.cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004, 2005 by Autrijus Tang
+E<lt>autrijus at autrijus.orgE<gt>.
+
+Neither this program nor the associated L<parl> program 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, 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 L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Property changes on: packages/libpar-perl/branches/upstream/current/script/pp
___________________________________________________________________
Name: svn:executable
+
Added: packages/libpar-perl/branches/upstream/current/script/tkpp
===================================================================
--- packages/libpar-perl/branches/upstream/current/script/tkpp 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/script/tkpp 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,900 @@
+#!/usr/bin/perl
+
+our $VERSION = '1.11';
+
+=head1 NAME
+
+tkpp - frontend to pp written in Perl/Tk
+
+=head1 SYNOPSIS
+
+B<tkpp>
+
+=head1 DESCRIPTION
+
+Tkpp is a GUI frontend to L<pp>, which can turn perl scripts into stand-alone
+PAR files, perl scripts or executables.
+
+Below is a short explanation of all available screen elements; it is also
+displayed from the C<Help> - C<Help Contents> menu item.
+
+=head2 Source file
+
+The file you want to pack.
+
+=head2 Output file (--output, --par, --perlscript)
+
+The file you want the source file packed as. This option recognizes the
+C<.par>, C<.pl> and executable extensions, and supplies the corresponding build
+option automatically.
+
+=head2 Use icon (--icon)
+
+The icon file you want your output file to use. This option will only work
+when building Microsoft Windows C<.exe> files. Currently, this option only
+accepts C<.ico> files.
+
+=head2 Add modules/files (--add)
+
+Add the specified items into the package, along with their dependencies.
+Multiple items should be seperated by a comma (C<,>) or semicolon (C<;>).
+
+=head2 Exclude modules (--exclude)
+
+Exclude the given module from the dependency search path and from
+the package. Multiple modules should be seperated by a comma (C<,>) or
+semicolon (C<;>).
+
+=head2 Scan dependencies (--compile, --execute, --noscan)
+
+Specify the dependency scanning method to use. See L<pp> for explanations
+of the options.
+
+=head2 GUI (--gui)
+
+Build an executable that does not have a console window. This option is
+only applicable on Microsoft Windows, and is ignored when the output file
+is a C<.par> file.
+
+=head2 Log (--log)
+
+Log the output of packaging to a file. The log file, F<tkpp.log>, will
+be written in the user's home directory.
+
+=head2 Verbose (--verbose)
+
+Increase verbosity of output; from 1 to 3, 3 being the most verbose.
+This option is ignored if logging is not enabled.
+
+=head2 Build
+
+Starts building the package.
+
+=head2 File Menu->Preferences
+
+Specify the location to F<perl> and F<pp>. They must be set before Tkpp
+will build anything. The Tkpp configuration file, F<.tkpprc>, is
+stored in the user's home directory.
+
+=head1 NOTES
+
+I write code for a living not literature, so any misspelled words in any
+comments or anything, whoops ;)
+
+=cut
+
+###################################################
+# use modules
+###################################################
+use strict;
+use warnings;
+
+use Config;
+use FindBin;
+use File::Spec;
+use File::Basename;
+use Tk;
+use Tk::Balloon;
+use Tk::Dialog;
+use Tk::LabEntry;
+
+###################################################
+# global variables
+###################################################
+my $homedir = $ENV{USERPROFILE} || $ENV{HOME};
+my $addmodules;
+my $configfile = File::Spec->catfile($homedir, ".tkpprc");
+my $dogui;
+my $dolog;
+my $doverbose;
+my $excludemodules;
+my $scanmethod;
+my $gpgpath;
+my $iconfile;
+my $logfile = File::Spec->catfile($homedir, "tkpp.log");
+my $outputfile;
+my $perlfile = $^X;
+my $perlpath;
+my $pppath;
+my $sourcefile;
+my $statusbar;
+my $verboselevel;
+my $verboselevelbox;
+my $version = "1.1";
+my $ppfile = ($^O eq 'MSWin32') ? "pp.bat" : "pp";
+my @win32_only = ($^O eq 'MSWin32') ? () : (-state => 'disabled');
+
+###################################################
+# declare subroutines
+###################################################
+sub build;
+sub checkconfig;
+sub editpreferences;
+sub help;
+sub myicon;
+sub openfile;
+sub savefile;
+sub showdialog;
+sub splashimage;
+
+$| = 1;
+
+# begin building the gui
+#
+my $main = MainWindow->new();
+my $iconimage = &myicon(1);
+$main->title("Tkpp");
+
+# make the menu bar
+#
+$main->configure(-menu => my $menu_bar = $main->Menu);
+my $file_mb = $menu_bar->cascade(
+ -label => "~File",
+ -tearoff => 0
+);
+my $help_mb = $menu_bar->cascade(
+ -label => "~Help",
+ -tearoff => 0,
+);
+$file_mb->command(
+ -label => "~Preferences",
+ -command => \&editpreferences
+);
+$file_mb->command(
+ -label => "E~xit",
+ -command => sub { $main->destroy }
+);
+$help_mb->command(
+ -label => "~Help Contents",
+ -command => \&help
+);
+$help_mb->command(
+ -label => "~About Tkpp",
+ -command => [
+ sub { &showdialog },
+ "About Tkpp", << ".",
+Tkpp was written by Doug Gruber <doug(a)dougthug.com>.
+In the event this application breaks, you get both pieces ; )
+
+Tkpp Version: $version
+.
+ "info"
+ ]
+);
+
+# the frame from which all frames will come
+#
+my $bigframe = $main->Frame(-borderwidth => 10);
+
+# make the top frame
+#
+my $frame = $bigframe->Frame();
+$frame->Label(-text => "Source file ")->grid(
+ ( $frame->Entry(
+ -textvariable => \$sourcefile,
+ -background => "white",
+ -width => 30
+ )
+ ),
+ ( $frame->Button(
+ -image => $main->Getimage("srcfile"),
+ -command => [
+ sub { &openfile },
+ [ [ "Perl Files", [ ".par", ".pl", ".pm" ] ],
+ [ "All Files", ["*"] ]
+ ],
+ \$sourcefile
+ ]
+ )
+ ),
+ -padx => 1,
+ -pady => 2
+);
+
+$frame->Label(-text => "Output file ")->grid(
+ ( $frame->Entry(
+ -textvariable => \$outputfile,
+ -background => "white",
+ -width => 30
+ )
+ ),
+ ( $frame->Button(
+ -image => $main->Getimage("textfile"),
+ -command => [
+ sub { &savefile },
+ [ [ "Binary Files", ["*$Config{_exe}"] ],
+ [ "PAR Files", [".par"] ],
+ [ "All Files", ["*"] ]
+ ],
+ \$outputfile
+ ]
+ )
+ ),
+ -padx => 1,
+ -pady => 2,
+ );
+$frame->Label(-text => "Use icon ")->grid(
+ ( $frame->Entry(
+ -textvariable => \$iconfile,
+ -background => "white",
+ -width => 30
+ )
+ ),
+ ( $frame->Button(
+ -image => $main->Getimage("file"),
+ -command => [
+ sub { &openfile }, [ [ "ICO Files", [".ico"] ] ], \$iconfile
+ ]
+ )
+ ),
+ -padx => 1,
+ -pady => 2,
+ )
+ if ($^O eq 'MSWin32');
+
+# make the middle frame with the module lists
+#
+my $frame2 = $bigframe->Frame(-borderwidth => 1);
+my $frame2balloon = $frame2->Balloon();
+$frame2->Label(-text => "Add modules ")->grid(
+ my $addmoduleentry = $frame2->Entry(
+ -textvariable => \$addmodules,
+ -background => "white",
+ -width => 30
+ ),
+ -padx => 1,
+ -pady => 2
+);
+
+$frame2->Label(-text => "Exclude modules ")->grid(
+ my $excludemoduleentry = $frame2->Entry(
+ -textvariable => \$excludemodules,
+ -background => "white",
+ -width => 30
+ ),
+ -padx => 1,
+ -pady => 2
+);
+
+$frame2->Label(-text => "Scan dependencies ")->grid(
+ my $scanmethodbox = $frame2->Optionmenu(
+ -options => [
+ ['static' => undef],
+ ['compile + static' => ['--compile']],
+ ['execute + static' => ['--execute']],
+ ['compile only' => ['--compile', '--noscan']],
+ ['execute only' => ['--execute', '--noscan']],
+ ],
+ -variable => \$scanmethod,
+ ),
+ -padx => 1,
+ -pady => 2
+);
+
+$frame2balloon->attach(
+ $addmoduleentry,
+ -balloonposition => "mouse",
+ -balloonmsg =>
+"Adds the specified module(s) into the package, along with its dependencies, seperate each module with a comma or semicolon"
+);
+$frame2balloon->attach(
+ $excludemoduleentry,
+ -balloonposition => "mouse",
+ -balloonmsg =>
+"Excludes the given module(s) from the dependency search path and from the package, seperate each module with a comma or semicolon"
+);
+
+# make the middle frame with the checkboxes
+#
+my $frame3 = $bigframe->Frame(-borderwidth => 5);
+my $frame3balloon = $frame3->Balloon();
+my $guicheck = $frame3->Checkbutton(
+ -text => "GUI",
+ -variable => \$dogui,
+ -onvalue => "--gui",
+ -offvalue => "",
+ @win32_only
+ )->grid(
+ ( my $logcheck = $frame3->Checkbutton(
+ -text => "Log",
+ -variable => \$dolog,
+ -onvalue => "--log=$logfile",
+ -offvalue => ""
+ )
+ ),
+ ( my $verbosecheck = $frame3->Checkbutton(
+ -text => "Verbose",
+ -variable => \$doverbose,
+ -onvalue => "--verbose=",
+ -offvalue => ""
+ )
+ ),
+ ( $verboselevelbox = $frame3->Optionmenu(
+ -options => [ 3, 2, 1 ],
+ -variable => \$verboselevel,
+ )
+ )
+ );
+
+my $guiballon =
+ (($^O eq "MSWin32")
+ ? "Build an executable that does not have a console window"
+ : "This option is only available under Windows");
+$frame3balloon->attach(
+ $guicheck,
+ -balloonposition => "mouse",
+ -balloonmsg => $guiballon
+);
+$frame3balloon->attach(
+ $logcheck,
+ -balloonposition => "mouse",
+ -balloonmsg => "Log the output of packaging to a file"
+);
+$frame3balloon->attach(
+ $verbosecheck,
+ -balloonposition => "mouse",
+ -balloonmsg =>
+"Increase verbosity of output, this option is ignored if logging is not enabled"
+);
+$frame3balloon->attach(
+ $verboselevelbox,
+ -balloonposition => "mouse",
+ -balloonmsg => "The verbosity level from 1 to 3, 3 being the most verbose"
+);
+
+# make the bottom frame
+#
+my $frame4 = $bigframe->Frame(-borderwidth => 5);
+$frame4->Button(
+ -text => "Build",
+ -width => 10,
+ -underline => 0,
+ -command => \&build
+)->grid();
+$main->bind("<Alt-b>" => \&build);
+$main->bind("<Alt-B>" => \&build);
+
+# make the status bar (for future use)
+#
+$statusbar = "Ready";
+my $statusbottom = $main->Label(
+ -textvariable => \$statusbar,
+ -anchor => "w",
+ -relief => "sunken"
+ )->pack(
+ -side => "bottom",
+ -fill => "x"
+ );
+
+$frame->pack();
+$frame2->pack();
+$frame3->pack();
+$frame4->pack();
+$bigframe->pack();
+
+# create the splashscreen
+#
+my $splashimage = &splashimage(1);
+$main->withdraw();
+if (my $splash = eval { require Tk::Splashscreen; $main->Splashscreen }) {
+$splash->Label(
+ -text => "Tkpp",
+ -font => [ -size => "10", -weight => "bold" ],
+ -background => "#746b6b"
+ )->pack(
+ -fill => "both",
+ -expand => 1
+ );
+$splash->Label(
+ -image => $main->Photo("image", -data => $splashimage, -format => "gif"),
+ -background => "#746b6b"
+)->pack();
+$splash->Splash(1000);
+$splash->Destroy();
+}
+checkconfig();
+$main->iconify();
+$main->deiconify();
+
+#$main->raise();
+
+my $icon = $main->Photo(
+ "image",
+ -data => $iconimage,
+ -format => "gif"
+);
+$main->idletasks;
+$main->iconimage($icon);
+
+# align the main window appx with the middle of the screen
+#
+my $centerwidth = int(($main->screenwidth / 2) - ($main->width / 2));
+my $centerheight = int(($main->screenheight / 2) - ($main->height / 2));
+$main->geometry("+$centerwidth+$centerheight");
+
+MainLoop;
+
+###################################################
+# begin subroutines
+###################################################
+
+sub build {
+ if (!(-e $configfile)) {
+ showdialog("Preferences not set", << ".", "error");
+Your preferences have not been set or your preferences file has been removed.
+You will not be able to build your file untill this is complete.
+Please go to File -> Preferences to continue.
+.
+ }
+ elsif (!$pppath) {
+ showdialog("Path not set", << ".", "error");
+The path to $ppfile has not been set.
+Please go to File -> Preferences to continue.
+.
+ }
+ elsif ($perlpath eq "") {
+ showdialog("Path not set", << ".", "error");
+The path to perl$Config{_exe} has not been set.
+Please go to File -> Preferences to continue.
+.
+ }
+ elsif (!(-e $pppath)) {
+ showdialog("Invalid path", << ".", "error");
+The path to $ppfile is invalid.
+Check that the file exits and that your path is setup correctly.
+Please go to File -> Preferences to change the setting.
+.
+ }
+ elsif (!(-e $perlpath)) {
+ showdialog("Invalid path", << ".", "error");
+The path to perl$Config{_exe} is invalid.
+Check that the file exits and that your path is setup correctly.
+Please go to File -> Preferences to change the setting.
+.
+ }
+ elsif ($sourcefile eq "") {
+ showdialog("Missing parameter",
+ "You must specify a source file to build.", "error");
+ }
+ elsif ($outputfile eq "") {
+ showdialog("Missing parameter",
+ "You must specify an output file to write.", "error");
+ }
+ else {
+ $statusbar = "Building...";
+ $main->Busy();
+ my @args = ("$pppath", "--output=$outputfile");
+
+ if ($outputfile =~ /\.par$/i) {
+ push(@args, "--par");
+ }
+ elsif ($outputfile =~ /\.pl$/i) {
+ push(@args, "--perlscript");
+ }
+ elsif ($outputfile !~ /\Q$Config{_exe}\E$/i) {
+ showdialog("Invalid File Format", << ".", "error");
+You are trying to write your output file as an invalid file format.
+It must be either a $Config{_exe} or .par file.
+.
+ $main->Unbusy();
+ $statusbar = "Ready";
+ return ();
+ }
+
+ if ($iconfile) {
+ push(@args, "--icon=$iconfile");
+ }
+ if ($dogui) {
+ push(@args, $dogui);
+ }
+ if ($dolog) {
+ push(@args, $dolog);
+ }
+ if ($doverbose) {
+ push(@args, "$doverbose$verboselevel");
+ }
+ if ($addmodules) {
+ foreach (split(/,|;/, $addmodules)) {
+ $_ =~ s/^\s//;
+ push(@args, "--add=$_");
+ }
+ }
+ if ($excludemodules) {
+ foreach (split(/,|;/, $excludemodules)) {
+ $_ =~ s/^\s//;
+ push(@args, "--exclude=$_");
+ }
+ }
+ if ($scanmethod) {
+ push @args, @$scanmethod;
+ }
+
+ unlink($logfile);
+ system($^X, @args, $sourcefile);
+ if ($dolog) {
+ open LOGFILE, ">>$logfile";
+ print LOGFILE "Executed Command: @args\n";
+ close LOGFILE;
+ }
+ $main->Unbusy();
+ $statusbar = "Ready";
+ # $statusbar .= "(Error $?: $!)" if $?;
+ }
+}
+
+sub checkconfig {
+ if (-e $configfile) {
+ open CONFIGFILE, "$configfile";
+ while (<CONFIGFILE>) {
+ if ($_ =~ m/perlpath = (.*)/) {
+ $perlpath = $1;
+ }
+ elsif ($_ =~ m/pppath = (.*)/) {
+ $pppath = $1;
+ }
+ elsif ($_ =~ m/gpgpath = (.*)/) {
+ $gpgpath = $1;
+ }
+ }
+ close CONFIGFILE;
+ }
+ else {
+ editpreferences();
+ }
+}
+
+sub editpreferences {
+ if (-e $configfile) {
+ open CONFIGFILE, "+<$configfile";
+ while (<CONFIGFILE>) {
+ if ($_ =~ m/perlpath = (.*)/) {
+ $perlpath = $1;
+ }
+ elsif ($_ =~ m/pppath = (.*)/) {
+ $pppath = $1;
+ }
+ elsif ($_ =~ m/gpgpath = (.*)/) {
+ $gpgpath = $1;
+ }
+ }
+ }
+ else {
+ $perlpath = can_run($^X);
+ $pppath = File::Spec->catfile($FindBin::Bin, $ppfile);
+ $pppath = File::Spec->catfile(dirname($perlpath), $ppfile)
+ unless -e $pppath;
+ $perlpath = '' unless -e $perlpath;
+ $pppath = '' unless -e $pppath;
+ open CONFIGFILE, ">>$configfile";
+ }
+ my $preferences = $main->DialogBox(-title => "Preferences");
+ my $prefframe = $preferences->Frame(-borderwidth => 5);
+
+ $prefframe->Label(-text => "Path to perl ")->grid(
+ ( $prefframe->Entry(
+ -textvariable => \$perlpath,
+ -background => "white",
+ -width => 30
+ )
+ ),
+ ( $prefframe->Button(
+ -image => $main->Getimage("openfold"),
+ -command => [ sub { &openfile },
+ [ [ "Perl", ["$perlfile"] ], [ "All Files", ["*"] ] ],
+ \$perlpath
+ ]
+ )
+ ),
+ -padx => 1,
+ -pady => 2
+ );
+
+ $prefframe->Label(-text => "Path to pp ")->grid(
+ ( $prefframe->Entry(
+ -textvariable => \$pppath,
+ -background => "white",
+ -width => 30
+ )
+ ),
+ ( $preferences->Button(
+ -image => $main->Getimage("openfold"),
+ -command => [ sub { &openfile },
+ [ [ "pp Batch File",
+ [ $ppfile ]
+ ],
+ [ "All Files", ["*"] ]
+ ],
+ \$pppath
+ ]
+ )
+ ),
+ -padx => 1,
+ -pady => 2,
+ );
+ $prefframe->pack();
+ my $answer = $preferences->Show();
+ if ($answer eq "OK") {
+ no warnings "uninitialized";
+ print CONFIGFILE "perlpath = $perlpath\n";
+ print CONFIGFILE "pppath = $pppath\n";
+ print CONFIGFILE "gpgpath = $gpgpath\n";
+ close CONFIGFILE;
+ sub { $preferences->destroy };
+ }
+}
+
+my $help_text;
+sub help {
+ my $help = $main->DialogBox(-title => "Tkpp Help");
+ if (!$help_text) {
+ local $/;
+ seek DATA, 0, 0;
+ $help_text = <DATA>;
+ $help_text =~ s/.*?=head2/=head2/s;
+ $help_text =~ s/=head1 NOTES.*//s;
+ $help_text =~ s/=head2 (.*)\s+/* $1:\n/g;
+ $help_text =~ s/[LF]<(.*?)>/$1/g;
+ $help_text =~ s/C<(.*?)>/"$1"/g;
+ };
+ $help->Label(
+ -text => $help_text,
+ -justify => "left"
+ )->pack(-fill => "x");
+ $help->Show();
+}
+
+sub openfile {
+ my $types = shift();
+ my $file = shift();
+
+ $$file = $main->getOpenFile(
+ -filetypes => $types,
+ -initialdir => $$file
+ );
+ return ();
+}
+
+sub savefile {
+ my $types = shift();
+ my $file = shift();
+
+ $$file = $main->getSaveFile(
+ -filetypes => $types,
+ -initialdir => $$file
+ );
+ return ();
+}
+
+sub showdialog {
+ my $title = shift();
+ my $message = shift();
+ my $icon = shift();
+
+ if ($^O eq "MSWin32") {
+ my $messageBox = $main->messageBox(
+ -title => "$title",
+ -message => "$message",
+ -type => "OK",
+ -icon => "$icon"
+ );
+ }
+ else {
+ my $dialog = $main->DialogBox(-title => $title);
+ my $frame = $dialog->Frame(-borderwidth => 2);
+ $frame->Label(-width => 4)->grid($frame->Label());
+ $frame->Label(-bitmap => $icon)->grid(
+ $frame->Label(
+ -text => $message,
+ -justify => "left"
+ )
+ );
+ $frame->pack();
+ $dialog->bell();
+ $dialog->Show();
+ }
+
+ return 0;
+}
+
+sub splashimage {
+ my $splash_gif = << '.';
+R0lGODlh8gB5AKUAAP///////vj4+Pb29vDw7+zr5Obl3d7e3NjX1Ojo58/OzNnXx8vIxMXDv767
+t7m3tbWxsK+sqKimpKGdnZiSkpONjY+JiIyGhomEg4Z/f4F5eXtzc3dubnRra3FpaW9mZm1lZaaj
+m2FgYGphYVtXVkdFRUI/PlBOTWtqant5eXBubWdmZnVzc4uJeJWThD06NC4sKSQiHwEBASAfGzMy
+LBAQDG1kY2tjY3JwYXd3ZmdeXmVlUEVENikoJFRUPxgYEiH+FUNyZWF0ZWQgd2l0aCBUaGUgR0lN
+UAAsAAAAAPIAeQAABv5AgHBILBqPyKRyyWw6n9CodEqtWq/YrHbL7Xq/4LB4TC6bz+i0es1uu9/w
+uHxOr9vv+Lx+z+/7/4CBgnQBAQIDBAQFi4yNBQaPjwaTlJWWl5iZlosDAYOfZ4aIi5UHBgeoqQcI
+q6sIr7CxsrO0tAsICwsMugsGAqDAYQGIigmptAoLCsvMCgzODNHS09TR0NXYDA3bDg8QDgwFweNb
+AokFCacI19rb3A0O8Q/z9BD29/j53t759vz9ESJICEEwRIQF5BJWCaDo0QEFDbwJlEBxgsUJFDBS
+oFChYwULIC+IHInhQsmRF0KaNFnypEgMMGFmgAnSQoubLg4o3PmEYf66VQ0gSNDIsaOFCxmSali6
+YQOHpx06eJjq4YNVEFitUqVq9QNWEF2v2rhB9sYIGx86NMWRI0cLTzzjJhHwaJ2DCBY36jVqUmkG
+DU2fcohKmGvWD1MJSw3r9epXG2PNjtCh46wNHSRI7GAgt7ORAasg4iW692NfpYCdQlUstWpXqoqn
+hv1KG0TkEZMpUyZxogSPC56DCymgjAGEvHpLH8WQ9G9q1YIHt3aNmHVUrl3Bho0sWbeOEzxevDgh
+PLgBXXdJlzbNHHXTwNGvy0bswXph6lpdc8ftnYQJGj28UJ5nD0UkQXLJebRcc0y9F510W9UX1WrW
+MTYfCGTxpxtvJv7A0AMNA3amS1AHIriRUQui9hx0EMI2IYUvLqbdhRnmptsJL3gIYohxoQdBCCae
++FGKzq0Yn3yKHdmBYDIy5lVZGlKGIwwx7MjjTj4CGSSKpxW5InT2LfngkfhlV5ZZ3uHYw4dX8uSj
+esoRuVSD77E4IWHR2XndbF+dGaWabLapkC7eaImggkch1VyRGxg55pjwteiabZBx152UL6xppaDj
+vLkllzItOidTqXHA4oMeiDACVjfc51VklUJp4wkmaMppQlnCiehLoTI4ap1OqeYUCCSUYIIJJZRw
+AgkjyMhdrJfulmmgtwaT5adDHvVXryrS6eAGvBmrbGYiZEaCbP623TBWrFFiamu11jLggFBBFjUk
+CseegEJ7vo66ogjIKisCCilg8BEGKaAwaaXs2rhbrdTC+4mn9XZ0AcDJLqtBTAx6uVQHtAqsAgYT
+fLPNAxFQwIJYDNfoHWbTbiqxIBTvlRJIK4R8wgospJACS/z+5WXIJKhgwQQPKIBAAkwngEADEnTw
+qrq34eYwCTHPDErNHIWcLLLLslCBBMcBza1SHCRLAgsUJH1AAgQMIDciCTCwwdSyRgvzu1rTLO9x
+elmg87KZoZDBBA2wogAEvMoUdG8kpCBBAwckMvflBBgAAQfp1ujyhhDL3LcfNbOALAkEJ3U0BApU
+TkACCkzQOP7HGXBgwgksTMAA3Jf3jsgBFHSe4efS8j36HzVbQIIIKZT8QDyt825O3RSgxOsGvYlg
+gQOV++57AhFYKpnV/YV+fCBcX9C8A0s3HTfmB0iQaEomjZCv5Aq87z3mCKRg9f/tgpmOzgcIriVH
+AgnYn9wIEIGagCQDGNMXBRqQQAX2LgEPAMH/XlY+4xFwDwZMjgN45z0CTMCB2AMbCirwAAToz4IL
+RAAGKsNB74wAawP8YB9CyBEKsK57vjOhRzRgrGWlgALsqyAML5eABnCghjb0jwd1iIcQVoACMwkB
+AwywvxBYrDcnYN7kgLhE/k3gBlCkzA3NR0UQ/k0jV4yj8v5EcIEHkPFyEuiICpS1AgtEoHUvLOPc
+6qaBGpJPihFr4x2suEcSYMCO3lNAUUSwswtAYGmBFOQC44fGl/0PkaJTJB0O8MYg7REFFNid9xyQ
+kQqoAAWWXJomFUgABGTAkJMBpSjzwEMURA4Cd5RbAghynBb4UJZlFIAylem9BEygMg7DzQ10uctF
+ltJEItAeBb13gIA4YCAtVOIAlnmIy5HznOVcoARq9D91+SeH1awDD0mwglSKU24CYMDz7hKBByTw
+nAZwYTrNYQBjuOIAy7ycASggGc8Rq0OJjGccrnUoFaxgAgooQO+UiRcXZMCXvJEAOQkggeadM3ZY
+ZEE2Kf6pAGYuUAEYGMGZ1PWBd0ZUom+gaA878lGMBlKZE1CBCEogHhhQqQHLVIAEUPCCczYgBSug
+5LJqVYMEpJMAB4CACipFG5uGEqdtqJlHKtDT/G1UAILT4gJMIYIYWECZAZAABkggA4Qu8wEomABc
+A3CAHsiAAgl9nSRtox2reBWsc6DoWMlaTwXcU5kZKIEEcqHRB8yABAIIgAEy8DMZYICcDxCBXg1h
+iBR41qW/a0AFUIAWrzwUnojN6TVPxBEMiKACqjSnAFJAgwhAggACcIAMSmCIBqjAhzLA7DIjcAIK
+FCKzAljBadM5gKQ5AANfMSxEvxrbNKAHL4eqHiy3qf7bFJjgAXMTAF1XkNkMkMABAaiBDKyqTAiQ
+QAKkNaEMZMAA6g7gAhFAgFbVhZXDdjen8ABceI/iAC6mF7InyAAFLIABGuz3AXw9wQkyK13A1rdY
+hCuBfEuAWtB4IAIHaMAGyAIZah44rPrESxz3whELAPOFylQBDPbL49MGYAImSEEhJJBc6EogBj2W
+QQ0+W2IFeACjdjuTi1+8hgVERMYeoW1HMKrEZa43JhhAAHRPIN8kFyCzE5DBBTJ7gf3it8QT8AAS
+HZCB20yZyt69sr3iOOMKBFh/yjyBDDCMzgIkmcdvroBnScsCJdN3bgS42wXIFjzJYG2KeDaDlSGA
+l/6aLHasDX6fMkswaHQGgAJFJi0GZLACQ6z6s4ZIAJJFgNoDSO24Eqgzmu6caU0baMKetsCnWVjB
+UZeamV7+qyGUeQAlZ/bV5CSyDMQ8NwRkhWQWqBGve02GTafMgcH+yEcmMEJ8kvoBqBVAAvZL32Va
+WKTQXmYBLHwCyw2gAeliGwbGt21ui2HTBwK3wIUtbHBw0QQyCAFC04tqGqCz0eyNtzIVYAE3884B
+H0DLvljAbzb629ecBnZN6HcUcHdEAgjINQUiIOoBIKCF1FX3A/r7cgTMrQAUcEEOACxLCNjGAytI
+gQc+ud2PnwHgIp9fogR+xYzoxRT6Q0A7zuryuP6VUwFLyYALJLDFAUTgBh8QqgpkWpZ+G90LC5jX
+gURS8pEo3dMdcUEPwQFECjCnAiTEJ0wPcLnNveeRfH/ACDyggrIwzMBnH0Paf2R367Hd7QNP1Ngc
+O4AEKIUCrMh7CDSwO8tRoCpVUYEE8mcAsBeewF9BfOLDkHaBVAAmjkeJwHmVMAts8wCp8TP33mf5
+DfzxbZEeC25uS0EDfECaqNcubFf/hcV7EcwxcbwDSYIBcF2g3LhvSgoOR/nqNsWHlEvAijXEgksm
+gAPIt8FhVM98tM/LizOBfvRlPz+YpICO23TAe15pT7lNoCkWcEwHwAGXIlqOZQFWw2LawX7tx/4F
+rQd/YDYT8Td/9PMSf4F/TFMB75FN/VcAtdMoGDB6CDB0DpMCdjQBZEd2lcKADagFD0hWEhg08ocS
+MnF/F0BBD/AeLEBPFEB5DiAYLJA7StMBaKIbIzB6GZCCZOdORdeC7hcB8JcUMsgcM9grK5ABI0QB
+7+FLeZU/DBAdKqACGAUBGWKEI7A9KKCES8iCTngFrXdCzUGFcTiB8qcUIpABLZQB77ECkRNguCcm
+HLACF+UM46dGuCF6GwBAMtViTdiGW7AAKAOHiyKHUih//KIBzHNJpbI8FTBCE8AaOtCFCRBT/GE1
+t0UBAGR4bOiIVPCGFrAoUgiLdAiLGqAC5f4HAQ5CT1xmAawhAvX0ABcgK/xBAhlQAZ6jio3IilgA
+iZ0mNLIIi5QoNLXIAhKgf4EhAqLnQhJQH1ShAyuwWks4PjeUAtkWjixmdsoYBa44J874jLQ4JwPD
+dc/BAdToQglQAa3xATuzYjMlGeXyM/14jsmYjlXAjCfkLxrQjs/oL77YNt/SAZgnWBlQFcWyAshH
+NQ0VOSngWljBHV7FAyAZkiI5kj7gFpxBkERgkBcAGAipkNLoLxa1EU8RKRXgWEpFhCVAAg2Feh65
+kYyRLjbgVTEQAz0wlEVJlEZJlD0AAzTAAz7QAr+AkgCgkizZKOyYkH6BkKlxWxvAAqbylf5PkQGs
+4ACuRALQZHhggSFksTZO8ipBuV01EJdyOZdy+QM18AMzAANOGQJSOZWRuJJ1Mirv+CuAwQF3GBiR
+MhgYoDSsxAIXSWBuSSwq0JZd4VWHdpn7FZcx8AI+oAF9qZKB2SgK6S+N8h6p8iVgORgXsAzX9Zjq
+xxio8xp8YpmYeZk1MAOc6QKf+ZcrcpUvSSp1Ui7AkphRIYIPoAE7CZn0QQL5USY1tV21eZk/EANO
+2QC7iRcYUJVWeZWECSyZ8S1jIhUspDgXkIBUkx/MuRVhMRU6AJ3R2WO3SQMl2Zd+2WlWWZpaWZrD
+yQFhlJhMEhXYqDsBFQEapIKv6QEgcP4CICAfr1EV7akj78ljd6mXOyAO1yk73cmS2jmcGwACJSAC
+YMkaFBlGGXABqOBE5nmgvLEC9+EiD/ohEapkP9ADTqkA9FmfGDon+smhwGIqvaEC/0kY7XksH5oB
+ILA7MmSehfWhIgobHvCiFvaecYmbPiABN4qjFoCQPNqjK5aTXikdiqEDGSMCLGCkFcAKFbCErTUV
+YeMUYQKlERqfT3mlU5keWdqdW2oqTlEsdwgj97EYXQEYakkWYFEfvHGHtQOmhQGn0XmXTYkDBECn
+60iaXPotHaosPRMmrjIbLPaaiPEBt4NKFgCk9sGomHmXNLoDBkCnddppWlqpXwliRf6qqNYxHz95
+GNUBMmJkAX46FbRpmzPKmdbJqpP6Kz36leASMGszARqwJGHinBbiIjOpJ3vyq0k2pfLJl6zaqgdJ
+qeDJJJnBMxeghZoKqPQRIS7yIuFZGM+pKac6A00JldvKrXdqrHXyIIkJpIMRpHvSnBJiHY8SpK4B
+SsCql5A6r/Sqo8CJmPgasPw6H4mhqQ4LpvNBsNc6ozywAwiBsA9Yr/eJmqk5sRQbIUkSpBO7qRYr
+odPJmQ+AsEJQrNv5JQ7yKKfSov8KiEfyIPbBFW/prvAJrz6gmy6LpVpZlY4CKWSSrji7rkqyqV5x
+aTAqofDKAzkwtC8bifVKmgsLH/5LCybTgSd58ihg26RhcUMvQJRRKqMUaqFDuwCMl7VFu6M0O5O0
+qq6CAR/UOrK2enwnQANom5kY6wMba7VuCyRIkXVxO48B67Ule7d6+rj8Kh+2ehklUJRLKaOb6QMQ
+YLVDsAAR4AKvh5UJmZ9HK7ITu5+qQbaMYbYzEANGpZm5yblDcAAh4FHOISqMIrOnYrqQcqx6OylY
+MRmVOwNLOQPTKZ85MACyKwQE4AIagANLIpodY6++eyq727v3SiGg1xVjgRknAAOt+yHEy5k4sKrL
+CwAB8AA4YC46SXhOwQJei67oUhu1ARn0mxVbkS4BtBsaVivhSwNGRb7me77DkOoDOCIeLxAwYARG
+ydLADuzAAfPA4vLAEUzBxnIsGIzAABwDM9DBS0kDL+CULhCp5ysEhWAAPADAa7ImSTmULvzCMNy6
+Q9nBHPzCMmzDNdy6OszBHdzDPlzDRMmUTpkDg1vC6FsILvACNADARrWUK/zEUPzESGm5UKyUUkzF
+SpnFSLnFU/zBnLkD6GbERFAIhpABPqDES7zETGlUbNzGbvzGcBzHcjzHTMmZLdBSYlwEZFwIDNAC
+OeADIxnIgjzIhFzIhgySO4ADLsAAypvHjvzIkBzJkjzJlFzJlnzJmJzJmrzJnNzJnkynQQAAOw==
+.
+
+ my %send_back = (1 => $splash_gif);
+
+ return ($send_back{ $_[0] });
+}
+
+sub myicon {
+ my $icon_gif = << '.';
+R0lGODlhIAAgAOcAAComItra1qKiok5OSoqKfnp6dl5eXrKyrmpqZuLi2sLCuk5KRkZGOp6enubm
+4nZ2coaGfpqWlu7u6tbWzkI+Om5ubmZmZn5+fpKOilJSTs7Oyra2rjIyKvLy7q6qonZubnZyblZW
+VmZeXr66ssbGvpaOjvr6+oKCgmZiYnZqavb28mpmZlpaUn52do6GhioqJpaSknJmZsrKwm5iYt7e
+2pqaljYyKnpubnJqaoqCgqaenoJ+epKKiurq5sK+tn56eqqmopqSknpybjY2Lm5mYjIuKo6KhtLS
+yq6uoi4uJk5GRoZ+flpSUmJaWkpGQmpiYmpeXsrKyr6+usK+voqGgp6alt7a2l5aVi4uKlZOTl5W
+VoJ6dpKSjm5mZtrW0uLi3sbGwtLS0np2crKuqo6KimJiVqKemp6WlkZCPrayrubi4rq2trq6uoaG
+hq6qpjY2NqainlZSTvby8lpWUoaCfoqGhlpaWlJOSpKOjm5qZnJubnp2dvLy8sbCvsrGxlpWVmJe
+XtLOyrq2sjo2LtbS0r66uoaCgsrKxkpGRqaiot7e3urq6tra2ubm5srGvtbSys7Kyk5KSoJ+ftbW
+0vb29npycoJ6ep6amlZSUu7u7nZycjYyLl5aWlJOTqKenqqmpm5qarKyssLCvpqamuLi4rKurq6q
+qjY2MkZCQraysv//////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////yH+FUNyZWF0ZWQgd2l0aCBU
+aGUgR0lNUAAh+QQBCgD/ACwAAAAAIAAgAAAI/gD/mTDRwUGCgzQCKPQyqaFDhg4bTnh0hAaNf//U
+qPEz5pMnT1XOlCiBwYiLky6MkEHJkkpKI0gSsGFzKQgMMmSW/NCkKcUHHF26xMABNCiRoE+giJgz
+h4WGRIlsljhJZ0ulqz+J+vT5MyhSEVmyFJGhQ4fUk0sstWhR6UMKPXq4pkgBdMaMFTNE3LmTxBEc
+ODBK8MCZI63aFppu3NADSAsgQDG6rMD75EnYF46g2uTBk8meHIUt/QiaoUKDT58M3V3xRIQIJkyS
+yPiIJ4SByQIK4aSTwxLTCDQyqVBhpYXdyiLixMH8sYQkKQr5qFizxgUVLXv2qKHEnZKKT5WT/r5m
+ggVSWRhBdJAixX3KFCqYHmjQoKI79y9rlULBhOkFWR0l4LECGGBwt8EGmrRhBR982McdH4II0toT
+sPX1EQx4FNBII5TwkUoqQFhhAoPcZbJhJpQsskglUDyhhRYvQPKXYGSoSIkDJ5wAQQWUjDLKGipE
+0EADCBRIiRSSvYiFIxeWUIeNimCAASl/MFJFFRXwwYWKbYTCnQaXEPHHH0s2WUJDlAQwwAAWNIBH
+BRW8kQkLoICCSIOU6GBKFxWSEEEEZOCBB1SNhCGJJCZQEkIUUexRyArcGRAFgz/AMANsL/QRRBA4
+8eCpDoIYYkgmi4zCICOhJMLdJXWsd4Mm/iuMiYUCf55UB044SZmGBBgQyIcXfmzYwg4NiYEXpj5I
+aQgVVNRxqwt00FGHIi3k2IgpMBxySGWhhGLJE10o6cNIhYGWA7NLLFGHKZVkdwRiH+YFWgtPzDBm
+EVLglO6+ou4LAw5/JkLUJZd08cRke1QGGxY+eGqJJUuAltYPPzzgQiV/TiIEJ5PNEN4HK4j5RxJS
+nNTCDxCntVYLH1RywwcfRICEZHgRgQIKkfFJ3gg47dHCw4ddhUIlmsCMQyimVLZCF1BAkUdQTTRR
+xAgnqVXJWlcFJYJbrmUhhg8xxDBDF1FnJa6nK19VSRchhNATDnPhELZXXSCAgCU/ccJJhxEN82D1
+VTd0UeceH+hBlOBDEQXz4jgwxTBOaRP9gWIv06XV4lvNlUIMmFLtwsNpL35DW4rDzNPiP4HSxWUe
+7As61oqJ/nLLgGcV2RNDDAHAP044oUQnWUQi/PCIFF+8EsgLjwgqzKNCARYvvDDIPwYYwMAQHGyy
+CQfcd++995vY4H0RGP0TEAA7
+.
+
+ my %send_back = (1 => $icon_gif);
+
+ return ($send_back{ $_[0] });
+}
+
+sub can_run {
+ my $cmd = $_[0];
+
+ require Config;
+ require ExtUtils::MakeMaker;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ my $abs = File::Spec->catfile($dir, $_[0]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+__DATA__
+
+=head1 SEE ALSO
+
+L<pp>, L<PAR>
+
+=head1 AUTHORS
+
+Tkpp was written by Doug Gruber.
+In the event this application breaks, you get both pieces ;)
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004, 2005 by Doug Gruber E<lt>doug(a)dougthug.comE<gt>,
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+Neither this program nor the associated L<pp> program 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, 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 L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Property changes on: packages/libpar-perl/branches/upstream/current/script/tkpp
___________________________________________________________________
Name: svn:executable
+
Added: packages/libpar-perl/branches/upstream/current/t/1-basic.t
===================================================================
--- packages/libpar-perl/branches/upstream/current/t/1-basic.t 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/t/1-basic.t 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use Test;
+BEGIN { plan tests => 8 }
+
+$ENV{PAR_CLEAN} = 1;
+
+ok(
+ `"$^X" -Mblib -MPAR -It/hello -MHello -e Hello::hello`,
+ "Hello, world!\n",
+);
+
+ok(
+ `"$^X" -Mblib -MPAR t/hello.par hello.pl`,
+ "Hello, world!\nGoodbye, world!\n",
+);
+
+ok(
+ `"$^X" -Mblib -MPAR t/hello.par nostrict.pl`,
+ "No Strict!\n",
+);
+
+ok(
+ `"$^X" -Mblib -MPAR t/hello.par data.pl`,
+ "Data section\nData reflection\n",
+);
+
+require PAR;
+PAR->import('t/hello.par');
+
+ok(
+ PAR::read_file('script/hello.pl'),
+ qr/Hello::hello/,
+);
+
+ok( my $zip = PAR::par_handle('t/hello.par') );
+ok( my $member = $zip->memberNamed('lib/Hello.pm') );
+ok(
+ $member->contents,
+ qr/package Hello/,
+);
+
+__END__
Added: packages/libpar-perl/branches/upstream/current/t/2-pp.t
===================================================================
--- packages/libpar-perl/branches/upstream/current/t/2-pp.t 2005-12-17 12:56:37 UTC (rev 1678)
+++ packages/libpar-perl/branches/upstream/current/t/2-pp.t 2005-12-17 17:40:04 UTC (rev 1679)
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+
+use strict;
+use Cwd;
+use Config;
+use FindBin;
+use File::Spec;
+use ExtUtils::MakeMaker;
+
+sub samefiles {
+ my ($f1, $f2) = @_;
+ $f1 eq $f2 and return 1;
+ -e $f1 && -e $f2 or return 0;
+ -s $f1 == -s $f2 or return 0;
+ local $/ = \32768;
+ open my $fh1, $f1
+ and open my $fh2, $f2
+ or return 0;
+ while (1) {
+ my $c1 = <$fh1>;
+ my $c2 = <$fh2>;
+ last if !defined $c1 or !defined $c2;
+ return 0 if $c1 ne $c2;
+ }
+ return 1;
+}
+
+chdir File::Spec->catdir($FindBin::Bin, File::Spec->updir);
+
+my $cwd = getcwd();
+my $test_dir = File::Spec->catdir($cwd, 'contrib', 'automated_pp_test');
+
+my $parl = File::Spec->catfile($cwd, 'blib', 'script', "parl$Config{_exe}");
+my $startperl = $Config{startperl};
+$startperl =~ s/^#!//;
+
+my $orig_X = $^X;
+my $orig_startperl = $startperl;
+
+if (!-e $parl) {
+ print "1..0 # Skip 'parl' not found\n";
+ exit;
+}
+elsif (!($^X = main->can_run($^X))) {
+ print "1..0 # Skip '$orig_X' not found\n";
+ exit;
+}
+elsif (!($startperl = main->can_run($startperl))) {
+ print "1..0 # Skip '$orig_startperl' not found\n";
+ exit;
+}
+
+if (defined &Win32::GetShortPathName) {
+ $^X = lc(Win32::GetShortPathName($^X));
+ $startperl = lc(Win32::GetShortPathName($startperl));
+}
+
+if (!samefiles($startperl, $^X)) {
+ print "1..0 # Skip '$^X' is not the same as '$startperl'\n";
+ exit;
+}
+
+unshift @INC, File::Spec->catdir($cwd, 'inc');
+unshift @INC, File::Spec->catdir($cwd, 'blib', 'lib');
+unshift @INC, File::Spec->catdir($cwd, 'blib', 'script');
+
+$ENV{PAR_GLOBAL_CLEAN} = 1;
+
+$ENV{PATH} = join(
+ $Config{path_sep},
+ grep length,
+ File::Spec->catdir($cwd, 'blib', 'script'),
+ $ENV{PATH},
+);
+$ENV{PERL5LIB} = join(
+ $Config{path_sep},
+ grep length,
+ File::Spec->catdir($cwd, 'blib', 'lib'),
+ $test_dir,
+ $ENV{PERL5LIB},
+);
+
+chdir $test_dir;
+do "automated_pp_test.pl";
+
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+__END__
Added: packages/libpar-perl/branches/upstream/current/t/hello.par
===================================================================
(Binary files differ)
Property changes on: packages/libpar-perl/branches/upstream/current/t/hello.par
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
More information about the Pkg-perl-cvs-commits
mailing list