Created
May 9, 2011 12:04
-
-
Save gugod/962406 to your computer and use it in GitHub Desktop.
patchperl packed by fatpacker
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| all: | |
| fatpack trace `which patchperl` | |
| fatpack packlists-for `cat fatpacker.trace` >packlists | |
| fatpack tree `cat packlists` | |
| (echo "#!/usr/bin/env perl"; fatpack file; cat `which patchperl`) > patchperl | |
| chmod +x patchperl | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/usr/bin/env perl | |
| # This chunk of stuff was generated by App::FatPacker. To find the original | |
| # file's code, look for the end of this BEGIN block or the string 'FATPACK' | |
| BEGIN { | |
| my %fatpacked; | |
| $fatpacked{"Devel/PatchPerl.pm"} = <<'DEVEL_PATCHPERL'; | |
| package Devel::PatchPerl; | |
| { | |
| $Devel::PatchPerl::VERSION = '0.52'; | |
| } | |
| # ABSTRACT: Patch perl source a la Devel::PPPort's buildperl.pl | |
| use strict; | |
| use warnings; | |
| use File::pushd qw[pushd]; | |
| use File::Spec; | |
| use IO::File; | |
| use IPC::Cmd qw[can_run run]; | |
| use Devel::PatchPerl::Hints qw[hint_file]; | |
| use vars qw[@ISA @EXPORT_OK]; | |
| @ISA = qw(Exporter); | |
| @EXPORT_OK = qw(patch_source); | |
| my $patch_exe = can_run('patch'); | |
| my @patch = ( | |
| { | |
| perl => [ | |
| qr/^5\.00[01234]/, | |
| qw/ | |
| 5.005 | |
| 5.005_01 | |
| 5.005_02 | |
| 5.005_03 | |
| /, | |
| ], | |
| subs => [ | |
| [ \&_patch_db, 1 ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qw/ | |
| 5.6.0 | |
| 5.6.1 | |
| 5.7.0 | |
| 5.7.1 | |
| 5.7.2 | |
| 5.7.3 | |
| 5.8.0 | |
| /, | |
| ], | |
| subs => [ | |
| [ \&_patch_db, 3 ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qr/^5\.004_0[1234]$/, | |
| ], | |
| subs => [ | |
| [ \&_patch_doio ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qw/ | |
| 5.005 | |
| 5.005_01 | |
| 5.005_02 | |
| /, | |
| ], | |
| subs => [ | |
| [ \&_patch_sysv, old_format => 1 ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qw/ | |
| 5.005_03 | |
| 5.005_04 | |
| /, | |
| qr/^5\.6\.[0-2]$/, | |
| qr/^5\.7\.[0-3]$/, | |
| qr/^5\.8\.[0-8]$/, | |
| qr/^5\.9\.[0-5]$/ | |
| ], | |
| subs => [ | |
| [ \&_patch_sysv, old_format => 0 ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qr/^5\.004_05$/, | |
| qr/^5\.005(?:_0[1-4])?$/, | |
| qr/^5\.6\.[01]$/, | |
| ], | |
| subs => [ | |
| [ \&_patch_configure ], | |
| [ \&_patch_makedepend_lc ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| '5.8.0', | |
| ], | |
| subs => [ | |
| [ \&_patch_makedepend_lc ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qr/.*/, | |
| ], | |
| subs => [ | |
| [ \&_patch_hints ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qr/^5\.6\.[0-2]$/, | |
| qr/^5\.7\.[0-3]$/, | |
| qr/^5\.8\.[0-8]$/, | |
| ], | |
| subs => [ | |
| [ \&_patch_makedepend_SH ], | |
| ], | |
| }, | |
| { | |
| perl => [ | |
| qr/^5\.1[0-2]/, | |
| ], | |
| subs => [ | |
| [ \&_patch_archive_tar_tests ], | |
| [ \&_patch_odbm_file_hints_linux ], | |
| ], | |
| }, | |
| ); | |
| sub patch_source { | |
| my $vers = shift; | |
| $vers = shift if eval { $vers->isa(__PACKAGE__) }; | |
| my $source = shift || '.'; | |
| if ( !$vers ) { | |
| $vers = _determine_version($source); | |
| if ( $vers ) { | |
| warn "Auto-guessed '$vers'\n"; | |
| } | |
| else { | |
| die "You didn't provide a perl version and I don't appear to be in a perl source tree\n"; | |
| } | |
| } | |
| $source = File::Spec->rel2abs($source); | |
| { | |
| my $dir = pushd( $source ); | |
| for my $p ( grep { _is( $_->{perl}, $vers ) } @patch ) { | |
| for my $s (@{$p->{subs}}) { | |
| my($sub, @args) = @$s; | |
| push @args, $vers unless scalar @args; | |
| $sub->(@args); | |
| } | |
| } | |
| } | |
| } | |
| sub _is | |
| { | |
| my($s1, $s2) = @_; | |
| defined $s1 != defined $s2 and return 0; | |
| ref $s2 and ($s1, $s2) = ($s2, $s1); | |
| if (ref $s1) { | |
| if (ref $s1 eq 'ARRAY') { | |
| _is($_, $s2) and return 1 for @$s1; | |
| return 0; | |
| } | |
| return $s2 =~ $s1; | |
| } | |
| return $s1 eq $s2; | |
| } | |
| sub _patch | |
| { | |
| my($patch) = @_; | |
| print "patching $_\n" for $patch =~ /^\+{3}\s+(\S+)/gm; | |
| my $diff = 'tmp.diff'; | |
| _write_or_die($diff, $patch); | |
| die "No patch utility found\n" unless $patch_exe; | |
| _run_or_die("$patch_exe -f -s -p0 <$diff"); | |
| unlink $diff or die "unlink $diff: $!\n"; | |
| } | |
| sub _write_or_die | |
| { | |
| my($file, $data) = @_; | |
| my $fh = IO::File->new(">$file") or die "$file: $!\n"; | |
| $fh->print($data); | |
| } | |
| sub _run_or_die | |
| { | |
| # print "[running @_]\n"; | |
| die unless scalar run( command => [ @_ ], verbose => 1 ); | |
| } | |
| sub _determine_version { | |
| my ($source) = @_; | |
| my $patchlevel_h = File::Spec->catfile($source, 'patchlevel.h'); | |
| return unless -e $patchlevel_h; | |
| my $version; | |
| { | |
| my %defines; | |
| open my $fh, '<', $patchlevel_h; | |
| my @vers; | |
| while (<$fh>) { | |
| chomp; | |
| next unless /^#define/; | |
| my ($foo,$bar) = ( split /\s+/ )[1,2]; | |
| $defines{$foo} = $bar; | |
| } | |
| if ( my @wotsits = grep { defined $defines{$_} } qw(PERL_REVISION PERL_VERSION PERL_API_SUBVERSION) ) { | |
| $version = join '.', map { $defines{$_} } @wotsits; | |
| } | |
| else { | |
| $version = sprintf '5.%03d_%02d', map { $defines{$_} } qw(PATCHLEVEL SUBVERSION); | |
| } | |
| } | |
| return $version; | |
| } | |
| sub _patch_hints { | |
| return unless my ($file,$data) = hint_file(); | |
| my $path = File::Spec->catfile( 'hints', $file ); | |
| chmod 0644, $path or die "$!\n"; | |
| open my $fh, '>', $path or die "$!\n"; | |
| print $fh $data; | |
| close $fh; | |
| return 1; | |
| } | |
| sub _patch_db | |
| { | |
| my $ver = shift; | |
| print "patching ext/DB_File/DB_File.xs\n"; | |
| _run_or_die($^X, '-pi.bak', '-e', "s/<db.h>/<db$ver\\/db.h>/", 'ext/DB_File/DB_File.xs'); | |
| unlink 'ext/DB_File/DB_File.xs.bak' if -e 'ext/DB_File/DB_File.xs.bak'; | |
| } | |
| sub _patch_doio | |
| { | |
| _patch(<<'END'); | |
| --- doio.c.org 2004-06-07 23:14:45.000000000 +0200 | |
| +++ doio.c 2003-11-04 08:03:03.000000000 +0100 | |
| @@ -75,6 +75,16 @@ | |
| # endif | |
| #endif | |
| +#if _SEM_SEMUN_UNDEFINED | |
| +union semun | |
| +{ | |
| + int val; | |
| + struct semid_ds *buf; | |
| + unsigned short int *array; | |
| + struct seminfo *__buf; | |
| +}; | |
| +#endif | |
| + | |
| bool | |
| do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) | |
| GV *gv; | |
| END | |
| } | |
| sub _patch_sysv | |
| { | |
| my %opt = @_; | |
| # check if patching is required | |
| return if $^O ne 'linux' or -f '/usr/include/asm/page.h'; | |
| if ($opt{old_format}) { | |
| _patch(<<'END'); | |
| --- ext/IPC/SysV/SysV.xs.org 1998-07-20 10:20:07.000000000 +0200 | |
| +++ ext/IPC/SysV/SysV.xs 2007-08-12 10:51:06.000000000 +0200 | |
| @@ -3,9 +3,6 @@ | |
| #include "XSUB.h" | |
| #include <sys/types.h> | |
| -#ifdef __linux__ | |
| -#include <asm/page.h> | |
| -#endif | |
| #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) | |
| #include <sys/ipc.h> | |
| #ifdef HAS_MSG | |
| END | |
| } | |
| else { | |
| _patch(<<'END'); | |
| --- ext/IPC/SysV/SysV.xs.org 2007-08-11 00:12:46.000000000 +0200 | |
| +++ ext/IPC/SysV/SysV.xs 2007-08-11 00:10:51.000000000 +0200 | |
| @@ -3,9 +3,6 @@ | |
| #include "XSUB.h" | |
| #include <sys/types.h> | |
| -#ifdef __linux__ | |
| -# include <asm/page.h> | |
| -#endif | |
| #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) | |
| #ifndef HAS_SEM | |
| # include <sys/ipc.h> | |
| END | |
| } | |
| } | |
| sub _patch_configure | |
| { | |
| _patch(<<'END'); | |
| --- Configure | |
| +++ Configure | |
| @@ -3380,6 +3380,18 @@ | |
| test "X$gfpthkeep" != Xy && gfpth="" | |
| EOSC | |
| +# gcc 3.1 complains about adding -Idirectories that it already knows about, | |
| +# so we will take those off from locincpth. | |
| +case "$gccversion" in | |
| +3*) | |
| + echo "main(){}">try.c | |
| + for incdir in `$cc -v -c try.c 2>&1 | \ | |
| + sed '1,/^#include <\.\.\.>/d;/^End of search list/,$d;s/^ //'` ; do | |
| + locincpth=`echo $locincpth | sed s!$incdir!!` | |
| + done | |
| + $rm -f try try.* | |
| +esac | |
| + | |
| : What should the include directory be ? | |
| echo " " | |
| $echo $n "Hmm... $c" | |
| END | |
| } | |
| sub _patch_makedepend_lc | |
| { | |
| _patch(<<'END'); | |
| --- makedepend.SH | |
| +++ makedepend.SH | |
| @@ -58,6 +58,10 @@ case $PERL_CONFIG_SH in | |
| ;; | |
| esac | |
| +# Avoid localized gcc/cc messages | |
| +LC_ALL=C | |
| +export LC_ALL | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| END | |
| } | |
| sub _patch_makedepend_SH | |
| { | |
| my $perl = shift; | |
| SWITCH: { | |
| # If 5.6.0 | |
| if ( $perl eq '5.6.0' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2000-03-02 18:12:26.000000000 +0000 | |
| +++ makedepend.SH 2010-09-01 10:13:37.000000000 +0100 | |
| @@ -1,5 +1,5 @@ | |
| #! /bin/sh | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -29,6 +29,13 @@ | |
| !GROK!THIS! | |
| $spitshell >>makedepend <<'!NO!SUBS!' | |
| +if test -d .depending; then | |
| + echo "$0: Already running, exiting." | |
| + exit 0 | |
| +fi | |
| + | |
| +mkdir .depending | |
| + | |
| # This script should be called with | |
| # sh ./makedepend MAKE=$(MAKE) | |
| case "$1" in | |
| @@ -37,7 +44,7 @@ | |
| export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -51,6 +58,11 @@ | |
| ;; | |
| esac | |
| +# Avoid localized gcc messages | |
| +case "$ccname" in | |
| + gcc) LC_ALL=C ; export LC_ALL ;; | |
| +esac | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| @@ -58,6 +70,10 @@ | |
| PATH=".$path_sep..$path_sep$PATH" | |
| export PATH | |
| +case "$osname" in | |
| +amigaos) cat=/bin/cat ;; # must be absolute | |
| +esac | |
| + | |
| $cat /dev/null >.deptmp | |
| $rm -f *.c.c c/*.c.c | |
| if test -f Makefile; then | |
| @@ -67,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -99,25 +114,20 @@ | |
| $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) | |
| for file in `$cat .clist`; do | |
| # for file in `cat /dev/null`; do | |
| - if [ "$osname" = uwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" | |
| - else | |
| - if [ "$osname" = os2 ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$archname" = cygwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - uwinfix= | |
| - fi | |
| - fi | |
| - fi | |
| + case "$osname" in | |
| + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; | |
| + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; | |
| + vos) uwinfix="-e s/\#/\\\#/" ;; | |
| + *) uwinfix="" ;; | |
| + esac | |
| case "$file" in | |
| *.c) filebase=`basename $file .c` ;; | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -130,22 +140,45 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| $echo '#endif' >>UU/$file.c | |
| fi | |
| - $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| - $sed \ | |
| - -e '1d' \ | |
| - -e '/^#.*<stdin>/d' \ | |
| - -e '/^#.*"-"/d' \ | |
| - -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| - -e 's/^[ ]*#[ ]*line/#/' \ | |
| - -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| - -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| - -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| - -e 's|: \./|: |' \ | |
| - -e 's|\.c\.c|.c|' $uwinfix | \ | |
| - $uniq | $sort | $uniq >> .deptmp | |
| + | |
| + if [ "$osname" = os390 ]; then | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| + $sed \ | |
| + -e '/^#.*<stdin>/d' \ | |
| + -e '/^#.*"-"/d' \ | |
| + -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| + -e 's/^[ ]*#[ ]*line/#/' \ | |
| + -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| + -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| + -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| + -e 's|: \./|: |' \ | |
| + -e 's|\.c\.c|.c|' $uwinfix | \ | |
| + $uniq | $sort | $uniq >> .deptmp | |
| + else | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr | |
| + $sed \ | |
| + -e '1d' \ | |
| + -e '/^#.*<stdin>/d' \ | |
| + -e '/^#.*<builtin>/d' \ | |
| + -e '/^#.*<built-in>/d' \ | |
| + -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| + -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| + -e '/: file path prefix .* never used$/d' \ | |
| + -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| + -e 's/^[ ]*#[ ]*line/#/' \ | |
| + -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| + -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| + -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| + -e 's|: \./|: |' \ | |
| + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ | |
| + $uniq | $sort | $uniq >> .deptmp | |
| + fi | |
| done | |
| $sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d' | |
| @@ -177,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| @@ -208,7 +245,8 @@ | |
| $cp $mf.new $mf | |
| $rm $mf.new | |
| $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf | |
| -$rm -rf .deptmp UU .shlist .clist .hlist .hsed | |
| +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr | |
| +rmdir .depending | |
| !NO!SUBS! | |
| $eunicefix makedepend | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.6.1 | |
| if ( $perl eq '5.6.1' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2001-03-19 07:33:17.000000000 +0000 | |
| +++ makedepend.SH 2010-09-01 10:14:47.000000000 +0100 | |
| @@ -1,5 +1,5 @@ | |
| #! /bin/sh | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -29,6 +29,13 @@ | |
| !GROK!THIS! | |
| $spitshell >>makedepend <<'!NO!SUBS!' | |
| +if test -d .depending; then | |
| + echo "$0: Already running, exiting." | |
| + exit 0 | |
| +fi | |
| + | |
| +mkdir .depending | |
| + | |
| # This script should be called with | |
| # sh ./makedepend MAKE=$(MAKE) | |
| case "$1" in | |
| @@ -37,7 +44,7 @@ | |
| export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -51,6 +58,11 @@ | |
| ;; | |
| esac | |
| +# Avoid localized gcc messages | |
| +case "$ccname" in | |
| + gcc) LC_ALL=C ; export LC_ALL ;; | |
| +esac | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| @@ -58,6 +70,10 @@ | |
| PATH=".$path_sep..$path_sep$PATH" | |
| export PATH | |
| +case "$osname" in | |
| +amigaos) cat=/bin/cat ;; # must be absolute | |
| +esac | |
| + | |
| $cat /dev/null >.deptmp | |
| $rm -f *.c.c c/*.c.c | |
| if test -f Makefile; then | |
| @@ -67,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -99,29 +114,20 @@ | |
| $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) | |
| for file in `$cat .clist`; do | |
| # for file in `cat /dev/null`; do | |
| - if [ "$osname" = uwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" | |
| - else | |
| - if [ "$osname" = os2 ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$archname" = cygwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$osname" = posix-bc ]; then | |
| - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" | |
| - else | |
| - uwinfix= | |
| - fi | |
| - fi | |
| - fi | |
| - fi | |
| + case "$osname" in | |
| + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; | |
| + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; | |
| + vos) uwinfix="-e s/\#/\\\#/" ;; | |
| + *) uwinfix="" ;; | |
| + esac | |
| case "$file" in | |
| *.c) filebase=`basename $file .c` ;; | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -134,10 +140,12 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| + if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| + $echo '#endif' >>UU/$file.c | |
| + fi | |
| + | |
| if [ "$osname" = os390 ]; then | |
| - if [ "$file" = perly.c ]; then | |
| - $echo '#endif' >>UU/$file.c | |
| - fi | |
| $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| $sed \ | |
| -e '/^#.*<stdin>/d' \ | |
| @@ -151,18 +159,24 @@ | |
| -e 's|\.c\.c|.c|' $uwinfix | \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| else | |
| - $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr | |
| $sed \ | |
| -e '1d' \ | |
| -e '/^#.*<stdin>/d' \ | |
| + -e '/^#.*<builtin>/d' \ | |
| + -e '/^#.*<built-in>/d' \ | |
| + -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| + -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's|: \./|: |' \ | |
| - -e 's|\.c\.c|.c|' $uwinfix | \ | |
| + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| fi | |
| done | |
| @@ -196,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| @@ -227,7 +245,8 @@ | |
| $cp $mf.new $mf | |
| $rm $mf.new | |
| $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf | |
| -$rm -rf .deptmp UU .shlist .clist .hlist .hsed | |
| +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr | |
| +rmdir .depending | |
| !NO!SUBS! | |
| $eunicefix makedepend | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.6.2 | |
| if ( $perl eq '5.6.2' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2003-07-30 23:46:59.000000000 +0100 | |
| +++ makedepend.SH 2010-09-01 10:15:47.000000000 +0100 | |
| @@ -1,5 +1,5 @@ | |
| #! /bin/sh | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -29,6 +29,13 @@ | |
| !GROK!THIS! | |
| $spitshell >>makedepend <<'!NO!SUBS!' | |
| +if test -d .depending; then | |
| + echo "$0: Already running, exiting." | |
| + exit 0 | |
| +fi | |
| + | |
| +mkdir .depending | |
| + | |
| # This script should be called with | |
| # sh ./makedepend MAKE=$(MAKE) | |
| case "$1" in | |
| @@ -37,7 +44,7 @@ | |
| export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -63,6 +70,10 @@ | |
| PATH=".$path_sep..$path_sep$PATH" | |
| export PATH | |
| +case "$osname" in | |
| +amigaos) cat=/bin/cat ;; # must be absolute | |
| +esac | |
| + | |
| $cat /dev/null >.deptmp | |
| $rm -f *.c.c c/*.c.c | |
| if test -f Makefile; then | |
| @@ -72,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -104,29 +114,20 @@ | |
| $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) | |
| for file in `$cat .clist`; do | |
| # for file in `cat /dev/null`; do | |
| - if [ "$osname" = uwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" | |
| - else | |
| - if [ "$osname" = os2 ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$archname" = cygwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$osname" = posix-bc ]; then | |
| - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" | |
| - else | |
| - uwinfix= | |
| - fi | |
| - fi | |
| - fi | |
| - fi | |
| + case "$osname" in | |
| + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; | |
| + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; | |
| + vos) uwinfix="-e s/\#/\\\#/" ;; | |
| + *) uwinfix="" ;; | |
| + esac | |
| case "$file" in | |
| *.c) filebase=`basename $file .c` ;; | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -139,10 +140,12 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| + if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| + $echo '#endif' >>UU/$file.c | |
| + fi | |
| + | |
| if [ "$osname" = os390 ]; then | |
| - if [ "$file" = perly.c ]; then | |
| - $echo '#endif' >>UU/$file.c | |
| - fi | |
| $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| $sed \ | |
| -e '/^#.*<stdin>/d' \ | |
| @@ -156,21 +159,24 @@ | |
| -e 's|\.c\.c|.c|' $uwinfix | \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| else | |
| - $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr | |
| $sed \ | |
| -e '1d' \ | |
| -e '/^#.*<stdin>/d' \ | |
| - -e '/^#.*<builtin>/d' \ | |
| - -e '/^#.*<built-in>/d' \ | |
| - -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<builtin>/d' \ | |
| + -e '/^#.*<built-in>/d' \ | |
| + -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| + -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's|: \./|: |' \ | |
| - -e 's|\.c\.c|.c|' $uwinfix | \ | |
| + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| fi | |
| done | |
| @@ -204,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| @@ -235,7 +245,8 @@ | |
| $cp $mf.new $mf | |
| $rm $mf.new | |
| $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf | |
| -$rm -rf .deptmp UU .shlist .clist .hlist .hsed | |
| +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr | |
| +rmdir .depending | |
| !NO!SUBS! | |
| $eunicefix makedepend | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.7.0 | |
| if ( $perl eq '5.7.0' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2000-08-13 19:35:04.000000000 +0100 | |
| +++ makedepend.SH 2010-09-01 10:47:14.000000000 +0100 | |
| @@ -1,5 +1,5 @@ | |
| #! /bin/sh | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -29,6 +29,13 @@ | |
| !GROK!THIS! | |
| $spitshell >>makedepend <<'!NO!SUBS!' | |
| +if test -d .depending; then | |
| + echo "$0: Already running, exiting." | |
| + exit 0 | |
| +fi | |
| + | |
| +mkdir .depending | |
| + | |
| # This script should be called with | |
| # sh ./makedepend MAKE=$(MAKE) | |
| case "$1" in | |
| @@ -37,7 +44,7 @@ | |
| export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -51,6 +58,11 @@ | |
| ;; | |
| esac | |
| +# Avoid localized gcc messages | |
| +case "$ccname" in | |
| + gcc) LC_ALL=C ; export LC_ALL ;; | |
| +esac | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| @@ -58,6 +70,10 @@ | |
| PATH=".$path_sep..$path_sep$PATH" | |
| export PATH | |
| +case "$osname" in | |
| +amigaos) cat=/bin/cat ;; # must be absolute | |
| +esac | |
| + | |
| $cat /dev/null >.deptmp | |
| $rm -f *.c.c c/*.c.c | |
| if test -f Makefile; then | |
| @@ -67,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -99,25 +114,20 @@ | |
| $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) | |
| for file in `$cat .clist`; do | |
| # for file in `cat /dev/null`; do | |
| - if [ "$osname" = uwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" | |
| - else | |
| - if [ "$osname" = os2 ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$archname" = cygwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - uwinfix= | |
| - fi | |
| - fi | |
| - fi | |
| + case "$osname" in | |
| + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; | |
| + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; | |
| + vos) uwinfix="-e s/\#/\\\#/" ;; | |
| + *) uwinfix="" ;; | |
| + esac | |
| case "$file" in | |
| *.c) filebase=`basename $file .c` ;; | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -130,10 +140,12 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| + if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| + $echo '#endif' >>UU/$file.c | |
| + fi | |
| + | |
| if [ "$osname" = os390 ]; then | |
| - if [ "$file" = perly.c ]; then | |
| - $echo '#endif' >>UU/$file.c | |
| - fi | |
| $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| $sed \ | |
| -e '/^#.*<stdin>/d' \ | |
| @@ -147,18 +159,24 @@ | |
| -e 's|\.c\.c|.c|' $uwinfix | \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| else | |
| - $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr | |
| $sed \ | |
| -e '1d' \ | |
| -e '/^#.*<stdin>/d' \ | |
| + -e '/^#.*<builtin>/d' \ | |
| + -e '/^#.*<built-in>/d' \ | |
| + -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| + -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's|: \./|: |' \ | |
| - -e 's|\.c\.c|.c|' $uwinfix | \ | |
| + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| fi | |
| done | |
| @@ -192,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| @@ -223,7 +245,8 @@ | |
| $cp $mf.new $mf | |
| $rm $mf.new | |
| $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf | |
| -$rm -rf .deptmp UU .shlist .clist .hlist .hsed | |
| +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr | |
| +rmdir .depending | |
| !NO!SUBS! | |
| $eunicefix makedepend | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.7.1 | |
| if ( $perl eq '5.7.1' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2001-03-11 16:30:08.000000000 +0000 | |
| +++ makedepend.SH 2010-09-01 10:44:54.000000000 +0100 | |
| @@ -1,5 +1,5 @@ | |
| #! /bin/sh | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -29,6 +29,13 @@ | |
| !GROK!THIS! | |
| $spitshell >>makedepend <<'!NO!SUBS!' | |
| +if test -d .depending; then | |
| + echo "$0: Already running, exiting." | |
| + exit 0 | |
| +fi | |
| + | |
| +mkdir .depending | |
| + | |
| # This script should be called with | |
| # sh ./makedepend MAKE=$(MAKE) | |
| case "$1" in | |
| @@ -37,7 +44,7 @@ | |
| export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) | |
| -case $CONFIGDOTSH in | |
| +case $PERL_CONFIG_SH in | |
| '') | |
| if test -f config.sh; then TOP=.; | |
| elif test -f ../config.sh; then TOP=..; | |
| @@ -51,6 +58,11 @@ | |
| ;; | |
| esac | |
| +# Avoid localized gcc messages | |
| +case "$ccname" in | |
| + gcc) LC_ALL=C ; export LC_ALL ;; | |
| +esac | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| @@ -58,6 +70,10 @@ | |
| PATH=".$path_sep..$path_sep$PATH" | |
| export PATH | |
| +case "$osname" in | |
| +amigaos) cat=/bin/cat ;; # must be absolute | |
| +esac | |
| + | |
| $cat /dev/null >.deptmp | |
| $rm -f *.c.c c/*.c.c | |
| if test -f Makefile; then | |
| @@ -67,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -99,29 +114,20 @@ | |
| $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) | |
| for file in `$cat .clist`; do | |
| # for file in `cat /dev/null`; do | |
| - if [ "$osname" = uwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" | |
| - else | |
| - if [ "$osname" = os2 ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$archname" = cygwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$osname" = posix-bc ]; then | |
| - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" | |
| - else | |
| - uwinfix= | |
| - fi | |
| - fi | |
| - fi | |
| - fi | |
| + case "$osname" in | |
| + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; | |
| + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; | |
| + vos) uwinfix="-e s/\#/\\\#/" ;; | |
| + *) uwinfix="" ;; | |
| + esac | |
| case "$file" in | |
| *.c) filebase=`basename $file .c` ;; | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -134,10 +140,12 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| + if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| + $echo '#endif' >>UU/$file.c | |
| + fi | |
| + | |
| if [ "$osname" = os390 ]; then | |
| - if [ "$file" = perly.c ]; then | |
| - $echo '#endif' >>UU/$file.c | |
| - fi | |
| $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| $sed \ | |
| -e '/^#.*<stdin>/d' \ | |
| @@ -151,18 +159,24 @@ | |
| -e 's|\.c\.c|.c|' $uwinfix | \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| else | |
| - $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr | |
| $sed \ | |
| -e '1d' \ | |
| -e '/^#.*<stdin>/d' \ | |
| + -e '/^#.*<builtin>/d' \ | |
| + -e '/^#.*<built-in>/d' \ | |
| + -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| + -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's|: \./|: |' \ | |
| - -e 's|\.c\.c|.c|' $uwinfix | \ | |
| + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| fi | |
| done | |
| @@ -196,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| @@ -227,7 +245,8 @@ | |
| $cp $mf.new $mf | |
| $rm $mf.new | |
| $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf | |
| -$rm -rf .deptmp UU .shlist .clist .hlist .hsed | |
| +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr | |
| +rmdir .depending | |
| !NO!SUBS! | |
| $eunicefix makedepend | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.7.2 | |
| if ( $perl eq '5.7.2' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2001-07-09 15:11:05.000000000 +0100 | |
| +++ makedepend.SH 2010-09-01 10:45:32.000000000 +0100 | |
| @@ -18,10 +18,6 @@ | |
| */*) cd `expr X$0 : 'X\(.*\)/'` ;; | |
| esac | |
| -case "$osname" in | |
| -amigaos) cat=/bin/cat ;; # must be absolute | |
| -esac | |
| - | |
| echo "Extracting makedepend (with variable substitutions)" | |
| rm -f makedepend | |
| $spitshell >makedepend <<!GROK!THIS! | |
| @@ -33,6 +29,13 @@ | |
| !GROK!THIS! | |
| $spitshell >>makedepend <<'!NO!SUBS!' | |
| +if test -d .depending; then | |
| + echo "$0: Already running, exiting." | |
| + exit 0 | |
| +fi | |
| + | |
| +mkdir .depending | |
| + | |
| # This script should be called with | |
| # sh ./makedepend MAKE=$(MAKE) | |
| case "$1" in | |
| @@ -55,6 +58,11 @@ | |
| ;; | |
| esac | |
| +# Avoid localized gcc messages | |
| +case "$ccname" in | |
| + gcc) LC_ALL=C ; export LC_ALL ;; | |
| +esac | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| @@ -62,6 +70,10 @@ | |
| PATH=".$path_sep..$path_sep$PATH" | |
| export PATH | |
| +case "$osname" in | |
| +amigaos) cat=/bin/cat ;; # must be absolute | |
| +esac | |
| + | |
| $cat /dev/null >.deptmp | |
| $rm -f *.c.c c/*.c.c | |
| if test -f Makefile; then | |
| @@ -71,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -103,29 +114,20 @@ | |
| $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) | |
| for file in `$cat .clist`; do | |
| # for file in `cat /dev/null`; do | |
| - if [ "$osname" = uwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" | |
| - else | |
| - if [ "$osname" = os2 ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$archname" = cygwin ]; then | |
| - uwinfix="-e s,\\\\\\\\,/,g" | |
| - else | |
| - if [ "$osname" = posix-bc ]; then | |
| - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" | |
| - else | |
| - uwinfix= | |
| - fi | |
| - fi | |
| - fi | |
| - fi | |
| + case "$osname" in | |
| + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; | |
| + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; | |
| + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; | |
| + vos) uwinfix="-e s/\#/\\\#/" ;; | |
| + *) uwinfix="" ;; | |
| + esac | |
| case "$file" in | |
| *.c) filebase=`basename $file .c` ;; | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -138,10 +140,12 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| + if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| + $echo '#endif' >>UU/$file.c | |
| + fi | |
| + | |
| if [ "$osname" = os390 ]; then | |
| - if [ "$file" = perly.c ]; then | |
| - $echo '#endif' >>UU/$file.c | |
| - fi | |
| $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| $sed \ | |
| -e '/^#.*<stdin>/d' \ | |
| @@ -155,18 +159,24 @@ | |
| -e 's|\.c\.c|.c|' $uwinfix | \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| else | |
| - $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr | |
| $sed \ | |
| -e '1d' \ | |
| -e '/^#.*<stdin>/d' \ | |
| + -e '/^#.*<builtin>/d' \ | |
| + -e '/^#.*<built-in>/d' \ | |
| + -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| + -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| -e '/^# *[0-9][0-9]* *[".\/]/!d' \ | |
| -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's|: \./|: |' \ | |
| - -e 's|\.c\.c|.c|' $uwinfix | \ | |
| + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| fi | |
| done | |
| @@ -200,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| @@ -231,7 +245,8 @@ | |
| $cp $mf.new $mf | |
| $rm $mf.new | |
| $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf | |
| -$rm -rf .deptmp UU .shlist .clist .hlist .hsed | |
| +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr | |
| +rmdir .depending | |
| !NO!SUBS! | |
| $eunicefix makedepend | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.7.3 | |
| if ( $perl eq '5.7.3' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2002-03-05 01:10:22.000000000 +0000 | |
| +++ makedepend.SH 2010-09-01 10:46:13.000000000 +0100 | |
| @@ -18,10 +18,6 @@ | |
| */*) cd `expr X$0 : 'X\(.*\)/'` ;; | |
| esac | |
| -case "$osname" in | |
| -amigaos) cat=/bin/cat ;; # must be absolute | |
| -esac | |
| - | |
| echo "Extracting makedepend (with variable substitutions)" | |
| rm -f makedepend | |
| $spitshell >makedepend <<!GROK!THIS! | |
| @@ -33,6 +29,13 @@ | |
| !GROK!THIS! | |
| $spitshell >>makedepend <<'!NO!SUBS!' | |
| +if test -d .depending; then | |
| + echo "$0: Already running, exiting." | |
| + exit 0 | |
| +fi | |
| + | |
| +mkdir .depending | |
| + | |
| # This script should be called with | |
| # sh ./makedepend MAKE=$(MAKE) | |
| case "$1" in | |
| @@ -55,6 +58,11 @@ | |
| ;; | |
| esac | |
| +# Avoid localized gcc messages | |
| +case "$ccname" in | |
| + gcc) LC_ALL=C ; export LC_ALL ;; | |
| +esac | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| @@ -62,6 +70,10 @@ | |
| PATH=".$path_sep..$path_sep$PATH" | |
| export PATH | |
| +case "$osname" in | |
| +amigaos) cat=/bin/cat ;; # must be absolute | |
| +esac | |
| + | |
| $cat /dev/null >.deptmp | |
| $rm -f *.c.c c/*.c.c | |
| if test -f Makefile; then | |
| @@ -71,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -116,7 +127,7 @@ | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -129,6 +140,11 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| + if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| + $echo '#endif' >>UU/$file.c | |
| + fi | |
| + | |
| if [ "$osname" = os390 ]; then | |
| $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| $sed \ | |
| @@ -143,13 +159,16 @@ | |
| -e 's|\.c\.c|.c|' $uwinfix | \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| else | |
| - $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c 2>&1 | | |
| + $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr | |
| $sed \ | |
| -e '1d' \ | |
| -e '/^#.*<stdin>/d' \ | |
| -e '/^#.*<builtin>/d' \ | |
| + -e '/^#.*<built-in>/d' \ | |
| -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| @@ -157,7 +176,7 @@ | |
| -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ | |
| -e 's|: \./|: |' \ | |
| - -e 's|\.c\.c|.c|' $uwinfix | \ | |
| + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ | |
| $uniq | $sort | $uniq >> .deptmp | |
| fi | |
| done | |
| @@ -191,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| @@ -222,7 +245,8 @@ | |
| $cp $mf.new $mf | |
| $rm $mf.new | |
| $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf | |
| -$rm -rf .deptmp UU .shlist .clist .hlist .hsed | |
| +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr | |
| +rmdir .depending | |
| !NO!SUBS! | |
| $eunicefix makedepend | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.8.0 | |
| if ( $perl eq '5.8.0' ) { | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2002-07-09 15:06:42.000000000 +0100 | |
| +++ makedepend.SH 2010-09-01 10:16:37.000000000 +0100 | |
| @@ -58,6 +58,11 @@ | |
| ;; | |
| esac | |
| +# Avoid localized gcc messages | |
| +case "$ccname" in | |
| + gcc) LC_ALL=C ; export LC_ALL ;; | |
| +esac | |
| + | |
| # We need .. when we are in the x2p directory if we are using the | |
| # cppstdin wrapper script. | |
| # Put .. and . first so that we pick up the present cppstdin, not | |
| @@ -78,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -123,7 +127,7 @@ | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -136,6 +140,11 @@ | |
| -e 's|\\$||' \ | |
| -e p \ | |
| -e '}' ) >UU/$file.c | |
| + | |
| + if [ "$osname" = os390 -a "$file" = perly.c ]; then | |
| + $echo '#endif' >>UU/$file.c | |
| + fi | |
| + | |
| if [ "$osname" = os390 ]; then | |
| $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | | |
| $sed \ | |
| @@ -157,7 +166,9 @@ | |
| -e '/^#.*<builtin>/d' \ | |
| -e '/^#.*<built-in>/d' \ | |
| -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| @@ -199,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| BADGER | |
| last SWITCH; | |
| } | |
| # If 5.8.[12345678] | |
| _patch(<<'BADGER'); | |
| --- makedepend.SH.org 2003-06-05 19:11:10.000000000 +0100 | |
| +++ makedepend.SH 2010-09-01 10:24:39.000000000 +0100 | |
| @@ -83,7 +83,6 @@ | |
| # to be out of date. I don't know if OS/2 has touch, so do this: | |
| case "$osname" in | |
| os2) ;; | |
| - netbsd) ;; | |
| *) $touch $firstmakefile ;; | |
| esac | |
| fi | |
| @@ -128,7 +127,7 @@ | |
| *.y) filebase=`basename $file .y` ;; | |
| esac | |
| case "$file" in | |
| - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; | |
| + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; | |
| *) finc= ;; | |
| esac | |
| $echo "Finding dependencies for $filebase$_o." | |
| @@ -167,7 +166,9 @@ | |
| -e '/^#.*<builtin>/d' \ | |
| -e '/^#.*<built-in>/d' \ | |
| -e '/^#.*<command line>/d' \ | |
| + -e '/^#.*<command-line>/d' \ | |
| -e '/^#.*"-"/d' \ | |
| + -e '/^#.*"\/.*\/"/d' \ | |
| -e '/: file path prefix .* never used$/d' \ | |
| -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ | |
| -e 's/^[ ]*#[ ]*line/#/' \ | |
| @@ -209,6 +210,10 @@ | |
| $echo "Updating $mf..." | |
| $echo "# If this runs make out of memory, delete /usr/include lines." \ | |
| >> $mf.new | |
| + if [ "$osname" = vos ]; then | |
| + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos | |
| + mv -f .deptmp.vos .deptmp | |
| + fi | |
| $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ | |
| >>$mf.new | |
| else | |
| BADGER | |
| } | |
| } | |
| sub _patch_archive_tar_tests | |
| { | |
| my $perl = shift; | |
| if ($perl =~ /^5\.10/) { | |
| _patch(<<'END'); | |
| --- lib/Archive/Tar/t/02_methods.t | |
| +++ lib/Archive/Tar/t/02_methods.t | |
| @@ -70,6 +70,20 @@ my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-re | |
| my $TOO_LONG = ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS') | |
| && length( cwd(). $LONG_FILE ) > 247; | |
| +if(!$TOO_LONG) { | |
| + my $alt = File::Spec->catfile( cwd(), $LONG_FILE); | |
| + eval 'mkpath([$alt]);'; | |
| + if($@) | |
| + { | |
| + $TOO_LONG = 1; | |
| + } | |
| + else | |
| + { | |
| + $@ = ''; | |
| + my $base = File::Spec->catfile( cwd(), 'directory'); | |
| + rmtree $base; | |
| + } | |
| +} | |
| ### warn if we are going to skip long file names | |
| if ($TOO_LONG) { | |
| diag("No long filename support - long filename extraction disabled") if ! $ENV{PERL_CORE}; | |
| END | |
| } | |
| else { | |
| _patch(<<'END'); | |
| --- cpan/Archive-Tar/t/02_methods.t | |
| +++ cpan/Archive-Tar/t/02_methods.t | |
| @@ -70,6 +70,20 @@ my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-re | |
| my $TOO_LONG = ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS') | |
| && length( cwd(). $LONG_FILE ) > 247; | |
| +if(!$TOO_LONG) { | |
| + my $alt = File::Spec->catfile( cwd(), $LONG_FILE); | |
| + eval 'mkpath([$alt]);'; | |
| + if($@) | |
| + { | |
| + $TOO_LONG = 1; | |
| + } | |
| + else | |
| + { | |
| + $@ = ''; | |
| + my $base = File::Spec->catfile( cwd(), 'directory'); | |
| + rmtree $base; | |
| + } | |
| +} | |
| ### warn if we are going to skip long file names | |
| if ($TOO_LONG) { | |
| diag("No long filename support - long filename extraction disabled") if ! $ENV{PERL_CORE}; | |
| END | |
| } | |
| } | |
| sub _patch_odbm_file_hints_linux | |
| { | |
| _patch(<<'END'); | |
| --- ext/ODBM_File/hints/linux.pl | |
| +++ ext/ODBM_File/hints/linux.pl | |
| @@ -1,8 +1,8 @@ | |
| # uses GDBM dbm compatibility feature - at least on SuSE 8.0 | |
| $self->{LIBS} = ['-lgdbm']; | |
| -# Debian/Ubuntu have /usr/lib/libgdbm_compat.so.3* but not this file, | |
| +# Debian/Ubuntu have libgdbm_compat.so but not this file, | |
| # so linking may fail | |
| -if (-e '/usr/lib/libgdbm_compat.so' or -e '/usr/lib64/libgdbm_compat.so') { | |
| - $self->{LIBS}->[0] .= ' -lgdbm_compat'; | |
| +foreach (split / /, $Config{libpth}) { | |
| + $self->{LIBS}->[0] .= ' -lgdbm_compat' if -e $_.'/libgdbm_compat.so'; | |
| } | |
| END | |
| } | |
| qq[patchin']; | |
| __END__ | |
| =pod | |
| =head1 NAME | |
| Devel::PatchPerl - Patch perl source a la Devel::PPPort's buildperl.pl | |
| =head1 VERSION | |
| version 0.52 | |
| =head1 SYNOPSIS | |
| use strict; | |
| use warnings; | |
| use Devel::PatchPerl; | |
| Devel::PatchPerl->patch_source( '5.6.1', '/path/to/untarred/perl/source/perl-5.6.1' ); | |
| =head1 DESCRIPTION | |
| Devel::PatchPerl is a modularisation of the patching code contained in L<Devel::PPPort>'s | |
| C<buildperl.pl>. | |
| It does not build perls, it merely provides an interface to the source patching | |
| functionality. | |
| =head1 FUNCTION | |
| =over | |
| =item C<patch_source> | |
| Takes two parameters, a C<perl> version and the path to unwrapped perl source for that version. | |
| It dies on any errors. | |
| If you don't supply a C<perl> version, it will attempt to auto-determine the | |
| C<perl> version from the specified path. | |
| If you don't supply the path to unwrapped perl source, it will assume the | |
| current working directory. | |
| =back | |
| =head1 SEE ALSO | |
| L<Devel::PPPort> | |
| =head1 AUTHOR | |
| Chris Williams <[email protected]> | |
| =head1 COPYRIGHT AND LICENSE | |
| This software is copyright (c) 2011 by Chris Williams and Marcus Holland-Moritz. | |
| This is free software; you can redistribute it and/or modify it under | |
| the same terms as the Perl 5 programming language system itself. | |
| =cut | |
| DEVEL_PATCHPERL | |
| $fatpacked{"Devel/PatchPerl/Hints.pm"} = <<'DEVEL_PATCHPERL_HINTS'; | |
| package Devel::PatchPerl::Hints; | |
| { | |
| $Devel::PatchPerl::Hints::VERSION = '0.52'; | |
| } | |
| #ABSTRACT: replacement 'hints' files | |
| use strict; | |
| use warnings; | |
| use MIME::Base64 qw[decode_base64]; | |
| use File::Spec; | |
| our @ISA = qw[Exporter]; | |
| our @EXPORT_OK = qw[hint_file]; | |
| my %hints = ( | |
| 'netbsd' => | |
| 'IyBoaW50cy9uZXRic2Quc2gKIwojIFBsZWFzZSBjaGVjayB3aXRoIHBhY2thZ2VzQG5ldGJzZC5v | |
| cmcgYmVmb3JlIG1ha2luZyBtb2RpZmljYXRpb25zCiMgdG8gdGhpcyBmaWxlLgoKY2FzZSAiJGFy | |
| Y2huYW1lIiBpbgonJykKICAgIGFyY2huYW1lPWB1bmFtZSAtbWAtJHtvc25hbWV9CiAgICA7Owpl | |
| c2FjCgojIE5ldEJTRCBrZWVwcyBkeW5hbWljIGxvYWRpbmcgZGwqKCkgZnVuY3Rpb25zIGluIC91 | |
| c3IvbGliL2NydDAubywKIyBzbyBDb25maWd1cmUgZG9lc24ndCBmaW5kIHRoZW0gKHVubGVzcyB5 | |
| b3UgYWJhbmRvbiB0aGUgbm0gc2NhbikuCiMgQWxzbywgTmV0QlNEIDAuOWEgd2FzIHRoZSBmaXJz | |
| dCByZWxlYXNlIHRvIGludHJvZHVjZSBzaGFyZWQKIyBsaWJyYXJpZXMuCiMKY2FzZSAiJG9zdmVy | |
| cyIgaW4KMC45fDAuOCopCgl1c2VkbD0iJHVuZGVmIgoJOzsKKikKCWNhc2UgYHVuYW1lIC1tYCBp | |
| bgoJcG1heCkKCQkjIE5ldEJTRCAxLjMgYW5kIDEuMy4xIG9uIHBtYXggc2hpcHBlZCBhbiBgb2xk | |
| JyBsZC5zbywKCQkjIHdoaWNoIHdpbGwgbm90IHdvcmsuCgkJY2FzZSAiJG9zdmVycyIgaW4KCQkx | |
| LjN8MS4zLjEpCgkJCWRfZGxvcGVuPSR1bmRlZgoJCQk7OwoJCWVzYWMKCQk7OwoJZXNhYwoJaWYg | |
| dGVzdCAtZiAvdXNyL2xpYmV4ZWMvbGQuZWxmX3NvOyB0aGVuCgkJIyBFTEYKCQlkX2Rsb3Blbj0k | |
| ZGVmaW5lCgkJZF9kbGVycm9yPSRkZWZpbmUKCQljY2NkbGZsYWdzPSItRFBJQyAtZlBJQyAkY2Nj | |
| ZGxmbGFncyIKCQlsZGRsZmxhZ3M9Ii0td2hvbGUtYXJjaGl2ZSAtc2hhcmVkICRsZGRsZmxhZ3Mi | |
| CgkJcnBhdGhmbGFnPSItV2wsLXJwYXRoLCIKCQljYXNlICIkb3N2ZXJzIiBpbgoJCTEuWzAtNV0q | |
| KQoJCQkjCgkJCSMgSW5jbHVkZSB0aGUgd2hvbGUgbGliZ2NjLmEgaW50byB0aGUgcGVybCBleGVj | |
| dXRhYmxlCgkJCSMgc28gdGhhdCBjZXJ0YWluIHN5bWJvbHMgbmVlZGVkIGJ5IGxvYWRhYmxlIG1v | |
| ZHVsZXMKCQkJIyBidWlsdCBhcyBDKysgb2JqZWN0cyAoX19laF9hbGxvYywgX19wdXJlX3ZpcnR1 | |
| YWwsCgkJCSMgZXRjLikgd2lsbCBhbHdheXMgYmUgZGVmaW5lZC4KCQkJIwoJCQljY2RsZmxhZ3M9 | |
| Ii1XbCwtd2hvbGUtYXJjaGl2ZSAtbGdjYyBcCgkJCQktV2wsLW5vLXdob2xlLWFyY2hpdmUgLVds | |
| LC1FICRjY2RsZmxhZ3MiCgkJCTs7CgkJKikKCQkJY2NkbGZsYWdzPSItV2wsLUUgJGNjZGxmbGFn | |
| cyIKCQkJOzsKCQllc2FjCgllbGlmIHRlc3QgLWYgL3Vzci9saWJleGVjL2xkLnNvOyB0aGVuCgkJ | |
| IyBhLm91dAoJCWRfZGxvcGVuPSRkZWZpbmUKCQlkX2RsZXJyb3I9JGRlZmluZQoJCWNjY2RsZmxh | |
| Z3M9Ii1EUElDIC1mUElDICRjY2NkbGZsYWdzIgoJCWxkZGxmbGFncz0iLUJzaGFyZWFibGUgJGxk | |
| ZGxmbGFncyIKCQlycGF0aGZsYWc9Ii1SIgoJZWxzZQoJCWRfZGxvcGVuPSR1bmRlZgoJCXJwYXRo | |
| ZmxhZz0KCWZpCgk7Owplc2FjCgojIG5ldGJzZCBoYWQgdGhlc2UgYnV0IHRoZXkgZG9uJ3QgcmVh | |
| bGx5IHdvcmsgYXMgYWR2ZXJ0aXNlZCwgaW4gdGhlCiMgdmVyc2lvbnMgbGlzdGVkIGJlbG93LiAg | |
| aWYgdGhleSBhcmUgZGVmaW5lZCwgdGhlbiB0aGVyZSBpc24ndCBhCiMgd2F5IHRvIG1ha2UgcGVy | |
| bCBjYWxsIHNldHVpZCgpIG9yIHNldGdpZCgpLiAgaWYgdGhleSBhcmVuJ3QsIHRoZW4KIyAoJDws | |
| ICQ+KSA9ICgkdSwgJHUpOyB3aWxsIHdvcmsgKHNhbWUgZm9yICQoLyQpKS4gIHRoaXMgaXMgYmVj | |
| YXVzZQojIHlvdSBjYW4gbm90IGNoYW5nZSB0aGUgcmVhbCB1c2VyaWQgb2YgYSBwcm9jZXNzIHVu | |
| ZGVyIDQuNEJTRC4KIyBuZXRic2QgZml4ZWQgdGhpcyBpbiAxLjMuMi4KY2FzZSAiJG9zdmVycyIg | |
| aW4KMC45KnwxLlswMTJdKnwxLjN8MS4zLjEpCglkX3NldHJlZ2lkPSIkdW5kZWYiCglkX3NldHJl | |
| dWlkPSIkdW5kZWYiCgk7Owplc2FjCmNhc2UgIiRvc3ZlcnMiIGluCjAuOSp8MS4qfDIuKnwzLip8 | |
| NC4qfDUuKikKCWRfZ2V0cHJvdG9lbnRfcj0iJHVuZGVmIgoJZF9nZXRwcm90b2J5bmFtZV9yPSIk | |
| dW5kZWYiCglkX2dldHByb3RvYnludW1iZXJfcj0iJHVuZGVmIgoJZF9zZXRwcm90b2VudF9yPSIk | |
| dW5kZWYiCglkX2VuZHByb3RvZW50X3I9IiR1bmRlZiIKCWRfZ2V0c2VydmVudF9yPSIkdW5kZWYi | |
| CglkX2dldHNlcnZieW5hbWVfcj0iJHVuZGVmIgoJZF9nZXRzZXJ2Ynlwb3J0X3I9IiR1bmRlZiIK | |
| CWRfc2V0c2VydmVudF9yPSIkdW5kZWYiCglkX2VuZHNlcnZlbnRfcj0iJHVuZGVmIgoJZF9nZXRw | |
| cm90b2VudF9yX3Byb3RvPSIwIgoJZF9nZXRwcm90b2J5bmFtZV9yX3Byb3RvPSIwIgoJZF9nZXRw | |
| cm90b2J5bnVtYmVyX3JfcHJvdG89IjAiCglkX3NldHByb3RvZW50X3JfcHJvdG89IjAiCglkX2Vu | |
| ZHByb3RvZW50X3JfcHJvdG89IjAiCglkX2dldHNlcnZlbnRfcl9wcm90bz0iMCIKCWRfZ2V0c2Vy | |
| dmJ5bmFtZV9yX3Byb3RvPSIwIgoJZF9nZXRzZXJ2Ynlwb3J0X3JfcHJvdG89IjAiCglkX3NldHNl | |
| cnZlbnRfcl9wcm90bz0iMCIKCWRfZW5kc2VydmVudF9yX3Byb3RvPSIwIgoJOzsKZXNhYwoKIyBU | |
| aGVzZSBhcmUgb2Jzb2xldGUgaW4gYW55IG5ldGJzZC4KZF9zZXRyZ2lkPSIkdW5kZWYiCmRfc2V0 | |
| cnVpZD0iJHVuZGVmIgoKIyB0aGVyZSdzIG5vIHByb2JsZW0gd2l0aCB2Zm9yay4KdXNldmZvcms9 | |
| dHJ1ZQoKIyBUaGlzIGlzIHRoZXJlIGJ1dCBpbiBtYWNoaW5lL2llZWVmcF9oLgppZWVlZnBfaD0i | |
| ZGVmaW5lIgoKIyBUaGlzIHNjcmlwdCBVVS91c2V0aHJlYWRzLmNidSB3aWxsIGdldCAnY2FsbGVk | |
| LWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVyIGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBmb3Ig | |
| d2hldGhlciB0byB1c2UgdGhyZWFkcy4KY2F0ID4gVVUvdXNldGhyZWFkcy5jYnUgPDwnRU9DQlUn | |
| CmNhc2UgIiR1c2V0aHJlYWRzIiBpbgokZGVmaW5lfHRydWV8W3lZXSopCglscHRocmVhZD0KCWZv | |
| ciB4eHggaW4gcHRocmVhZDsgZG8KCQlmb3IgeXl5IGluICRsb2NsaWJwdGggJHBsaWJwdGggJGds | |
| aWJwdGggZHVtbXk7IGRvCgkJCXp6ej0keXl5L2xpYiR4eHguYQoJCQlpZiB0ZXN0IC1mICIkenp6 | |
| IjsgdGhlbgoJCQkJbHB0aHJlYWQ9JHh4eAoJCQkJYnJlYWs7CgkJCWZpCgkJCXp6ej0keXl5L2xp | |
| YiR4eHguc28KCQkJaWYgdGVzdCAtZiAiJHp6eiI7IHRoZW4KCQkJCWxwdGhyZWFkPSR4eHgKCQkJ | |
| CWJyZWFrOwoJCQlmaQoJCQl6eno9YGxzICR5eXkvbGliJHh4eC5zby4qIDI+L2Rldi9udWxsYAoJ | |
| CQlpZiB0ZXN0ICJYJHp6eiIgIT0gWDsgdGhlbgoJCQkJbHB0aHJlYWQ9JHh4eAoJCQkJYnJlYWs7 | |
| CgkJCWZpCgkJZG9uZQoJCWlmIHRlc3QgIlgkbHB0aHJlYWQiICE9IFg7IHRoZW4KCQkJYnJlYWs7 | |
| CgkJZmkKCWRvbmUKCWlmIHRlc3QgIlgkbHB0aHJlYWQiICE9IFg7IHRoZW4KCQkjIEFkZCAtbHB0 | |
| aHJlYWQuCgkJbGlic3dhbnRlZD0iJGxpYnN3YW50ZWQgJGxwdGhyZWFkIgoJCSMgVGhlcmUgaXMg | |
| bm8gbGliY19yIGFzIG9mIE5ldEJTRCAxLjUuMiwgc28gbm8gYyAtPiBjX3IuCgkJIyBUaGlzIHdp | |
| bGwgYmUgcmV2aXNpdGVkIHdoZW4gTmV0QlNEIGdhaW5zIGEgbmF0aXZlIHB0aHJlYWRzCgkJIyBp | |
| bXBsZW1lbnRhdGlvbi4KCWVsc2UKCQllY2hvICIkMDogTm8gUE9TSVggdGhyZWFkcyBsaWJyYXJ5 | |
| ICgtbHB0aHJlYWQpIGZvdW5kLiAgIiBcCgkJICAgICAiWW91IG1heSB3YW50IHRvIGluc3RhbGwg | |
| R05VIHB0aC4gIEFib3J0aW5nLiIgPiY0CgkJZXhpdCAxCglmaQoJdW5zZXQgbHB0aHJlYWQKCgkj | |
| IHNldmVyYWwgcmVlbnRyYW50IGZ1bmN0aW9ucyBhcmUgZW1iZWRkZWQgaW4gbGliYywgYnV0IGhh | |
| dmVuJ3QKCSMgYmVlbiBhZGRlZCB0byB0aGUgaGVhZGVyIGZpbGVzIHlldC4gIExldCdzIGhvbGQg | |
| b2ZmIG9uIHVzaW5nCgkjIHRoZW0gdW50aWwgdGhleSBhcmUgYSB2YWxpZCBwYXJ0IG9mIHRoZSBB | |
| UEkKCWNhc2UgIiRvc3ZlcnMiIGluCglbMDEyXS4qfDMuWzAtMV0pCgkJZF9nZXRwcm90b2J5bmFt | |
| ZV9yPSR1bmRlZgoJCWRfZ2V0cHJvdG9ieW51bWJlcl9yPSR1bmRlZgoJCWRfZ2V0cHJvdG9lbnRf | |
| cj0kdW5kZWYKCQlkX2dldHNlcnZieW5hbWVfcj0kdW5kZWYKCQlkX2dldHNlcnZieXBvcnRfcj0k | |
| dW5kZWYKCQlkX2dldHNlcnZlbnRfcj0kdW5kZWYKCQlkX3NldHByb3RvZW50X3I9JHVuZGVmCgkJ | |
| ZF9zZXRzZXJ2ZW50X3I9JHVuZGVmCgkJZF9lbmRwcm90b2VudF9yPSR1bmRlZgoJCWRfZW5kc2Vy | |
| dmVudF9yPSR1bmRlZiA7OwoJZXNhYwoJOzsKCmVzYWMKRU9DQlUKCiMgU2V0IHNlbnNpYmxlIGRl | |
| ZmF1bHRzIGZvciBOZXRCU0Q6IGxvb2sgZm9yIGxvY2FsIHNvZnR3YXJlIGluCiMgL3Vzci9wa2cg | |
| KE5ldEJTRCBQYWNrYWdlcyBDb2xsZWN0aW9uKSBhbmQgaW4gL3Vzci9sb2NhbC4KIwpsb2NsaWJw | |
| dGg9Ii91c3IvcGtnL2xpYiAvdXNyL2xvY2FsL2xpYiIKbG9jaW5jcHRoPSIvdXNyL3BrZy9pbmNs | |
| dWRlIC91c3IvbG9jYWwvaW5jbHVkZSIKY2FzZSAiJHJwYXRoZmxhZyIgaW4KJycpCglsZGZsYWdz | |
| PQoJOzsKKikKCWxkZmxhZ3M9Cglmb3IgeXl5IGluICRsb2NsaWJwdGg7IGRvCgkJbGRmbGFncz0i | |
| JGxkZmxhZ3MgJHJwYXRoZmxhZyR5eXkiCglkb25lCgk7Owplc2FjCgpjYXNlIGB1bmFtZSAtbWAg | |
| aW4KYWxwaGEpCiAgICBlY2hvICdpbnQgbWFpbigpIHt9JyA+IHRyeS5jCiAgICBnY2M9YCR7Y2M6 | |
| LWNjfSAtdiAtYyB0cnkuYyAyPiYxfGdyZXAgJ2djYyB2ZXJzaW9uIGVnY3MtMidgCiAgICBjYXNl | |
| ICIkZ2NjIiBpbgogICAgJycgfCAiZ2NjIHZlcnNpb24gZWdjcy0yLjk1LiJbMy05XSopIDs7ICMg | |
| Mi45NS4zIG9yIGJldHRlciBva2F5CiAgICAqKQljYXQgPiY0IDw8RU9GCioqKgoqKiogWW91ciBn | |
| Y2MgKCRnY2MpIGlzIGtub3duIHRvIGJlCioqKiB0b28gYnVnZ3kgb24gbmV0YnNkL2FscGhhIHRv | |
| IGNvbXBpbGUgUGVybCB3aXRoIG9wdGltaXphdGlvbi4KKioqIEl0IGlzIHN1Z2dlc3RlZCB5b3Ug | |
| aW5zdGFsbCB0aGUgbGFuZy9nY2MgcGFja2FnZSB3aGljaCBzaG91bGQKKioqIGhhdmUgYXQgbGVh | |
| c3QgZ2NjIDIuOTUuMyB3aGljaCBzaG91bGQgd29yayBva2F5OiB1c2UgZm9yIGV4YW1wbGUKKioq | |
| IENvbmZpZ3VyZSAtRGNjPS91c3IvcGtnL2djYy0yLjk1LjMvYmluL2NjLiAgWW91IGNvdWxkIGFs | |
| c28KKioqIENvbmZpZ3VyZSAtRG9wdGltaXplPS1PMCB0byBjb21waWxlIFBlcmwgd2l0aG91dCBh | |
| bnkgb3B0aW1pemF0aW9uCioqKiBidXQgdGhhdCBpcyBub3QgcmVjb21tZW5kZWQuCioqKgpFT0YK | |
| CWV4aXQgMQoJOzsKICAgIGVzYWMKICAgIHJtIC1mIHRyeS4qCiAgICA7Owplc2FjCgojIE5ldEJT | |
| RC9zcGFyYyAxLjUuMy8xLjYuMSBkdW1wcyBjb3JlIGluIHRoZSBzZW1pZF9kcyB0ZXN0IG9mIENv | |
| bmZpZ3VyZS4KY2FzZSBgdW5hbWUgLW1gIGluCnNwYXJjKSBkX3NlbWN0bF9zZW1pZF9kcz11bmRl | |
| ZiA7Owplc2FjCgojIG1hbGxvYyB3cmFwIHdvcmtzCmNhc2UgIiR1c2VtYWxsb2N3cmFwIiBpbgon | |
| JykgdXNlbWFsbG9jd3JhcD0nZGVmaW5lJyA7Owplc2FjCgojIGRvbid0IHVzZSBwZXJsIG1hbGxv | |
| YyBieSBkZWZhdWx0CmNhc2UgIiR1c2VteW1hbGxvYyIgaW4KJycpIHVzZW15bWFsbG9jPW4gOzsK | |
| ZXNhYwo=', | |
| 'freebsd' => | |
| 'IyBPcmlnaW5hbCBiYXNlZCBvbiBpbmZvIGZyb20KIyBDYXJsIE0uIEZvbmdoZWlzZXIgPGNtZkBp | |
| bnMuaW5mb25ldC5uZXQ+CiMgRGF0ZTogVGh1LCAyOCBKdWwgMTk5NCAxOToxNzowNSAtMDUwMCAo | |
| Q0RUKQojCiMgQWRkaXRpb25hbCAxLjEuNSBkZWZpbmVzIGZyb20gCiMgT2xsaXZpZXIgUm9iZXJ0 | |
| IDxPbGxpdmllci5Sb2JlcnRAa2VsdGlhLmZybXVnLmZyLm5ldD4KIyBEYXRlOiBXZWQsIDI4IFNl | |
| cCAxOTk0IDAwOjM3OjQ2ICswMTAwIChNRVQpCiMKIyBBZGRpdGlvbmFsIDIuKiBkZWZpbmVzIGZy | |
| b20KIyBPbGxpdmllciBSb2JlcnQgPE9sbGl2aWVyLlJvYmVydEBrZWx0aWEuZnJtdWcuZnIubmV0 | |
| PgojIERhdGU6IFNhdCwgOCBBcHIgMTk5NSAyMDo1Mzo0MSArMDIwMCAoTUVUIERTVCkKIwojIEFk | |
| ZGl0aW9uYWwgMi4wLjUgYW5kIDIuMSBkZWZpbmVkIGZyb20KIyBPbGxpdmllciBSb2JlcnQgPE9s | |
| bGl2aWVyLlJvYmVydEBrZWx0aWEuZnJtdWcuZnIubmV0PgojIERhdGU6IEZyaSwgMTIgTWF5IDE5 | |
| OTUgMTQ6MzA6MzggKzAyMDAgKE1FVCBEU1QpCiMKIyBBZGRpdGlvbmFsIDIuMiBkZWZpbmVzIGZy | |
| b20KIyBNYXJrIE11cnJheSA8bWFya0Bncm9uZGFyLnphPgojIERhdGU6IFdlZCwgNiBOb3YgMTk5 | |
| NiAwOTo0NDo1OCArMDIwMCAoTUVUKQojCiMgTW9kaWZpZWQgdG8gZW5zdXJlIHdlIHJlcGxhY2Ug | |
| LWxjIHdpdGggLWxjX3IsIGFuZAojIHRvIHB1dCBpbiBwbGFjZS1ob2xkZXJzIGZvciB2YXJpb3Vz | |
| IHNwZWNpZmljIGhpbnRzLgojIEFuZHkgRG91Z2hlcnR5IDxkb3VnaGVyYUBsYWZheWV0dGUuZWR1 | |
| PgojIERhdGU6IFR1ZSBNYXIgMTAgMTY6MDc6MDAgRVNUIDE5OTgKIwojIFN1cHBvcnQgZm9yIEZy | |
| ZWVCU0QvRUxGCiMgT2xsaXZpZXIgUm9iZXJ0IDxyb2JlcnRvQGtlbHRpYS5mcmVlbml4LmZyPgoj | |
| IERhdGU6IFdlZCBTZXAgIDIgMTY6MjI6MTIgQ0VTVCAxOTk4CiMKIyBUaGUgdHdvIGZsYWdzICIt | |
| ZnBpYyAtRFBJQyIgYXJlIHVzZWQgdG8gaW5kaWNhdGUgYQojIHdpbGwtYmUtc2hhcmVkIG9iamVj | |
| dC4gIENvbmZpZ3VyZSB3aWxsIGd1ZXNzIHRoZSAtZnBpYywgKGFuZCB0aGUKIyAtRFBJQyBpcyBu | |
| b3QgdXNlZCBieSBwZXJsIHByb3BlcikgYnV0IHRoZSBmdWxsIGRlZmluZSBpcyBpbmNsdWRlZCB0 | |
| byAKIyBiZSBjb25zaXN0ZW50IHdpdGggdGhlIEZyZWVCU0QgZ2VuZXJhbCBzaGFyZWQgbGlicyBi | |
| dWlsZGluZyBwcm9jZXNzLgojCiMgc2V0cmV1aWQgYW5kIGZyaWVuZHMgYXJlIGluaGVyZW50bHkg | |
| YnJva2VuIGluIGFsbCB2ZXJzaW9ucyBvZiBGcmVlQlNECiMgYmVmb3JlIDIuMS1jdXJyZW50IChi | |
| ZWZvcmUgYXBwcm94IGRhdGUgNC8xNS85NSkuIEl0IGlzIGZpeGVkIGluIDIuMC41CiMgYW5kIHdo | |
| YXQtd2lsbC1iZS0yLjEKIwoKY2FzZSAiJG9zdmVycyIgaW4KMC4qfDEuMCopCgl1c2VkbD0iJHVu | |
| ZGVmIgoJOzsKMS4xKikKCW1hbGxvY3R5cGU9J3ZvaWQgKicKCWdyb3Vwc3R5cGU9J2ludCcKCWRf | |
| c2V0cmVnaWQ9J3VuZGVmJwoJZF9zZXRyZXVpZD0ndW5kZWYnCglkX3NldHJnaWQ9J3VuZGVmJwoJ | |
| ZF9zZXRydWlkPSd1bmRlZicKCTs7CjIuMC1yZWxlYXNlKikKCWRfc2V0cmVnaWQ9J3VuZGVmJwoJ | |
| ZF9zZXRyZXVpZD0ndW5kZWYnCglkX3NldHJnaWQ9J3VuZGVmJwoJZF9zZXRydWlkPSd1bmRlZicK | |
| CTs7CiMKIyBUcnlpbmcgdG8gY292ZXIgMi4wLjUsIDIuMS1jdXJyZW50IGFuZCBmdXR1cmUgMi4x | |
| LzIuMgojIEl0IGRvZXMgbm90IGNvdmVydCBhbGwgMi4xLWN1cnJlbnQgdmVyc2lvbnMgYXMgdGhl | |
| IG91dHB1dCBvZiB1bmFtZQojIGNoYW5nZWQgYSBmZXcgdGltZXMuCiMKIyBFdmVuIHRob3VnaCBz | |
| ZXRldWlkL3NldGVnaWQgYXJlIGF2YWlsYWJsZSwgdGhleSd2ZSBiZWVuIHR1cm5lZCBvZmYKIyBi | |
| ZWNhdXNlIHBlcmwgaXNuJ3QgY29kZWQgd2l0aCBzYXZlZCBzZXRbdWddaWQgdmFyaWFibGVzIGlu | |
| IG1pbmQuCiMgSW4gYWRkaXRpb24sIGEgc21hbGwgcGF0Y2ggaXMgcmVxdWlyZWQgdG8gc3VpZHBl | |
| cmwgdG8gYXZvaWQgYSBzZWN1cml0eQojIHByb2JsZW0gd2l0aCBGcmVlQlNELgojCjIuMC41Knwy | |
| LjAtYnVpbHQqfDIuMSopCiAJdXNldmZvcms9J3RydWUnCgljYXNlICIkdXNlbXltYWxsb2MiIGlu | |
| CgkgICAgIiIpIHVzZW15bWFsbG9jPSduJwoJICAgICAgICA7OwoJZXNhYwoJZF9zZXRyZWdpZD0n | |
| ZGVmaW5lJwoJZF9zZXRyZXVpZD0nZGVmaW5lJwoJZF9zZXRlZ2lkPSd1bmRlZicKCWRfc2V0ZXVp | |
| ZD0ndW5kZWYnCgl0ZXN0IC1yIC4vYnJva2VuLWRiLm1zZyAmJiAuIC4vYnJva2VuLWRiLm1zZwoJ | |
| OzsKIwojIDIuMiBhbmQgYWJvdmUgaGF2ZSBwaGttYWxsb2MoMykuCiMgZG9uJ3QgdXNlIC1sbWFs | |
| bG9jIChtYXliZSB0aGVyZSdzIGFuIG9sZCBvbmUgZnJvbSAxLjEuNS4xIGZsb2F0aW5nIGFyb3Vu | |
| ZCkKMi4yKikKIAl1c2V2Zm9yaz0ndHJ1ZScKCWNhc2UgIiR1c2VteW1hbGxvYyIgaW4KCSAgICAi | |
| IikgdXNlbXltYWxsb2M9J24nCgkgICAgICAgIDs7Cgllc2FjCglsaWJzd2FudGVkPWBlY2hvICRs | |
| aWJzd2FudGVkIHwgc2VkICdzLyBtYWxsb2MgLyAvJ2AKCWxpYnN3YW50ZWQ9YGVjaG8gJGxpYnN3 | |
| YW50ZWQgfCBzZWQgJ3MvIGJpbmQgLyAvJ2AKCSMgaWNvbnYgZ29uZSBpbiBQZXJsIDUuOC4xLCBi | |
| dXQgaWYgc29tZW9uZSBjb21waWxlcyA1LjguMCBvciBlYXJsaWVyLgoJbGlic3dhbnRlZD1gZWNo | |
| byAkbGlic3dhbnRlZCB8IHNlZCAncy8gaWNvbnYgLyAvJ2AKCWRfc2V0cmVnaWQ9J2RlZmluZScK | |
| CWRfc2V0cmV1aWQ9J2RlZmluZScKCWRfc2V0ZWdpZD0nZGVmaW5lJwoJZF9zZXRldWlkPSdkZWZp | |
| bmUnCgkjIGRfZG9zdWlkPSdkZWZpbmUnICMgT2Jzb2xldGUuCgk7OwoqKQl1c2V2Zm9yaz0ndHJ1 | |
| ZScKCWNhc2UgIiR1c2VteW1hbGxvYyIgaW4KCSAgICAiIikgdXNlbXltYWxsb2M9J24nCgkgICAg | |
| ICAgIDs7Cgllc2FjCglsaWJzd2FudGVkPWBlY2hvICRsaWJzd2FudGVkIHwgc2VkICdzLyBtYWxs | |
| b2MgLyAvJ2AKCTs7CmVzYWMKCiMgRHluYW1pYyBMb2FkaW5nIGZsYWdzIGhhdmUgbm90IGNoYW5n | |
| ZWQgbXVjaCwgc28gdGhleSBhcmUgc2VwYXJhdGVkCiMgb3V0IGhlcmUgdG8gYXZvaWQgZHVwbGlj | |
| YXRpbmcgdGhlbSBldmVyeXdoZXJlLgpjYXNlICIkb3N2ZXJzIiBpbgowLip8MS4wKikgOzsKCjEq | |
| fDIqKQljY2NkbGZsYWdzPSctRFBJQyAtZnBpYycKCWxkZGxmbGFncz0iLUJzaGFyZWFibGUgJGxk | |
| ZGxmbGFncyIKCTs7CgozKnw0Knw1Knw2KikKICAgICAgICBvYmpmb3JtYXQ9YC91c3IvYmluL29i | |
| amZvcm1hdGAKICAgICAgICBpZiBbIHgkb2JqZm9ybWF0ID0geGFvdXQgXTsgdGhlbgogICAgICAg | |
| ICAgICBpZiBbIC1lIC91c3IvbGliL2FvdXQgXTsgdGhlbgogICAgICAgICAgICAgICAgbGlicHRo | |
| PSIvdXNyL2xpYi9hb3V0IC91c3IvbG9jYWwvbGliIC91c3IvbGliIgogICAgICAgICAgICAgICAg | |
| Z2xpYnB0aD0iL3Vzci9saWIvYW91dCAvdXNyL2xvY2FsL2xpYiAvdXNyL2xpYiIKICAgICAgICAg | |
| ICAgZmkKICAgICAgICAgICAgbGRkbGZsYWdzPSctQnNoYXJlYWJsZScKICAgICAgICBlbHNlCiAg | |
| ICAgICAgICAgIGxpYnB0aD0iL3Vzci9saWIgL3Vzci9sb2NhbC9saWIiCiAgICAgICAgICAgIGds | |
| aWJwdGg9Ii91c3IvbGliIC91c3IvbG9jYWwvbGliIgogICAgICAgICAgICBsZGZsYWdzPSItV2ws | |
| LUUgIgogICAgICAgICAgICBsZGRsZmxhZ3M9Ii1zaGFyZWQgIgogICAgICAgIGZpCiAgICAgICAg | |
| Y2NjZGxmbGFncz0nLURQSUMgLWZQSUMnCiAgICAgICAgOzsKKikKICAgICAgIGxpYnB0aD0iL3Vz | |
| ci9saWIgL3Vzci9sb2NhbC9saWIiCiAgICAgICBnbGlicHRoPSIvdXNyL2xpYiAvdXNyL2xvY2Fs | |
| L2xpYiIKICAgICAgIGxkZmxhZ3M9Ii1XbCwtRSAiCiAgICAgICAgbGRkbGZsYWdzPSItc2hhcmVk | |
| ICIKICAgICAgICBjY2NkbGZsYWdzPSctRFBJQyAtZlBJQycKICAgICAgIDs7CmVzYWMKCmNhc2Ug | |
| IiRvc3ZlcnMiIGluCjAqfDEqfDIqfDMqKSA7OwoKKikKCWNjZmxhZ3M9IiR7Y2NmbGFnc30gLURI | |
| QVNfRlBTRVRNQVNLIC1ESEFTX0ZMT0FUSU5HUE9JTlRfSCIKCWlmIC91c3IvYmluL2ZpbGUgLUwg | |
| L3Vzci9saWIvbGliYy5zbyB8IC91c3IvYmluL2dyZXAgLXZxICJub3Qgc3RyaXBwZWQiIDsgdGhl | |
| bgoJICAgIHVzZW5tPWZhbHNlCglmaQogICAgICAgIDs7CmVzYWMKCmNhdCA8PCdFT00nID4mNAoK | |
| U29tZSB1c2VycyBoYXZlIHJlcG9ydGVkIHRoYXQgQ29uZmlndXJlIGhhbHRzIHdoZW4gdGVzdGlu | |
| ZyBmb3IKdGhlIE9fTk9OQkxPQ0sgc3ltYm9sIHdpdGggYSBzeW50YXggZXJyb3IuICBUaGlzIGlz | |
| IGFwcGFyZW50bHkgYQpzaCBlcnJvci4gIFJlcnVubmluZyBDb25maWd1cmUgd2l0aCBrc2ggYXBw | |
| YXJlbnRseSBmaXhlcyB0aGUKcHJvYmxlbS4gIFRyeQoJa3NoIENvbmZpZ3VyZSBbeW91ciBvcHRp | |
| b25zXQoKRU9NCgojIEZyb206IEFudG9uIEJlcmV6aW4gPHRvYmV6QHBsYWIua3UuZGs+CiMgVG86 | |
| IHBlcmw1LXBvcnRlcnNAcGVybC5vcmcKIyBTdWJqZWN0OiBbUEFUQ0ggNS4wMDVfNTRdIENvbmZp | |
| Z3VyZSAtIGhpbnRzL2ZyZWVic2Quc2ggc2lnbmFsIGhhbmRsZXIgdHlwZQojIERhdGU6IDMwIE5v | |
| diAxOTk4IDE5OjQ2OjI0ICswMTAwCiMgTWVzc2FnZS1JRDogPDg2NHNyaGh2Y3YuZnNmQGxpb24u | |
| cGxhYi5rdS5kaz4KCnNpZ25hbF90PSd2b2lkJwpkX3ZvaWRzaWc9J2RlZmluZScKCiMgc2V0IGxp | |
| YnBlcmwuc28uWC5YIGZvciAyLjIuWApjYXNlICIkb3N2ZXJzIiBpbgoyLjIqKQogICAgIyB1bmZv | |
| cnR1bmF0ZWx5IHRoaXMgY29kZSBnZXRzIGV4ZWN1dGVkIGJlZm9yZQogICAgIyB0aGUgZXF1aXZh | |
| bGVudCBpbiB0aGUgbWFpbiBDb25maWd1cmUgc28gd2UgY29weSBhIGxpdHRsZQogICAgIyBmcm9t | |
| IENvbmZpZ3VyZSBYWFggQ29uZmlndXJlIHNob3VsZCBiZSBmaXhlZC4KICAgIGlmICR0ZXN0IC1y | |
| ICRzcmMvcGF0Y2hsZXZlbC5oO3RoZW4KICAgICAgIHBhdGNobGV2ZWw9YGF3ayAnL2RlZmluZVsg | |
| CV0rUEVSTF9WRVJTSU9OLyB7cHJpbnQgJDN9JyAkc3JjL3BhdGNobGV2ZWwuaGAKICAgICAgIHN1 | |
| YnZlcnNpb249YGF3ayAnL2RlZmluZVsgCV0rUEVSTF9TVUJWRVJTSU9OLyB7cHJpbnQgJDN9JyAk | |
| c3JjL3BhdGNobGV2ZWwuaGAKICAgIGVsc2UKICAgICAgIHBhdGNobGV2ZWw9MAogICAgICAgc3Vi | |
| dmVyc2lvbj0wCiAgICBmaQogICAgbGlicGVybD0ibGlicGVybC5zby4kcGF0Y2hsZXZlbC4kc3Vi | |
| dmVyc2lvbiIKICAgIHVuc2V0IHBhdGNobGV2ZWwKICAgIHVuc2V0IHN1YnZlcnNpb24KICAgIDs7 | |
| CmVzYWMKCiMgVGhpcyBzY3JpcHQgVVUvdXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1i | |
| YWNrJyBieSBDb25maWd1cmUgCiMgYWZ0ZXIgaXQgaGFzIHByb21wdGVkIHRoZSB1c2VyIGZvciB3 | |
| aGV0aGVyIHRvIHVzZSB0aHJlYWRzLgpjYXQgPiBVVS91c2V0aHJlYWRzLmNidSA8PCdFT0NCVScK | |
| Y2FzZSAiJHVzZXRocmVhZHMiIGluCiRkZWZpbmV8dHJ1ZXxbeVldKikKICAgICAgICBsY19yPWAv | |
| c2Jpbi9sZGNvbmZpZyAtcnxncmVwICc6LWxjX3InfGF3ayAne3ByaW50ICRORn0nfHNlZCAtbiAn | |
| JHAnYAogICAgICAgIGNhc2UgIiRvc3ZlcnMiIGluICAKCTAqfDEqfDIuMCp8Mi4xKikgICBjYXQg | |
| PDxFT00gPiY0CkkgZGlkIG5vdCBrbm93IHRoYXQgRnJlZUJTRCAkb3N2ZXJzIHN1cHBvcnRzIFBP | |
| U0lYIHRocmVhZHMuCgpGZWVsIGZyZWUgdG8gdGVsbCBwZXJsYnVnQHBlcmwub3JnIG90aGVyd2lz | |
| ZS4KRU9NCgkgICAgICBleGl0IDEKCSAgICAgIDs7CgogICAgICAgIDIuMi5bMC03XSopCiAgICAg | |
| ICAgICAgICAgY2F0IDw8RU9NID4mNApQT1NJWCB0aHJlYWRzIGFyZSBub3Qgc3VwcG9ydGVkIHdl | |
| bGwgYnkgRnJlZUJTRCAkb3N2ZXJzLgoKUGxlYXNlIGNvbnNpZGVyIHVwZ3JhZGluZyB0byBhdCBs | |
| ZWFzdCBGcmVlQlNEIDIuMi44LApvciBwcmVmZXJhYmx5IHRvIHRoZSBtb3N0IHJlY2VudCAtUkVM | |
| RUFTRSBvciAtU1RBQkxFCnZlcnNpb24gKHNlZSBodHRwOi8vd3d3LmZyZWVic2Qub3JnL3JlbGVh | |
| c2VzLykuCgooV2hpbGUgMi4yLjcgZG9lcyBoYXZlIHB0aHJlYWRzLCBpdCBoYXMgc29tZSBwcm9i | |
| bGVtcwogd2l0aCB0aGUgY29tYmluYXRpb24gb2YgdGhyZWFkcyBhbmQgcGlwZXMgYW5kIHRoZXJl | |
| Zm9yZQogbWFueSBQZXJsIHRlc3RzIHdpbGwgZWl0aGVyIGhhbmcgb3IgZmFpbC4pCkVPTQoJICAg | |
| ICAgZXhpdCAxCgkgICAgICA7OwoKCVszLTVdLiopCgkgICAgICBpZiBbICEgLXIgIiRsY19yIiBd | |
| OyB0aGVuCgkgICAgICBjYXQgPDxFT00gPiY0ClBPU0lYIHRocmVhZHMgc2hvdWxkIGJlIHN1cHBv | |
| cnRlZCBieSBGcmVlQlNEICRvc3ZlcnMgLS0KYnV0IHlvdXIgc3lzdGVtIGlzIG1pc3NpbmcgdGhl | |
| IHNoYXJlZCBsaWJjX3IuCigvc2Jpbi9sZGNvbmZpZyAtciBkb2Vzbid0IGZpbmQgYW55KS4KCkNv | |
| bnNpZGVyIHVzaW5nIHRoZSBsYXRlc3QgU1RBQkxFIHJlbGVhc2UuCkVPTQoJCSBleGl0IDEKCSAg | |
| ICAgIGZpCgkgICAgICAjIDUwMDAxNiBpcyB0aGUgZmlyc3Qgb3NyZWxkYXRlIGluIHdoaWNoIG9u | |
| ZSBjb3VsZAoJICAgICAgIyBqdXN0IGxpbmsgYWdhaW5zdCBsaWJjX3Igd2l0aG91dCBkaXNwb3Np | |
| bmcgb2YgbGliYwoJICAgICAgIyBhdCB0aGUgc2FtZSB0aW1lLiAgNTAwMDE2IC4uLiB1cCB0byB3 | |
| aGF0ZXZlciBpdCB3YXMKCSAgICAgICMgb24gdGhlIDMxc3Qgb2YgQXVndXN0IDIwMDMgY2FuIHN0 | |
| aWxsIGJlIHVzZWQgd2l0aCAtcHRocmVhZCwKCSAgICAgICMgYnV0IGl0IGlzIG5vdCBuZWNlc3Nh | |
| cnkuCgoJICAgICAgIyBBbnRvbiBCZXJlemluIHNheXMgdGhhdCBwb3N0IDUwMHNvbWV0aGluZyB3 | |
| ZSdyZSB3cm9uZyB0byBiZQoJICAgICAgIyB0byBiZSB1c2luZyAtbGNfciwgYW5kIHNob3VsZCBq | |
| dXN0IGJlIHVzaW5nIC1wdGhyZWFkIG9uIHRoZQoJICAgICAgIyBsaW5rZXIgbGluZS4KCSAgICAg | |
| ICMgU28gcHJlc3VtYWJseSByZWFsbHkgd2Ugc2hvdWxkIGJlIGNoZWNraW5nIHRoYXQgJG9zdmVy | |
| IGlzIDUuKikKCSAgICAgICMgYW5kIHRoYXQgYC9zYmluL3N5c2N0bCAtbiBrZXJuLm9zcmVsZGF0 | |
| ZWAgLWdlIDUwMDAxNgoJICAgICAgIyBvciAtbHQgNTAwc29tZXRoaW5nIGFuZCBvbmx5IGluIHRo | |
| YXQgcmFuZ2Ugbm90IGRvaW5nIHRoaXM6CgkgICAgICBsZGZsYWdzPSItcHRocmVhZCAkbGRmbGFn | |
| cyIKCgkgICAgICAjIEJvdGggaW4gNC54IGFuZCA1LnggZ2V0aG9zdGJ5YWRkcl9yIGV4aXN0cyBi | |
| dXQKCSAgICAgICMgaXQgaXMgIlRlbXBvcmFyeSBmdW5jdGlvbiwgbm90IHRocmVhZHNhZmUiLi4u | |
| CgkgICAgICAjIFByZXN1bWFibHkgZWFybGllciBpdCBkaWRuJ3QgZXZlbiBleGlzdC4KCSAgICAg | |
| IGRfZ2V0aG9zdGJ5YWRkcl9yPSJ1bmRlZiIKCSAgICAgIGRfZ2V0aG9zdGJ5YWRkcl9yX3Byb3Rv | |
| PSIwIgoJICAgICAgOzsKCgkqKQoJICAgICAgIyA3LnggZG9lc24ndCBpbnN0YWxsIGxpYmNfciBi | |
| eSBkZWZhdWx0LCBhbmQgQ29uZmlndXJlCgkgICAgICAjIHdvdWxkIGZhaWwgaW4gdGhlIGNvZGUg | |
| Zm9sbG93aW5nCgkgICAgICAjCgkgICAgICAjIGdldGhvc3RieWFkZHJfcigpIGFwcGVhcnMgdG8g | |
| aGF2ZSBiZWVuIGltcGxlbWVudGVkIGluIDYueCsKCSAgICAgIGxkZmxhZ3M9Ii1wdGhyZWFkICRs | |
| ZGZsYWdzIgoJICAgICAgOzsKCgllc2FjCgogICAgICAgIGNhc2UgIiRvc3ZlcnMiIGluCiAgICAg | |
| ICAgWzEtNF0qKQoJICAgIHNldCBgZWNobyBYICIkbGlic3dhbnRlZCAifCBzZWQgLWUgJ3MvIGMg | |
| LyBjX3IgLydgCgkgICAgc2hpZnQKCSAgICBsaWJzd2FudGVkPSIkKiIKCSAgICA7OwogICAgICAg | |
| ICopCgkgICAgc2V0IGBlY2hvIFggIiRsaWJzd2FudGVkICJ8IHNlZCAtZSAncy8gYyAvLydgCgkg | |
| ICAgc2hpZnQKCSAgICBsaWJzd2FudGVkPSIkKiIKCSAgICA7OwoJZXNhYwoJICAgIAoJIyBDb25m | |
| aWd1cmUgd2lsbCBwcm9iYWJseSBwaWNrIHRoZSB3cm9uZyBsaWJjIHRvIHVzZSBmb3Igbm0gc2Nh | |
| bi4KCSMgVGhlIHNhZmVzdCBxdWljay1maXggaXMganVzdCB0byBub3QgdXNlIG5tIGF0IGFsbC4u | |
| LgoJdXNlbm09ZmFsc2UKCiAgICAgICAgY2FzZSAiJG9zdmVycyIgaW4KICAgICAgICAyLjIuOCop | |
| CiAgICAgICAgICAgICMgLi4uIGJ1dCB0aGlzIGRvZXMgbm90IGFwcGx5IGZvciAyLjIuOCAtIHdl | |
| IGtub3cgaXQncyBzYWZlCiAgICAgICAgICAgIGxpYmM9IiRsY19yIgogICAgICAgICAgICB1c2Vu | |
| bT10cnVlCiAgICAgICAgICAgOzsKICAgICAgICBlc2FjCgogICAgICAgIHVuc2V0IGxjX3IKCgkj | |
| IEV2ZW4gd2l0aCB0aGUgbWFsbG9jIG11dGV4ZXMgdGhlIFBlcmwgbWFsbG9jIGRvZXMgbm90Cgkj | |
| IHNlZW0gdG8gYmUgdGhyZWFkc2FmZSBpbiBGcmVlQlNEPwoJY2FzZSAiJHVzZW15bWFsbG9jIiBp | |
| bgoJJycpIHVzZW15bWFsbG9jPW4gOzsKCWVzYWMKZXNhYwpFT0NCVQoKIyBtYWxsb2Mgd3JhcCB3 | |
| b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIgaW4KJycpIHVzZW1hbGxvY3dyYXA9J2RlZmluZScg | |
| OzsKZXNhYwoKIyBYWFggVW5kZXIgRnJlZUJTRCA2LjAgKGFuZCBwcm9iYWJseSBtb3N0IG90aGVy | |
| IHNpbWlsYXIgdmVyc2lvbnMpCiMgUGVybF9kaWUoTlVMTCkgZ2VuZXJhdGVzIGEgd2FybmluZzoK | |
| IyAgICBwcF9zeXMuYzo0OTE6IHdhcm5pbmc6IG51bGwgZm9ybWF0IHN0cmluZwojIENvbmZpZ3Vy | |
| ZSBzdXBwb3NlZGVseSB0ZXN0cyBmb3IgdGhpcywgYnV0IGFwcGFyZW50bHkgdGhlIHRlc3QgZG9l | |
| c24ndAojIHdvcmsuICBWb2x1bnRlZXJzIHdpdGggRnJlZUJTRCBhcmUgbmVlZGVkIHRvIGltcHJv | |
| dmluZyB0aGUgQ29uZmlndXJlIHRlc3QuCiMgTWVhbndoaWxlLCB0aGUgZm9sbG93aW5nIHdvcmth | |
| cm91bmQgc2hvdWxkIGJlIHNhZmUgb24gYWxsIHZlcnNpb25zCiMgb2YgRnJlZUJTRC4KZF9wcmlu | |
| dGZfZm9ybWF0X251bGw9J3VuZGVmJwo=', | |
| 'openbsd' => | |
| 'IyBoaW50cy9vcGVuYnNkLnNoCiMKIyBoaW50cyBmaWxlIGZvciBPcGVuQlNEOyBUb2RkIE1pbGxl | |
| ciA8bWlsbGVydEBvcGVuYnNkLm9yZz4KIyBFZGl0ZWQgdG8gYWxsb3cgQ29uZmlndXJlIGNvbW1h | |
| bmQtbGluZSBvdmVycmlkZXMgYnkKIyAgQW5keSBEb3VnaGVydHkgPGRvdWdoZXJhQGxhZmF5ZXR0 | |
| ZS5lZHU+CiMKIyBUbyBidWlsZCB3aXRoIGRpc3RyaWJ1dGlvbiBwYXRocywgdXNlOgojCS4vQ29u | |
| ZmlndXJlIC1kZXMgLURvcGVuYnNkX2Rpc3RyaWJ1dGlvbj1kZWZpbmVkCiMKCiMgSW4gT3BlbkJT | |
| RCA+IDMuNywgdXNlIHBlcmwncyBtYWxsb2MgW3BlcmwgIzc1NzQyXQpjYXNlICIkb3N2ZXJzIiBp | |
| bgozLls4OV0qfFs0LTldKikKICAgIHRlc3QgIiR1c2VteW1hbGxvYyIgfHwgdXNlbXltYWxsb2M9 | |
| eQogICAgOzsKZXNhYwoKIyBtYWxsb2Mgd3JhcCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIg | |
| aW4KJycpIHVzZW1hbGxvY3dyYXA9J2RlZmluZScgOzsKZXNhYwoKIyBDdXJyZW50bHksIHZmb3Jr | |
| KDIpIGlzIG5vdCBhIHJlYWwgd2luIG92ZXIgZm9yaygyKS4KdXNldmZvcms9IiR1bmRlZiIKCiMg | |
| SW4gT3BlbkJTRCA8IDMuMywgdGhlIHNldHJlP1t1Z11pZCgpIGFyZSBlbXVsYXRlZCB1c2luZyB0 | |
| aGUKIyBfUE9TSVhfU0FWRURfSURTIGZ1bmN0aW9uYWxpdHkgd2hpY2ggZG9lcyBub3QgaGF2ZSB0 | |
| aGUgc2FtZQojIHNlbWFudGljcyBhcyA0LjNCU0QuICBTdGFydGluZyB3aXRoIE9wZW5CU0QgMy4z | |
| LCB0aGUgb3JpZ2luYWwKIyBzZW1hbnRpY3MgaGF2ZSBiZWVuIHJlc3RvcmVkLgpjYXNlICIkb3N2 | |
| ZXJzIiBpbgpbMC0yXS4qfDMuWzAtMl0pCglkX3NldHJlZ2lkPSR1bmRlZgoJZF9zZXRyZXVpZD0k | |
| dW5kZWYKCWRfc2V0cmdpZD0kdW5kZWYKCWRfc2V0cnVpZD0kdW5kZWYKZXNhYwoKIwojIE5vdCBh | |
| bGwgcGxhdGZvcm1zIHN1cHBvcnQgZHluYW1pYyBsb2FkaW5nLi4uCiMgRm9yIHRoZSBjYXNlIG9m | |
| ICIkb3BlbmJzZF9kaXN0cmlidXRpb24iLCB0aGUgaGludHMgZmlsZQojIG5lZWRzIHRvIGtub3cg | |
| d2hldGhlciB3ZSBhcmUgdXNpbmcgZHluYW1pYyBsb2FkaW5nIHNvIHRoYXQKIyBpdCBjYW4gc2V0 | |
| IHRoZSBsaWJwZXJsIG5hbWUgYXBwcm9wcmlhdGVseS4KIyBBbGxvdyBjb21tYW5kIGxpbmUgb3Zl | |
| cnJpZGVzLgojCkFSQ0g9YGFyY2ggfCBzZWQgJ3MvXk9wZW5CU0QuLy8nYApjYXNlICIke0FSQ0h9 | |
| LSR7b3N2ZXJzfSIgaW4KYWxwaGEtMi5bMC04XXxtaXBzLTIuWzAtOF18cG93ZXJwYy0yLlswLTdd | |
| fG04OGstKnxocHBhLSp8dmF4LSopCgl0ZXN0IC16ICIkdXNlZGwiICYmIHVzZWRsPSR1bmRlZgoJ | |
| OzsKKikKCXRlc3QgLXogIiR1c2VkbCIgJiYgdXNlZGw9JGRlZmluZQoJIyBXZSB1c2UgLWZQSUMg | |
| aGVyZSBiZWNhdXNlIC1mcGljIGlzICpOT1QqIGVub3VnaCBmb3Igc29tZSBvZiB0aGUKCSMgZXh0 | |
| ZW5zaW9ucyBsaWtlIFRrIG9uIHNvbWUgT3BlbkJTRCBwbGF0Zm9ybXMgKGllOiBzcGFyYykKCWNj | |
| Y2RsZmxhZ3M9Ii1EUElDIC1mUElDICRjY2NkbGZsYWdzIgoJY2FzZSAiJG9zdmVycyIgaW4KCVsw | |
| MV0uKnwyLlswLTddfDIuWzAtN10uKikKCQlsZGRsZmxhZ3M9Ii1Cc2hhcmVhYmxlICRsZGRsZmxh | |
| Z3MiCgkJOzsKCTIuWzgtOV18My4wKQoJCWxkPSR7Y2M6LWNjfQoJCWxkZGxmbGFncz0iLXNoYXJl | |
| ZCAtZlBJQyAkbGRkbGZsYWdzIgoJCTs7CgkqKSAjIGZyb20gMy4xIG9ud2FyZHMKCQlsZD0ke2Nj | |
| Oi1jY30KCQlsZGRsZmxhZ3M9Ii1zaGFyZWQgLWZQSUMgJGxkZGxmbGFncyIKCQlsaWJzd2FudGVk | |
| PWBlY2hvICRsaWJzd2FudGVkIHwgc2VkICdzLyBkbCAvIC8nYAoJCTs7Cgllc2FjCgoJIyBXZSBu | |
| ZWVkIHRvIGZvcmNlIGxkIHRvIGV4cG9ydCBzeW1ib2xzIG9uIEVMRiBwbGF0Zm9ybXMuCgkjIFdp | |
| dGhvdXQgdGhpcywgZGxvcGVuKCkgaXMgY3JpcHBsZWQuCglFTEY9YCR7Y2M6LWNjfSAtZE0gLUUg | |
| LSA8L2Rldi9udWxsIHwgZ3JlcCBfX0VMRl9fYAoJdGVzdCAtbiAiJEVMRiIgJiYgbGRmbGFncz0i | |
| LVdsLC1FICRsZGZsYWdzIgoJOzsKZXNhYwoKIwojIFR3ZWFrcyBmb3IgdmFyaW91cyB2ZXJzaW9u | |
| cyBvZiBPcGVuQlNECiMKY2FzZSAiJG9zdmVycyIgaW4KMi41KQoJIyBPcGVuQlNEIDIuNSBoYXMg | |
| YnJva2VuIG9kYm0gc3VwcG9ydAoJaV9kYm09JHVuZGVmCgk7Owplc2FjCgojIE9wZW5CU0QgZG9l | |
| c24ndCBuZWVkIGxpYmNyeXB0IGJ1dCBtYW55IGZvbGtzIGtlZXAgYSBzdHViIGxpYgojIGFyb3Vu | |
| ZCBmb3Igb2xkIE5ldEJTRCBiaW5hcmllcy4KbGlic3dhbnRlZD1gZWNobyAkbGlic3dhbnRlZCB8 | |
| IHNlZCAncy8gY3J5cHQgLyAvJ2AKCiMgQ29uZmlndXJlIGNhbid0IGZpZ3VyZSB0aGlzIG91dCBu | |
| b24taW50ZXJhY3RpdmVseQpkX3N1aWRzYWZlPSRkZWZpbmUKCiMgY2MgaXMgZ2NjIHNvIHdlIGNh | |
| biBkbyBiZXR0ZXIgdGhhbiAtTwojIEFsbG93IGEgY29tbWFuZC1saW5lIG92ZXJyaWRlLCBzdWNo | |
| IGFzIC1Eb3B0aW1pemU9LWcKY2FzZSAke0FSQ0h9IGluCm04OGspCiAgIG9wdGltaXplPSctTzAn | |
| CiAgIDs7CmhwcGEpCiAgIG9wdGltaXplPSctTzAnCiAgIDs7CiopCiAgIHRlc3QgIiRvcHRpbWl6 | |
| ZSIgfHwgb3B0aW1pemU9Jy1PMicKICAgOzsKZXNhYwoKIyBUaGlzIHNjcmlwdCBVVS91c2V0aHJl | |
| YWRzLmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZSAKIyBhZnRlciBpdCBo | |
| YXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNhdCA+IFVV | |
| L3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRlZmluZXx0 | |
| cnVlfFt5WV0qKQoJIyBhbnkgb3BlbmJzZCB2ZXJzaW9uIGRlcGVuZGVuY2llcyB3aXRoIHB0aHJl | |
| YWRzPwoJY2NmbGFncz0iLXB0aHJlYWQgJGNjZmxhZ3MiCglsZGZsYWdzPSItcHRocmVhZCAkbGRm | |
| bGFncyIKCWNhc2UgIiRvc3ZlcnMiIGluCglbMC0yXS4qfDMuWzAtMl0pCgkJIyBDaGFuZ2UgZnJv | |
| bSAtbGMgdG8gLWxjX3IKCQlzZXQgYGVjaG8gIlggJGxpYnN3YW50ZWQgIiB8IHNlZCAncy8gYyAv | |
| IGNfciAvJ2AKCQlzaGlmdAoJCWxpYnN3YW50ZWQ9IiQqIgoJOzsKCWVzYWMKCWNhc2UgIiRvc3Zl | |
| cnMiIGluCglbMDEyXS4qfDMuWzAtNl0pCiAgICAgICAgCSMgQnJva2VuIGF0IGxlYXN0IHVwIHRv | |
| IE9wZW5CU0QgMy42LCB3ZSdsbCBzZWUgYWJvdXQgMy43CgkJZF9nZXRzZXJ2YnluYW1lX3I9JHVu | |
| ZGVmIDs7Cgllc2FjCmVzYWMKRU9DQlUKCiMgVGhpcyBzY3JpcHQgVVUvdXNlNjRiaXRpbnQuY2J1 | |
| IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIAojIGFmdGVyIGl0IGhhcyBwcm9t | |
| cHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgNjQtYml0bmVzcy4KY2F0ID4gVVUvdXNl | |
| NjRiaXRpbnQuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNlNjRiaXRpbnQiIGluCiRkZWZpbmV8dHJ1 | |
| ZXxbeVldKikKCWVjaG8gIiAiCgllY2hvICJDaGVja2luZyBpZiB5b3VyIEMgbGlicmFyeSBoYXMg | |
| YnJva2VuIDY0LWJpdCBmdW5jdGlvbnMuLi4iID4mNAoJJGNhdCA+Y2hlY2suYyA8PEVPQ1AKI2lu | |
| Y2x1ZGUgPHN0ZGlvLmg+CnR5cGVkZWYgJHVxdWFkdHlwZSBteVVMTDsKaW50IG1haW4gKHZvaWQp | |
| CnsKICAgIHN0cnVjdCB7Cglkb3VibGUgZDsKCW15VUxMICB1OwogICAgfSAqcCwgdGVzdFtdID0g | |
| ewoJezQyOTQ5NjczMDMuMTUsIDQyOTQ5NjczMDNVTEx9LAoJezQyOTQ5NjcyOTQuMiwgIDQyOTQ5 | |
| NjcyOTRVTEx9LAoJezQyOTQ5NjcyOTUuNywgIDQyOTQ5NjcyOTVVTEx9LAoJezAuMCwgMFVMTH0K | |
| ICAgIH07CiAgICBmb3IgKHAgPSB0ZXN0OyBwLT51OyBwKyspIHsKCW15VUxMIHggPSAobXlVTEwp | |
| cC0+ZDsKCWlmICh4ICE9IHAtPnUpIHsKCSAgICBwcmludGYoImJ1Z2d5XG4iKTsKCSAgICByZXR1 | |
| cm4gMDsKCX0KICAgIH0KICAgIHByaW50Zigib2tcbiIpOwogICAgcmV0dXJuIDA7Cn0KRU9DUAoJ | |
| c2V0IGNoZWNrCglpZiBldmFsICRjb21waWxlX29rOyB0aGVuCgkgICAgbGliY3F1YWQ9YC4vY2hl | |
| Y2tgCgkgICAgZWNobyAiWW91ciBDIGxpYnJhcnkncyA2NC1iaXQgZnVuY3Rpb25zIGFyZSAkbGli | |
| Y3F1YWQuIgoJZWxzZQoJICAgIGVjaG8gIihJIGNhbid0IHNlZW0gdG8gY29tcGlsZSB0aGUgdGVz | |
| dCBwcm9ncmFtLikiCgkgICAgZWNobyAiQXNzdW1pbmcgdGhhdCB5b3VyIEMgbGlicmFyeSdzIDY0 | |
| LWJpdCBmdW5jdGlvbnMgYXJlIG9rLiIKCSAgICBsaWJjcXVhZD0ib2siCglmaQoJJHJtIC1mIGNo | |
| ZWNrLmMgY2hlY2sKCgljYXNlICIkbGliY3F1YWQiIGluCgkgICAgYnVnZ3kqKQoJCWNhdCA+JjQg | |
| PDxFT00KCioqKiBZb3UgaGF2ZSBhIEMgbGlicmFyeSB3aXRoIGJyb2tlbiA2NC1iaXQgZnVuY3Rp | |
| b25zLgoqKiogNjQtYml0IHN1cHBvcnQgZG9lcyBub3Qgd29yayByZWxpYWJseSBpbiB0aGlzIGNv | |
| bmZpZ3VyYXRpb24uCioqKiBQbGVhc2UgcmVydW4gQ29uZmlndXJlIHdpdGhvdXQgLUR1c2U2NGJp | |
| dGludCBhbmQvb3IgLUR1c2Vtb3JlYml0cy4KKioqIENhbm5vdCBjb250aW51ZSwgYWJvcnRpbmcu | |
| CgpFT00KCQlleGl0IDEKCQk7OwoJZXNhYwplc2FjCkVPQ0JVCgojIFdoZW4gYnVpbGRpbmcgaW4g | |
| dGhlIE9wZW5CU0QgdHJlZSB3ZSB1c2UgZGlmZmVyZW50IHBhdGhzCiMgVGhpcyBpcyBvbmx5IHBh | |
| cnQgb2YgdGhlIHN0b3J5LCB0aGUgcmVzdCBjb21lcyBmcm9tIGNvbmZpZy5vdmVyCmNhc2UgIiRv | |
| cGVuYnNkX2Rpc3RyaWJ1dGlvbiIgaW4KJyd8JHVuZGVmfGZhbHNlKSA7OwoqKQoJIyBXZSBwdXQg | |
| dGhpbmdzIGluIC91c3IsIG5vdCAvdXNyL2xvY2FsCglwcmVmaXg9Jy91c3InCglwcmVmaXhleHA9 | |
| Jy91c3InCglzeXNtYW49Jy91c3Ivc2hhcmUvbWFuL21hbjEnCglsaWJwdGg9Jy91c3IvbGliJwoJ | |
| Z2xpYnB0aD0nL3Vzci9saWInCgkjIExvY2FsIHRoaW5ncywgaG93ZXZlciwgZG8gZ28gaW4gL3Vz | |
| ci9sb2NhbAoJc2l0ZXByZWZpeD0nL3Vzci9sb2NhbCcKCXNpdGVwcmVmaXhleHA9Jy91c3IvbG9j | |
| YWwnCgkjIFBvcnRzIGluc3RhbGxzIG5vbi1zdGQgbGlicyBpbiAvdXNyL2xvY2FsL2xpYiBzbyBs | |
| b29rIHRoZXJlIHRvbwoJbG9jaW5jcHRoPScvdXNyL2xvY2FsL2luY2x1ZGUnCglsb2NsaWJwdGg9 | |
| Jy91c3IvbG9jYWwvbGliJwoJIyBMaW5rIHBlcmwgd2l0aCBzaGFyZWQgbGlicGVybAoJaWYgWyAi | |
| JHVzZWRsIiA9ICIkZGVmaW5lIiAtYSAtciBzaGxpYl92ZXJzaW9uIF07IHRoZW4KCQl1c2VzaHJw | |
| bGliPXRydWUKCQlsaWJwZXJsPWAuIC4vc2hsaWJfdmVyc2lvbjsgZWNobyBsaWJwZXJsLnNvLiR7 | |
| bWFqb3J9LiR7bWlub3J9YAoJZmkKCTs7CmVzYWMKCiMgZW5kCg==', | |
| 'linux' => | |
| 'IyBoaW50cy9saW51eC5zaAojIE9yaWdpbmFsIHZlcnNpb24gYnkgcnNhbmRlcnMKIyBBZGRpdGlv | |
| bmFsIHN1cHBvcnQgYnkgS2VubmV0aCBBbGJhbm93c2tpIDxramFoZHNAa2phaGRzLmNvbT4KIwoj | |
| IEVMRiBzdXBwb3J0IGJ5IEguSi4gTHUgPGhqbEBueW5leHN0LmNvbT4KIyBBZGRpdGlvbmFsIGlu | |
| Zm8gZnJvbSBOaWdlbCBIZWFkIDxuaGVhZEBFU09DLmJpdG5ldD4KIyBhbmQgS2VubmV0aCBBbGJh | |
| bm93c2tpIDxramFoZHNAa2phaGRzLmNvbT4KIwojIENvbnNvbGlkYXRlZCBieSBBbmR5IERvdWdo | |
| ZXJ0eSA8ZG91Z2hlcmFAbGFmYXlldHRlLmVkdT4KIwojIFVwZGF0ZWQgVGh1IEZlYiAgOCAxMTo1 | |
| NjoxMCBFU1QgMTk5NgoKIyBVcGRhdGVkIFRodSBNYXkgMzAgMTA6NTA6MjIgRURUIDE5OTYgYnkg | |
| PGRvdWdoZXJhQGxhZmF5ZXR0ZS5lZHU+CgojIFVwZGF0ZWQgRnJpIEp1biAyMSAxMTowNzo1NCBF | |
| RFQgMTk5NgojIE5EQk0gc3VwcG9ydCBmb3IgRUxGIHJlLWVuYWJsZWQgYnkgPGtqYWhkc0BramFo | |
| ZHMuY29tPgoKIyBObyB2ZXJzaW9uIG9mIExpbnV4IHN1cHBvcnRzIHNldHVpZCBzY3JpcHRzLgpk | |
| X3N1aWRzYWZlPSd1bmRlZicKCiMgTm8gdmVyc2lvbiBvZiBMaW51eCBuZWVkcyBsaWJ1dGlsIGZv | |
| ciBwZXJsLgppX2xpYnV0aWw9J3VuZGVmJwoKIyBEZWJpYW4gYW5kIFJlZCBIYXQsIGFuZCBwZXJo | |
| YXBzIG90aGVyIHZlbmRvcnMsIHByb3ZpZGUgYm90aCBydW50aW1lIGFuZAojIGRldmVsb3BtZW50 | |
| IHBhY2thZ2VzIGZvciBzb21lIGxpYnJhcmllcy4gIFRoZSBydW50aW1lIHBhY2thZ2VzIGNvbnRh | |
| aW4gc2hhcmVkCiMgbGlicmFyaWVzIHdpdGggdmVyc2lvbiBpbmZvcm1hdGlvbiBpbiB0aGVpciBu | |
| YW1lcyAoZS5nLiwgbGliZ2RibS5zby4xLjcuMyk7CiMgdGhlIGRldmVsb3BtZW50IHBhY2thZ2Vz | |
| IHN1cHBsZW1lbnQgdGhpcyB3aXRoIHZlcnNpb25sZXNzIHNoYXJlZCBsaWJyYXJpZXMKIyAoZS5n | |
| LiwgbGliZ2RibS5zbykuCiMKIyBJZiB5b3Ugd2FudCB0byBsaW5rIGFnYWluc3Qgc3VjaCBhIGxp | |
| YnJhcnksIHlvdSBtdXN0IGluc3RhbGwgdGhlIGRldmVsb3BtZW50CiMgdmVyc2lvbiBvZiB0aGUg | |
| cGFja2FnZS4KIwojIFRoZXNlIHBhY2thZ2VzIHVzZSBhIC1kZXYgbmFtaW5nIGNvbnZlbnRpb24g | |
| aW4gYm90aCBEZWJpYW4gYW5kIFJlZCBIYXQ6CiMgICBsaWJnZGJtZzEgIChub24tZGV2ZWxvcG1l | |
| bnQgdmVyc2lvbiBvZiBHTlUgbGliYyAyLWxpbmtlZCBHREJNIGxpYnJhcnkpCiMgICBsaWJnZGJt | |
| ZzEtZGV2IChkZXZlbG9wbWVudCB2ZXJzaW9uIG9mIEdOVSBsaWJjIDItbGlua2VkIEdEQk0gbGli | |
| cmFyeSkKIyBTbyBtYWtlIHN1cmUgdGhhdCBmb3IgYW55IGxpYnJhcmllcyB5b3Ugd2lzaCB0byBs | |
| aW5rIFBlcmwgd2l0aCB1bmRlcgojIERlYmlhbiBvciBSZWQgSGF0IHlvdSBoYXZlIHRoZSAtZGV2 | |
| IHBhY2thZ2VzIGluc3RhbGxlZC4KCiMgU3VTRSBMaW51eCBjYW4gYmUgdXNlZCBhcyBjcm9zcy1j | |
| b21waWxhdGlvbiBob3N0IGZvciBDcmF5IFhUNCBDYXRhbW91bnQvUWsuCmlmIHRlc3QgLWQgL29w | |
| dC94dC1wZQp0aGVuCiAgY2FzZSAiYGNjIC1WIDI+JjFgIiBpbgogICpjYXRhbW91bnQqKSAuIGhp | |
| bnRzL2NhdGFtb3VudC5zaDsgcmV0dXJuIDs7CiAgZXNhYwpmaQoKIyBTb21lIG9wZXJhdGluZyBz | |
| eXN0ZW1zIChlLmcuLCBTb2xhcmlzIDIuNikgd2lsbCBsaW5rIHRvIGEgdmVyc2lvbmVkIHNoYXJl | |
| ZAojIGxpYnJhcnkgaW1wbGljaXRseS4gIEZvciBleGFtcGxlLCBvbiBTb2xhcmlzLCBgbGQgZm9v | |
| Lm8gLWxnZGJtJyB3aWxsIGZpbmQgYW4KIyBhcHByb3ByaWF0ZSB2ZXJzaW9uIG9mIGxpYmdkYm0s | |
| IGlmIG9uZSBpcyBhdmFpbGFibGU7IExpbnV4LCBob3dldmVyLCBkb2Vzbid0CiMgZG8gdGhlIGlt | |
| cGxpY2l0IG1hcHBpbmcuCmlnbm9yZV92ZXJzaW9uZWRfc29saWJzPSd5JwoKIyBCU0QgY29tcGF0 | |
| aWJpbGl0eSBsaWJyYXJ5IG5vIGxvbmdlciBuZWVkZWQKIyAna2FmZmUnIGhhcyBhIC91c3IvbGli | |
| L2xpYm5ldC5zbyB3aGljaCBpcyBub3QgYXQgYWxsIHJlbGV2YW50IGZvciBwZXJsLgojIGJpbmQg | |
| Y2F1c2VzIGlzc3VlcyB3aXRoIHNldmVyYWwgcmVlbnRyYW50IGZ1bmN0aW9ucwpzZXQgYGVjaG8g | |
| WCAiJGxpYnN3YW50ZWQgInwgc2VkIC1lICdzLyBic2QgLyAvJyAtZSAncy8gbmV0IC8gLycgLWUg | |
| J3MvIGJpbmQgLyAvJ2AKc2hpZnQKbGlic3dhbnRlZD0iJCoiCgojIERlYmlhbiA0LjAgcHV0cyBu | |
| ZGJtIGluIHRoZSAtbGdkYm1fY29tcGF0IGxpYnJhcnkuCmxpYnN3YW50ZWQ9IiRsaWJzd2FudGVk | |
| IGdkYm1fY29tcGF0IgoKIyBJZiB5b3UgaGF2ZSBnbGliYywgdGhlbiByZXBvcnQgdGhlIHZlcnNp | |
| b24gZm9yIC4vbXljb25maWcgYnVnIHJlcG9ydGluZy4KIyAoQ29uZmlndXJlIGRvZXNuJ3QgbmVl | |
| ZCB0byBrbm93IHRoZSBzcGVjaWZpYyB2ZXJzaW9uIHNpbmNlIGl0IGp1c3QgdXNlcwojIGdjYyB0 | |
| byBsb2FkIHRoZSBsaWJyYXJ5IGZvciBhbGwgdGVzdHMuKQojIFdlIGRvbid0IHVzZSBfX0dMSUJD | |
| X18gYW5kICBfX0dMSUJDX01JTk9SX18gYmVjYXVzZSB0aGV5CiMgYXJlIGluc3VmZmljaWVudGx5 | |
| IHByZWNpc2UgdG8gZGlzdGluZ3Vpc2ggdGhpbmdzIGxpa2UKIyBsaWJjLTIuMC42IGFuZCBsaWJj | |
| LTIuMC43LgppZiB0ZXN0IC1MIC9saWIvbGliYy5zby42OyB0aGVuCiAgICBsaWJjPWBscyAtbCAv | |
| bGliL2xpYmMuc28uNiB8IGF3ayAne3ByaW50ICRORn0nYAogICAgbGliYz0vbGliLyRsaWJjCmZp | |
| CgojIENvbmZpZ3VyZSBtYXkgZmFpbCB0byBmaW5kIGxzdGF0KCkgc2luY2UgaXQncyBhIHN0YXRp | |
| Yy9pbmxpbmUKIyBmdW5jdGlvbiBpbiA8c3lzL3N0YXQuaD4uCmRfbHN0YXQ9ZGVmaW5lCgojIG1h | |
| bGxvYyB3cmFwIHdvcmtzCmNhc2UgIiR1c2VtYWxsb2N3cmFwIiBpbgonJykgdXNlbWFsbG9jd3Jh | |
| cD0nZGVmaW5lJyA7Owplc2FjCgojIFRoZSBzeXN0ZW0gbWFsbG9jKCkgaXMgYWJvdXQgYXMgZmFz | |
| dCBhbmQgYXMgZnJ1Z2FsIGFzIHBlcmwncy4KIyBTaW5jZSB0aGUgc3lzdGVtIG1hbGxvYygpIGhh | |
| cyBiZWVuIHRoZSBkZWZhdWx0IHNpbmNlIGF0IGxlYXN0CiMgNS4wMDEsIHdlIG1pZ2h0IGFzIHdl | |
| bGwgbGVhdmUgaXQgdGhhdCB3YXkuICAtLUFEICAxMCBKYW4gMjAwMgpjYXNlICIkdXNlbXltYWxs | |
| b2MiIGluCicnKSB1c2VteW1hbGxvYz0nbicgOzsKZXNhYwoKIyBDaGVjayBpZiB3ZSdyZSBhYm91 | |
| dCB0byB1c2UgSW50ZWwncyBJQ0MgY29tcGlsZXIKY2FzZSAiYCR7Y2M6LWNjfSAtViAyPiYxYCIg | |
| aW4KKiJJbnRlbChSKSBDKysgQ29tcGlsZXIiKnwqIkludGVsKFIpIEMgQ29tcGlsZXIiKikKICAg | |
| ICMgcmVjb3JkIHRoZSB2ZXJzaW9uLCBmb3JtYXRzOgogICAgIyBpY2MgKElDQykgMTAuMSAyMDA4 | |
| MDgwMQogICAgIyBpY3BjIChJQ0MpIDEwLjEgMjAwODA4MDEKICAgICMgZm9sbG93ZWQgYnkgYSBj | |
| b3B5cmlnaHQgb24gdGhlIHNlY29uZCBsaW5lCiAgICBjY3ZlcnNpb249YCR7Y2M6LWNjfSAtLXZl | |
| cnNpb24gfCBzZWQgLW4gLWUgJ3MvXmljcFw/YyBcKChJQ0MpIFwpXD8vL3AnYAogICAgIyBUaGlz | |
| IGlzIG5lZWRlZCBmb3IgQ29uZmlndXJlJ3MgcHJvdG90eXBlIGNoZWNrcyB0byB3b3JrIGNvcnJl | |
| Y3RseQogICAgIyBUaGUgLW1wIGZsYWcgaXMgbmVlZGVkIHRvIHBhc3MgdmFyaW91cyBmbG9hdGlu | |
| ZyBwb2ludCByZWxhdGVkIHRlc3RzCiAgICAjIFRoZSAtbm8tZ2NjIGZsYWcgaXMgbmVlZGVkIG90 | |
| aGVyd2lzZSwgaWNjIHByZXRlbmRzIChwb29ybHkpIHRvIGJlIGdjYwogICAgY2NmbGFncz0iLXdl | |
| MTQ3IC1tcCAtbm8tZ2NjICRjY2ZsYWdzIgogICAgIyBQcmV2ZW50IHJlbG9jYXRpb24gZXJyb3Jz | |
| IG9uIDY0Yml0cyBhcmNoCiAgICBjYXNlICJgdW5hbWUgLW1gIiBpbgoJKmlhNjQqfCp4ODZfNjQq | |
| KQoJICAgIGNjY2RsZmxhZ3M9Jy1mUElDJwoJOzsKICAgIGVzYWMKICAgICMgSWYgd2UncmUgdXNp | |
| bmcgSUNDLCB3ZSB1c3VhbGx5IHdhbnQgdGhlIGJlc3QgcGVyZm9ybWFuY2UKICAgIGNhc2UgIiRv | |
| cHRpbWl6ZSIgaW4KICAgICcnKSBvcHRpbWl6ZT0nLU8zJyA7OwogICAgZXNhYwogICAgOzsKKiIg | |
| U3VuICIqIkMiKikKICAgICMgU3VuJ3MgQyBjb21waWxlciwgd2hpY2ggbWlnaHQgaGF2ZSBhICd0 | |
| YWcnIG5hbWUgYmV0d2VlbgogICAgIyAnU3VuJyBhbmQgdGhlICdDJzogIEV4YW1wbGVzOgogICAg | |
| IyBjYzogU3VuIEMgNS45IExpbnV4X2kzODYgUGF0Y2ggMTI0ODcxLTAxIDIwMDcvMDcvMzEKICAg | |
| ICMgY2M6IFN1biBDZXJlcyBDIDUuMTAgTGludXhfaTM4NiAyMDA4LzA3LzEwCiAgICB0ZXN0ICIk | |
| b3B0aW1pemUiIHx8IG9wdGltaXplPScteE8yJwogICAgY2NjZGxmbGFncz0nLUtQSUMnCiAgICBs | |
| ZGRsZmxhZ3M9Jy1HIC1CZHluYW1pYycKICAgICMgU3VuIEMgZG9lc24ndCBzdXBwb3J0IGdjYyBh | |
| dHRyaWJ1dGVzLCBidXQsIGluIG1hbnkgY2FzZXMsIGRvZXNuJ3QKICAgICMgY29tcGxhaW4gZWl0 | |
| aGVyLiAgTm90IGFsbCBjYXNlcywgdGhvdWdoLgogICAgZF9hdHRyaWJ1dGVfZm9ybWF0PSd1bmRl | |
| ZicKICAgIGRfYXR0cmlidXRlX21hbGxvYz0ndW5kZWYnCiAgICBkX2F0dHJpYnV0ZV9ub25udWxs | |
| PSd1bmRlZicKICAgIGRfYXR0cmlidXRlX25vcmV0dXJuPSd1bmRlZicKICAgIGRfYXR0cmlidXRl | |
| X3B1cmU9J3VuZGVmJwogICAgZF9hdHRyaWJ1dGVfdW51c2VkPSd1bmRlZicKICAgIGRfYXR0cmli | |
| dXRlX3dhcm5fdW51c2VkX3Jlc3VsdD0ndW5kZWYnCiAgICA7Owplc2FjCgpjYXNlICIkb3B0aW1p | |
| emUiIGluCiMgdXNlIC1PMiBieSBkZWZhdWx0IDsgLU8zIGRvZXNuJ3Qgc2VlbSB0byBicmluZyBz | |
| aWduaWZpY2FudCBiZW5lZml0cyB3aXRoIGdjYwonJykKICAgIG9wdGltaXplPSctTzInCiAgICBj | |
| YXNlICJgdW5hbWUgLW1gIiBpbgogICAgICAgIHBwYyopCiAgICAgICAgICAgICMgb24gcHBjLCBp | |
| dCBzZWVtcyB0aGF0IGdjYyAoYXQgbGVhc3QgZ2NjIDMuMy4yKSBpc24ndCBoYXBweQogICAgICAg | |
| ICAgICAjIHdpdGggLU8yIDsgc28gZG93bmdyYWRlIHRvIC1PMS4KICAgICAgICAgICAgb3B0aW1p | |
| emU9Jy1PMScKICAgICAgICA7OwogICAgICAgIGlhNjQqKQogICAgICAgICAgICAjIFRoaXMgYXJj | |
| aGl0ZWN0dXJlIGhhcyBoYWQgdmFyaW91cyBwcm9ibGVtcyB3aXRoIGdjYydzCiAgICAgICAgICAg | |
| ICMgaW4gdGhlIDMuMiwgMy4zLCBhbmQgMy40IHJlbGVhc2VzIHdoZW4gb3B0aW1pemVkIHRvIC1P | |
| Mi4gIFNlZQogICAgICAgICAgICAjIFJUICMzNzE1NiBmb3IgYSBkaXNjdXNzaW9uIG9mIHRoZSBw | |
| cm9ibGVtLgogICAgICAgICAgICBjYXNlICJgJHtjYzotZ2NjfSAtdiAyPiYxYCIgaW4KICAgICAg | |
| ICAgICAgKiJ2ZXJzaW9uIDMuMiIqfCoidmVyc2lvbiAzLjMiKnwqInZlcnNpb24gMy40IiopCiAg | |
| ICAgICAgICAgICAgICBjY2ZsYWdzPSItZm5vLWRlbGV0ZS1udWxsLXBvaW50ZXItY2hlY2tzICRj | |
| Y2ZsYWdzIgogICAgICAgICAgICA7OwogICAgICAgICAgICBlc2FjCiAgICAgICAgOzsKICAgIGVz | |
| YWMKICAgIDs7CmVzYWMKCiMgVWJ1bnR1IDExLjA0IChhbmQgbGF0ZXIsIHByZXN1bWFibHkpIGRv | |
| ZXNuJ3Qga2VlcCBtb3N0IGxpYnJhcmllcwojIChzdWNoIGFzIC1sbSkgaW4gL2xpYiBvciAvdXNy | |
| L2xpYi4gIFNvIHdlIGhhdmUgdG8gYXNrIGdjYyB0byB0ZWxsIHVzCiMgd2hlcmUgdG8gbG9vay4g | |
| IFdlIGRvbid0IHdhbnQgZ2NjJ3Mgb3duIGxpYnJhcmllcywgaG93ZXZlciwgc28gd2UKIyBmaWx0 | |
| ZXIgdGhvc2Ugb3V0LgojIFRoaXMgY291bGQgYmUgY29uZGl0aW9uYWwgb24gVW5idW50dSwgYnV0 | |
| IG90aGVyIGRpc3RyaWJ1dGlvbnMgbWF5CiMgZm9sbG93IHN1aXQsIGFuZCB0aGlzIHNjaGVtZSBz | |
| ZWVtcyB0byB3b3JrIGV2ZW4gb24gcmF0aGVyIG9sZCBnY2Mncy4KIyBUaGlzIHVuY29uZGl0aW9u | |
| YWxseSB1c2VzIGdjYyBiZWNhdXNlIGV2ZW4gaWYgdGhlIHVzZXIgaXMgdXNpbmcgYW5vdGhlcgoj | |
| IGNvbXBpbGVyLCB3ZSBzdGlsbCBuZWVkIHRvIGZpbmQgdGhlIG1hdGggbGlicmFyeSBhbmQgZnJp | |
| ZW5kcywgYW5kIEkgZG9uJ3QKIyBrbm93IGhvdyBvdGhlciBjb21waWxlcnMgd2lsbCBjb3BlIHdp | |
| dGggdGhhdCBzaXR1YXRpb24uCiMgTW9yZXZlciwgaWYgdGhlIHVzZXIgaGFzIHRoZWlyIG93biBn | |
| Y2MgZWFybGllciBpbiAkUEFUSCB0aGFuIHRoZSBzeXN0ZW0gZ2NjLAojIHdlIGRvbid0IHdhbnQg | |
| aXRzIGxpYnJhcmllcy4gU28gd2UgdHJ5IHRvIHByZWZlciB0aGUgc3lzdGVtIGdjYwojIFN0aWxs | |
| LCBhcyBhbiBlc2NhcGUgaGF0Y2gsIGFsbG93IENvbmZpZ3VyZSBjb21tYW5kIGxpbmUgb3ZlcnJp | |
| ZGVzIHRvCiMgcGxpYnB0aCB0byBieXBhc3MgdGhpcyBjaGVjay4KaWYgWyAteCAvdXNyL2Jpbi9n | |
| Y2MgXSA7IHRoZW4KICAgIGdjYz0vdXNyL2Jpbi9nY2MKZWxzZQogICAgZ2NjPWdjYwpmaQoKY2Fz | |
| ZSAiJHBsaWJwdGgiIGluCicnKSBwbGlicHRoPWAkZ2NjIC1wcmludC1zZWFyY2gtZGlycyB8IGdy | |
| ZXAgbGlicmFyaWVzIHwKCWN1dCAtZjItIC1kPSB8IHRyICc6JyAkdHJubCB8IGdyZXAgLXYgJ2dj | |
| YycgfCBzZWQgLWUgJ3M6LyQ6OidgCiAgICBzZXQgWCAkcGxpYnB0aCAjIENvbGxhcHNlIGFsbCBl | |
| bnRyaWVzIG9uIG9uZSBsaW5lCiAgICBzaGlmdAogICAgcGxpYnB0aD0iJCoiCiAgICA7Owplc2Fj | |
| CgojIEFyZSB3ZSB1c2luZyBFTEY/ICBUaGFua3MgdG8gS2VubmV0aCBBbGJhbm93c2tpIDxramFo | |
| ZHNAa2phaGRzLmNvbT4KIyBmb3IgdGhpcyB0ZXN0LgpjYXQgPnRyeS5jIDw8J0VPTScKLyogVGVz | |
| dCBmb3Igd2hldGhlciBFTEYgYmluYXJpZXMgYXJlIHByb2R1Y2VkICovCiNpbmNsdWRlIDxmY250 | |
| bC5oPgojaW5jbHVkZSA8c3RkbGliLmg+CiNpbmNsdWRlIDx1bmlzdGQuaD4KbWFpbigpIHsKCWNo | |
| YXIgYnVmZmVyWzRdOwoJaW50IGk9b3BlbigiYS5vdXQiLE9fUkRPTkxZKTsKCWlmKGk9PS0xKQoJ | |
| CWV4aXQoMSk7IC8qIGZhaWwgKi8KCWlmKHJlYWQoaSwmYnVmZmVyWzBdLDQpPDQpCgkJZXhpdCgx | |
| KTsgLyogZmFpbCAqLwoJaWYoYnVmZmVyWzBdICE9IDEyNyB8fCBidWZmZXJbMV0gIT0gJ0UnIHx8 | |
| CiAgICAgICAgICAgYnVmZmVyWzJdICE9ICdMJyB8fCBidWZmZXJbM10gIT0gJ0YnKQoJCWV4aXQo | |
| MSk7IC8qIGZhaWwgKi8KCWV4aXQoMCk7IC8qIHN1Y2NlZWQgKHllcywgaXQncyBFTEYpICovCn0K | |
| RU9NCmlmICR7Y2M6LWdjY30gdHJ5LmMgPi9kZXYvbnVsbCAyPiYxICYmICRydW4gLi9hLm91dDsg | |
| dGhlbgogICAgY2F0IDw8J0VPTScgPiY0CgpZb3UgYXBwZWFyIHRvIGhhdmUgRUxGIHN1cHBvcnQu | |
| ICBJJ2xsIHRyeSB0byB1c2UgaXQgZm9yIGR5bmFtaWMgbG9hZGluZy4KSWYgZHluYW1pYyBsb2Fk | |
| aW5nIGRvZXNuJ3Qgd29yaywgcmVhZCBoaW50cy9saW51eC5zaCBmb3IgZnVydGhlciBpbmZvcm1h | |
| dGlvbi4KRU9NCgplbHNlCiAgICBjYXQgPDwnRU9NJyA+JjQKCllvdSBkb24ndCBoYXZlIGFuIEVM | |
| RiBnY2MuICBJIHdpbGwgdXNlIGRsZCBpZiBwb3NzaWJsZS4gIElmIHlvdSBhcmUKdXNpbmcgYSB2 | |
| ZXJzaW9uIG9mIERMRCBlYXJsaWVyIHRoYW4gMy4yLjYsIG9yIGRvbid0IGhhdmUgaXQgYXQgYWxs | |
| LCB5b3UKc2hvdWxkIHByb2JhYmx5IHVwZ3JhZGUuIElmIHlvdSBhcmUgZm9yY2VkIHRvIHVzZSAz | |
| LjIuNCwgeW91IHNob3VsZAp1bmNvbW1lbnQgYSBjb3VwbGUgb2YgbGluZXMgaW4gaGludHMvbGlu | |
| dXguc2ggYW5kIHJlc3RhcnQgQ29uZmlndXJlIHNvCnRoYXQgc2hhcmVkIGxpYnJhcmllcyB3aWxs | |
| IGJlIGRpc2FsbG93ZWQuCgpFT00KICAgIGxkZGxmbGFncz0iLXIgJGxkZGxmbGFncyIKICAgICMg | |
| VGhlc2UgZW1wdHkgdmFsdWVzIGFyZSBzbyB0aGF0IENvbmZpZ3VyZSBkb2Vzbid0IHB1dCBpbiB0 | |
| aGUKICAgICMgTGludXggRUxGIHZhbHVlcy4KICAgIGNjZGxmbGFncz0nICcKICAgIGNjY2RsZmxh | |
| Z3M9JyAnCiAgICBjY2ZsYWdzPSItRE9WUl9EQkxfRElHPTE0ICRjY2ZsYWdzIgogICAgc289J3Nh | |
| JwogICAgZGxleHQ9J28nCiAgICBubV9zb19vcHQ9JyAnCiAgICAjIyBJZiB5b3UgYXJlIHVzaW5n | |
| IERMRCAzLjIuNCB3aGljaCBkb2VzIG5vdCBzdXBwb3J0IHNoYXJlZCBsaWJzLAogICAgIyMgdW5j | |
| b21tZW50IHRoZSBuZXh0IHR3byBsaW5lczoKICAgICNsZGZsYWdzPSItc3RhdGljIgogICAgI3Nv | |
| PSdub25lJwoKCSMgSW4gYWRkaXRpb24sIG9uIHNvbWUgc3lzdGVtcyB0aGVyZSBpcyBhIHByb2Js | |
| ZW0gd2l0aCBwZXJsIGFuZCBOREJNCgkjIHdoaWNoIGNhdXNlcyBBbnlEQk0gYW5kIE5EQk1fRmls | |
| ZSB0byBsb2NrIHVwLiBUaGlzIGlzIGV2aWRlbmNlZAoJIyBpbiB0aGUgdGVzdHMgYXMgQW55REJN | |
| IGp1c3QgZnJlZXppbmcuICBBcHBhcmVudGx5LCB0aGlzIG9ubHkKCSMgaGFwcGVucyBvbiBhLm91 | |
| dCBzeXN0ZW1zLCBzbyB3ZSBkaXNhYmxlIE5EQk0gZm9yIGFsbCBhLm91dCBsaW51eAoJIyBzeXN0 | |
| ZW1zLiAgSWYgc29tZW9uZSBjYW4gc3VnZ2VzdCBhIG1vcmUgcm9idXN0IHRlc3QKCSMgIHRoYXQg | |
| d291bGQgYmUgYXBwcmVjaWF0ZWQuCgkjCgkjIE1vcmUgaW5mbzoKCSMgRGF0ZTogV2VkLCA3IEZl | |
| YiAxOTk2IDAzOjIxOjA0ICswOTAwCgkjIEZyb206IEplZmZyZXkgRnJpZWRsIDxqZnJpZWRsQG5m | |
| Zi5uY2wub21yb24uY28uanA+CgkjCgkjIEkgdHJpZWQgY29tcGlsaW5nIHdpdGggREJNIHN1cHBv | |
| cnQgYW5kIHN1cmUgZW5vdWdoIHRoaW5ncyBsb2NrZWQgdXAKCSMganVzdCBhcyBhZHZlcnRpc2Vk | |
| LiBDaGVja2luZyBpbnRvIGl0LCBJIGZvdW5kIHRoYXQgdGhlIGxvY2t1cCB3YXMKCSMgZHVyaW5n | |
| IHRoZSBjYWxsIHRvIGRibV9vcGVuLiBOb3QgKmluKiBkYm1fb3BlbiAtLSBidXQgYmV0d2VlbiB0 | |
| aGUgY2FsbAoJIyB0byBhbmQgdGhlIGp1bXAgaW50by4KCSMKCSMgVG8gbWFrZSBhIGxvbmcgc3Rv | |
| cnkgc2hvcnQsIG1ha2luZyBzdXJlIHRoYXQgdGhlICouYSBhbmQgKi5zYSBwYWlycyBvZgoJIyAg | |
| IC91c3IvbGliL2xpYnttLGRiLGdkYm19LnthLHNhfQoJIyB3ZXJlIHBlcmZlY3RseSBpbiBzeW5j | |
| IHRvb2sgY2FyZSBvZiBpdC4KCSMKCSMgVGhpcyB3aWxsIGdlbmVyYXRlIGEgaGFybWxlc3MgV2hv | |
| YSBUaGVyZSEgbWVzc2FnZQoJY2FzZSAiJGRfZGJtX29wZW4iIGluCgknJykJY2F0IDw8J0VPTScg | |
| PiY0CgpEaXNhYmxpbmcgbmRibS4gIFRoaXMgd2lsbCBnZW5lcmF0ZSBhIFdob2EgVGhlcmUgbWVz | |
| c2FnZSBpbiBDb25maWd1cmUuClJlYWQgaGludHMvbGludXguc2ggZm9yIGZ1cnRoZXIgaW5mb3Jt | |
| YXRpb24uCkVPTQoJCSMgWW91IGNhbiBvdmVycmlkZSB0aGlzIHdpdGggQ29uZmlndXJlIC1EZF9k | |
| Ym1fb3BlbgoJCWRfZGJtX29wZW49dW5kZWYKCQk7OwoJZXNhYwpmaQoKcm0gLWYgdHJ5LmMgYS5v | |
| dXQKCmlmIC9iaW4vc2ggLWMgZXhpdDsgdGhlbgogIGVjaG8gJycKICBlY2hvICdZb3UgYXBwZWFy | |
| IHRvIGhhdmUgYSB3b3JraW5nIGJhc2guICBHb29kLicKZWxzZQogIGNhdCA8PCAnRU9NJyA+JjQK | |
| CioqKioqKioqKioqKioqKioqKioqKioqIFdhcm5pbmchICoqKioqKioqKioqKioqKioqKioqKgpJ | |
| dCB3b3VsZCBhcHBlYXIgeW91IGhhdmUgYSBkZWZlY3RpdmUgYmFzaCBzaGVsbCBpbnN0YWxsZWQu | |
| IFRoaXMgaXMgbGlrZWx5IHRvCmdpdmUgeW91IGEgZmFpbHVyZSBvZiBvcC9leGVjIHRlc3QgIzUg | |
| ZHVyaW5nIHRoZSB0ZXN0IHBoYXNlIG9mIHRoZSBidWlsZCwKVXBncmFkaW5nIHRvIGEgcmVjZW50 | |
| IHZlcnNpb24gKDEuMTQuNCBvciBsYXRlcikgc2hvdWxkIGZpeCB0aGUgcHJvYmxlbS4KKioqKioq | |
| KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqCkVPTQoKZmkK | |
| CiMgT24gU1BBUkNsaW51eCwKIyBUaGUgZm9sbG93aW5nIGNzaCBjb25zaXN0ZW50bHkgY29yZWR1 | |
| bXBlZCBpbiB0aGUgdGVzdCBkaXJlY3RvcnkKIyAiL2hvbWUvbWlrZWRsci9wZXJsNS4wMDNfOTQv | |
| dCIsIHRob3VnaCBub3QgbW9zdCBvdGhlciBkaXJlY3Rvcmllcy4KCiNOYW1lICAgICAgICA6IGNz | |
| aCAgICAgICAgICAgICAgICAgICAgRGlzdHJpYnV0aW9uOiBSZWQgSGF0IExpbnV4IChSZW1icmFu | |
| ZHQpCiNWZXJzaW9uICAgICA6IDUuMi42ICAgICAgICAgICAgICAgICAgICAgICAgVmVuZG9yOiBS | |
| ZWQgSGF0IFNvZnR3YXJlCiNSZWxlYXNlICAgICA6IDMgICAgICAgICAgICAgICAgICAgICAgICBC | |
| dWlsZCBEYXRlOiBGcmkgTWF5IDI0IDE5OjQyOjE0IDE5OTYKI0luc3RhbGwgZGF0ZTogVGh1IEp1 | |
| bCAxMSAxNjoyMDoxNCAxOTk2IEJ1aWxkIEhvc3Q6IGl0Y2h5LnJlZGhhdC5jb20KI0dyb3VwICAg | |
| ICAgIDogU2hlbGxzICAgICAgICAgICAgICAgICAgIFNvdXJjZSBSUE06IGNzaC01LjIuNi0zLnNy | |
| Yy5ycG0KI1NpemUgICAgICAgIDogMTg0NDE3CiNEZXNjcmlwdGlvbiA6IEJTRCBjLXNoZWxsCgoj | |
| IEZvciB0aGlzIHJlYXNvbiBJIHN1Z2dlc3QgdXNpbmcgdGhlIG11Y2ggYnVnLWZpeGVkIHRjc2gg | |
| Zm9yIGdsb2JiaW5nCiMgd2hlcmUgYXZhaWxhYmxlLgoKIyBOb3ZlbWJlciAyMDAxOiAgVGhhdCB3 | |
| YXJuaW5nJ3MgcHJldHR5IG9sZCBub3cgYW5kIHByb2JhYmx5IG5vdCBzbwojIHJlbGV2YW50LCBl | |
| c3BlY2lhbGx5IHNpbmNlIHBlcmwgbm93IHVzZXMgRmlsZTo6R2xvYiBmb3IgZ2xvYmJpbmcuCiMg | |
| V2UnbGwgc3RpbGwgbG9vayBmb3IgdGNzaCwgYnV0IHRvbmUgZG93biB0aGUgd2FybmluZ3MuCiMg | |
| QW5keSBEb3VnaGVydHksIE5vdi4gNiwgMjAwMQppZiAkY3NoIC1jICdlY2hvICR2ZXJzaW9uJyA+ | |
| L2Rldi9udWxsIDI+JjE7IHRoZW4KICAgIGVjaG8gJ1lvdXIgY3NoIGlzIHJlYWxseSB0Y3NoLiAg | |
| R29vZC4nCmVsc2UKICAgIGlmIHh4eD1gLi9VVS9sb2MgdGNzaCBibHVyZmwgJHB0aGA7ICR0ZXN0 | |
| IC1mICIkeHh4IjsgdGhlbgoJZWNobyAiRm91bmQgdGNzaC4gIEknbGwgdXNlIGl0IGZvciBnbG9i | |
| YmluZy4iCgkjIFdlIGNhbid0IGNoYW5nZSBDb25maWd1cmUncyBzZXR0aW5nIG9mICRjc2gsIGR1 | |
| ZSB0byB0aGUgd2F5CgkjIENvbmZpZ3VyZSBoYW5kbGVzICRkX3BvcnRhYmxlIGFuZCBjb21tYW5k | |
| cyBmb3VuZCBpbiAkbG9jbGlzdC4KCSMgV2UgY2FuIHNldCB0aGUgdmFsdWUgZm9yIENTSCBpbiBj | |
| b25maWcuaCBieSBzZXR0aW5nIGZ1bGxfY3NoLgoJZnVsbF9jc2g9JHh4eAogICAgZWxpZiBbIC1m | |
| ICIkY3NoIiBdOyB0aGVuCgllY2hvICJDb3VsZG4ndCBmaW5kIHRjc2guICBDc2gtYmFzZWQgZ2xv | |
| YmJpbmcgbWlnaHQgYmUgYnJva2VuLiIKICAgIGZpCmZpCgojIFNoaW1wZWkgWWFtYXNoaXRhIDxz | |
| aGltcGVpQHNvY3JhdGVzLnBhdG5ldC5jYWx0ZWNoLmVkdT4KIyBNZXNzYWdlLUlkOiA8MzNFRjE2 | |
| MzQuQjM2QjY1MDBAcG9ib3guY29tPgojCiMgVGhlIERSMiBvZiBNa0xpbnV4IChvc25hbWU9bGlu | |
| dXgsYXJjaG5hbWU9cHBjLWxpbnV4KSBtYXkgbmVlZAojIHNwZWNpYWwgZmxhZ3MgcGFzc2VkIGlu | |
| IG9yZGVyIGZvciBkeW5hbWljIGxvYWRpbmcgdG8gd29yay4KIyBpbnN0ZWFkIG9mIHRoZSByZWNv | |
| bW1lbmRlZDoKIwojIGNjZGxmbGFncz0nLXJkeW5hbWljJwojCiMgaXQgc2hvdWxkIGJlOgojIGNj | |
| ZGxmbGFncz0nLVdsLC1FJwojCiMgU28gaWYgeW91ciBEUjIgKERSMyBjYW1lIG91dCBzdW1tZXIg | |
| MTk5OCwgY29uc2lkZXIgdXBncmFkaW5nKQojIGhhcyBwcm9ibGVtcyB3aXRoIGR5bmFtaWMgbG9h | |
| ZGluZywgdW5jb21tZW50IHRoZQojIGZvbGxvd2luZyB0aHJlZSBsaW5lcywgbWFrZSBkaXN0Y2xl | |
| YW4sIGFuZCByZS1Db25maWd1cmU6CiNjYXNlICJgdW5hbWUgLXIgfCBzZWQgJ3MvXlswLTkuLV0q | |
| Ly8nYGBhcmNoYCIgaW4KIydvc2ZtYWNoM3BwYycpIGNjZGxmbGFncz0nLVdsLC1FJyA7OwojZXNh | |
| YwoKY2FzZSAiYHVuYW1lIC1tYCIgaW4Kc3BhcmMqKQoJY2FzZSAiJGNjY2RsZmxhZ3MiIGluCgkq | |
| LWZwaWMqKSBjY2NkbGZsYWdzPSJgZWNobyAkY2NjZGxmbGFnc3xzZWQgJ3MvLWZwaWMvLWZQSUMv | |
| J2AiIDs7CgkqLWZQSUMqKSA7OwoJKikJIGNjY2RsZmxhZ3M9IiRjY2NkbGZsYWdzIC1mUElDIiA7 | |
| OwoJZXNhYwoJOzsKZXNhYwoKIyBTdVNFOC4yIGhhcyAvdXNyL2xpYi9saWJuZGJtKiB3aGljaCBh | |
| cmUgbGQgc2NyaXB0cyByYXRoZXIgdGhhbgojIHRydWUgbGlicmFyaWVzLiBUaGUgc2NyaXB0cyBj | |
| YXVzZSBiaW5kaW5nIGFnYWluc3Qgc3RhdGljCiMgdmVyc2lvbiBvZiAtbGdkYm0gd2hpY2ggaXMg | |
| YSBiYWQgaWRlYS4gU28gaWYgd2UgaGF2ZSAnbm0nCiMgbWFrZSBzdXJlIGl0IGNhbiByZWFkIHRo | |
| ZSBmaWxlCiMgTkktUyAyMDAzLzA4LzA3CmlmIFsgLXIgL3Vzci9saWIvbGlibmRibS5zbyAgLWEg | |
| IC14IC91c3IvYmluL25tIF0gOyB0aGVuCiAgIGlmIC91c3IvYmluL25tIC91c3IvbGliL2xpYm5k | |
| Ym0uc28gPi9kZXYvbnVsbCAyPiYxIDsgdGhlbgogICAgZWNobyAnWW91ciBzaGFyZWQgLWxuZGJt | |
| IHNlZW1zIHRvIGJlIGEgcmVhbCBsaWJyYXJ5LicKICAgZWxzZQogICAgZWNobyAnWW91ciBzaGFy | |
| ZWQgLWxuZGJtIGlzIG5vdCBhIHJlYWwgbGlicmFyeS4nCiAgICBzZXQgYGVjaG8gWCAiJGxpYnN3 | |
| YW50ZWQgInwgc2VkIC1lICdzLyBuZGJtIC8gLydgCiAgICBzaGlmdAogICAgbGlic3dhbnRlZD0i | |
| JCoiCiAgIGZpCmZpCgoKIyBUaGlzIHNjcmlwdCBVVS91c2V0aHJlYWRzLmNidSB3aWxsIGdldCAn | |
| Y2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVyIGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNl | |
| ciBmb3Igd2hldGhlciB0byB1c2UgdGhyZWFkcy4KY2F0ID4gVVUvdXNldGhyZWFkcy5jYnUgPDwn | |
| RU9DQlUnCmlmIGdldGNvbmYgR05VX0xJQlBUSFJFQURfVkVSU0lPTiB8IGdyZXAgTlBUTCA+L2Rl | |
| di9udWxsIDI+L2Rldi9udWxsCnRoZW4KICAgIHRocmVhZHNoYXZlcGlkcz0iIgplbHNlCiAgICB0 | |
| aHJlYWRzaGF2ZXBpZHM9Ii1EVEhSRUFEU19IQVZFX1BJRFMiCmZpCmNhc2UgIiR1c2V0aHJlYWRz | |
| IiBpbgokZGVmaW5lfHRydWV8W3lZXSopCiAgICAgICAgY2NmbGFncz0iLURfUkVFTlRSQU5UIC1E | |
| X0dOVV9TT1VSQ0UgJHRocmVhZHNoYXZlcGlkcyAkY2NmbGFncyIKICAgICAgICBpZiBlY2hvICRs | |
| aWJzd2FudGVkIHwgZ3JlcCAtdiBwdGhyZWFkID4vZGV2L251bGwKICAgICAgICB0aGVuCiAgICAg | |
| ICAgICAgIHNldCBgZWNobyBYICIkbGlic3dhbnRlZCAifCBzZWQgLWUgJ3MvIGMgLyBwdGhyZWFk | |
| IGMgLydgCiAgICAgICAgICAgIHNoaWZ0CiAgICAgICAgICAgIGxpYnN3YW50ZWQ9IiQqIgogICAg | |
| ICAgIGZpCgoJIyBTb21laG93IGF0IGxlYXN0IGluIERlYmlhbiAyLjIgdGhlc2UgbWFuYWdlIHRv | |
| IGVzY2FwZQoJIyB0aGUgI2RlZmluZSBmb3Jlc3Qgb2YgPGZlYXR1cmVzLmg+IGFuZCA8dGltZS5o | |
| PiBzbyB0aGF0CgkjIHRoZSBoYXNwcm90byBtYWNybyBvZiBDb25maWd1cmUgZG9lc24ndCBzZWUg | |
| dGhlc2UgcHJvdG9zLAoJIyBldmVuIHdpdGggdGhlIC1EX0dOVV9TT1VSQ0UuCgoJZF9hc2N0aW1l | |
| X3JfcHJvdG89IiRkZWZpbmUiCglkX2NyeXB0X3JfcHJvdG89IiRkZWZpbmUiCglkX2N0aW1lX3Jf | |
| cHJvdG89IiRkZWZpbmUiCglkX2dtdGltZV9yX3Byb3RvPSIkZGVmaW5lIgoJZF9sb2NhbHRpbWVf | |
| cl9wcm90bz0iJGRlZmluZSIKCWRfcmFuZG9tX3JfcHJvdG89IiRkZWZpbmUiCgoJOzsKZXNhYwpF | |
| T0NCVQoKY2F0ID4gVVUvdXNlbGFyZ2VmaWxlcy5jYnUgPDwnRU9DQlUnCiMgVGhpcyBzY3JpcHQg | |
| VVUvdXNlbGFyZ2VmaWxlcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUK | |
| IyBhZnRlciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIGxhcmdl | |
| IGZpbGVzLgpjYXNlICIkdXNlbGFyZ2VmaWxlcyIgaW4KJyd8JGRlZmluZXx0cnVlfFt5WV0qKQoj | |
| IEtlZXAgdGhpcyBpbiB0aGUgbGVmdCBtYXJnaW4uCmNjZmxhZ3NfdXNlbGFyZ2VmaWxlcz0iLURf | |
| TEFSR0VGSUxFX1NPVVJDRSAtRF9GSUxFX09GRlNFVF9CSVRTPTY0IgoKCWNjZmxhZ3M9IiRjY2Zs | |
| YWdzICRjY2ZsYWdzX3VzZWxhcmdlZmlsZXMiCgk7Owplc2FjCkVPQ0JVCgojIFB1cmlmeSBmYWls | |
| cyB0byBsaW5rIFBlcmwgaWYgYSAiLWxjIiBpcyBwYXNzZWQgaW50byBpdHMgbGlua2VyCiMgZHVl | |
| IHRvIGR1cGxpY2F0ZSBzeW1ib2xzLgpjYXNlICIkUFVSSUZZIiBpbgokZGVmaW5lfHRydWV8W3lZ | |
| XSopCiAgICBzZXQgYGVjaG8gWCAiJGxpYnN3YW50ZWQgInwgc2VkIC1lICdzLyBjIC8gLydgCiAg | |
| ICBzaGlmdAogICAgbGlic3dhbnRlZD0iJCoiCiAgICA7Owplc2FjCgojIElmIHdlIGFyZSB1c2lu | |
| ZyBnKysgd2UgbXVzdCB1c2Ugbm0gYW5kIGZvcmNlIG91cnNlbHZlcyB0byB1c2UKIyB0aGUgL3Vz | |
| ci9saWIvbGliYy5hIChyZXNldHRpbmcgdGhlIGxpYmMgYmVsb3cgdG8gYW4gZW1wdHkgc3RyaW5n | |
| CiMgbWFrZXMgQ29uZmlndXJlIHRvIGxvb2sgZm9yIHRoZSByaWdodCBvbmUpIGJlY2F1c2UgdGhl | |
| IHN5bWJvbAojIHNjYW5uaW5nIHRyaWNrcyBvZiBDb25maWd1cmUgd2lsbCBjcmFzaCBhbmQgYnVy | |
| biBob3JyaWJseS4KY2FzZSAiJGNjIiBpbgoqZysrKikgdXNlbm09dHJ1ZQogICAgICAgbGliYz0n | |
| JwogICAgICAgOzsKZXNhYwoKIyBJZiB1c2luZyBnKyssIHRoZSBDb25maWd1cmUgc2NhbiBmb3Ig | |
| ZGxvcGVuKCkgYW5kIChlc3BlY2lhbGx5KQojIGRsZXJyb3IoKSBtaWdodCBmYWlsLCBlYXNpZXIg | |
| anVzdCB0byBmb3JjaWJseSBoaW50IHRoZW0gaW4uCmNhc2UgIiRjYyIgaW4KKmcrKyopCiAgZF9k | |
| bG9wZW49J2RlZmluZScKICBkX2RsZXJyb3I9J2RlZmluZScKICA7Owplc2FjCgojIFVuZGVyIHNv | |
| bWUgY2lyY3Vtc3RhbmNlcyBsaWJkYiBjYW4gZ2V0IGJ1aWx0IGluIHN1Y2ggYSB3YXkgYXMgdG8K | |
| IyBuZWVkIHB0aHJlYWQgZXhwbGljaXRseSBsaW5rZWQuCgpsaWJkYl9uZWVkc19wdGhyZWFkPSJO | |
| IgoKaWYgZWNobyAiICRsaWJzd2FudGVkICIgfCBncmVwIC12ICIgcHRocmVhZCAiID4vZGV2L251 | |
| bGwKdGhlbgogICBpZiBlY2hvICIgJGxpYnN3YW50ZWQgIiB8IGdyZXAgIiBkYiAiID4vZGV2L251 | |
| bGwKICAgdGhlbgogICAgIGZvciBEQkRJUiBpbiAkZ2xpYnB0aAogICAgIGRvCiAgICAgICBEQkxJ | |
| Qj0iJERCRElSL2xpYmRiLnNvIgogICAgICAgaWYgWyAtZiAkREJMSUIgXQogICAgICAgdGhlbgog | |
| ICAgICAgICBpZiBubSAtdSAkREJMSUIgfCBncmVwIHB0aHJlYWQgPi9kZXYvbnVsbAogICAgICAg | |
| ICB0aGVuCiAgICAgICAgICAgaWYgbGRkICREQkxJQiB8IGdyZXAgcHRocmVhZCA+L2Rldi9udWxs | |
| CiAgICAgICAgICAgdGhlbgogICAgICAgICAgICAgbGliZGJfbmVlZHNfcHRocmVhZD0iTiIKICAg | |
| ICAgICAgICBlbHNlCiAgICAgICAgICAgICBsaWJkYl9uZWVkc19wdGhyZWFkPSJZIgogICAgICAg | |
| ICAgIGZpCiAgICAgICAgIGZpCiAgICAgICBmaQogICAgIGRvbmUKICAgZmkKZmkKCmNhc2UgIiRs | |
| aWJkYl9uZWVkc19wdGhyZWFkIiBpbgogICJZIikKICAgIGxpYnN3YW50ZWQ9IiRsaWJzd2FudGVk | |
| IHB0aHJlYWQiCiAgICA7Owplc2FjCg==', | |
| 'dragonfly' => | |
| 'IyBoaW50cy9kcmFnb25mbHkuc2gKIwojIFRoaXMgZmlsZSBpcyBtb3N0bHkgY29waWVkIGZyb20g | |
| aGludHMvZnJlZWJzZC5zaCB3aXRoIHRoZSBPUyB2ZXJzaW9uCiMgaW5mb3JtYXRpb24gdGFrZW4g | |
| b3V0IGFuZCBvbmx5IHRoZSBGcmVlQlNELTQgaW5mb3JtYXRpb24gaW50YWN0LgojIFBsZWFzZSBj | |
| aGVjayB3aXRoIFRvZGQgV2lsbGV5IDx4dG9kZHhAZ21haWwuY29tPiBiZWZvcmUgbWFraW5nCiMg | |
| bW9kaWZpY2F0aW9ucyB0byB0aGlzIGZpbGUuIFNlZSBodHRwOi8vd3d3LmRyYWdvbmZseWJzZC5v | |
| cmcvCgpjYXNlICIkb3N2ZXJzIiBpbgoqKSAgdXNldmZvcms9J3RydWUnCiAgICBjYXNlICIkdXNl | |
| bXltYWxsb2MiIGluCgkiIikgdXNlbXltYWxsb2M9J24nCgkgICAgOzsKICAgIGVzYWMKICAgIGxp | |
| YnN3YW50ZWQ9YGVjaG8gJGxpYnN3YW50ZWQgfCBzZWQgJ3MvIG1hbGxvYyAvIC8nYAogICAgOzsK | |
| ZXNhYwoKIyBEeW5hbWljIExvYWRpbmcgZmxhZ3MgaGF2ZSBub3QgY2hhbmdlZCBtdWNoLCBzbyB0 | |
| aGV5IGFyZSBzZXBhcmF0ZWQKIyBvdXQgaGVyZSB0byBhdm9pZCBkdXBsaWNhdGluZyB0aGVtIGV2 | |
| ZXJ5d2hlcmUuCmNhc2UgIiRvc3ZlcnMiIGluCiopICBvYmpmb3JtYXQ9YC91c3IvYmluL29iamZv | |
| cm1hdGAKICAgIGxpYnB0aD0iL3Vzci9saWIgL3Vzci9sb2NhbC9saWIiCiAgICBnbGlicHRoPSIv | |
| dXNyL2xpYiAvdXNyL2xvY2FsL2xpYiIKICAgIGxkZmxhZ3M9Ii1XbCwtRSAiCiAgICBsZGRsZmxh | |
| Z3M9Ii1zaGFyZWQgIgogICAgY2NjZGxmbGFncz0nLURQSUMgLWZQSUMnCiAgICA7Owplc2FjCgpj | |
| YXNlICIkb3N2ZXJzIiBpbgoqKSAgY2NmbGFncz0iJHtjY2ZsYWdzfSAtREhBU19GUFNFVE1BU0sg | |
| LURIQVNfRkxPQVRJTkdQT0lOVF9IIgogICAgaWYgL3Vzci9iaW4vZmlsZSAtTCAvdXNyL2xpYi9s | |
| aWJjLnNvIHwgL3Vzci9iaW4vZ3JlcCAtdnEgIm5vdCBzdHJpcHBlZCIgOyB0aGVuCgl1c2VubT1m | |
| YWxzZQogICAgZmkKICAgIDs7CmVzYWMKCmNhdCA8PCdFT00nID4mNAoKU29tZSB1c2VycyBoYXZl | |
| IHJlcG9ydGVkIHRoYXQgQ29uZmlndXJlIGhhbHRzIHdoZW4gdGVzdGluZyBmb3IKdGhlIE9fTk9O | |
| QkxPQ0sgc3ltYm9sIHdpdGggYSBzeW50YXggZXJyb3IuICBUaGlzIGlzIGFwcGFyZW50bHkgYQpz | |
| aCBlcnJvci4gIFJlcnVubmluZyBDb25maWd1cmUgd2l0aCBrc2ggYXBwYXJlbnRseSBmaXhlcyB0 | |
| aGUKcHJvYmxlbS4gIFRyeQogICAgICAga3NoIENvbmZpZ3VyZSBbeW91ciBvcHRpb25zXQoKRU9N | |
| CgojIEZyb206IEFudG9uIEJlcmV6aW4gPHRvYmV6QHBsYWIua3UuZGs+CiMgVG86IHBlcmw1LXBv | |
| cnRlcnNAcGVybC5vcmcKIyBTdWJqZWN0OiBbUEFUQ0ggNS4wMDVfNTRdIENvbmZpZ3VyZSAtIGhp | |
| bnRzL2ZyZWVic2Quc2ggc2lnbmFsIGhhbmRsZXIgdHlwZQojIERhdGU6IDMwIE5vdiAxOTk4IDE5 | |
| OjQ2OjI0ICswMTAwCiMgTWVzc2FnZS1JRDogPDg2NHNyaGh2Y3YuZnNmQGxpb24ucGxhYi5rdS5k | |
| az4KCnNpZ25hbF90PSd2b2lkJwpkX3ZvaWRzaWc9J2RlZmluZScKCiMgVGhpcyBzY3JpcHQgVVUv | |
| dXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUKIyBhZnRl | |
| ciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNh | |
| dCA+IFVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRl | |
| ZmluZXx0cnVlfFt5WV0qKQogICAgY2FzZSAiJG9zdmVycyIgaW4KICAgICopICBsZGZsYWdzPSIt | |
| cHRocmVhZCAkbGRmbGFncyIKCgkjIEJvdGggaW4gNC54IGFuZCA1LnggZ2V0aG9zdGJ5YWRkcl9y | |
| IGV4aXN0cyBidXQKCSMgaXQgaXMgIlRlbXBvcmFyeSBmdW5jdGlvbiwgbm90IHRocmVhZHNhZmUi | |
| Li4uCgkjIFByZXN1bWFibHkgZWFybGllciBpdCBkaWRuJ3QgZXZlbiBleGlzdC4KCWRfZ2V0aG9z | |
| dGJ5YWRkcl9yPSJ1bmRlZiIKCWRfZ2V0aG9zdGJ5YWRkcl9yX3Byb3RvPSIwIgoKCTs7CiAgICBl | |
| c2FjCmVzYWMKRU9DQlUKCiMgbWFsbG9jIHdyYXAgd29ya3MKY2FzZSAiJHVzZW1hbGxvY3dyYXAi | |
| IGluCicnKSB1c2VtYWxsb2N3cmFwPSdkZWZpbmUnIDs7CmVzYWMK', | |
| 'darwin' => | |
| 'IyMKIyBEYXJ3aW4gKE1hYyBPUykgaGludHMKIyBXaWxmcmVkbyBTYW5jaGV6IDx3c2FuY2hlekB3 | |
| c2FuY2hlei5uZXQ+CiMjCgojIwojIFBhdGhzCiMjCgojIENvbmZpZ3VyZSBoYXNuJ3QgZmlndXJl | |
| ZCBvdXQgdGhlIHZlcnNpb24gbnVtYmVyIHlldC4gIEJ1bW1lci4KcGVybF9yZXZpc2lvbj1gYXdr | |
| ICcvZGVmaW5lWyAJXStQRVJMX1JFVklTSU9OLyB7cHJpbnQgJDN9JyAkc3JjL3BhdGNobGV2ZWwu | |
| aGAKcGVybF92ZXJzaW9uPWBhd2sgJy9kZWZpbmVbIAldK1BFUkxfVkVSU0lPTi8ge3ByaW50ICQz | |
| fScgJHNyYy9wYXRjaGxldmVsLmhgCnBlcmxfc3VidmVyc2lvbj1gYXdrICcvZGVmaW5lWyAJXStQ | |
| RVJMX1NVQlZFUlNJT04vIHtwcmludCAkM30nICRzcmMvcGF0Y2hsZXZlbC5oYAp2ZXJzaW9uPSIk | |
| e3BlcmxfcmV2aXNpb259LiR7cGVybF92ZXJzaW9ufS4ke3Blcmxfc3VidmVyc2lvbn0iCgojIFBy | |
| ZXRlbmQgdGhhdCBEYXJ3aW4gZG9lc24ndCBrbm93IGFib3V0IHRob3NlIHN5c3RlbSBjYWxscyBp | |
| biBUaWdlcgojICgxMC40L2RhcndpbiA4KSBhbmQgZWFybGllciBbcGVybCAjMjQxMjJdCmNhc2Ug | |
| IiRvc3ZlcnMiIGluClsxLThdLiopCiAgICBkX3NldHJlZ2lkPSd1bmRlZicKICAgIGRfc2V0cmV1 | |
| aWQ9J3VuZGVmJwogICAgZF9zZXRyZ2lkPSd1bmRlZicKICAgIGRfc2V0cnVpZD0ndW5kZWYnCiAg | |
| ICA7Owplc2FjCgojIFRoaXMgd2FzIHByZXZpb3VzbHkgdXNlZCBpbiBhbGwgYnV0IGNhdXNlcyB0 | |
| aHJlZSBjYXNlcwojIChubyAtRGRwcmVmaXg9LCAtRHByZWZpeD0vdXNyLCAtRHByZWZpeD0vc29t | |
| ZS90aGluZy9lbHNlKQojIGJ1dCB0aGF0IGNhdXNlZCB0b28gbXVjaCBncmllZi4KIyB2ZW5kb3Js | |
| aWI9Ii9TeXN0ZW0vTGlicmFyeS9QZXJsLyR7dmVyc2lvbn0iOyAjIEFwcGxlLXN1cHBsaWVkIG1v | |
| ZHVsZXMKCiMgQlNEIHBhdGhzCmNhc2UgIiRwcmVmaXgiIGluCicnKQkjIERlZmF1bHQgaW5zdGFs | |
| bDsgdXNlIG5vbi1zeXN0ZW0gZGlyZWN0b3JpZXMKCXByZWZpeD0nL3Vzci9sb2NhbCc7CglzaXRl | |
| cHJlZml4PScvdXNyL2xvY2FsJzsKCTs7CicvdXNyJykJIyBXZSBhcmUgYnVpbGRpbmcvcmVwbGFj | |
| aW5nIHRoZSBidWlsdC1pbiBwZXJsCglwcmVmaXg9Jy8nOwoJaW5zdGFsbHByZWZpeD0nLyc7Cgli | |
| aW49Jy91c3IvYmluJzsKCXNpdGVwcmVmaXg9Jy91c3IvbG9jYWwnOwoJIyBXZSBkb24ndCB3YW50 | |
| IC91c3IvYmluL0hFQUQgaXNzdWVzLgoJc2l0ZWJpbj0nL3Vzci9sb2NhbC9iaW4nOwoJc2l0ZXNj | |
| cmlwdD0nL3Vzci9sb2NhbC9iaW4nOwoJaW5zdGFsbHVzcmJpbnBlcmw9J2RlZmluZSc7ICMgWW91 | |
| IGtuZXcgd2hhdCB5b3Ugd2VyZSBkb2luZy4KCXByaXZsaWI9Ii9TeXN0ZW0vTGlicmFyeS9QZXJs | |
| LyR7dmVyc2lvbn0iOwoJc2l0ZWxpYj0iL0xpYnJhcnkvUGVybC8ke3ZlcnNpb259IjsKCXZlbmRv | |
| cnByZWZpeD0nLyc7Cgl1c2V2ZW5kb3JwcmVmaXg9J2RlZmluZSc7Cgl2ZW5kb3JiaW49Jy91c3Iv | |
| YmluJzsKCXZlbmRvcnNjcmlwdD0nL3Vzci9iaW4nOwoJdmVuZG9ybGliPSIvTmV0d29yay9MaWJy | |
| YXJ5L1BlcmwvJHt2ZXJzaW9ufSI7CgkjIDRCU0QgdXNlcyAke3ByZWZpeH0vc2hhcmUvbWFuLCBu | |
| b3QgJHtwcmVmaXh9L21hbi4KCW1hbjFkaXI9Jy91c3Ivc2hhcmUvbWFuL21hbjEnOwoJbWFuM2Rp | |
| cj0nL3Vzci9zaGFyZS9tYW4vbWFuMyc7CgkjIEJ1dCB1c2VycycgaW5zdGFsbHMgc2hvdWxkbid0 | |
| IHRvdWNoIHRoZSBzeXN0ZW0gbWFuIHBhZ2VzLgoJIyBUcmFuc2llbnQgb2Jzb2xldGVkIHN0eWxl | |
| LgoJc2l0ZW1hbjE9Jy91c3IvbG9jYWwvc2hhcmUvbWFuL21hbjEnOwoJc2l0ZW1hbjM9Jy91c3Iv | |
| bG9jYWwvc2hhcmUvbWFuL21hbjMnOwoJIyBOZXcgc3R5bGUuCglzaXRlbWFuMWRpcj0nL3Vzci9s | |
| b2NhbC9zaGFyZS9tYW4vbWFuMSc7CglzaXRlbWFuM2Rpcj0nL3Vzci9sb2NhbC9zaGFyZS9tYW4v | |
| bWFuMyc7Cgk7OwogICopCSMgQW55dGhpbmcgZWxzZTsgdXNlIG5vbi1zeXN0ZW0gZGlyZWN0b3Jp | |
| ZXMsIHVzZSBDb25maWd1cmUgZGVmYXVsdHMKCTs7CmVzYWMKCiMjCiMgVG9vbCBjaGFpbiBzZXR0 | |
| aW5ncwojIwoKIyBTaW5jZSB3ZSBjYW4gYnVpbGQgZmF0LCB0aGUgYXJjaG5hbWUgZG9lc24ndCBu | |
| ZWVkIHRoZSBwcm9jZXNzb3IgdHlwZQphcmNobmFtZT0nZGFyd2luJzsKCiMgbm0gaXNuJ3Qga25v | |
| d24gdG8gd29yayBhZnRlciBTbm93IExlb3BhcmQgYW5kIFhDb2RlIDQ7IHRlc3Rpbmcgd2l0aCBP | |
| UyBYIDEwLjUKIyBhbmQgWGNvZGUgMyBzaG93cyBhIHdvcmtpbmcgbm0sIGJ1dCBwcmV0ZW5kaW5n | |
| IGl0IGRvZXNuJ3Qgd29yayBwcm9kdWNlcyBubwojIHByb2JsZW1zLgp1c2VubT0nZmFsc2UnOwoK | |
| Y2FzZSAiJG9wdGltaXplIiBpbgonJykKIyAgICBPcHRpbWl6aW5nIGZvciBzaXplIGFsc28gbWVh | |
| biBsZXNzIHJlc2lkZW50IG1lbW9yeSB1c2FnZSBvbiB0aGUgcGFydAojIG9mIFBlcmwuICBBcHBs | |
| ZSBhc3NlcnRzIHRoYXQgdGhpcyBpcyBhIG1vcmUgaW1wb3J0YW50IG9wdGltaXphdGlvbiB0aGFu | |
| CiMgc2F2aW5nIG9uIENQVSBjeWNsZXMuICBHaXZlbiB0aGF0IG1lbW9yeSBzcGVlZCBoYXMgbm90 | |
| IGluY3JlYXNlZCBhdAojIHBhY2Ugd2l0aCBDUFUgc3BlZWQgb3ZlciB0aW1lIChvbiBhbnkgcGxh | |
| dGZvcm0pLCB0aGlzIGlzIHByb2JhYmx5IGEKIyByZWFzb25hYmxlIGFzc2VydGlvbi4KaWYgWyAt | |
| eiAiJHtvcHRpbWl6ZX0iIF07IHRoZW4KICBjYXNlICJgJHtjYzotZ2NjfSAtdiAyPiYxYCIgaW4K | |
| ICAgICoiZ2NjIHZlcnNpb24gMy4iKikgb3B0aW1pemU9Jy1PcycgOzsKICAgICopIG9wdGltaXpl | |
| PSctTzMnIDs7CiAgZXNhYwplbHNlCiAgb3B0aW1pemU9Jy1PMycKZmkKOzsKZXNhYwoKIyAtZm5v | |
| LWNvbW1vbiBiZWNhdXNlIGNvbW1vbiBzeW1ib2xzIGFyZSBub3QgYWxsb3dlZCBpbiBNSF9EWUxJ | |
| QgojIC1EUEVSTF9EQVJXSU46IGFwcGFyZW50bHkgdGhlIF9fQVBQTEVfXyBpcyBub3Qgc2FuY3Rp | |
| b25lZCBieSBBcHBsZQojIGFzIHRoZSB3YXkgdG8gZGlmZmVyZW50aWF0ZSBNYWMgT1MgWC4gIChU | |
| aGUgb2ZmaWNpYWwgbGluZSBpcyB0aGF0CiMgKm5vKiBjcHAgc3ltYm9sIGRvZXMgZGlmZmVyZW50 | |
| aWF0ZSBNYWMgT1MgWC4pCmNjZmxhZ3M9IiR7Y2NmbGFnc30gLWZuby1jb21tb24gLURQRVJMX0RB | |
| UldJTiIKCiMgQXQgbGVhc3Qgb24gRGFyd2luIDEuMy54OgojCiMgIyBkZWZpbmUgSU5UMzJfTUlO | |
| IC0yMTQ3NDgzNjQ4CiMgaW50IG1haW4gKCkgewojICBkb3VibGUgYSA9IElOVDMyX01JTjsKIyAg | |
| cHJpbnRmICgiSU5UMzJfTUlOPSVnXG4iLCBhKTsKIyAgcmV0dXJuIDA7CiMgfQojIHdpbGwgb3V0 | |
| cHV0OgojIElOVDMyX01JTj0yLjE0NzQ4ZSswOQojIE5vdGUgdGhhdCB0aGUgSU5UMzJfTUlOIGhh | |
| cyBiZWNvbWUgcG9zaXRpdmUuCiMgSU5UMzJfTUlOIGlzIHNldCBpbiAvdXNyL2luY2x1ZGUvc3Rk | |
| aW50LmggYnk6CiMgI2RlZmluZSBJTlQzMl9NSU4gICAgICAgIC0yMTQ3NDgzNjQ4CiMgd2hpY2gg | |
| c2VlbXMgdG8gYnJlYWsgdGhlIGdjYy4gIERlZmluaW5nIElOVDMyX01JTiBhcyAoLTIxNDc0ODM2 | |
| NDctMSkKIyBzZWVtcyB0byB3b3JrLiAgSU5UNjRfTUlOIHNlZW1zIHRvIGJlIHNpbWlsYXJseSBi | |
| cm9rZW4uCiMgLS0gTmljaG9sYXMgQ2xhcmssIEtlbiBXaWxsaWFtcywgYW5kIEVkd2FyZCBNb3kK | |
| IwojIFRoaXMgc2VlbXMgdG8gaGF2ZSBiZWVuIGZpeGVkIHNpbmNlIGF0IGxlYXN0IE1hYyBPUyBY | |
| IDEwLjEuMywKIyBzdGRpbnQuaCBkZWZpbmluZyBJTlQzMl9NSU4gYXMgKC1JTlQzMl9NQVgtMSkK | |
| IyAtLSBFZHdhcmQgTW95CiMKY2FzZSAiJChncmVwICdeI2RlZmluZSBJTlQzMl9NSU4nIC91c3Iv | |
| aW5jbHVkZS9zdGRpbnQuaCkiIGluCiAgKi0yMTQ3NDgzNjQ4KSBjY2ZsYWdzPSIke2NjZmxhZ3N9 | |
| IC1ESU5UMzJfTUlOX0JST0tFTiAtRElOVDY0X01JTl9CUk9LRU4iIDs7CmVzYWMKCiMgQXZvaWQg | |
| QXBwbGUncyBjcHAgcHJlY29tcGlsZXIsIGJldHRlciBmb3IgZXh0ZW5zaW9ucwppZiBbICJYYGVj | |
| aG8gfCAke2NjfSAtbm8tY3BwLXByZWNvbXAgLUUgLSAyPiYxID4vZGV2L251bGxgIiA9ICJYIiBd | |
| OyB0aGVuCiAgICBjcHBmbGFncz0iJHtjcHBmbGFnc30gLW5vLWNwcC1wcmVjb21wIgoKICAgICMg | |
| VGhpcyBpcyBuZWNlc3NhcnkgYmVjYXVzZSBwZXJsJ3MgYnVpbGQgc3lzdGVtIGRvZXNuJ3QKICAg | |
| ICMgYXBwbHkgY3BwZmxhZ3MgdG8gY2MgY29tcGlsZSBsaW5lcyBhcyBpdCBzaG91bGQuCiAgICBj | |
| Y2ZsYWdzPSIke2NjZmxhZ3N9ICR7Y3BwZmxhZ3N9IgpmaQoKIyBLbm93biBvcHRpbWl6ZXIgcHJv | |
| YmxlbXMuCmNhc2UgImBjYyAtdiAyPiYxYCIgaW4KICAqIjMuMSAyMDAyMDEwNSIqKSB0b2tlX2Nm | |
| bGFncz0nb3B0aW1pemU9IiInIDs7CmVzYWMKCiMgU2hhcmVkIGxpYnJhcnkgZXh0ZW5zaW9uIGlz | |
| IC5keWxpYi4KIyBCdW5kbGUgZXh0ZW5zaW9uIGlzIC5idW5kbGUuCmxkPSdjYyc7CnNvPSdkeWxp | |
| Yic7CmRsZXh0PSdidW5kbGUnOwp1c2VkbD0nZGVmaW5lJzsKCiMgMTAuNCBjYW4gdXNlIGRsb3Bl | |
| bi4KIyAxMC40IGJyb2tlIHBvbGwoKS4KY2FzZSAiJG9zdmVycyIgaW4KWzEtN10uKikKICAgIGRs | |
| c3JjPSdkbF9keWxkLnhzJzsKICAgIDs7CiopCiAgICBkbHNyYz0nZGxfZGxvcGVuLnhzJzsKICAg | |
| IGRfcG9sbD0ndW5kZWYnOwogICAgaV9wb2xsPSd1bmRlZic7CiAgICA7Owplc2FjCgpjYXNlICIk | |
| Y2NkbGZsYWdzIiBpbgkJIyBJZiBwYXNzZWQgaW4gZnJvbSBjb21tYW5kIGxpbmUsIHByZXN1bWUg | |
| dXNlciBrbm93cyBiZXN0CicnKQogICBjY2NkbGZsYWdzPScgJzsgIyBzcGFjZSwgbm90IGVtcHR5 | |
| LCBiZWNhdXNlIG90aGVyd2lzZSB3ZSBnZXQgLWZwaWMKOzsKZXNhYwoKIyBQZXJsIGJ1bmRsZXMg | |
| ZG8gbm90IGV4cGVjdCB0d28tbGV2ZWwgbmFtZXNwYWNlLCBhZGRlZCBpbiBEYXJ3aW4gMS40Lgoj | |
| IEJ1dCBzdGFydGluZyBmcm9tIHBlcmwgNS44LjEvRGFyd2luIDcgdGhlIGRlZmF1bHQgaXMgdGhl | |
| IHR3by1sZXZlbC4KY2FzZSAiJG9zdmVycyIgaW4KMS5bMC0zXS4qKQogICBsZGRsZmxhZ3M9IiR7 | |
| bGRmbGFnc30gLWJ1bmRsZSAtdW5kZWZpbmVkIHN1cHByZXNzIgogICA7OwoxLiopCiAgIGxkZmxh | |
| Z3M9IiR7bGRmbGFnc30gLWZsYXRfbmFtZXNwYWNlIgogICBsZGRsZmxhZ3M9IiR7bGRmbGFnc30g | |
| LWJ1bmRsZSAtdW5kZWZpbmVkIHN1cHByZXNzIgogICA7OwpbMi02XS4qKQogICBsZGZsYWdzPSIk | |
| e2xkZmxhZ3N9IC1mbGF0X25hbWVzcGFjZSIKICAgbGRkbGZsYWdzPSIke2xkZmxhZ3N9IC1idW5k | |
| bGUgLXVuZGVmaW5lZCBzdXBwcmVzcyIKICAgOzsKKikgCiAgIGxkZGxmbGFncz0iJHtsZGZsYWdz | |
| fSAtYnVuZGxlIC11bmRlZmluZWQgZHluYW1pY19sb29rdXAiCiAgIGNhc2UgIiRsZCIgaW4KICAg | |
| ICAgICpNQUNPU1hfREVWRUxPUE1FTlRfVEFSR0VUKikgOzsKICAgICAgICopIGxkPSJlbnYgTUFD | |
| T1NYX0RFUExPWU1FTlRfVEFSR0VUPTEwLjMgJHtsZH0iIDs7CiAgIGVzYWMKICAgOzsKZXNhYwps | |
| ZGxpYnB0aG5hbWU9J0RZTERfTElCUkFSWV9QQVRIJzsKCiMgdXNlc2hycGxpYj10cnVlIHJlc3Vs | |
| dHMgaW4gbXVjaCBzbG93ZXIgc3RhcnR1cCB0aW1lcy4KIyAnZmFsc2UnIGlzIHRoZSBkZWZhdWx0 | |
| IHZhbHVlLiAgVXNlIENvbmZpZ3VyZSAtRHVzZXNocnBsaWIgdG8gb3ZlcnJpZGUuCgpjYXQgPiBV | |
| VS9hcmNobmFtZS5jYnUgPDwnRU9DQlUnCiMgVGhpcyBzY3JpcHQgVVUvYXJjaG5hbWUuY2J1IHdp | |
| bGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIAojIGFmdGVyIGl0IGhhcyBvdGhlcndp | |
| c2UgZGV0ZXJtaW5lZCB0aGUgYXJjaGl0ZWN0dXJlIG5hbWUuCmNhc2UgIiRsZGZsYWdzIiBpbgoq | |
| Ii1mbGF0X25hbWVzcGFjZSIqKSA7OyAjIEJhY2t3YXJkIGNvbXBhdCwgYmUgZmxhdC4KIyBJZiB3 | |
| ZSBhcmUgdXNpbmcgdHdvLWxldmVsIG5hbWVzcGFjZSwgd2Ugd2lsbCBtdW5nZSB0aGUgYXJjaG5h | |
| bWUgdG8gc2hvdyBpdC4KKikgYXJjaG5hbWU9IiR7YXJjaG5hbWV9LTJsZXZlbCIgOzsKZXNhYwpF | |
| T0NCVQoKIyA2NC1iaXQgYWRkcmVzc2luZyBzdXBwb3J0LiBDdXJyZW50bHkgc3RyaWN0bHkgZXhw | |
| ZXJpbWVudGFsLiBERkQgMjAwNS0wNi0wNgpjYXNlICIkdXNlNjRiaXRhbGwiIGluCiRkZWZpbmV8 | |
| dHJ1ZXxbeVldKikKY2FzZSAiJG9zdmVycyIgaW4KWzEtN10uKikKICAgICBjYXQgPDxFT00gPiY0 | |
| CgoKCioqKiA2NC1iaXQgYWRkcmVzc2luZyBpcyBub3Qgc3VwcG9ydGVkIGZvciBNYWMgT1MgWCB2 | |
| ZXJzaW9ucwoqKiogYmVsb3cgMTAuNCAoIlRpZ2VyIikgb3IgRGFyd2luIHZlcnNpb25zIGJlbG93 | |
| IDguIFBsZWFzZSB0cnkKKioqIGFnYWluIHdpdGhvdXQgLUR1c2U2NGJpdGFsbC4gKC1EdXNlNjRi | |
| aXRpbnQgd2lsbCB3b3JrLCBob3dldmVyLikKCkVPTQogICAgIGV4aXQgMQogIDs7CiopCiAgICBj | |
| YXNlICIkb3N2ZXJzIiBpbgogICAgOC4qKQogICAgICAgIGNhdCA8PEVPTSA+JjQKCgoKKioqIFBl | |
| cmwgNjQtYml0IGFkZHJlc3Npbmcgc3VwcG9ydCBpcyBleHBlcmltZW50YWwgZm9yIE1hYyBPUyBY | |
| CioqKiAxMC40ICgiVGlnZXIiKSBhbmQgRGFyd2luIHZlcnNpb24gOC4gU3lzdGVtIFYgSVBDIGlz | |
| IGRpc2FibGVkCioqKiBkdWUgdG8gcHJvYmxlbXMgd2l0aCB0aGUgNjQtYml0IHZlcnNpb25zIG9m | |
| IG1zZ2N0bCwgc2VtY3RsLAoqKiogYW5kIHNobWN0bC4gWW91IHNob3VsZCBhbHNvIGV4cGVjdCB0 | |
| aGUgZm9sbG93aW5nIHRlc3QgZmFpbHVyZXM6CioqKgoqKiogICAgZXh0L3RocmVhZHMtc2hhcmVk | |
| L3Qvd2FpdCAodGhyZWFkZWQgYnVpbGRzIG9ubHkpCgpFT00KCiAgICAgICAgWyAiJGRfbXNnY3Rs | |
| IiBdIHx8IGRfbXNnY3RsPSd1bmRlZicKICAgICAgICBbICIkZF9zZW1jdGwiIF0gfHwgZF9zZW1j | |
| dGw9J3VuZGVmJwogICAgICAgIFsgIiRkX3NobWN0bCIgXSB8fCBkX3NobWN0bD0ndW5kZWYnCiAg | |
| ICA7OwogICAgZXNhYwoKICAgIGNhc2UgYHVuYW1lIC1wYCBpbiAKICAgIHBvd2VycGMpIGFyY2g9 | |
| cHBjNjQgOzsKICAgIGkzODYpIGFyY2g9eDg2XzY0IDs7CiAgICAqKSBjYXQgPDxFT00gPiY0Cgoq | |
| KiogRG9uJ3QgcmVjb2duaXplIHByb2Nlc3NvciwgY2FuJ3Qgc3BlY2lmeSA2NCBiaXQgY29tcGls | |
| YXRpb24uCgpFT00KICAgIDs7CiAgICBlc2FjCiAgICBmb3IgdmFyIGluIGNjZmxhZ3MgY3BwZmxh | |
| Z3MgbGQgbGRmbGFncwogICAgZG8KICAgICAgIGV2YWwgJHZhcj0iXCQke3Zhcn1cIC1hcmNoXCAk | |
| YXJjaCIKICAgIGRvbmUKCiAgICA7Owplc2FjCjs7CmVzYWMKCiMjCiMgU3lzdGVtIGxpYnJhcmll | |
| cwojIwoKIyB2Zm9yayB3b3Jrcwp1c2V2Zm9yaz0ndHJ1ZSc7CgojIG1hbGxvYyB3cmFwIHdvcmtz | |
| CmNhc2UgIiR1c2VtYWxsb2N3cmFwIiBpbgonJykgdXNlbWFsbG9jd3JhcD0nZGVmaW5lJyA7Owpl | |
| c2FjCgojIG91ciBtYWxsb2Mgd29ya3MgKGJ1dCBhbGxvdyB1c2VycyB0byBvdmVycmlkZSkKY2Fz | |
| ZSAiJHVzZW15bWFsbG9jIiBpbgonJykgdXNlbXltYWxsb2M9J24nIDs7CmVzYWMKIyBIb3dldmVy | |
| IHNicmsoKSByZXR1cm5zIC0xIChmYWlsdXJlKSBzb21ld2hlcmUgaW4gbGliL3VuaWNvcmUvbWt0 | |
| YWJsZXMgYXQKIyBhcm91bmQgMTRNLCBzbyB3ZSBuZWVkIHRvIHVzZSBzeXN0ZW0gbWFsbG9jKCkg | |
| YXMgb3VyIHNicmsoKQptYWxsb2NfY2ZsYWdzPSdjY2ZsYWdzPSItRFVTRV9QRVJMX1NCUksgLURQ | |
| RVJMX1NCUktfVklBX01BTExPQyAkY2NmbGFncyInCgojIExvY2FsZXMgYXJlbid0IGZlZWxpbmcg | |
| d2VsbC4KTENfQUxMPUM7IGV4cG9ydCBMQ19BTEw7CkxBTkc9QzsgZXhwb3J0IExBTkc7CgojCiMg | |
| VGhlIGxpYnJhcmllcyBhcmUgbm90IHRocmVhZHNhZmUgYXMgb2YgT1MgWCAxMC4xLgojCiMgRml4 | |
| IHdoZW4gQXBwbGUgZml4ZXMgbGliYy4KIwpjYXNlICIkdXNldGhyZWFkcyR1c2VpdGhyZWFkcyIg | |
| aW4KICAqZGVmaW5lKikKICBjYXNlICIkb3N2ZXJzIiBpbgogICAgWzEyMzQ1XS4qKSAgICAgY2F0 | |
| IDw8RU9NID4mNAoKCgoqKiogV2FybmluZywgdGhlcmUgbWlnaHQgYmUgcHJvYmxlbXMgd2l0aCB5 | |
| b3VyIGxpYnJhcmllcyB3aXRoCioqKiByZWdhcmRzIHRvIHRocmVhZGluZy4gIFRoZSB0ZXN0IGV4 | |
| dC90aHJlYWRzL3QvbGliYy50IGlzIGxpa2VseQoqKiogdG8gZmFpbC4KCkVPTQogICAgOzsKICAg | |
| ICopIHVzZXJlZW50cmFudD0nZGVmaW5lJzs7CiAgZXNhYwoKZXNhYwoKIyBGaW5rIGNhbiBpbnN0 | |
| YWxsIGEgR0RCTSBsaWJyYXJ5IHRoYXQgY2xhaW1zIHRvIGhhdmUgdGhlIE9EQk0gaW50ZXJmYWNl | |
| cwojIGJ1dCBQZXJsIGR5bmFsb2FkZXIgY2Fubm90IGZvciBzb21lIHJlYXNvbiB1c2UgdGhhdCBs | |
| aWJyYXJ5LiAgV2UgZG9uJ3QKIyByZWFsbHkgbmVlZCBPREJNX0ZJbGUsIHRob3VnaCwgc28gbGV0 | |
| J3MganVzdCBoaW50IE9EQk0gYXdheS4KaV9kYm09dW5kZWY7CgojIENvbmZpZ3VyZSBkb2Vzbid0 | |
| IGRldGVjdCByYW5saWIgb24gVGlnZXIgcHJvcGVybHkuCiMgTmVpbFcgc2F5cyB0aGlzIHNob3Vs | |
| ZCBiZSBhY2NlcHRhYmxlIG9uIGFsbCBkYXJ3aW4gdmVyc2lvbnMuCnJhbmxpYj0ncmFubGliJwoK | |
| IyMKIyBCdWlsZCBwcm9jZXNzCiMjCgojIENhc2UtaW5zZW5zaXRpdmUgZmlsZXN5c3RlbXMgZG9u | |
| J3QgZ2V0IGFsb25nIHdpdGggTWFrZWZpbGUgYW5kCiMgbWFrZWZpbGUgaW4gdGhlIHNhbWUgcGxh | |
| Y2UuICBTaW5jZSBEYXJ3aW4gdXNlcyBHTlUgbWFrZSwgdGhpcyBkb2RnZXMKIyB0aGUgcHJvYmxl | |
| bS4KZmlyc3RtYWtlZmlsZT1HTlVtYWtlZmlsZTsK', | |
| 'hpux' => | |
| 'IyEvdXNyL2Jpbi9zaAoKIyMjIFNZU1RFTSBBUkNISVRFQ1RVUkUKCiMgRGV0ZXJtaW5lIHRoZSBh | |
| cmNoaXRlY3R1cmUgdHlwZSBvZiB0aGlzIHN5c3RlbS4KIyBLZWVwIGxlYWRpbmcgdGFiIGJlbG93 | |
| IC0tIENvbmZpZ3VyZSBCbGFjayBNYWdpYyAtLSBSQU0sIDAzLzAyLzk3Cgl4eE9zUmV2TWFqb3I9 | |
| YHVuYW1lIC1yIHwgc2VkIC1lICdzL15bXjAtOV0qLy8nIHwgY3V0IC1kLiAtZjFgOwoJeHhPc1Jl | |
| dk1pbm9yPWB1bmFtZSAtciB8IHNlZCAtZSAncy9eW14wLTldKi8vJyB8IGN1dCAtZC4gLWYyYDsK | |
| CXh4T3NSZXY9YGV4cHIgMTAwIFwqICR4eE9zUmV2TWFqb3IgKyAkeHhPc1Jldk1pbm9yYAppZiBb | |
| ICIkeHhPc1Jldk1ham9yIiAtZ2UgMTAgXTsgdGhlbgogICAgIyBUaGlzIHN5c3RlbSBpcyBydW5u | |
| aW5nID49IDEwLngKCiAgICAjIFRlc3RlZCBvbiAxMC4wMSBQQTEueCBhbmQgMTAuMjAgUEFbMTJd | |
| LnguCiAgICAjIElkZWE6IFNjYW4gL3Vzci9pbmNsdWRlL3N5cy91bmlzdGQuaCBmb3IgbWF0Y2hl | |
| cyB3aXRoCiAgICAjICIjZGVmaW5lIENQVV8qIGBnZXRjb25mICMgQ1BVX1ZFUlNJT05gIiB0byBk | |
| ZXRlcm1pbmUgQ1BVIHR5cGUuCiAgICAjIE5vdGUgdGhlIHRleHQgZm9sbG93aW5nICJDUFVfIiBp | |
| cyB1c2VkLCAqTk9UKiB0aGUgY29tbWVudC4KICAgICMKICAgICMgQVNTVU1QVElPTlM6IE51bWJl | |
| cnMgd2lsbCBjb250aW51ZSB0byBiZSBkZWZpbmVkIGluIGhleCAtLSBhbmQgaW4KICAgICMgL3Vz | |
| ci9pbmNsdWRlL3N5cy91bmlzdGQuaCAtLSBhbmQgdGhlIENQVV8qICNkZWZpbmVzIHdpbGwgYmUg | |
| a2VwdAogICAgIyB1cCB0byBkYXRlIHdpdGggbmV3IENQVS9PUyByZWxlYXNlcy4KICAgIHh4Y3B1 | |
| PWBnZXRjb25mIENQVV9WRVJTSU9OYDsgIyBHZXQgdGhlIG51bWJlci4KICAgIHh4Y3B1PWBwcmlu | |
| dGYgJzB4JXgnICR4eGNwdWA7ICMgY29udmVydCB0byBoZXgKICAgIGFyY2huYW1lPWBzZWQgLW4g | |
| LWUgInMvXiNbWzpzcGFjZTpdXSpkZWZpbmVbWzpzcGFjZTpdXSpDUFVfLy9wIiAvdXNyL2luY2x1 | |
| ZGUvc3lzL3VuaXN0ZC5oIHwKCXNlZCAtbiAtZSAicy9bWzpzcGFjZTpdXSokeHhjcHVbWzpzcGFj | |
| ZTpdXS4qLy9wIiB8CglzZWQgLWUgcy9fUklTQy8tUklTQy8gLWUgcy9IUF8vLyAtZSBzL18vLi8g | |
| LWUgInMvW1s6c3BhY2U6XV0qLy9nImA7CmVsc2UKICAgICMgVGhpcyBzeXN0ZW0gaXMgcnVubmlu | |
| ZyA8PSA5LngKICAgICMgVGVzdGVkIG9uIDkuMFs1N10gUEEgYW5kIFs3OF0uMCBNQzY4MFsyM10w | |
| LiAgSWRlYTogQWZ0ZXIgcmVtb3ZpbmcKICAgICMgTUM2ODg4WzEyXSBmcm9tIGNvbnRleHQgc3Ry | |
| aW5nLCB1c2UgZmlyc3QgQ1BVIGlkZW50aWZpZXIuCiAgICAjCiAgICAjIEFTU1VNUFRJT046IE9u | |
| bHkgQ1BVIGlkZW50aWZpZXJzIGNvbnRhaW4gbm8gbG93ZXJjYXNlIGxldHRlcnMuCiAgICBhcmNo | |
| bmFtZT1gZ2V0Y29udGV4dCB8IHRyICcgJyAnXDAxMicgfCBncmVwIC12ICdbYS16XScgfCBncmVw | |
| IC12IE1DNjg4IHwKCXNlZCAtZSAncy9IUC0vLycgLWUgMXFgOwogICAgc2VsZWN0dHlwZT0naW50 | |
| IConCiAgICBmaQoKIyBGb3Igc29tZSBzdHJhbmdlIHJlYXNvbiwgdGhlIHUzMmFsaWduIHRlc3Qg | |
| ZnJvbSBDb25maWd1cmUgaGFuZ3MgaW4KIyBIUC1VWCAxMC4yMCBzaW5jZSB0aGUgRGVjZW1iZXIg | |
| MjAwMSBwYXRjaGVzLiAgU28gaGludCBpdCB0byBhdm9pZAojIHRoZSB0ZXN0LgppZiBbICIkeHhP | |
| c1Jldk1ham9yIiAtbGUgMTAgXTsgdGhlbgogICAgZF91MzJhbGlnbj0kZGVmaW5lCiAgICBmaQoK | |
| ZWNobyAiQXJjaG5hbWUgaXMgJGFyY2huYW1lIgoKIyBGaXggWFNsaWIgKENQQU4pIGNvbmZ1c2lv | |
| biB3aGVuIHJlLXVzaW5nIGEgcHJlZml4IGJ1dCBjaGFuZ2luZyBmcm9tIElMUDMyCiMgdG8gTFA2 | |
| NCBidWlsZHMuICBUaGV5J3JlIE5PVCBiaW5hcnkgY29tcGF0aWJsZSwgc28gcXVpdCBjbGFpbWlu | |
| ZyB0aGV5IGFyZS4KYXJjaG5hbWU2ND1MUDY0CgoKIyMjIEhQLVVYIE9TIHNwZWNpZmljIGJlaGF2 | |
| aW91cgoKIyAtbGRibSBpcyBvYnNvbGV0ZSBhbmQgc2hvdWxkIG5vdCBiZSB1c2VkCiMgLWxCU0Qg | |
| Y29udGFpbnMgQlNELXN0eWxlIGR1cGxpY2F0ZXMgb2YgU1ZSNCByb3V0aW5lcyB0aGF0IGNhdXNl | |
| IGNvbmZ1c2lvbgojIC1sUFcgaXMgb2Jzb2xldGUgYW5kIHNob3VsZCBub3QgYmUgdXNlZAojIFRo | |
| ZSBsaWJyYXJpZXMgY3J5cHQsIG1hbGxvYywgbmRpciwgYW5kIG5ldCBhcmUgZW1wdHkuCnNldCBg | |
| ZWNobyAiWCAkbGlic3dhbnRlZCAiIHwgc2VkIC1lICdzLyBsZCAvIC8nIC1lICdzLyBkYm0gLyAv | |
| JyAtZSAncy8gQlNEIC8gLycgLWUgJ3MvIFBXIC8gLydgCnNoaWZ0CmxpYnN3YW50ZWQ9IiQqIgoK | |
| Y2M9JHtjYzotY2N9CmFyPS91c3IvYmluL2FyCSMgWWVzLCB0cnVseSBvdmVycmlkZS4gIFdlIGRv | |
| IG5vdCB3YW50IHRoZSBHTlUgYXIuCmZ1bGxfYXI9JGFyCSMgSSByZXBlYXQsIG5vIEdOVSBhci4g | |
| IGFycnIuCgpzZXQgYGVjaG8gIlggJGNjZmxhZ3MgIiB8IHNlZCAtZSAncy8gLUFbZWFdIC8gLycg | |
| LWUgJ3MvIC1EX0hQVVhfU09VUkNFIC8gLydgCnNoaWZ0CgljY19jcHBmbGFncz0iJCogLURfSFBV | |
| WF9TT1VSQ0UiCmNwcGZsYWdzPSItQWEgLURfX1NURENfRVhUX18gJGNjX2NwcGZsYWdzIgoKY2Fz | |
| ZSAiJHByZWZpeCIgaW4KICAgICIiKSBwcmVmaXg9Jy9vcHQvcGVybDUnIDs7CiAgICBlc2FjCgog | |
| ICAgZ251X2FzPW5vCiAgICBnbnVfbGQ9bm8KY2FzZSBgJGNjIC12IDI+JjFgIiIgaW4KICAgICpn | |
| Y2MqKSAgY2Npc2djYz0iJGRlZmluZSIKCSAgICBjY2ZsYWdzPSIkY2NfY3BwZmxhZ3MiCgkgICAg | |
| aWYgWyAiWCRnY2N2ZXJzaW9uIiA9ICJYIiBdOyB0aGVuCgkJIyBEb25lIHRvbyBsYXRlIGluIENv | |
| bmZpZ3VyZSBpZiBoaW50ZWQKCQlnY2N2ZXJzaW9uPWAkY2MgLWR1bXB2ZXJzaW9uYAoJCWZpCgkg | |
| ICAgY2FzZSAiJGdjY3ZlcnNpb24iIGluCgkJWzAxMl0qKSAjIEhQLVVYIGFuZCBnY2MtMi4qIGJy | |
| ZWFrIFVJTlQzMl9NQVggOi0oCgkJCWNjZmxhZ3M9IiRjY2ZsYWdzIC1EVUlOVDMyX01BWF9CUk9L | |
| RU4iCgkJCTs7CgkJWzM0XSopICMgR0NDIChib3RoIDMyYml0IGFuZCA2NGJpdCkgd2lsbCBkZWZp | |
| bmUgX19TVERDX0VYVF9fCiAgICAgICAgICAgICAgICAgICAgICAgIyBieSBkZWZhdWx0IHdoZW4g | |
| dXNpbmcgR0NDIDMuMCBhbmQgbmV3ZXIgdmVyc2lvbnMgb2YKICAgICAgICAgICAgICAgICAgICAg | |
| ICAjIHRoZSBjb21waWxlci4KICAgICAgICAgICAgICAgICAgICAgICBjcHBmbGFncz0iJGNjX2Nw | |
| cGZsYWdzIgogICAgICAgICAgICAgICAgICAgICAgIDs7CgkJZXNhYwoJICAgIGNhc2UgImBnZXRj | |
| b25mIEtFUk5FTF9CSVRTIDI+L2Rldi9udWxsYCIgaW4KCQkqNjQqKQoJCSAgICBlY2hvICJtYWlu | |
| KCl7fSI+dHJ5LmMKCQkgICAgY2FzZSAiJGdjY3ZlcnNpb24iIGluCgkJCVszNF0qKQoJCQkgICAg | |
| Y2FzZSAiJGFyY2huYW1lIiBpbgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgUEEtUklT | |
| QyopCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY2FzZSAiJGNjZmxhZ3MiIGlu | |
| CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICotbXBhLXJpc2MqKSA7Owog | |
| ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAqKSBjY2ZsYWdzPSIkY2NmbGFn | |
| cyAtbXBhLXJpc2MtMi0wIiA7OwogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg | |
| ICBlc2FjCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgOzsKCQkJCWVzYWMKCQkJ | |
| ICAgIDs7CgkJCSopICAjIGdjYyB3aXRoIGdhcyB3aWxsIG5vdCBhY2NlcHQgK0RBMi4wCgkJCSAg | |
| ICBjYXNlICJgJGNjIC1jIC1XYSwrREEyLjAgdHJ5LmMgMj4mMWAiIGluCgkJCQkqIitEQTIuMCIq | |
| KQkJIyBnYXMKCQkJCSAgICBnbnVfYXM9eWVzCgkJCQkgICAgOzsKCQkJCSopCQkJIyBIUGFzCgkJ | |
| CQkgICAgY2NmbGFncz0iJGNjZmxhZ3MgLVdhLCtEQTIuMCIKCQkJCSAgICA7OwoJCQkJZXNhYwoJ | |
| CQkgICAgOzsKCQkJZXNhYwoJCSAgICAjIGdjYyB3aXRoIGdsZCB3aWxsIG5vdCBhY2NlcHQgK3Zu | |
| b2NvbXBhdHdhcm5pbmdzCgkJICAgIGNhc2UgImAkY2MgLW8gdHJ5IC1XbCwrdm5vY29tcGF0d2Fy | |
| bmluZ3MgdHJ5LmMgMj4mMWAiIGluCgkJCSoiK3Zub2NvbXBhdCIqKQkJIyBnbGQKCQkJICAgIGdu | |
| dV9sZD15ZXMKCQkJICAgIDs7CgkJCSopCQkJIyBIUGxkCgkJCSAgIGNhc2UgIiRnY2N2ZXJzaW9u | |
| IiBpbgoJCQkgICAgICAgWzEyXSopCgkJCQkgICAjIFdoeSBub3QgMyBhcyB3ZWxsIGhlcmU/CgkJ | |
| CQkgICAjIFNpbmNlIG5vdCByZWxldmFudCB0byBJQTY0LCBub3QgY2hhbmdlZC4KCQkJCSAgIGxk | |
| ZmxhZ3M9IiRsZGZsYWdzIC1XbCwrdm5vY29tcGF0d2FybmluZ3MiCgkJCQkgICBjY2ZsYWdzPSIk | |
| Y2NmbGFncyAtV2wsK3Zub2NvbXBhdHdhcm5pbmdzIgoJCQkJICAgOzsKCQkJICAgICAgIGVzYWMK | |
| CQkJICAgIDs7CgkJCWVzYWMKCQkgICAgcm0gLWYgdHJ5LmMKCQkgICAgOzsKCQllc2FjCgkgICAg | |
| OzsKICAgICopICAgICAgY2Npc2djYz0nJwoJICAgICMgV2hhdCBjYW5ub3QgYmUgdXNlIGluIGNv | |
| bWJpbmF0aW9uIHdpdGggY2NhY2hlIGxpbmtzIDooCgkgICAgY2NfZm91bmQ9IiIKCSAgICBmb3Ig | |
| cCBpbiBgZWNobyAkUEFUSCB8IHRyIDogJyAnJ2AgOyBkbwoJCXg9IiRwL2NjIgoJCWlmIFsgLWYg | |
| JHggXSAmJiBbIC14ICR4IF07IHRoZW4KCQkgICAgaWYgWyAtaCAkeCBdOyB0aGVuCgkJCWw9YGxz | |
| IC1sICR4IHwgc2VkICdzLC4qLT4gLCwnYAoJCQljYXNlICRsIGluCgkJCSAgICAvKikgeD0kbAkJ | |
| OzsKCQkJICAgICopICB4PSIkcC8kbCIJOzsKCQkJICAgIGVzYWMKCQkJZmkKCQkgICAgeD1gZWNo | |
| byAkeCB8IHNlZCAncywvXC4vLC8sZydgCgkJICAgIGNhc2UgJHggaW4KCQkJKmNjYWNoZSopIDs7 | |
| CgkJCSopIFsgLXogIiRjY19mb3VuZCIgXSAmJiBjY19mb3VuZD0keCA7OwoJCQllc2FjCgkJICAg | |
| IGZpCgkJZG9uZQoJICAgIFsgLXogIiRjY19mb3VuZCIgXSAmJiBjY19mb3VuZD1gd2hpY2ggY2Ng | |
| CgkgICAgd2hhdCAkY2NfZm91bmQgPiY0CgkgICAgY2N2ZXJzaW9uPWB3aGF0ICRjY19mb3VuZCB8 | |
| IGF3ayAnL0NvbXBpbGVyL3twcmludCAkMn0vSXRhbml1bS97cHJpbnQgJDYsJDd9L2ZvciBJbnRl | |
| Z3JpdHkve3ByaW50ICQ2fSdgCgkgICAgY2FzZSAiJGNjZmxhZ3MiIGluCiAgICAgICAgICAgICAg | |
| ICItQWUgIiopIDs7CgkJKikgIGNjZmxhZ3M9Ii1BZSAkY2NfY3BwZmxhZ3MiCgkJICAgICMgK3Zu | |
| b2NvbXBhdHdhcm5pbmdzIG5vdCBrbm93biBpbiAxMC4xMCBhbmQgb2xkZXIKCQkgICAgaWYgWyAk | |
| eHhPc1JldiAtZ2UgMTAyMCBdOyB0aGVuCgkJCWNjZmxhZ3M9IiRjY2ZsYWdzIC1XbCwrdm5vY29t | |
| cGF0d2FybmluZ3MiCgkJCWZpCgkJICAgIDs7CiAgICAgICAgICAgICAgIGVzYWMKCSAgICAjIE5l | |
| ZWRlZCBiZWNhdXNlIGNwcCBkb2VzIG9ubHkgc3VwcG9ydCAtQWEgKG5vdCAtQWUpCgkgICAgY3Bw | |
| bGFzdD0nLScKCSAgICBjcHBtaW51cz0nLScKCSAgICBjcHBzdGRpbj0nY2MgLUUgLUFhIC1EX19T | |
| VERDX0VYVF9fJwoJICAgIGNwcHJ1bj0kY3Bwc3RkaW4KIwkgICAgY2FzZSAiJGRfY2FzdGkzMiIg | |
| aW4KIwkJIiIpIGRfY2FzdGkzMj0ndW5kZWYnIDs7CiMJCWVzYWMKCSAgICA7OwogICAgZXNhYwoK | |
| IyBXaGVuIEhQLVVYIHJ1bnMgYSBzY3JpcHQgd2l0aCAiIyEiLCBpdCBzZXRzIGFyZ3ZbMF0gdG8g | |
| dGhlIHNjcmlwdCBuYW1lLgp0b2tlX2NmbGFncz0nY2NmbGFncz0iJGNjZmxhZ3MgLURBUkdfWkVS | |
| T19JU19TQ1JJUFQiJwoKIyMjIDY0IEJJVE5FU1MKCiMgU29tZSBnY2MgdmVyc2lvbnMgZG8gbmF0 | |
| aXZlIDY0IGJpdCBsb25nIChlLmcuIDIuOS1ocHBhLTAwMDMxMCBhbmQgZ2NjLTMuMCkKIyBXZSBo | |
| YXZlIHRvIGZvcmNlIDY0Yml0bmVzcyB0byBnbyBzZWFyY2ggdGhlIHJpZ2h0IGxpYnJhcmllcwog | |
| ICAgZ2NjXzY0bmF0aXZlPW5vCmNhc2UgIiRjY2lzZ2NjIiBpbgogICAgJGRlZmluZXx0cnVlfFtZ | |
| eV0pCgllY2hvICcjaW5jbHVkZSA8c3RkaW8uaD5cbmludCBtYWluKCl7bG9uZyBsO3ByaW50Zigi | |
| JWRcXG4iLHNpemVvZihsKSk7fSc+dHJ5LmMKCSRjYyAtbyB0cnkgJGNjZmxhZ3MgJGxkZmxhZ3Mg | |
| dHJ5LmMKCWlmIFsgImB0cnlgIiA9ICI4IiBdOyB0aGVuCgkgICAgY2FzZSAiJHVzZTY0Yml0YWxs | |
| IiBpbgoJCSRkZWZpbmV8dHJ1ZXxbWXldKSA7OwoJCSopICBjYXQgPDxFT00gPiY0CgoqKiogVGhp | |
| cyB2ZXJzaW9uIG9mIGdjYyB1c2VzIDY0IGJpdCBsb25ncy4gLUR1c2U2NGJpdGFsbCBpcwoqKiog | |
| aW1wbGljaXRseSBzZXQgdG8gZW5hYmxlIGNvbnRpbnVhdGlvbgpFT00KCQllc2FjCgkgICAgdXNl | |
| NjRiaXRhbGw9JGRlZmluZQoJICAgIGdjY182NG5hdGl2ZT15ZXMKCSAgICBmaQoJOzsKICAgIGVz | |
| YWMKCmNhc2UgIiR1c2U2NGJpdGFsbCIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbeVldKikgdXNlNjRi | |
| aXRpbnQ9IiRkZWZpbmUiIDs7CiAgICBlc2FjCgpjYXNlICIkdXNlbW9yZWJpdHMiIGluCiAgICAk | |
| ZGVmaW5lfHRydWV8W3lZXSopIHVzZTY0Yml0aW50PSIkZGVmaW5lIjsgdXNlbG9uZ2RvdWJsZT0i | |
| JGRlZmluZSIgOzsKICAgIGVzYWMKCmNhc2UgIiRhcmNobmFtZSIgaW4KICAgIElBNjQqKQoJIyBX | |
| aGlsZSBoZXJlLCBvdmVycmlkZSBzbz1zbCBhdXRvLWRldGVjdGlvbgoJc289J3NvJwoJOzsKICAg | |
| IGVzYWMKCmNhc2UgIiR1c2U2NGJpdGFsbCIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbWXldKQoKCWlm | |
| IFsgIiR4eE9zUmV2TWFqb3IiIC1sdCAxMSBdOyB0aGVuCgkgICAgY2F0IDw8RU9NID4mNAoKKioq | |
| IDY0LWJpdCBjb21waWxhdGlvbiBpcyBub3Qgc3VwcG9ydGVkIG9uIEhQLVVYICR4eE9zUmV2TWFq | |
| b3IuCioqKiBZb3UgbmVlZCBhdCBsZWFzdCBIUC1VWCAxMS4wLgoqKiogQ2Fubm90IGNvbnRpbnVl | |
| LCBhYm9ydGluZy4KRU9NCgkgICAgZXhpdCAxCgkgICAgZmkKCglpZiBbICR4eE9zUmV2IC1lcSAx | |
| MTAwIF07IHRoZW4KCSAgICAjIEhQLVVYIDExLjAwIHVzZXMgb25seSA0OCBiaXRzIGludGVybmFs | |
| bHkgaW4gNjRiaXQgbW9kZSwgbm90IDY0CgkgICAgIyBmb3JjZSBtaW4vbWF4IHRvIDIqKjQ3LTEK | |
| CSAgICBzR01USU1FX21heD0xNDA3Mzc0ODgzNTUzMjcKCSAgICBzR01USU1FX21pbj0tNjIxNjcy | |
| MTkyMDAKCSAgICBzTE9DQUxUSU1FX21heD0xNDA3Mzc0ODgzNTUzMjcKCSAgICBzTE9DQUxUSU1F | |
| X21pbj0tNjIxNjcyMTkyMDAKCSAgICBmaQoKCSMgU2V0IGxpYmMgYW5kIHRoZSBsaWJyYXJ5IHBh | |
| dGhzCgljYXNlICIkYXJjaG5hbWUiIGluCgkgICAgUEEtUklTQyopCgkJbG9jbGlicHRoPSIkbG9j | |
| bGlicHRoIC9saWIvcGEyMF82NCIKCQlsaWJjPScvbGliL3BhMjBfNjQvbGliYy5zbCcgOzsKCSAg | |
| ICBJQTY0KikKCQlsb2NsaWJwdGg9IiRsb2NsaWJwdGggL3Vzci9saWIvaHB1eDY0IgoJCWxpYmM9 | |
| Jy91c3IvbGliL2hwdXg2NC9saWJjLnNvJyA7OwoJICAgIGVzYWMKCWlmIFsgISAtZiAiJGxpYmMi | |
| IF07IHRoZW4KCSAgICBjYXQgPDxFT00gPiY0CgoqKiogWW91IGRvIG5vdCBzZWVtIHRvIGhhdmUg | |
| dGhlIDY0LWJpdCBsaWJjLgoqKiogSSBjYW5ub3QgZmluZCB0aGUgZmlsZSAkbGliYy4KKioqIENh | |
| bm5vdCBjb250aW51ZSwgYWJvcnRpbmcuCkVPTQoJICAgIGV4aXQgMQoJICAgIGZpCgoJY2FzZSAi | |
| JGNjaXNnY2MiIGluCgkgICAgJGRlZmluZXx0cnVlfFtZeV0pCgkJIyBUaGUgZml4ZWQgc29ja2V0 | |
| LmggaGVhZGVyIGZpbGUgaXMgd3JvbmcgZm9yIGdjYy00LngKCQkjIG9uIFBBLVJJU0MyLjBXLCBz | |
| byBTb2NrX3R5cGVfdCBpcyBzaXplX3Qgd2hpY2ggaXMKCQkjIHVuc2lnbmVkIGxvbmcgd2hpY2gg | |
| aXMgNjRiaXQgd2hpY2ggaXMgdG9vIGxvbmcKCQljYXNlICIkZ2NjdmVyc2lvbiIgaW4KCQkgICAg | |
| NCopIGNhc2UgIiRhcmNobmFtZSIgaW4KCQkJICAgIFBBLVJJU0MqKSBzb2Nrc2l6ZXR5cGU9aW50 | |
| IDs7CgkJCSAgICBlc2FjCgkJCTs7CgkJICAgIGVzYWMKCgkJIyBGb3IgdGhlIG1vbWVudCwgZG9u | |
| J3QgY2FyZSB0aGF0IGl0IGFpbid0IHN1cHBvcnRlZCAoeWV0KQoJCSMgYnkgZ2NjICh1cCB0byBh | |
| bmQgaW5jbHVkaW5nIDIuOTUuMyksIGNhdXNlIGl0J2xsIGNyYXNoCgkJIyBhbnl3YXkuIEV4cGVj | |
| dCBhdXRvLWRldGVjdGlvbiBvZiA2NC1iaXQgZW5hYmxlZCBnY2Mgb24KCQkjIEhQLVVYIHNvb24s | |
| IGluY2x1ZGluZyBhIHVzZXItZnJpZW5kbHkgZXhpdAoJCWNhc2UgJGdjY182NG5hdGl2ZSBpbgoJ | |
| CSAgICBubykgY2FzZSAiJGdjY3ZlcnNpb24iIGluCgkJCSAgICBbMTIzNF0qKQoJCQkJY2NmbGFn | |
| cz0iJGNjZmxhZ3MgLW1scDY0IgoJCQkJY2FzZSAiJGFyY2huYW1lIiBpbgoJCQkJICAgIFBBLVJJ | |
| U0MqKQoJCQkJCWxkZmxhZ3M9IiRsZGZsYWdzIC1XbCwrREQ2NCIKCQkJCQk7OwoJCQkJICAgIElB | |
| NjQqKQoJCQkJCWxkZmxhZ3M9IiRsZGZsYWdzIC1tbHA2NCIKCQkJCQk7OwoJCQkJICAgIGVzYWMK | |
| CQkJCTs7CgkJCSAgICBlc2FjCgkJCTs7CgkJICAgIGVzYWMKCQk7OwoJICAgICopCgkJY2FzZSAi | |
| JHVzZTY0Yml0YWxsIiBpbgoJCSAgICAkZGVmaW5lfHRydWV8W3lZXSopCgkJCWNjZmxhZ3M9IiRj | |
| Y2ZsYWdzICtERDY0IgoJCQlsZGZsYWdzPSIkbGRmbGFncyArREQ2NCIKCQkJOzsKCQkgICAgZXNh | |
| YwoJCTs7CgkgICAgZXNhYwoKCSMgUmVzZXQgdGhlIGxpYnJhcnkgY2hlY2tlciB0byBtYWtlIHN1 | |
| cmUgbGlicmFyaWVzCgkjIGFyZSB0aGUgcmlnaHQgdHlwZQoJIyAoTk9URTogb24gSUE2NCwgdGhp | |
| cyBkb2Vzbid0IHdvcmsgd2l0aCAuYSBmaWxlcy4pCglsaWJzY2hlY2s9J2Nhc2UgImAvdXNyL2Jp | |
| bi9maWxlICR4eHhgIiBpbgoJCSAgICAgICAqRUxGLTY0KnwqTFA2NCp8KlBBLVJJU0MyLjAqKSA7 | |
| OwoJCSAgICAgICAqKSB4eHg9L25vLzY0LWJpdCR4eHggOzsKCQkgICAgICAgZXNhYycKCgk7OwoK | |
| ICAgICopCSMgTm90IGluIDY0LWJpdCBtb2RlCgoJY2FzZSAiJGFyY2huYW1lIiBpbgoJICAgIFBB | |
| LVJJU0MqKQoJCWxpYmM9Jy9saWIvbGliYy5zbCcgOzsKCSAgICBJQTY0KikKCQlsb2NsaWJwdGg9 | |
| IiRsb2NsaWJwdGggL3Vzci9saWIvaHB1eDMyIgoJCWxpYmM9Jy91c3IvbGliL2hwdXgzMi9saWJj | |
| LnNvJyA7OwoJICAgIGVzYWMKCTs7CiAgICBlc2FjCgojIEJ5IHNldHRpbmcgdGhlIGRlZmVycmVk | |
| IGZsYWcgYmVsb3csIHRoaXMgbWVhbnMgdGhhdCBpZiB5b3UgcnVuIHBlcmwKIyBvbiBhIHN5c3Rl | |
| bSB0aGF0IGRvZXMgbm90IGhhdmUgdGhlIHJlcXVpcmVkIHNoYXJlZCBsaWJyYXJ5IHRoYXQgeW91 | |
| CiMgbGlua2VkIGl0IHdpdGgsIGl0IHdpbGwgZGllIHdoZW4geW91IHRyeSB0byBhY2Nlc3MgYSBz | |
| eW1ib2wgaW4gdGhlCiMgKG1pc3NpbmcpIHNoYXJlZCBsaWJyYXJ5LiAgSWYgeW91IHdvdWxkIHJh | |
| dGhlciBrbm93IGF0IHBlcmwgc3RhcnR1cAojIHRpbWUgdGhhdCB5b3UgYXJlIG1pc3NpbmcgYW4g | |
| aW1wb3J0YW50IHNoYXJlZCBsaWJyYXJ5LCBzd2l0Y2ggdGhlCiMgY29tbWVudHMgc28gdGhhdCBp | |
| bW1lZGlhdGUsIHJhdGhlciB0aGFuIGRlZmVycmVkIGxvYWRpbmcgaXMKIyBwZXJmb3JtZWQuICBF | |
| dmVuIHdpdGggaW1tZWRpYXRlIGxvYWRpbmcsIHlvdSBjYW4gcG9zdHBvbmUgZXJyb3JzIGZvcgoj | |
| IHVuZGVmaW5lZCAob3IgbXVsdGlwbHkgZGVmaW5lZCkgcm91dGluZXMgdW50aWwgYWN0dWFsIGFj | |
| Y2VzcyBieQojIGFkZGluZyB0aGUgIm5vbmZhdGFsIiBvcHRpb24uCiMgY2NkbGZsYWdzPSItV2ws | |
| LUUgLVdsLC1CLGltbWVkaWF0ZSAkY2NkbGZsYWdzIgojIGNjZGxmbGFncz0iLVdsLC1FIC1XbCwt | |
| QixpbW1lZGlhdGUsLUIsbm9uZmF0YWwgJGNjZGxmbGFncyIKaWYgWyAiJGdudV9sZCIgPSAieWVz | |
| IiBdOyB0aGVuCiAgICBjY2RsZmxhZ3M9Ii1XbCwtRSAkY2NkbGZsYWdzIgplbHNlCiAgICBjY2Rs | |
| ZmxhZ3M9Ii1XbCwtRSAtV2wsLUIsZGVmZXJyZWQgJGNjZGxmbGFncyIKICAgIGZpCgoKIyMjIENP | |
| TVBJTEVSIFNQRUNJRklDUwoKIyMgTG9jYWwgcmVzdHJpY3Rpb25zIChwb2ludCB0byBSRUFETUUu | |
| aHB1eCB0byBsaWZ0IHRoZXNlKQoKIyMgT3B0aW1pemF0aW9uIGxpbWl0cwpjYXQgPnRyeS5jIDw8 | |
| RU9GCiNpbmNsdWRlIDxzdGRpby5oPgojaW5jbHVkZSA8c3lzL3Jlc291cmNlLmg+CgppbnQgbWFp | |
| biAoKQp7CiAgICBzdHJ1Y3QgcmxpbWl0IHJsOwogICAgaW50IGkgPSBnZXRybGltaXQgKFJMSU1J | |
| VF9EQVRBLCAmcmwpOwogICAgcHJpbnRmICgiJWRcbiIsIChpbnQpKHJsLnJsaW1fY3VyIC8gKDEw | |
| MjQgKiAxMDI0KSkpOwogICAgfSAvKiBtYWluICovCkVPRgokY2MgLW8gdHJ5ICRjY2ZsYWdzICRs | |
| ZGZsYWdzIHRyeS5jCgltYXhkc2l6PWB0cnlgCnJtIC1mIHRyeSB0cnkuYyBjb3JlCmlmIFsgJG1h | |
| eGRzaXogLWxlIDY0IF07IHRoZW4KICAgICMgNjQgTWIgaXMgcHJvYmFibHkgbm90IGVub3VnaCB0 | |
| byBvcHRpbWl6ZSB0b2tlLmMKICAgICMgYW5kIHJlZ2V4cC5jIHdpdGggLU8yCiAgICBjYXQgPDxF | |
| T00gPiY0CllvdXIga2VybmVsIGxpbWl0cyB0aGUgZGF0YSBzZWN0aW9uIG9mIHlvdXIgcHJvZ3Jh | |
| bXMgdG8gJG1heGRzaXogTWIsCndoaWNoIGlzIChzYWRseSkgbm90IGVub3VnaCB0byBmdWxseSBv | |
| cHRpbWl6ZSBzb21lIHBhcnRzIG9mIHRoZQpwZXJsIGJpbmFyeS4gSSdsbCB0cnkgdG8gdXNlIGEg | |
| bG93ZXIgb3B0aW1pemF0aW9uIGxldmVsIGZvcgp0aG9zZSBwYXJ0cy4gSWYgeW91IGFyZSBhIHN5 | |
| c2FkbWluLCBhbmQgeW91ICpkbyogd2FudCBmdWxsCm9wdGltaXphdGlvbiwgcmFpc2UgdGhlICdt | |
| YXhkc2l6JyBrZXJuZWwgY29uZmlndXJhdGlvbiBwYXJhbWV0ZXIKdG8gYXQgbGVhc3QgMHgwODAw | |
| MDAwMCAoMTI4IE1iKSBhbmQgcmVidWlsZCB5b3VyIGtlcm5lbC4KRU9NCnJlZ2V4ZWNfY2ZsYWdz | |
| PScnCmRvb3BfY2ZsYWdzPScnCm9wX2NmbGFncz0nJwogICAgZmkKCmNhc2UgIiRjY2lzZ2NjIiBp | |
| bgogICAgJGRlZmluZXx0cnVlfFtZeV0pCgoJY2FzZSAiJG9wdGltaXplIiBpbgoJICAgICIiKSAg | |
| ICAgICAgICAgb3B0aW1pemU9Ii1nIC1PIiA7OwoJICAgICpPWzM0NTY3ODldKikgb3B0aW1pemU9 | |
| YGVjaG8gIiRvcHRpbWl6ZSIgfCBzZWQgLWUgJ3MvT1szLTldL08yLydgIDs7CgkgICAgZXNhYwoJ | |
| I2xkPSIkY2MiCglsZD0vdXNyL2Jpbi9sZAoJY2NjZGxmbGFncz0nLWZQSUMnCgkjbGRkbGZsYWdz | |
| PSctc2hhcmVkJwoJbGRkbGZsYWdzPSctYicKCWNhc2UgIiRvcHRpbWl6ZSIgaW4KCSAgICAqLWcq | |
| LU8qfCotTyotZyopCgkJIyBnY2Mgd2l0aG91dCBnYXMgd2lsbCBub3QgYWNjZXB0IC1nCgkJZWNo | |
| byAibWFpbigpe30iPnRyeS5jCgkJY2FzZSAiYCRjYyAkb3B0aW1pemUgLWMgdHJ5LmMgMj4mMWAi | |
| IGluCgkJICAgICoiLWcgb3B0aW9uIGRpc2FibGVkIiopCgkJCXNldCBgZWNobyAiWCAkb3B0aW1p | |
| emUgIiB8IHNlZCAtZSAncy8gLWcgLyAvJ2AKCQkJc2hpZnQKCQkJb3B0aW1pemU9IiQqIgoJCQk7 | |
| OwoJCSAgICBlc2FjCgkJOzsKCSAgICBlc2FjCglpZiBbICRtYXhkc2l6IC1sZSA2NCBdOyB0aGVu | |
| CgkgICAgY2FzZSAiJG9wdGltaXplIiBpbgoJCSpPMiopCW9wdD1gZWNobyAiJG9wdGltaXplIiB8 | |
| IHNlZCAtZSAncy9PMi9PMS8nYAoJCQl0b2tlX2NmbGFncz0iJHRva2VfY2ZsYWdzO29wdGltaXpl | |
| PVwiJG9wdFwiIgoJCQlyZWdleGVjX2NmbGFncz0ib3B0aW1pemU9XCIkb3B0XCIiCgkJCTs7CgkJ | |
| ZXNhYwoJICAgIGZpCgk7OwoKICAgICopCSMgSFAncyBjb21waWxlciBjYW5ub3QgY29tYmluZSAt | |
| ZyBhbmQgLU8KCWNhc2UgIiRvcHRpbWl6ZSIgaW4KCSAgICAiIikgICAgICAgICAgIG9wdGltaXpl | |
| PSIrTzIgK09ub2xpbWl0IiA7OwoJICAgICpPWzM0NTY3ODldKikgb3B0aW1pemU9YGVjaG8gIiRv | |
| cHRpbWl6ZSIgfCBzZWQgLWUgJ3MvT1szLTldL08yLydgIDs7CgkgICAgZXNhYwoJY2FzZSAiJG9w | |
| dGltaXplIiBpbgoJICAgICotTyp8XAoJICAgICpPMiopICAgb3B0PWBlY2hvICIkb3B0aW1pemUi | |
| IHwgc2VkIC1lICdzLy1PLytPMi8nIC1lICdzL08yL08xLycgLWUgJ3MvICorT25vbGltaXQvLydg | |
| CgkJICAgIDs7CgkgICAgKikgICAgICBvcHQ9IiRvcHRpbWl6ZSIKCQkgICAgOzsKCSAgICBlc2Fj | |
| CgljYXNlICIkYXJjaG5hbWUiIGluCgkgICAgSUE2NCopCgkJY2FzZSAiJGNjdmVyc2lvbiIgaW4K | |
| CQkgICAgQjM5MTBCKkEuMDYuMFsxMjM0NV0pCgkJCSMgPiBjYyAtLXZlcnNpb24KCQkJIyBjYzog | |
| SFAgYUMrKy9BTlNJIEMgQjM5MTBCIEEuMDYuMDUgW0p1bCAyNSAyMDA1XQoJCQkjIEhhcyBvcHRp | |
| bWl6aW5nIHByb2JsZW1zIHdpdGggLU8yIGFuZCB1cCBmb3IgYm90aAoJCQkjIG1haW50ICg1Ljgu | |
| OCspIGFuZCBibGVhZCAoNS45LjMrKQoJCQkjIC1PMS8rTzEgcGFzc2VkIGFsbCB0ZXN0cyAobSkn | |
| MDUgWyAxMCBKYW4gMjAwNSBdCgkJCW9wdGltaXplPSIkb3B0IgkJCTs7CgkJICAgICopICBkb29w | |
| X2NmbGFncz0ib3B0aW1pemU9XCIkb3B0XCIiCgkJCW9wX2NmbGFncz0ib3B0aW1pemU9XCIkb3B0 | |
| XCIiCTs7CgkJICAgIGVzYWMKCQk7OwoJICAgIGVzYWMKCWlmIFsgJG1heGRzaXogLWxlIDY0IF07 | |
| IHRoZW4KCSAgICB0b2tlX2NmbGFncz0iJHRva2VfY2ZsYWdzO29wdGltaXplPVwiJG9wdFwiIgoJ | |
| ICAgIHJlZ2V4ZWNfY2ZsYWdzPSJvcHRpbWl6ZT1cIiRvcHRcIiIKCSAgICBmaQoJbGQ9L3Vzci9i | |
| aW4vbGQKCWNjY2RsZmxhZ3M9JytaJwoJbGRkbGZsYWdzPSctYiArdm5vY29tcGF0d2FybmluZ3Mn | |
| Cgk7OwogICAgZXNhYwoKIyMgTEFSR0VGSUxFUwppZiBbICR4eE9zUmV2IC1sdCAxMDIwIF07IHRo | |
| ZW4KICAgIHVzZWxhcmdlZmlsZXM9IiR1bmRlZiIKICAgIGZpCgojY2FzZSAiJHVzZWxhcmdlZmls | |
| ZXMtJGNjaXNnY2MiIGluCiMgICAgIiRkZWZpbmUtJGRlZmluZSJ8Jy1kZWZpbmUnKQojCWNhdCA8 | |
| PEVPTSA+JjQKIwojKioqIEknbSBpZ25vcmluZyBsYXJnZSBmaWxlcyBmb3IgdGhpcyBidWlsZCBi | |
| ZWNhdXNlCiMqKiogSSBkb24ndCBrbm93IGhvdyB0byBkbyB1c2UgbGFyZ2UgZmlsZXMgaW4gSFAt | |
| VVggdXNpbmcgZ2NjLgojCiNFT00KIwl1c2VsYXJnZWZpbGVzPSIkdW5kZWYiCiMJOzsKIyAgICBl | |
| c2FjCgojIE9uY2Ugd2UgaGF2ZSB0aGUgY29tcGlsZXIgZmxhZ3MgZGVmaW5lZCwgQ29uZmlndXJl | |
| IHdpbGwKIyBleGVjdXRlIHRoZSBmb2xsb3dpbmcgY2FsbC1iYWNrIHNjcmlwdC4gU2VlIGhpbnRz | |
| L1JFQURNRS5oaW50cwojIGZvciBkZXRhaWxzLgpjYXQgPiBVVS9jYy5jYnUgPDwnRU9DQlUnCiMg | |
| VGhpcyBzY3JpcHQgVVUvY2MuY2J1IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJl | |
| IGFmdGVyIGl0CiMgaGFzIHByb21wdGVkIHRoZSB1c2VyIGZvciB0aGUgQyBjb21waWxlciB0byB1 | |
| c2UuCgojIENvbXBpbGUgYW5kIHJ1biB0aGUgYSB0ZXN0IGNhc2UgdG8gc2VlIGlmIGEgY2VydGFp | |
| biBnY2MgYnVnIGlzCiMgcHJlc2VudC4gSWYgc28sIGxvd2VyIHRoZSBvcHRpbWl6YXRpb24gbGV2 | |
| ZWwgd2hlbiBjb21waWxpbmcKIyBwcF9wYWNrLmMuICBUaGlzIHdvcmtzIGFyb3VuZCBhIGJ1ZyBp | |
| biB1bnBhY2suCgppZiB0ZXN0IC16ICIkY2Npc2djYyIgLWEgLXogIiRnY2N2ZXJzaW9uIjsgdGhl | |
| bgogICAgOiBubyB0ZXN0cyBuZWVkZWQgZm9yIEhQYwplbHNlCiAgICBlY2hvICIgIgogICAgZWNo | |
| byAiVGVzdGluZyBmb3IgYSBjZXJ0YWluIGdjYyBidWcgaXMgZml4ZWQgaW4geW91ciBjb21waWxl | |
| ci4uLiIKCiAgICAjIFRyeSBjb21waWxpbmcgdGhlIHRlc3QgY2FzZS4KICAgIGlmICRjYyAtbyB0 | |
| MDAxIC1PICRjY2ZsYWdzICRsZGZsYWdzIC1sbSAuLi9oaW50cy90MDAxLmM7IHRoZW4KICAgICAg | |
| IGdjY2J1Zz1gJHJ1biAuL3QwMDFgCiAgICAgICBjYXNlICIkZ2NjYnVnIiBpbgogICAgICAgICAg | |
| ICpmYWlscyopCiAgICAgICAgICAgICAgIGNhdCA+JjQgPDxFT0YKVGhpcyBDIGNvbXBpbGVyICgk | |
| Z2NjdmVyc2lvbikgaXMga25vd24gdG8gaGF2ZSBvcHRpbWl6ZXIKcHJvYmxlbXMgd2hlbiBjb21w | |
| aWxpbmcgcHBfcGFjay5jLgoKRGlzYWJsaW5nIG9wdGltaXphdGlvbiBmb3IgcHBfcGFjay5jLgpF | |
| T0YKICAgICAgICAgICAgICAgY2FzZSAiJHBwX3BhY2tfY2ZsYWdzIiBpbgogICAgICAgICAgICAg | |
| ICAgICAgJycpIHBwX3BhY2tfY2ZsYWdzPSdvcHRpbWl6ZT0nCiAgICAgICAgICAgICAgICAgICAg | |
| ICAgZWNobyAicHBfcGFja19jZmxhZ3M9J29wdGltaXplPVwiXCInIiA+PiBjb25maWcuc2ggOzsK | |
| ICAgICAgICAgICAgICAgICAgICopICBlY2hvICJZb3Ugc3BlY2lmaWVkIHBwX3BhY2tfY2ZsYWdz | |
| IHlvdXJzZWxmLCBzbyB3ZSdsbCBnbyB3aXRoIHlvdXIgdmFsdWUuIiA+JjQgOzsKICAgICAgICAg | |
| ICAgICAgICAgIGVzYWMKICAgICAgICAgICAgICAgOzsKICAgICAgICAgICAqKSAgZWNobyAiWW91 | |
| ciBjb21waWxlciBpcyBvay4iID4mNAogICAgICAgICAgICAgICA7OwogICAgICAgICAgIGVzYWMK | |
| ICAgIGVsc2UKICAgICAgIGVjaG8gIiAiCiAgICAgICBlY2hvICIqKiogV0hPQSBUSEVSRSEhISAq | |
| KioiID4mNAogICAgICAgZWNobyAiICAgIFlvdXIgQyBjb21waWxlciBcIiRjY1wiIGRvZXNuJ3Qg | |
| c2VlbSB0byBiZSB3b3JraW5nISIgPiY0CiAgICAgICBjYXNlICIka25vd2l0YWxsIiBpbgogICAg | |
| ICAgICAgICcnKSBlY2hvICIgICAgWW91J2QgYmV0dGVyIHN0YXJ0IGh1bnRpbmcgZm9yIG9uZSBh | |
| bmQgbGV0IG1lIGtub3cgYWJvdXQgaXQuIiA+JjQKICAgICAgICAgICAgICAgZXhpdCAxCiAgICAg | |
| ICAgICAgICAgIDs7CiAgICAgICAgICAgZXNhYwogICAgICAgZmkKCiAgICBybSAtZiB0MDAxJF9v | |
| IHQwMDEkX2V4ZQogICAgZmkKRU9DQlUKCmNhdCA+VVUvdXNlbGFyZ2VmaWxlcy5jYnUgPDwnRU9D | |
| QlUnCiMgVGhpcyBzY3JpcHQgVVUvdXNlbGFyZ2VmaWxlcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1i | |
| YWNrJyBieSBDb25maWd1cmUKIyBhZnRlciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdo | |
| ZXRoZXIgdG8gdXNlIGxhcmdlIGZpbGVzLgpjYXNlICIkdXNlbGFyZ2VmaWxlcyIgaW4KICAgICIi | |
| fCRkZWZpbmV8dHJ1ZXxbeVldKikKCSMgdGhlcmUgYXJlIGxhcmdlZmlsZSBmbGFncyBhdmFpbGFi | |
| bGUgdmlhIGdldGNvbmYoMSkKCSMgYnV0IHdlIGNoZWF0IGZvciBub3cuICAoS2VlcCB0aGF0IGlu | |
| IHRoZSBsZWZ0IG1hcmdpbi4pCmNjZmxhZ3NfdXNlbGFyZ2VmaWxlcz0iLURfTEFSR0VGSUxFX1NP | |
| VVJDRSAtRF9GSUxFX09GRlNFVF9CSVRTPTY0IgoKCWNhc2UgIiAkY2NmbGFncyAiIGluCgkqIiAk | |
| Y2NmbGFnc191c2VsYXJnZWZpbGVzICIqKSA7OwoJKikgY2NmbGFncz0iJGNjZmxhZ3MgJGNjZmxh | |
| Z3NfdXNlbGFyZ2VmaWxlcyIgOzsKCWVzYWMKCglpZiB0ZXN0IC16ICIkY2Npc2djYyIgLWEgLXog | |
| IiRnY2N2ZXJzaW9uIjsgdGhlbgoJICAgICMgVGhlIHN0cmljdCBBTlNJIG1vZGUgKC1BYSkgZG9l | |
| c24ndCBsaWtlIGxhcmdlIGZpbGVzLgoJICAgIGNjZmxhZ3M9YGVjaG8gIiAkY2NmbGFncyAifHNl | |
| ZCAnc0AgLUFhIEAgQGcnYAoJICAgIGNhc2UgIiRjY2ZsYWdzIiBpbgoJCSotQWUqKSA7OwoJCSop | |
| ICAgICBjY2ZsYWdzPSIkY2NmbGFncyAtQWUiIDs7CgkJZXNhYwoJICAgIGZpCgk7OwogICAgZXNh | |
| YwpFT0NCVQoKIyBUSFJFQURJTkcKCiMgVGhpcyBzY3JpcHQgVVUvdXNldGhyZWFkcy5jYnUgd2ls | |
| bCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUKIyBhZnRlciBpdCBoYXMgcHJvbXB0ZWQg | |
| dGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNhdCA+VVUvdXNldGhyZWFkcy5j | |
| YnUgPDwnRU9DQlUnCmNhc2UgIiR1c2V0aHJlYWRzIiBpbgogICAgJGRlZmluZXx0cnVlfFt5WV0q | |
| KQoJaWYgWyAiJHh4T3NSZXZNYWpvciIgLWx0IDEwIF07IHRoZW4KCSAgICBjYXQgPDxFT00gPiY0 | |
| CgpIUC1VWCAkeHhPc1Jldk1ham9yIGNhbm5vdCBzdXBwb3J0IFBPU0lYIHRocmVhZHMuCkNvbnNp | |
| ZGVyIHVwZ3JhZGluZyB0byBhdCBsZWFzdCBIUC1VWCAxMS4KQ2Fubm90IGNvbnRpbnVlLCBhYm9y | |
| dGluZy4KRU9NCgkgICAgZXhpdCAxCgkgICAgZmkKCglpZiBbICIkeHhPc1Jldk1ham9yIiAtZXEg | |
| MTAgXTsgdGhlbgoJICAgICMgVW5kZXIgMTAuWCwgYSB0aHJlYWRlZCBwZXJsIGNhbiBiZSBidWls | |
| dAoJICAgIGlmIFsgLWYgL3Vzci9pbmNsdWRlL3B0aHJlYWQuaCBdOyB0aGVuCgkJaWYgWyAtZiAv | |
| dXNyL2xpYi9saWJjbWEuc2wgXTsgdGhlbgoJCSAgICAjIERDRSAoZnJvbSBDb3JlIE9TIENEKSBp | |
| cyBpbnN0YWxsZWQKCgkJICAgIyBDaGVjayBpZiBpdCBpcyBwcmlzdGluZSwgb3IgcGF0Y2hlZAoJ | |
| CSAgIGNtYXZzbj1gd2hhdCAvdXNyL2xpYi9saWJjbWEuc2wgMj4mMSB8IGdyZXAgMTk5NmAKCQkg | |
| ICBpZiBbICEgLXogIiRjbWF2c24iIF07IHRoZW4KCQkgICAgICAgY2F0IDw8RU9NID4mNAoHCioq | |
| KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioq | |
| KioqKioqKioqKioqKioqKgoKUGVybCB3aWxsIHN1cHBvcnQgdGhyZWFkaW5nIHRocm91Z2ggL3Vz | |
| ci9saWIvbGliY21hLnNsIGZyb20KdGhlIEhQIERDRSBwYWNrYWdlLCBidXQgdGhlIHZlcnNpb24g | |
| Zm91bmQgaXMgdG9vIG9sZCB0byBiZQpyZWxpYWJsZS4KCklmIHlvdSBhcmUgbm90IGRlcGVuZGlu | |
| ZyBvbiB0aGlzIHNwZWNpZmljIHZlcnNpb24gb2YgdGhlIGxpYnJhcnksCmNvbnNpZGVyIHRvIHVw | |
| Z3JhZGUgdXNpbmcgcGF0Y2ggUEhTU18yMzY3MiAocmVhZCBSRUFETUUuaHB1eCkKCioqKioqKioq | |
| KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioq | |
| KioqKioqKioqKgoKKHNsZWVwaW5nIGZvciAxMCBzZWNvbmRzLi4uKQpFT00KCQkgICAgICAgc2xl | |
| ZXAgMTAKCQkgICAgICAgZmkKCgkJICAgICMgSXQgbmVlZHMgIyBsaWJjbWEgYW5kIE9MRF9QVEhS | |
| RUFEU19BUEkuIEFsc28KCQkgICAgIyA8cHRocmVhZC5oPiBuZWVkcyB0byBiZSAjaW5jbHVkZWQg | |
| YmVmb3JlIGFueQoJCSAgICAjIG90aGVyIGluY2x1ZGVzIChpbiBwZXJsLmgpCgoJCSAgICAjIEhQ | |
| LVVYIDEwLlggdXNlcyB0aGUgb2xkIHB0aHJlYWRzIEFQSQoJCSAgICBkX29sZHB0aHJlYWRzPSIk | |
| ZGVmaW5lIgoKCQkgICAgIyBpbmNsdWRlIGxpYmNtYSBiZWZvcmUgYWxsIHRoZSBvdGhlcnMKCQkg | |
| ICAgbGlic3dhbnRlZD0iY21hICRsaWJzd2FudGVkIgoKCQkgICAgIyB0ZWxsIHBlcmwuaCB0byBp | |
| bmNsdWRlIDxwdGhyZWFkLmg+IGJlZm9yZSBvdGhlcgoJCSAgICAjIGluY2x1ZGUgZmlsZXMKCQkg | |
| ICAgY2NmbGFncz0iJGNjZmxhZ3MgLURQVEhSRUFEX0hfRklSU1QiCiMgRmlyc3QgY29sdW1uIG9u | |
| IHB1cnBvc2U6CiMgdGhpcyBpcyBub3QgYSBzdGFuZGFyZCBDb25maWd1cmUgdmFyaWFibGUKIyBi | |
| dXQgd2UgbmVlZCB0byBnZXQgdGhpcyBub3RpY2VkLgpwdGhyZWFkX2hfZmlyc3Q9IiRkZWZpbmUi | |
| CgoJCSAgICAjIEhQLVVYIDEwLlggc2VlbXMgdG8gaGF2ZSBubyBlYXN5CgkJICAgICMgd2F5IG9m | |
| IGRldGVjdGluZyB0aGVzZSAqdGltZV9yIHByb3Rvcy4KCQkgICAgZF9nbXRpbWVfcl9wcm90bz0n | |
| ZGVmaW5lJwoJCSAgICBnbXRpbWVfcl9wcm90bz0nUkVFTlRSQU5UX1BST1RPX0lfVFMnCgkJICAg | |
| IGRfbG9jYWx0aW1lX3JfcHJvdG89J2RlZmluZScKCQkgICAgbG9jYWx0aW1lX3JfcHJvdG89J1JF | |
| RU5UUkFOVF9QUk9UT19JX1RTJwoKCQkgICAgIyBBdm9pZCB0aGUgcG9pc29ub3VzIGNvbmZsaWN0 | |
| aW5nIChhbmQgaXJyZWxldmFudCkKCQkgICAgIyBwcm90b3R5cGVzIG9mIHNldGtleSAoKS4KCQkg | |
| ICAgaV9jcnlwdD0iJHVuZGVmIgoKCQkgICAgIyBDTUEgcmVkZWZpbmVzIHNlbGVjdCB0byBjbWFf | |
| c2VsZWN0LCBhbmQgY21hX3NlbGVjdAoJCSAgICAjIGV4cGVjdHMgaW50ICogaW5zdGVhZCBvZiBm | |
| ZF9zZXQgKiAoanVzdCBsaWtlIDkuWCkKCQkgICAgc2VsZWN0dHlwZT0naW50IConCgoJCWVsaWYg | |
| WyAtZiAvdXNyL2xpYi9saWJwdGhyZWFkLnNsIF07IHRoZW4KCQkgICAgIyBQVEggcGFja2FnZSBp | |
| cyBpbnN0YWxsZWQKCQkgICAgbGlic3dhbnRlZD0icHRocmVhZCAkbGlic3dhbnRlZCIKCQllbHNl | |
| CgkJICAgIGxpYnN3YW50ZWQ9Im5vX3RocmVhZHNfYXZhaWxhYmxlIgoJCSAgICBmaQoJICAgIGVs | |
| c2UKCQlsaWJzd2FudGVkPSJub190aHJlYWRzX2F2YWlsYWJsZSIKCQlmaQoKCSAgICBpZiBbICRs | |
| aWJzd2FudGVkID0gIm5vX3RocmVhZHNfYXZhaWxhYmxlIiBdOyB0aGVuCgkJY2F0IDw8RU9NID4m | |
| NAoKSW4gSFAtVVggMTAuWCBmb3IgUE9TSVggdGhyZWFkcyB5b3UgbmVlZCBib3RoIG9mIHRoZSBm | |
| aWxlcwovdXNyL2luY2x1ZGUvcHRocmVhZC5oIGFuZCBlaXRoZXIgL3Vzci9saWIvbGliY21hLnNs | |
| IG9yIC91c3IvbGliL2xpYnB0aHJlYWQuc2wuCkVpdGhlciB5b3UgbXVzdCB1cGdyYWRlIHRvIEhQ | |
| LVVYIDExIG9yIGluc3RhbGwgYSBwb3NpeCB0aHJlYWQgbGlicmFyeToKCiAgICBEQ0UtQ29yZVRv | |
| b2xzIGZyb20gSFAtVVggMTAuMjAgSGFyZHdhcmUgRXh0ZW5zaW9ucyAzLjAgQ0QgKEIzOTIwLTEz | |
| OTQxKQoKb3IKCiAgICBQVEggcGFja2FnZSBmcm9tIGUuZy4gaHR0cDovL2hwdXguY29ubmVjdC5v | |
| cmcudWsvaHBwZC9ocHV4L0dudS9wdGgtMi4wLjcvCgpDYW5ub3QgY29udGludWUsIGFib3J0aW5n | |
| LgpFT00KCQlleGl0IDEKCQlmaQoJZWxzZQoJICAgICMgMTIgbWF5IHdhbnQgdXBwaW5nIHRoZSBf | |
| UE9TSVhfQ19TT1VSQ0UgZGF0ZXN0YW1wLi4uCgkgICAgY2NmbGFncz0iIC1EX1BPU0lYX0NfU09V | |
| UkNFPTE5OTUwNkwgLURfUkVFTlRSQU5UICRjY2ZsYWdzIgoJICAgIHNldCBgZWNobyBYICIkbGli | |
| c3dhbnRlZCAifCBzZWQgLWUgJ3MvIGMgLyBwdGhyZWFkIGMgLydgCgkgICAgc2hpZnQKCSAgICBs | |
| aWJzd2FudGVkPSIkKiIKCgkgICAgIyBIUC1VWCAxMS5YIHNlZW1zIHRvIGhhdmUgbm8gZWFzeQoJ | |
| ICAgICMgd2F5IG9mIGRldGVjdGluZyB0aGVzZSAqdGltZV9yIHByb3Rvcy4KCSAgICBkX2dtdGlt | |
| ZV9yX3Byb3RvPSdkZWZpbmUnCgkgICAgZ210aW1lX3JfcHJvdG89J1JFRU5UUkFOVF9QUk9UT19T | |
| X1RTJwoJICAgIGRfbG9jYWx0aW1lX3JfcHJvdG89J2RlZmluZScKCSAgICBsb2NhbHRpbWVfcl9w | |
| cm90bz0nUkVFTlRSQU5UX1BST1RPX1NfVFMnCgkgICAgZmkKCTs7CiAgICBlc2FjCkVPQ0JVCgoj | |
| IFRoZXJlIHVzZWQgdG8gYmU6CiMgIFRoZSBteXN0ZXJpb3VzIGlvX3hzIG1lbW9yeSBjb3JydXB0 | |
| aW9uIGluIDExLjAwIDMyYml0IHNlZW1zIHRvIGdldAojICBmaXhlZCBieSBub3QgdXNpbmcgUGVy | |
| bCdzIG1hbGxvYy4gIEZsaXAgc2lkZSBpcyBwZXJmb3JtYW5jZSBsb3NzLgojICBTbyB3ZSB3YW50 | |
| IG15bWFsbG9jIGZvciBhbGwgc2l0dWF0aW9ucyBwb3NzaWJsZQojIFRoYXQgc2V0IHVzZW15bWFs | |
| bG9jIHRvICduJyBmb3IgdGhyZWFkZWQgYnVpbGRzIGFuZCBub24tZ2NjIDMyYml0CiMgIG5vbi1k | |
| ZWJ1Z2dpbmcgYnVpbGRzIGFuZCAneScgZm9yIGFsbCBvdGhlcnMKCnVzZW15bWFsbG9jPSduJwpj | |
| YXNlICIkdXNlcGVybGlvIiBpbgogICAgJHVuZGVmfGZhbHNlfFtuTl0qKSB1c2VteW1hbGxvYz0n | |
| eScgOzsKICAgIGVzYWMKCiMgbWFsbG9jIHdyYXAgd29ya3MKY2FzZSAiJHVzZW1hbGxvY3dyYXAi | |
| IGluCiAgICAnJykgdXNlbWFsbG9jd3JhcD0nZGVmaW5lJyA7OwogICAgZXNhYwoKIyBjdGltZV9y | |
| ICgpIGFuZCBhc2N0aW1lX3IgKCkgc2VlbSB0byBoYXZlIGlzc3VlcyBmb3IgdmVyc2lvbnMgYmVm | |
| b3JlCiMgSFAtVVggMTEKaWYgWyAkeHhPc1Jldk1ham9yIC1sdCAxMSBdOyB0aGVuCiAgICBkX2N0 | |
| aW1lX3I9IiR1bmRlZiIKICAgIGRfYXNjdGltZV9yPSIkdW5kZWYiCiAgICBmaQoKIyBmcGNsYXNz | |
| aWZ5ICgpIGlzIGEgbWFjcm8sIHRoZSBsaWJyYXJ5IGNhbGwgaXMgRnBjbGFzc2lmeQojIFNpbWls | |
| YXJseSB3aXRoIHRoZSBvdGhlcnMgYmVsb3cuCmRfZnBjbGFzc2lmeT0nZGVmaW5lJwpkX2lzbmFu | |
| PSdkZWZpbmUnCmRfaXNpbmY9J2RlZmluZScKZF9pc2Zpbml0ZT0nZGVmaW5lJwpkX3Vub3JkZXJl | |
| ZD0nZGVmaW5lJwojIE5leHQgb25lKHMpIG5lZWQgdGhlIGxlYWRpbmcgdGFiLiAgVGhlc2UgYXJl | |
| IHNwZWNpYWwgJ2hpbnQnIHN5bWJvbHMgdGhhdAojIGFyZSBub3QgdG8gYmUgcHJvcGFnYXRlZCB0 | |
| byBjb25maWcuc2gsIGFsbCByZWxhdGVkIHRvIHB0aHJlYWRzIGRyYWZ0IDQKIyBpbnRlcmZhY2Vz | |
| LgpjYXNlICIkZF9vbGRwdGhyZWFkcyIgaW4KICAgICcnfCR1bmRlZikKCWRfY3J5cHRfcl9wcm90 | |
| bz0ndW5kZWYnCglkX2dldGdyZW50X3JfcHJvdG89J3VuZGVmJwoJZF9nZXRwd2VudF9yX3Byb3Rv | |
| PSd1bmRlZicKCWRfc3RyZXJyb3Jfcl9wcm90bz0ndW5kZWYnCgk7OwogICAgZXNhYwo=', | |
| ); | |
| my %files = ( | |
| 'freebsd' => 'freebsd.sh', | |
| 'netbsd' => 'netbsd.sh', | |
| 'openbsd' => 'openbsd.sh', | |
| 'linux' => 'linux.sh', | |
| 'dragonfly' => 'dragonfly.sh', | |
| 'darwin' => 'darwin.sh', | |
| 'hpux' => 'hpux.sh', | |
| ); | |
| sub hint_file { | |
| my $os = shift; | |
| $os = shift if eval { $os->isa(__PACKAGE__) }; | |
| $os = $^O unless $os; | |
| return unless defined $hints{ $os }; | |
| my $content = decode_base64( $hints{ $os } ); | |
| return $content unless wantarray; | |
| return ( $files{ $os }, $content ); | |
| } | |
| qq'nudge nudge wink wink'; | |
| __END__ | |
| =pod | |
| =head1 NAME | |
| Devel::PatchPerl::Hints - replacement 'hints' files | |
| =head1 VERSION | |
| version 0.52 | |
| =head1 SYNOPSIS | |
| use Devel::PatchPerl::Hints; | |
| if ( my $content = Devel::PatchPerl::Hints->hint_file() ) { | |
| chmod 0644, 'hints/netbsd.sh' or die "$!"; | |
| open my $hints, '>', 'hints/netbsd.sh' or die "$!"; | |
| print $hints $content; | |
| close $hints; | |
| } | |
| =head1 DESCRIPTION | |
| Sometimes there is a problem with Perls C<hints> file for a particular | |
| perl port. This module provides fixed C<hints> files encoded using | |
| C<MIME::Base64>. | |
| =head1 FUNCTION | |
| The function is exported, but has to implicitly imported into the | |
| requesting package. | |
| use Devel::PatchPerl::Hints qw[hint_file]; | |
| It may also be called as a class method: | |
| use Devel::PatchPerl::Hints; | |
| my $content = Devel::PatchPerl::Hints->hint_file(); | |
| =over | |
| =item C<hint_file> | |
| Takes an optional argument which is the OS name ( as would be returned by C<$^O> ). | |
| By default it will use C<$^O>. | |
| In a scalar context, Will return the decoded content of the C<hints> file suitable for writing straight to a | |
| file handle or undef list if there isn't an applicable C<hints> file for the given or derived | |
| OS. | |
| If called in a list context, will return a list, the first item will be the name of the C<hints> file that | |
| will need to be amended, the second item will be a string with the decoded content of the C<hints> file suitable | |
| for writing straight to a file handle. Otherwise an empty list will be returned. | |
| =back | |
| =head1 AUTHOR | |
| Chris Williams <[email protected]> | |
| =head1 COPYRIGHT AND LICENSE | |
| This software is copyright (c) 2011 by Chris Williams and Marcus Holland-Moritz. | |
| This is free software; you can redistribute it and/or modify it under | |
| the same terms as the Perl 5 programming language system itself. | |
| =cut | |
| DEVEL_PATCHPERL_HINTS | |
| $fatpacked{"ExtUtils/Command/MM.pm"} = <<'EXTUTILS_COMMAND_MM'; | |
| package ExtUtils::Command::MM; | |
| require 5.006; | |
| use strict; | |
| use warnings; | |
| require Exporter; | |
| our @ISA = qw(Exporter); | |
| our @EXPORT = qw(test_harness pod2man perllocal_install uninstall | |
| warn_if_old_packlist); | |
| our $VERSION = '6.59'; | |
| my $Is_VMS = $^O eq 'VMS'; | |
| =head1 NAME | |
| ExtUtils::Command::MM - Commands for the MM's to use in Makefiles | |
| =head1 SYNOPSIS | |
| perl "-MExtUtils::Command::MM" -e "function" "--" arguments... | |
| =head1 DESCRIPTION | |
| B<FOR INTERNAL USE ONLY!> The interface is not stable. | |
| ExtUtils::Command::MM encapsulates code which would otherwise have to | |
| be done with large "one" liners. | |
| Any $(FOO) used in the examples are make variables, not Perl. | |
| =over 4 | |
| =item B<test_harness> | |
| test_harness($verbose, @test_libs); | |
| Runs the tests on @ARGV via Test::Harness passing through the $verbose | |
| flag. Any @test_libs will be unshifted onto the test's @INC. | |
| @test_libs are run in alphabetical order. | |
| =cut | |
| sub test_harness { | |
| require Test::Harness; | |
| require File::Spec; | |
| $Test::Harness::verbose = shift; | |
| # Because Windows doesn't do this for us and listing all the *.t files | |
| # out on the command line can blow over its exec limit. | |
| require ExtUtils::Command; | |
| my @argv = ExtUtils::Command::expand_wildcards(@ARGV); | |
| local @INC = @INC; | |
| unshift @INC, map { File::Spec->rel2abs($_) } @_; | |
| Test::Harness::runtests(sort { lc $a cmp lc $b } @argv); | |
| } | |
| =item B<pod2man> | |
| pod2man( '--option=value', | |
| $podfile1 => $manpage1, | |
| $podfile2 => $manpage2, | |
| ... | |
| ); | |
| # or args on @ARGV | |
| pod2man() is a function performing most of the duties of the pod2man | |
| program. Its arguments are exactly the same as pod2man as of 5.8.0 | |
| with the addition of: | |
| --perm_rw octal permission to set the resulting manpage to | |
| And the removal of: | |
| --verbose/-v | |
| --help/-h | |
| If no arguments are given to pod2man it will read from @ARGV. | |
| If Pod::Man is unavailable, this function will warn and return undef. | |
| =cut | |
| sub pod2man { | |
| local @ARGV = @_ ? @_ : @ARGV; | |
| { | |
| local $@; | |
| if( !eval { require Pod::Man } ) { | |
| warn "Pod::Man is not available: $@". | |
| "Man pages will not be generated during this install.\n"; | |
| return undef; | |
| } | |
| } | |
| require Getopt::Long; | |
| # We will cheat and just use Getopt::Long. We fool it by putting | |
| # our arguments into @ARGV. Should be safe. | |
| my %options = (); | |
| Getopt::Long::config ('bundling_override'); | |
| Getopt::Long::GetOptions (\%options, | |
| 'section|s=s', 'release|r=s', 'center|c=s', | |
| 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s', | |
| 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l', | |
| 'name|n=s', 'perm_rw=i' | |
| ); | |
| # If there's no files, don't bother going further. | |
| return 0 unless @ARGV; | |
| # Official sets --center, but don't override things explicitly set. | |
| if ($options{official} && !defined $options{center}) { | |
| $options{center} = q[Perl Programmer's Reference Guide]; | |
| } | |
| # This isn't a valid Pod::Man option and is only accepted for backwards | |
| # compatibility. | |
| delete $options{lax}; | |
| do {{ # so 'next' works | |
| my ($pod, $man) = splice(@ARGV, 0, 2); | |
| next if ((-e $man) && | |
| (-M $man < -M $pod) && | |
| (-M $man < -M "Makefile")); | |
| print "Manifying $man\n"; | |
| my $parser = Pod::Man->new(%options); | |
| $parser->parse_from_file($pod, $man) | |
| or do { warn("Could not install $man\n"); next }; | |
| if (exists $options{perm_rw}) { | |
| chmod(oct($options{perm_rw}), $man) | |
| or do { warn("chmod $options{perm_rw} $man: $!\n"); next }; | |
| } | |
| }} while @ARGV; | |
| return 1; | |
| } | |
| =item B<warn_if_old_packlist> | |
| perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile> | |
| Displays a warning that an old packlist file was found. Reads the | |
| filename from @ARGV. | |
| =cut | |
| sub warn_if_old_packlist { | |
| my $packlist = $ARGV[0]; | |
| return unless -f $packlist; | |
| print <<"PACKLIST_WARNING"; | |
| WARNING: I have found an old package in | |
| $packlist. | |
| Please make sure the two installations are not conflicting | |
| PACKLIST_WARNING | |
| } | |
| =item B<perllocal_install> | |
| perl "-MExtUtils::Command::MM" -e perllocal_install | |
| <type> <module name> <key> <value> ... | |
| # VMS only, key|value pairs come on STDIN | |
| perl "-MExtUtils::Command::MM" -e perllocal_install | |
| <type> <module name> < <key>|<value> ... | |
| Prints a fragment of POD suitable for appending to perllocal.pod. | |
| Arguments are read from @ARGV. | |
| 'type' is the type of what you're installing. Usually 'Module'. | |
| 'module name' is simply the name of your module. (Foo::Bar) | |
| Key/value pairs are extra information about the module. Fields include: | |
| installed into which directory your module was out into | |
| LINKTYPE dynamic or static linking | |
| VERSION module version number | |
| EXE_FILES any executables installed in a space seperated | |
| list | |
| =cut | |
| sub perllocal_install { | |
| my($type, $name) = splice(@ARGV, 0, 2); | |
| # VMS feeds args as a piped file on STDIN since it usually can't | |
| # fit all the args on a single command line. | |
| my @mod_info = $Is_VMS ? split /\|/, <STDIN> | |
| : @ARGV; | |
| my $pod; | |
| $pod = sprintf <<POD, scalar localtime; | |
| =head2 %s: C<$type> L<$name|$name> | |
| =over 4 | |
| POD | |
| do { | |
| my($key, $val) = splice(@mod_info, 0, 2); | |
| $pod .= <<POD | |
| =item * | |
| C<$key: $val> | |
| POD | |
| } while(@mod_info); | |
| $pod .= "=back\n\n"; | |
| $pod =~ s/^ //mg; | |
| print $pod; | |
| return 1; | |
| } | |
| =item B<uninstall> | |
| perl "-MExtUtils::Command::MM" -e uninstall <packlist> | |
| A wrapper around ExtUtils::Install::uninstall(). Warns that | |
| uninstallation is deprecated and doesn't actually perform the | |
| uninstallation. | |
| =cut | |
| sub uninstall { | |
| my($packlist) = shift @ARGV; | |
| require ExtUtils::Install; | |
| print <<'WARNING'; | |
| Uninstall is unsafe and deprecated, the uninstallation was not performed. | |
| We will show what would have been done. | |
| WARNING | |
| ExtUtils::Install::uninstall($packlist, 1, 1); | |
| print <<'WARNING'; | |
| Uninstall is unsafe and deprecated, the uninstallation was not performed. | |
| Please check the list above carefully, there may be errors. | |
| Remove the appropriate files manually. | |
| Sorry for the inconvenience. | |
| WARNING | |
| } | |
| =back | |
| =cut | |
| 1; | |
| EXTUTILS_COMMAND_MM | |
| $fatpacked{"ExtUtils/Liblist.pm"} = <<'EXTUTILS_LIBLIST'; | |
| package ExtUtils::Liblist; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| use File::Spec; | |
| require ExtUtils::Liblist::Kid; | |
| our @ISA = qw(ExtUtils::Liblist::Kid File::Spec); | |
| # Backwards compatibility with old interface. | |
| sub ext { | |
| goto &ExtUtils::Liblist::Kid::ext; | |
| } | |
| sub lsdir { | |
| shift; | |
| my $rex = qr/$_[1]/; | |
| opendir DIR, $_[0]; | |
| my @out = grep /$rex/, readdir DIR; | |
| closedir DIR; | |
| return @out; | |
| } | |
| __END__ | |
| =head1 NAME | |
| ExtUtils::Liblist - determine libraries to use and how to use them | |
| =head1 SYNOPSIS | |
| require ExtUtils::Liblist; | |
| $MM->ext($potential_libs, $verbose, $need_names); | |
| # Usually you can get away with: | |
| ExtUtils::Liblist->ext($potential_libs, $verbose, $need_names) | |
| =head1 DESCRIPTION | |
| This utility takes a list of libraries in the form C<-llib1 -llib2 | |
| -llib3> and returns lines suitable for inclusion in an extension | |
| Makefile. Extra library paths may be included with the form | |
| C<-L/another/path> this will affect the searches for all subsequent | |
| libraries. | |
| It returns an array of four or five scalar values: EXTRALIBS, | |
| BSLOADLIBS, LDLOADLIBS, LD_RUN_PATH, and, optionally, a reference to | |
| the array of the filenames of actual libraries. Some of these don't | |
| mean anything unless on Unix. See the details about those platform | |
| specifics below. The list of the filenames is returned only if | |
| $need_names argument is true. | |
| Dependent libraries can be linked in one of three ways: | |
| =over 2 | |
| =item * For static extensions | |
| by the ld command when the perl binary is linked with the extension | |
| library. See EXTRALIBS below. | |
| =item * For dynamic extensions at build/link time | |
| by the ld command when the shared object is built/linked. See | |
| LDLOADLIBS below. | |
| =item * For dynamic extensions at load time | |
| by the DynaLoader when the shared object is loaded. See BSLOADLIBS | |
| below. | |
| =back | |
| =head2 EXTRALIBS | |
| List of libraries that need to be linked with when linking a perl | |
| binary which includes this extension. Only those libraries that | |
| actually exist are included. These are written to a file and used | |
| when linking perl. | |
| =head2 LDLOADLIBS and LD_RUN_PATH | |
| List of those libraries which can or must be linked into the shared | |
| library when created using ld. These may be static or dynamic | |
| libraries. LD_RUN_PATH is a colon separated list of the directories | |
| in LDLOADLIBS. It is passed as an environment variable to the process | |
| that links the shared library. | |
| =head2 BSLOADLIBS | |
| List of those libraries that are needed but can be linked in | |
| dynamically at run time on this platform. SunOS/Solaris does not need | |
| this because ld records the information (from LDLOADLIBS) into the | |
| object file. This list is used to create a .bs (bootstrap) file. | |
| =head1 PORTABILITY | |
| This module deals with a lot of system dependencies and has quite a | |
| few architecture specific C<if>s in the code. | |
| =head2 VMS implementation | |
| The version of ext() which is executed under VMS differs from the | |
| Unix-OS/2 version in several respects: | |
| =over 2 | |
| =item * | |
| Input library and path specifications are accepted with or without the | |
| C<-l> and C<-L> prefixes used by Unix linkers. If neither prefix is | |
| present, a token is considered a directory to search if it is in fact | |
| a directory, and a library to search for otherwise. Authors who wish | |
| their extensions to be portable to Unix or OS/2 should use the Unix | |
| prefixes, since the Unix-OS/2 version of ext() requires them. | |
| =item * | |
| Wherever possible, shareable images are preferred to object libraries, | |
| and object libraries to plain object files. In accordance with VMS | |
| naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl; | |
| it also looks for I<lib>lib and libI<lib> to accommodate Unix conventions | |
| used in some ported software. | |
| =item * | |
| For each library that is found, an appropriate directive for a linker options | |
| file is generated. The return values are space-separated strings of | |
| these directives, rather than elements used on the linker command line. | |
| =item * | |
| LDLOADLIBS contains both the libraries found based on C<$potential_libs> and | |
| the CRTLs, if any, specified in Config.pm. EXTRALIBS contains just those | |
| libraries found based on C<$potential_libs>. BSLOADLIBS and LD_RUN_PATH | |
| are always empty. | |
| =back | |
| In addition, an attempt is made to recognize several common Unix library | |
| names, and filter them out or convert them to their VMS equivalents, as | |
| appropriate. | |
| In general, the VMS version of ext() should properly handle input from | |
| extensions originally designed for a Unix or VMS environment. If you | |
| encounter problems, or discover cases where the search could be improved, | |
| please let us know. | |
| =head2 Win32 implementation | |
| The version of ext() which is executed under Win32 differs from the | |
| Unix-OS/2 version in several respects: | |
| =over 2 | |
| =item * | |
| If C<$potential_libs> is empty, the return value will be empty. | |
| Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) | |
| will be appended to the list of C<$potential_libs>. The libraries | |
| will be searched for in the directories specified in C<$potential_libs>, | |
| C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. | |
| For each library that is found, a space-separated list of fully qualified | |
| library pathnames is generated. | |
| =item * | |
| Input library and path specifications are accepted with or without the | |
| C<-l> and C<-L> prefixes used by Unix linkers. | |
| An entry of the form C<-La:\foo> specifies the C<a:\foo> directory to look | |
| for the libraries that follow. | |
| An entry of the form C<-lfoo> specifies the library C<foo>, which may be | |
| spelled differently depending on what kind of compiler you are using. If | |
| you are using GCC, it gets translated to C<libfoo.a>, but for other win32 | |
| compilers, it becomes C<foo.lib>. If no files are found by those translated | |
| names, one more attempt is made to find them using either C<foo.a> or | |
| C<libfoo.lib>, depending on whether GCC or some other win32 compiler is | |
| being used, respectively. | |
| If neither the C<-L> or C<-l> prefix is present in an entry, the entry is | |
| considered a directory to search if it is in fact a directory, and a | |
| library to search for otherwise. The C<$Config{lib_ext}> suffix will | |
| be appended to any entries that are not directories and don't already have | |
| the suffix. | |
| Note that the C<-L> and C<-l> prefixes are B<not required>, but authors | |
| who wish their extensions to be portable to Unix or OS/2 should use the | |
| prefixes, since the Unix-OS/2 version of ext() requires them. | |
| =item * | |
| Entries cannot be plain object files, as many Win32 compilers will | |
| not handle object files in the place of libraries. | |
| =item * | |
| Entries in C<$potential_libs> beginning with a colon and followed by | |
| alphanumeric characters are treated as flags. Unknown flags will be ignored. | |
| An entry that matches C</:nodefault/i> disables the appending of default | |
| libraries found in C<$Config{perllibs}> (this should be only needed very rarely). | |
| An entry that matches C</:nosearch/i> disables all searching for | |
| the libraries specified after it. Translation of C<-Lfoo> and | |
| C<-lfoo> still happens as appropriate (depending on compiler being used, | |
| as reflected by C<$Config{cc}>), but the entries are not verified to be | |
| valid files or directories. | |
| An entry that matches C</:search/i> reenables searching for | |
| the libraries specified after it. You can put it at the end to | |
| enable searching for default libraries specified by C<$Config{perllibs}>. | |
| =item * | |
| The libraries specified may be a mixture of static libraries and | |
| import libraries (to link with DLLs). Since both kinds are used | |
| pretty transparently on the Win32 platform, we do not attempt to | |
| distinguish between them. | |
| =item * | |
| LDLOADLIBS and EXTRALIBS are always identical under Win32, and BSLOADLIBS | |
| and LD_RUN_PATH are always empty (this may change in future). | |
| =item * | |
| You must make sure that any paths and path components are properly | |
| surrounded with double-quotes if they contain spaces. For example, | |
| C<$potential_libs> could be (literally): | |
| "-Lc:\Program Files\vc\lib" msvcrt.lib "la test\foo bar.lib" | |
| Note how the first and last entries are protected by quotes in order | |
| to protect the spaces. | |
| =item * | |
| Since this module is most often used only indirectly from extension | |
| C<Makefile.PL> files, here is an example C<Makefile.PL> entry to add | |
| a library to the build process for an extension: | |
| LIBS => ['-lgl'] | |
| When using GCC, that entry specifies that MakeMaker should first look | |
| for C<libgl.a> (followed by C<gl.a>) in all the locations specified by | |
| C<$Config{libpth}>. | |
| When using a compiler other than GCC, the above entry will search for | |
| C<gl.lib> (followed by C<libgl.lib>). | |
| If the library happens to be in a location not in C<$Config{libpth}>, | |
| you need: | |
| LIBS => ['-Lc:\gllibs -lgl'] | |
| Here is a less often used example: | |
| LIBS => ['-lgl', ':nosearch -Ld:\mesalibs -lmesa -luser32'] | |
| This specifies a search for library C<gl> as before. If that search | |
| fails to find the library, it looks at the next item in the list. The | |
| C<:nosearch> flag will prevent searching for the libraries that follow, | |
| so it simply returns the value as C<-Ld:\mesalibs -lmesa -luser32>, | |
| since GCC can use that value as is with its linker. | |
| When using the Visual C compiler, the second item is returned as | |
| C<-libpath:d:\mesalibs mesa.lib user32.lib>. | |
| When using the Borland compiler, the second item is returned as | |
| C<-Ld:\mesalibs mesa.lib user32.lib>, and MakeMaker takes care of | |
| moving the C<-Ld:\mesalibs> to the correct place in the linker | |
| command line. | |
| =back | |
| =head1 SEE ALSO | |
| L<ExtUtils::MakeMaker> | |
| =cut | |
| EXTUTILS_LIBLIST | |
| $fatpacked{"ExtUtils/Liblist/Kid.pm"} = <<'EXTUTILS_LIBLIST_KID'; | |
| package ExtUtils::Liblist::Kid; | |
| # XXX Splitting this out into its own .pm is a temporary solution. | |
| # This kid package is to be used by MakeMaker. It will not work if | |
| # $self is not a Makemaker. | |
| use 5.006; | |
| # Broken out of MakeMaker from version 4.11 | |
| use strict; | |
| use warnings; | |
| our $VERSION = '6.59'; | |
| use ExtUtils::MakeMaker::Config; | |
| use Cwd 'cwd'; | |
| use File::Basename; | |
| use File::Spec; | |
| sub ext { | |
| if ( $^O eq 'VMS' ) { return &_vms_ext; } | |
| elsif ( $^O eq 'MSWin32' ) { return &_win32_ext; } | |
| else { return &_unix_os2_ext; } | |
| } | |
| sub _unix_os2_ext { | |
| my ( $self, $potential_libs, $verbose, $give_libs ) = @_; | |
| $verbose ||= 0; | |
| if ( $^O =~ 'os2' and $Config{perllibs} ) { | |
| # Dynamic libraries are not transitive, so we may need including | |
| # the libraries linked against perl.dll again. | |
| $potential_libs .= " " if $potential_libs; | |
| $potential_libs .= $Config{perllibs}; | |
| } | |
| return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs; | |
| warn "Potential libraries are '$potential_libs':\n" if $verbose; | |
| my ( $so ) = $Config{so}; | |
| my ( $libs ) = defined $Config{perllibs} ? $Config{perllibs} : $Config{libs}; | |
| my $Config_libext = $Config{lib_ext} || ".a"; | |
| my $Config_dlext = $Config{dlext}; | |
| # compute $extralibs, $bsloadlibs and $ldloadlibs from | |
| # $potential_libs | |
| # this is a rewrite of Andy Dougherty's extliblist in perl | |
| my ( @searchpath ); # from "-L/path" entries in $potential_libs | |
| my ( @libpath ) = split " ", $Config{'libpth'}; | |
| my ( @ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen ); | |
| my ( @libs, %libs_seen ); | |
| my ( $fullname, @fullname ); | |
| my ( $pwd ) = cwd(); # from Cwd.pm | |
| my ( $found ) = 0; | |
| foreach my $thislib ( split ' ', $potential_libs ) { | |
| # Handle possible linker path arguments. | |
| if ( $thislib =~ s/^(-[LR]|-Wl,-R)// ) { # save path flag type | |
| my ( $ptype ) = $1; | |
| unless ( -d $thislib ) { | |
| warn "$ptype$thislib ignored, directory does not exist\n" | |
| if $verbose; | |
| next; | |
| } | |
| my ( $rtype ) = $ptype; | |
| if ( ( $ptype eq '-R' ) or ( $ptype eq '-Wl,-R' ) ) { | |
| if ( $Config{'lddlflags'} =~ /-Wl,-R/ ) { | |
| $rtype = '-Wl,-R'; | |
| } | |
| elsif ( $Config{'lddlflags'} =~ /-R/ ) { | |
| $rtype = '-R'; | |
| } | |
| } | |
| unless ( File::Spec->file_name_is_absolute( $thislib ) ) { | |
| warn "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n"; | |
| $thislib = $self->catdir( $pwd, $thislib ); | |
| } | |
| push( @searchpath, $thislib ); | |
| push( @extralibs, "$ptype$thislib" ); | |
| push( @ldloadlibs, "$rtype$thislib" ); | |
| next; | |
| } | |
| # Handle possible library arguments. | |
| unless ( $thislib =~ s/^-l// ) { | |
| warn "Unrecognized argument in LIBS ignored: '$thislib'\n"; | |
| next; | |
| } | |
| my ( $found_lib ) = 0; | |
| foreach my $thispth ( @searchpath, @libpath ) { | |
| # Try to find the full name of the library. We need this to | |
| # determine whether it's a dynamically-loadable library or not. | |
| # This tends to be subject to various os-specific quirks. | |
| # For gcc-2.6.2 on linux (March 1995), DLD can not load | |
| # .sa libraries, with the exception of libm.sa, so we | |
| # deliberately skip them. | |
| if ( @fullname = $self->lsdir( $thispth, "^\Qlib$thislib.$so.\E[0-9]+" ) ) { | |
| # Take care that libfoo.so.10 wins against libfoo.so.9. | |
| # Compare two libraries to find the most recent version | |
| # number. E.g. if you have libfoo.so.9.0.7 and | |
| # libfoo.so.10.1, first convert all digits into two | |
| # decimal places. Then we'll add ".00" to the shorter | |
| # strings so that we're comparing strings of equal length | |
| # Thus we'll compare libfoo.so.09.07.00 with | |
| # libfoo.so.10.01.00. Some libraries might have letters | |
| # in the version. We don't know what they mean, but will | |
| # try to skip them gracefully -- we'll set any letter to | |
| # '0'. Finally, sort in reverse so we can take the | |
| # first element. | |
| #TODO: iterate through the directory instead of sorting | |
| $fullname = "$thispth/" . ( | |
| sort { | |
| my ( $ma ) = $a; | |
| my ( $mb ) = $b; | |
| $ma =~ tr/A-Za-z/0/s; | |
| $ma =~ s/\b(\d)\b/0$1/g; | |
| $mb =~ tr/A-Za-z/0/s; | |
| $mb =~ s/\b(\d)\b/0$1/g; | |
| while ( length( $ma ) < length( $mb ) ) { $ma .= ".00"; } | |
| while ( length( $mb ) < length( $ma ) ) { $mb .= ".00"; } | |
| # Comparison deliberately backwards | |
| $mb cmp $ma; | |
| } @fullname | |
| )[0]; | |
| } | |
| elsif ( -f ( $fullname = "$thispth/lib$thislib.$so" ) | |
| && ( ( $Config{'dlsrc'} ne "dl_dld.xs" ) || ( $thislib eq "m" ) ) ) | |
| { | |
| } | |
| elsif (-f ( $fullname = "$thispth/lib${thislib}_s$Config_libext" ) | |
| && ( $Config{'archname'} !~ /RM\d\d\d-svr4/ ) | |
| && ( $thislib .= "_s" ) ) | |
| { # we must explicitly use _s version | |
| } | |
| elsif ( -f ( $fullname = "$thispth/lib$thislib$Config_libext" ) ) { | |
| } | |
| elsif ( defined( $Config_dlext ) | |
| && -f ( $fullname = "$thispth/lib$thislib.$Config_dlext" ) ) | |
| { | |
| } | |
| elsif ( -f ( $fullname = "$thispth/$thislib$Config_libext" ) ) { | |
| } | |
| elsif ( -f ( $fullname = "$thispth/lib$thislib.dll$Config_libext" ) ) { | |
| } | |
| elsif ( -f ( $fullname = "$thispth/Slib$thislib$Config_libext" ) ) { | |
| } | |
| elsif ($^O eq 'dgux' | |
| && -l ( $fullname = "$thispth/lib$thislib$Config_libext" ) | |
| && readlink( $fullname ) =~ /^elink:/s ) | |
| { | |
| # Some of DG's libraries look like misconnected symbolic | |
| # links, but development tools can follow them. (They | |
| # look like this: | |
| # | |
| # libm.a -> elink:${SDE_PATH:-/usr}/sde/\ | |
| # ${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib/libm.a | |
| # | |
| # , the compilation tools expand the environment variables.) | |
| } | |
| else { | |
| warn "$thislib not found in $thispth\n" if $verbose; | |
| next; | |
| } | |
| warn "'-l$thislib' found at $fullname\n" if $verbose; | |
| push @libs, $fullname unless $libs_seen{$fullname}++; | |
| $found++; | |
| $found_lib++; | |
| # Now update library lists | |
| # what do we know about this library... | |
| my $is_dyna = ( $fullname !~ /\Q$Config_libext\E\z/ ); | |
| my $in_perl = ( $libs =~ /\B-l\Q${thislib}\E\b/s ); | |
| # include the path to the lib once in the dynamic linker path | |
| # but only if it is a dynamic lib and not in Perl itself | |
| my ( $fullnamedir ) = dirname( $fullname ); | |
| push @ld_run_path, $fullnamedir | |
| if $is_dyna | |
| && !$in_perl | |
| && !$ld_run_path_seen{$fullnamedir}++; | |
| # Do not add it into the list if it is already linked in | |
| # with the main perl executable. | |
| # We have to special-case the NeXT, because math and ndbm | |
| # are both in libsys_s | |
| unless ( | |
| $in_perl | |
| || ( $Config{'osname'} eq 'next' | |
| && ( $thislib eq 'm' || $thislib eq 'ndbm' ) ) | |
| ) | |
| { | |
| push( @extralibs, "-l$thislib" ); | |
| } | |
| # We might be able to load this archive file dynamically | |
| if ( ( $Config{'dlsrc'} =~ /dl_next/ && $Config{'osvers'} lt '4_0' ) | |
| || ( $Config{'dlsrc'} =~ /dl_dld/ ) ) | |
| { | |
| # We push -l$thislib instead of $fullname because | |
| # it avoids hardwiring a fixed path into the .bs file. | |
| # Mkbootstrap will automatically add dl_findfile() to | |
| # the .bs file if it sees a name in the -l format. | |
| # USE THIS, when dl_findfile() is fixed: | |
| # push(@bsloadlibs, "-l$thislib"); | |
| # OLD USE WAS while checking results against old_extliblist | |
| push( @bsloadlibs, "$fullname" ); | |
| } | |
| else { | |
| if ( $is_dyna ) { | |
| # For SunOS4, do not add in this shared library if | |
| # it is already linked in the main perl executable | |
| push( @ldloadlibs, "-l$thislib" ) | |
| unless ( $in_perl and $^O eq 'sunos' ); | |
| } | |
| else { | |
| push( @ldloadlibs, "-l$thislib" ); | |
| } | |
| } | |
| last; # found one here so don't bother looking further | |
| } | |
| warn "Note (probably harmless): " . "No library found for -l$thislib\n" | |
| unless $found_lib > 0; | |
| } | |
| unless ( $found ) { | |
| return ( '', '', '', '', ( $give_libs ? \@libs : () ) ); | |
| } | |
| else { | |
| return ( "@extralibs", "@bsloadlibs", "@ldloadlibs", join( ":", @ld_run_path ), ( $give_libs ? \@libs : () ) ); | |
| } | |
| } | |
| sub _win32_ext { | |
| require Text::ParseWords; | |
| my ( $self, $potential_libs, $verbose, $give_libs ) = @_; | |
| $verbose ||= 0; | |
| # If user did not supply a list, we punt. | |
| # (caller should probably use the list in $Config{libs}) | |
| return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs; | |
| # TODO: make this use MM_Win32.pm's compiler detection | |
| my %libs_seen; | |
| my @extralibs; | |
| my $cc = $Config{cc} || ''; | |
| my $VC = $cc =~ /\bcl\b/i; | |
| my $GC = $cc =~ /\bgcc\b/i; | |
| my $libext = _win32_lib_extensions(); | |
| my @searchpath = ( '' ); # from "-L/path" entries in $potential_libs | |
| my @libpath = _win32_default_search_paths( $VC ); | |
| my $pwd = cwd(); # from Cwd.pm | |
| my $search = 1; | |
| # compute @extralibs from $potential_libs | |
| my @lib_search_list = _win32_make_lib_search_list( $potential_libs, $verbose ); | |
| for ( @lib_search_list ) { | |
| my $thislib = $_; | |
| # see if entry is a flag | |
| if ( /^:\w+$/ ) { | |
| $search = 0 if lc eq ':nosearch'; | |
| $search = 1 if lc eq ':search'; | |
| _debug( "Ignoring unknown flag '$thislib'\n", $verbose ) if !/^:(no)?(search|default)$/i; | |
| next; | |
| } | |
| # if searching is disabled, do compiler-specific translations | |
| unless ( $search ) { | |
| s/^-l(.+)$/$1.lib/ unless $GC; | |
| s/^-L/-libpath:/ if $VC; | |
| push( @extralibs, $_ ); | |
| next; | |
| } | |
| # handle possible linker path arguments | |
| if ( s/^-L// and not -d ) { | |
| _debug( "$thislib ignored, directory does not exist\n", $verbose ); | |
| next; | |
| } | |
| elsif ( -d ) { | |
| unless ( File::Spec->file_name_is_absolute( $_ ) ) { | |
| warn "Warning: '$thislib' changed to '-L$pwd/$_'\n"; | |
| $_ = $self->catdir( $pwd, $_ ); | |
| } | |
| push( @searchpath, $_ ); | |
| next; | |
| } | |
| my @paths = ( @searchpath, @libpath ); | |
| my ( $fullname, $path ) = _win32_search_file( $thislib, $libext, \@paths, $verbose, $GC ); | |
| if ( !$fullname ) { | |
| warn "Note (probably harmless): No library found for $thislib\n"; | |
| next; | |
| } | |
| _debug( "'$thislib' found as '$fullname'\n", $verbose ); | |
| push( @extralibs, $fullname ); | |
| $libs_seen{$fullname} = 1 if $path; # why is this a special case? | |
| } | |
| my @libs = keys %libs_seen; | |
| return ( '', '', '', '', ( $give_libs ? \@libs : () ) ) unless @extralibs; | |
| # make sure paths with spaces are properly quoted | |
| @extralibs = map { /\s/ ? qq["$_"] : $_ } @extralibs; | |
| @libs = map { /\s/ ? qq["$_"] : $_ } @libs; | |
| my $lib = join( ' ', @extralibs ); | |
| # normalize back to backward slashes (to help braindead tools) | |
| # XXX this may break equally braindead GNU tools that don't understand | |
| # backslashes, either. Seems like one can't win here. Cursed be CP/M. | |
| $lib =~ s,/,\\,g; | |
| _debug( "Result: $lib\n", $verbose ); | |
| wantarray ? ( $lib, '', $lib, '', ( $give_libs ? \@libs : () ) ) : $lib; | |
| } | |
| sub _win32_make_lib_search_list { | |
| my ( $potential_libs, $verbose ) = @_; | |
| # If Config.pm defines a set of default libs, we always | |
| # tack them on to the user-supplied list, unless the user | |
| # specified :nodefault | |
| my $libs = $Config{'perllibs'}; | |
| $potential_libs = join( ' ', $potential_libs, $libs ) if $libs and $potential_libs !~ /:nodefault/i; | |
| _debug( "Potential libraries are '$potential_libs':\n", $verbose ); | |
| $potential_libs =~ s,\\,/,g; # normalize to forward slashes | |
| my @list = Text::ParseWords::quotewords( '\s+', 0, $potential_libs ); | |
| return @list; | |
| } | |
| sub _win32_default_search_paths { | |
| my ( $VC ) = @_; | |
| my $libpth = $Config{'libpth'} || ''; | |
| $libpth =~ s,\\,/,g; # normalize to forward slashes | |
| my @libpath = Text::ParseWords::quotewords( '\s+', 0, $libpth ); | |
| push @libpath, "$Config{installarchlib}/CORE"; # add "$Config{installarchlib}/CORE" to default search path | |
| if ( $VC and exists $ENV{LIB} and $ENV{LIB} ) { | |
| push @libpath, split /;/, $ENV{LIB}; | |
| } | |
| return @libpath; | |
| } | |
| sub _win32_search_file { | |
| my ( $thislib, $libext, $paths, $verbose, $GC ) = @_; | |
| my @file_list = _win32_build_file_list( $thislib, $GC, $libext ); | |
| for my $lib_file ( @file_list ) { | |
| for my $path ( @{$paths} ) { | |
| my $fullname = $lib_file; | |
| $fullname = "$path\\$fullname" if $path; | |
| return ( $fullname, $path ) if -f $fullname; | |
| _debug( "'$thislib' not found as '$fullname'\n", $verbose ); | |
| } | |
| } | |
| return; | |
| } | |
| sub _win32_build_file_list { | |
| my ( $lib, $GC, $extensions ) = @_; | |
| my @pre_fixed = _win32_build_prefixed_list( $lib, $GC ); | |
| return map _win32_attach_extensions( $_, $extensions ), @pre_fixed; | |
| } | |
| sub _win32_build_prefixed_list { | |
| my ( $lib, $GC ) = @_; | |
| return $lib if $lib !~ s/^-l//; | |
| return $lib if $lib =~ /^lib/ and !$GC; | |
| ( my $no_prefix = $lib ) =~ s/^lib//i; | |
| $lib = "lib$lib" if $no_prefix eq $lib; | |
| return ( $lib, $no_prefix ) if $GC; | |
| return ( $no_prefix, $lib ); | |
| } | |
| sub _win32_attach_extensions { | |
| my ( $lib, $extensions ) = @_; | |
| return map _win32_try_attach_extension( $lib, $_ ), @{$extensions}; | |
| } | |
| sub _win32_try_attach_extension { | |
| my ( $lib, $extension ) = @_; | |
| return $lib if $lib =~ /\Q$extension\E$/i; | |
| return "$lib$extension"; | |
| } | |
| sub _win32_lib_extensions { | |
| my %extensions; | |
| $extensions{ $Config{'lib_ext'} } = 1 if $Config{'lib_ext'}; | |
| $extensions{".lib"} = 1; | |
| return [ keys %extensions ]; | |
| } | |
| sub _debug { | |
| my ( $message, $verbose ) = @_; | |
| return if !$verbose; | |
| warn $message; | |
| return; | |
| } | |
| sub _vms_ext { | |
| my ( $self, $potential_libs, $verbose, $give_libs ) = @_; | |
| $verbose ||= 0; | |
| my ( @crtls, $crtlstr ); | |
| @crtls = ( ( $Config{'ldflags'} =~ m-/Debug-i ? $Config{'dbgprefix'} : '' ) . 'PerlShr/Share' ); | |
| push( @crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'} ); | |
| push( @crtls, grep { not /\(/ } split /\s+/, $Config{'libc'} ); | |
| # In general, we pass through the basic libraries from %Config unchanged. | |
| # The one exception is that if we're building in the Perl source tree, and | |
| # a library spec could be resolved via a logical name, we go to some trouble | |
| # to insure that the copy in the local tree is used, rather than one to | |
| # which a system-wide logical may point. | |
| if ( $self->{PERL_SRC} ) { | |
| my ( $locspec, $type ); | |
| foreach my $lib ( @crtls ) { | |
| if ( ( $locspec, $type ) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i ) { | |
| if ( lc $type eq '/share' ) { $locspec .= $Config{'exe_ext'}; } | |
| elsif ( lc $type eq '/library' ) { $locspec .= $Config{'lib_ext'}; } | |
| else { $locspec .= $Config{'obj_ext'}; } | |
| $locspec = $self->catfile( $self->{PERL_SRC}, $locspec ); | |
| $lib = "$locspec$type" if -e $locspec; | |
| } | |
| } | |
| } | |
| $crtlstr = @crtls ? join( ' ', @crtls ) : ''; | |
| unless ( $potential_libs ) { | |
| warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose; | |
| return ( '', '', $crtlstr, '', ( $give_libs ? [] : () ) ); | |
| } | |
| my ( %found, @fndlibs, $ldlib ); | |
| my $cwd = cwd(); | |
| my ( $so, $lib_ext, $obj_ext ) = @Config{ 'so', 'lib_ext', 'obj_ext' }; | |
| # List of common Unix library names and their VMS equivalents | |
| # (VMS equivalent of '' indicates that the library is automatically | |
| # searched by the linker, and should be skipped here.) | |
| my ( @flibs, %libs_seen ); | |
| my %libmap = ( | |
| 'm' => '', | |
| 'f77' => '', | |
| 'F77' => '', | |
| 'V77' => '', | |
| 'c' => '', | |
| 'malloc' => '', | |
| 'crypt' => '', | |
| 'resolv' => '', | |
| 'c_s' => '', | |
| 'socket' => '', | |
| 'X11' => 'DECW$XLIBSHR', | |
| 'Xt' => 'DECW$XTSHR', | |
| 'Xm' => 'DECW$XMLIBSHR', | |
| 'Xmu' => 'DECW$XMULIBSHR' | |
| ); | |
| if ( $Config{'vms_cc_type'} ne 'decc' ) { $libmap{'curses'} = 'VAXCCURSE'; } | |
| warn "Potential libraries are '$potential_libs'\n" if $verbose; | |
| # First, sort out directories and library names in the input | |
| my ( @dirs, @libs ); | |
| foreach my $lib ( split ' ', $potential_libs ) { | |
| push( @dirs, $1 ), next if $lib =~ /^-L(.*)/; | |
| push( @dirs, $lib ), next if $lib =~ /[:>\]]$/; | |
| push( @dirs, $lib ), next if -d $lib; | |
| push( @libs, $1 ), next if $lib =~ /^-l(.*)/; | |
| push( @libs, $lib ); | |
| } | |
| push( @dirs, split( ' ', $Config{'libpth'} ) ); | |
| # Now make sure we've got VMS-syntax absolute directory specs | |
| # (We don't, however, check whether someone's hidden a relative | |
| # path in a logical name.) | |
| foreach my $dir ( @dirs ) { | |
| unless ( -d $dir ) { | |
| warn "Skipping nonexistent Directory $dir\n" if $verbose > 1; | |
| $dir = ''; | |
| next; | |
| } | |
| warn "Resolving directory $dir\n" if $verbose; | |
| if ( File::Spec->file_name_is_absolute( $dir ) ) { | |
| $dir = $self->fixpath( $dir, 1 ); | |
| } | |
| else { | |
| $dir = $self->catdir( $cwd, $dir ); | |
| } | |
| } | |
| @dirs = grep { length( $_ ) } @dirs; | |
| unshift( @dirs, '' ); # Check each $lib without additions first | |
| LIB: foreach my $lib ( @libs ) { | |
| if ( exists $libmap{$lib} ) { | |
| next unless length $libmap{$lib}; | |
| $lib = $libmap{$lib}; | |
| } | |
| my ( @variants, $cand ); | |
| my ( $ctype ) = ''; | |
| # If we don't have a file type, consider it a possibly abbreviated name and | |
| # check for common variants. We try these first to grab libraries before | |
| # a like-named executable image (e.g. -lperl resolves to perlshr.exe | |
| # before perl.exe). | |
| if ( $lib !~ /\.[^:>\]]*$/ ) { | |
| push( @variants, "${lib}shr", "${lib}rtl", "${lib}lib" ); | |
| push( @variants, "lib$lib" ) if $lib !~ /[:>\]]/; | |
| } | |
| push( @variants, $lib ); | |
| warn "Looking for $lib\n" if $verbose; | |
| foreach my $variant ( @variants ) { | |
| my ( $fullname, $name ); | |
| foreach my $dir ( @dirs ) { | |
| my ( $type ); | |
| $name = "$dir$variant"; | |
| warn "\tChecking $name\n" if $verbose > 2; | |
| $fullname = VMS::Filespec::rmsexpand( $name ); | |
| if ( defined $fullname and -f $fullname ) { | |
| # It's got its own suffix, so we'll have to figure out the type | |
| if ( $fullname =~ /(?:$so|exe)$/i ) { $type = 'SHR'; } | |
| elsif ( $fullname =~ /(?:$lib_ext|olb)$/i ) { $type = 'OLB'; } | |
| elsif ( $fullname =~ /(?:$obj_ext|obj)$/i ) { | |
| warn "Note (probably harmless): " . "Plain object file $fullname found in library list\n"; | |
| $type = 'OBJ'; | |
| } | |
| else { | |
| warn "Note (probably harmless): " . "Unknown library type for $fullname; assuming shared\n"; | |
| $type = 'SHR'; | |
| } | |
| } | |
| elsif (-f ( $fullname = VMS::Filespec::rmsexpand( $name, $so ) ) | |
| or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.exe' ) ) ) | |
| { | |
| $type = 'SHR'; | |
| $name = $fullname unless $fullname =~ /exe;?\d*$/i; | |
| } | |
| elsif ( | |
| not length( $ctype ) and # If we've got a lib already, | |
| # don't bother | |
| ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $lib_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.olb' ) ) ) | |
| ) | |
| { | |
| $type = 'OLB'; | |
| $name = $fullname unless $fullname =~ /olb;?\d*$/i; | |
| } | |
| elsif ( | |
| not length( $ctype ) and # If we've got a lib already, | |
| # don't bother | |
| ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $obj_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.obj' ) ) ) | |
| ) | |
| { | |
| warn "Note (probably harmless): " . "Plain object file $fullname found in library list\n"; | |
| $type = 'OBJ'; | |
| $name = $fullname unless $fullname =~ /obj;?\d*$/i; | |
| } | |
| if ( defined $type ) { | |
| $ctype = $type; | |
| $cand = $name; | |
| last if $ctype eq 'SHR'; | |
| } | |
| } | |
| if ( $ctype ) { | |
| # This has to precede any other CRTLs, so just make it first | |
| if ( $cand eq 'VAXCCURSE' ) { unshift @{ $found{$ctype} }, $cand; } | |
| else { push @{ $found{$ctype} }, $cand; } | |
| warn "\tFound as $cand (really $fullname), type $ctype\n" | |
| if $verbose > 1; | |
| push @flibs, $name unless $libs_seen{$fullname}++; | |
| next LIB; | |
| } | |
| } | |
| warn "Note (probably harmless): " . "No library found for $lib\n"; | |
| } | |
| push @fndlibs, @{ $found{OBJ} } if exists $found{OBJ}; | |
| push @fndlibs, map { "$_/Library" } @{ $found{OLB} } if exists $found{OLB}; | |
| push @fndlibs, map { "$_/Share" } @{ $found{SHR} } if exists $found{SHR}; | |
| my $lib = join( ' ', @fndlibs ); | |
| $ldlib = $crtlstr ? "$lib $crtlstr" : $lib; | |
| warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose; | |
| wantarray ? ( $lib, '', $ldlib, '', ( $give_libs ? \@flibs : () ) ) : $lib; | |
| } | |
| 1; | |
| EXTUTILS_LIBLIST_KID | |
| $fatpacked{"ExtUtils/MM.pm"} = <<'EXTUTILS_MM'; | |
| package ExtUtils::MM; | |
| use strict; | |
| use ExtUtils::MakeMaker::Config; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::Liblist; | |
| require ExtUtils::MakeMaker; | |
| our @ISA = qw(ExtUtils::Liblist ExtUtils::MakeMaker); | |
| =head1 NAME | |
| ExtUtils::MM - OS adjusted ExtUtils::MakeMaker subclass | |
| =head1 SYNOPSIS | |
| require ExtUtils::MM; | |
| my $mm = MM->new(...); | |
| =head1 DESCRIPTION | |
| B<FOR INTERNAL USE ONLY> | |
| ExtUtils::MM is a subclass of ExtUtils::MakeMaker which automatically | |
| chooses the appropriate OS specific subclass for you | |
| (ie. ExtUils::MM_Unix, etc...). | |
| It also provides a convenient alias via the MM class (I didn't want | |
| MakeMaker modules outside of ExtUtils/). | |
| This class might turn out to be a temporary solution, but MM won't go | |
| away. | |
| =cut | |
| { | |
| # Convenient alias. | |
| package MM; | |
| our @ISA = qw(ExtUtils::MM); | |
| sub DESTROY {} | |
| } | |
| sub _is_win95 { | |
| # miniperl might not have the Win32 functions available and we need | |
| # to run in miniperl. | |
| my $have_win32 = eval { require Win32 }; | |
| return $have_win32 && defined &Win32::IsWin95 ? Win32::IsWin95() | |
| : ! defined $ENV{SYSTEMROOT}; | |
| } | |
| my %Is = (); | |
| $Is{VMS} = $^O eq 'VMS'; | |
| $Is{OS2} = $^O eq 'os2'; | |
| $Is{MacOS} = $^O eq 'MacOS'; | |
| if( $^O eq 'MSWin32' ) { | |
| _is_win95() ? $Is{Win95} = 1 : $Is{Win32} = 1; | |
| } | |
| $Is{UWIN} = $^O =~ /^uwin(-nt)?$/; | |
| $Is{Cygwin} = $^O eq 'cygwin'; | |
| $Is{NW5} = $Config{osname} eq 'NetWare'; # intentional | |
| $Is{BeOS} = ($^O =~ /beos/i or $^O eq 'haiku'); | |
| $Is{DOS} = $^O eq 'dos'; | |
| if( $Is{NW5} ) { | |
| $^O = 'NetWare'; | |
| delete $Is{Win32}; | |
| } | |
| $Is{VOS} = $^O eq 'vos'; | |
| $Is{QNX} = $^O eq 'qnx'; | |
| $Is{AIX} = $^O eq 'aix'; | |
| $Is{Darwin} = $^O eq 'darwin'; | |
| $Is{Unix} = !grep { $_ } values %Is; | |
| map { delete $Is{$_} unless $Is{$_} } keys %Is; | |
| _assert( keys %Is == 1 ); | |
| my($OS) = keys %Is; | |
| my $class = "ExtUtils::MM_$OS"; | |
| eval "require $class" unless $INC{"ExtUtils/MM_$OS.pm"}; ## no critic | |
| die $@ if $@; | |
| unshift @ISA, $class; | |
| sub _assert { | |
| my $sanity = shift; | |
| die sprintf "Assert failed at %s line %d\n", (caller)[1,2] unless $sanity; | |
| return; | |
| } | |
| EXTUTILS_MM | |
| $fatpacked{"ExtUtils/MM_AIX.pm"} = <<'EXTUTILS_MM_AIX'; | |
| package ExtUtils::MM_AIX; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw(ExtUtils::MM_Unix); | |
| use ExtUtils::MakeMaker qw(neatvalue); | |
| =head1 NAME | |
| ExtUtils::MM_AIX - AIX specific subclass of ExtUtils::MM_Unix | |
| =head1 SYNOPSIS | |
| Don't use this module directly. | |
| Use ExtUtils::MM and let it choose. | |
| =head1 DESCRIPTION | |
| This is a subclass of ExtUtils::MM_Unix which contains functionality for | |
| AIX. | |
| Unless otherwise stated it works just like ExtUtils::MM_Unix | |
| =head2 Overridden methods | |
| =head3 dlsyms | |
| Define DL_FUNCS and DL_VARS and write the *.exp files. | |
| =cut | |
| sub dlsyms { | |
| my($self,%attribs) = @_; | |
| return '' unless $self->needs_linking(); | |
| my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; | |
| my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; | |
| my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; | |
| my(@m); | |
| push(@m," | |
| dynamic :: $self->{BASEEXT}.exp | |
| ") unless $self->{SKIPHASH}{'dynamic'}; # dynamic and static are subs, so... | |
| push(@m," | |
| static :: $self->{BASEEXT}.exp | |
| ") unless $self->{SKIPHASH}{'static'}; # we avoid a warning if we tick them | |
| push(@m," | |
| $self->{BASEEXT}.exp: Makefile.PL | |
| ",' $(PERLRUN) -e \'use ExtUtils::Mksymlists; \\ | |
| Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ', | |
| neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist), | |
| ', "DL_VARS" => ', neatvalue($vars), ');\' | |
| '); | |
| join('',@m); | |
| } | |
| =head1 AUTHOR | |
| Michael G Schwern <[email protected]> with code from ExtUtils::MM_Unix | |
| =head1 SEE ALSO | |
| L<ExtUtils::MakeMaker> | |
| =cut | |
| 1; | |
| EXTUTILS_MM_AIX | |
| $fatpacked{"ExtUtils/MM_Any.pm"} = <<'EXTUTILS_MM_ANY'; | |
| package ExtUtils::MM_Any; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| use Carp; | |
| use File::Spec; | |
| use File::Basename; | |
| BEGIN { our @ISA = qw(File::Spec); } | |
| # We need $Verbose | |
| use ExtUtils::MakeMaker qw($Verbose); | |
| use ExtUtils::MakeMaker::Config; | |
| # So we don't have to keep calling the methods over and over again, | |
| # we have these globals to cache the values. Faster and shrtr. | |
| my $Curdir = __PACKAGE__->curdir; | |
| my $Rootdir = __PACKAGE__->rootdir; | |
| my $Updir = __PACKAGE__->updir; | |
| =head1 NAME | |
| ExtUtils::MM_Any - Platform-agnostic MM methods | |
| =head1 SYNOPSIS | |
| FOR INTERNAL USE ONLY! | |
| package ExtUtils::MM_SomeOS; | |
| # Temporarily, you have to subclass both. Put MM_Any first. | |
| require ExtUtils::MM_Any; | |
| require ExtUtils::MM_Unix; | |
| @ISA = qw(ExtUtils::MM_Any ExtUtils::Unix); | |
| =head1 DESCRIPTION | |
| B<FOR INTERNAL USE ONLY!> | |
| ExtUtils::MM_Any is a superclass for the ExtUtils::MM_* set of | |
| modules. It contains methods which are either inherently | |
| cross-platform or are written in a cross-platform manner. | |
| Subclass off of ExtUtils::MM_Any I<and> ExtUtils::MM_Unix. This is a | |
| temporary solution. | |
| B<THIS MAY BE TEMPORARY!> | |
| =head1 METHODS | |
| Any methods marked I<Abstract> must be implemented by subclasses. | |
| =head2 Cross-platform helper methods | |
| These are methods which help writing cross-platform code. | |
| =head3 os_flavor I<Abstract> | |
| my @os_flavor = $mm->os_flavor; | |
| @os_flavor is the style of operating system this is, usually | |
| corresponding to the MM_*.pm file we're using. | |
| The first element of @os_flavor is the major family (ie. Unix, | |
| Windows, VMS, OS/2, etc...) and the rest are sub families. | |
| Some examples: | |
| Cygwin98 ('Unix', 'Cygwin', 'Cygwin9x') | |
| Windows ('Win32') | |
| Win98 ('Win32', 'Win9x') | |
| Linux ('Unix', 'Linux') | |
| MacOS X ('Unix', 'Darwin', 'MacOS', 'MacOS X') | |
| OS/2 ('OS/2') | |
| This is used to write code for styles of operating system. | |
| See os_flavor_is() for use. | |
| =head3 os_flavor_is | |
| my $is_this_flavor = $mm->os_flavor_is($this_flavor); | |
| my $is_this_flavor = $mm->os_flavor_is(@one_of_these_flavors); | |
| Checks to see if the current operating system is one of the given flavors. | |
| This is useful for code like: | |
| if( $mm->os_flavor_is('Unix') ) { | |
| $out = `foo 2>&1`; | |
| } | |
| else { | |
| $out = `foo`; | |
| } | |
| =cut | |
| sub os_flavor_is { | |
| my $self = shift; | |
| my %flavors = map { ($_ => 1) } $self->os_flavor; | |
| return (grep { $flavors{$_} } @_) ? 1 : 0; | |
| } | |
| =head3 can_load_xs | |
| my $can_load_xs = $self->can_load_xs; | |
| Returns true if we have the ability to load XS. | |
| This is important because miniperl, used to build XS modules in the | |
| core, can not load XS. | |
| =cut | |
| sub can_load_xs { | |
| return defined &DynaLoader::boot_DynaLoader ? 1 : 0; | |
| } | |
| =head3 split_command | |
| my @cmds = $MM->split_command($cmd, @args); | |
| Most OS have a maximum command length they can execute at once. Large | |
| modules can easily generate commands well past that limit. Its | |
| necessary to split long commands up into a series of shorter commands. | |
| C<split_command> will return a series of @cmds each processing part of | |
| the args. Collectively they will process all the arguments. Each | |
| individual line in @cmds will not be longer than the | |
| $self->max_exec_len being careful to take into account macro expansion. | |
| $cmd should include any switches and repeated initial arguments. | |
| If no @args are given, no @cmds will be returned. | |
| Pairs of arguments will always be preserved in a single command, this | |
| is a heuristic for things like pm_to_blib and pod2man which work on | |
| pairs of arguments. This makes things like this safe: | |
| $self->split_command($cmd, %pod2man); | |
| =cut | |
| sub split_command { | |
| my($self, $cmd, @args) = @_; | |
| my @cmds = (); | |
| return(@cmds) unless @args; | |
| # If the command was given as a here-doc, there's probably a trailing | |
| # newline. | |
| chomp $cmd; | |
| # set aside 30% for macro expansion. | |
| my $len_left = int($self->max_exec_len * 0.70); | |
| $len_left -= length $self->_expand_macros($cmd); | |
| do { | |
| my $arg_str = ''; | |
| my @next_args; | |
| while( @next_args = splice(@args, 0, 2) ) { | |
| # Two at a time to preserve pairs. | |
| my $next_arg_str = "\t ". join ' ', @next_args, "\n"; | |
| if( !length $arg_str ) { | |
| $arg_str .= $next_arg_str | |
| } | |
| elsif( length($arg_str) + length($next_arg_str) > $len_left ) { | |
| unshift @args, @next_args; | |
| last; | |
| } | |
| else { | |
| $arg_str .= $next_arg_str; | |
| } | |
| } | |
| chop $arg_str; | |
| push @cmds, $self->escape_newlines("$cmd \n$arg_str"); | |
| } while @args; | |
| return @cmds; | |
| } | |
| sub _expand_macros { | |
| my($self, $cmd) = @_; | |
| $cmd =~ s{\$\((\w+)\)}{ | |
| defined $self->{$1} ? $self->{$1} : "\$($1)" | |
| }e; | |
| return $cmd; | |
| } | |
| =head3 echo | |
| my @commands = $MM->echo($text); | |
| my @commands = $MM->echo($text, $file); | |
| my @commands = $MM->echo($text, $file, $appending); | |
| Generates a set of @commands which print the $text to a $file. | |
| If $file is not given, output goes to STDOUT. | |
| If $appending is true the $file will be appended to rather than | |
| overwritten. | |
| =cut | |
| sub echo { | |
| my($self, $text, $file, $appending) = @_; | |
| $appending ||= 0; | |
| my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_) } | |
| split /\n/, $text; | |
| if( $file ) { | |
| my $redirect = $appending ? '>>' : '>'; | |
| $cmds[0] .= " $redirect $file"; | |
| $_ .= " >> $file" foreach @cmds[1..$#cmds]; | |
| } | |
| return @cmds; | |
| } | |
| =head3 wraplist | |
| my $args = $mm->wraplist(@list); | |
| Takes an array of items and turns them into a well-formatted list of | |
| arguments. In most cases this is simply something like: | |
| FOO \ | |
| BAR \ | |
| BAZ | |
| =cut | |
| sub wraplist { | |
| my $self = shift; | |
| return join " \\\n\t", @_; | |
| } | |
| =head3 maketext_filter | |
| my $filter_make_text = $mm->maketext_filter($make_text); | |
| The text of the Makefile is run through this method before writing to | |
| disk. It allows systems a chance to make portability fixes to the | |
| Makefile. | |
| By default it does nothing. | |
| This method is protected and not intended to be called outside of | |
| MakeMaker. | |
| =cut | |
| sub maketext_filter { return $_[1] } | |
| =head3 cd I<Abstract> | |
| my $subdir_cmd = $MM->cd($subdir, @cmds); | |
| This will generate a make fragment which runs the @cmds in the given | |
| $dir. The rough equivalent to this, except cross platform. | |
| cd $subdir && $cmd | |
| Currently $dir can only go down one level. "foo" is fine. "foo/bar" is | |
| not. "../foo" is right out. | |
| The resulting $subdir_cmd has no leading tab nor trailing newline. This | |
| makes it easier to embed in a make string. For example. | |
| my $make = sprintf <<'CODE', $subdir_cmd; | |
| foo : | |
| $(ECHO) what | |
| %s | |
| $(ECHO) mouche | |
| CODE | |
| =head3 oneliner I<Abstract> | |
| my $oneliner = $MM->oneliner($perl_code); | |
| my $oneliner = $MM->oneliner($perl_code, \@switches); | |
| This will generate a perl one-liner safe for the particular platform | |
| you're on based on the given $perl_code and @switches (a -e is | |
| assumed) suitable for using in a make target. It will use the proper | |
| shell quoting and escapes. | |
| $(PERLRUN) will be used as perl. | |
| Any newlines in $perl_code will be escaped. Leading and trailing | |
| newlines will be stripped. Makes this idiom much easier: | |
| my $code = $MM->oneliner(<<'CODE', [...switches...]); | |
| some code here | |
| another line here | |
| CODE | |
| Usage might be something like: | |
| # an echo emulation | |
| $oneliner = $MM->oneliner('print "Foo\n"'); | |
| $make = '$oneliner > somefile'; | |
| All dollar signs must be doubled in the $perl_code if you expect them | |
| to be interpreted normally, otherwise it will be considered a make | |
| macro. Also remember to quote make macros else it might be used as a | |
| bareword. For example: | |
| # Assign the value of the $(VERSION_FROM) make macro to $vf. | |
| $oneliner = $MM->oneliner('$$vf = "$(VERSION_FROM)"'); | |
| Its currently very simple and may be expanded sometime in the figure | |
| to include more flexible code and switches. | |
| =head3 quote_literal I<Abstract> | |
| my $safe_text = $MM->quote_literal($text); | |
| This will quote $text so it is interpreted literally in the shell. | |
| For example, on Unix this would escape any single-quotes in $text and | |
| put single-quotes around the whole thing. | |
| =head3 escape_newlines I<Abstract> | |
| my $escaped_text = $MM->escape_newlines($text); | |
| Shell escapes newlines in $text. | |
| =head3 max_exec_len I<Abstract> | |
| my $max_exec_len = $MM->max_exec_len; | |
| Calculates the maximum command size the OS can exec. Effectively, | |
| this is the max size of a shell command line. | |
| =for _private | |
| $self->{_MAX_EXEC_LEN} is set by this method, but only for testing purposes. | |
| =head3 make | |
| my $make = $MM->make; | |
| Returns the make variant we're generating the Makefile for. This attempts | |
| to do some normalization on the information from %Config or the user. | |
| =cut | |
| sub make { | |
| my $self = shift; | |
| my $make = lc $self->{MAKE}; | |
| # Truncate anything like foomake6 to just foomake. | |
| $make =~ s/^(\w+make).*/$1/; | |
| # Turn gnumake into gmake. | |
| $make =~ s/^gnu/g/; | |
| return $make; | |
| } | |
| =head2 Targets | |
| These are methods which produce make targets. | |
| =head3 all_target | |
| Generate the default target 'all'. | |
| =cut | |
| sub all_target { | |
| my $self = shift; | |
| return <<'MAKE_EXT'; | |
| all :: pure_all | |
| $(NOECHO) $(NOOP) | |
| MAKE_EXT | |
| } | |
| =head3 blibdirs_target | |
| my $make_frag = $mm->blibdirs_target; | |
| Creates the blibdirs target which creates all the directories we use | |
| in blib/. | |
| The blibdirs.ts target is deprecated. Depend on blibdirs instead. | |
| =cut | |
| sub blibdirs_target { | |
| my $self = shift; | |
| my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib | |
| autodir archautodir | |
| bin script | |
| man1dir man3dir | |
| ); | |
| my @exists = map { $_.'$(DFSEP).exists' } @dirs; | |
| my $make = sprintf <<'MAKE', join(' ', @exists); | |
| blibdirs : %s | |
| $(NOECHO) $(NOOP) | |
| # Backwards compat with 6.18 through 6.25 | |
| blibdirs.ts : blibdirs | |
| $(NOECHO) $(NOOP) | |
| MAKE | |
| $make .= $self->dir_target(@dirs); | |
| return $make; | |
| } | |
| =head3 clean (o) | |
| Defines the clean target. | |
| =cut | |
| sub clean { | |
| # --- Cleanup and Distribution Sections --- | |
| my($self, %attribs) = @_; | |
| my @m; | |
| push(@m, ' | |
| # Delete temporary files but do not touch installed files. We don\'t delete | |
| # the Makefile here so a later make realclean still has a makefile to use. | |
| clean :: clean_subdirs | |
| '); | |
| my @files = values %{$self->{XS}}; # .c files from *.xs files | |
| my @dirs = qw(blib); | |
| # Normally these are all under blib but they might have been | |
| # redefined. | |
| # XXX normally this would be a good idea, but the Perl core sets | |
| # INST_LIB = ../../lib rather than actually installing the files. | |
| # So a "make clean" in an ext/ directory would blow away lib. | |
| # Until the core is adjusted let's leave this out. | |
| # push @dirs, qw($(INST_ARCHLIB) $(INST_LIB) | |
| # $(INST_BIN) $(INST_SCRIPT) | |
| # $(INST_MAN1DIR) $(INST_MAN3DIR) | |
| # $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR) | |
| # $(INST_STATIC) $(INST_DYNAMIC) $(INST_BOOT) | |
| # ); | |
| if( $attribs{FILES} ) { | |
| # Use @dirs because we don't know what's in here. | |
| push @dirs, ref $attribs{FILES} ? | |
| @{$attribs{FILES}} : | |
| split /\s+/, $attribs{FILES} ; | |
| } | |
| push(@files, qw[$(MAKE_APERL_FILE) | |
| MYMETA.json MYMETA.yml perlmain.c tmon.out mon.out so_locations | |
| blibdirs.ts pm_to_blib pm_to_blib.ts | |
| *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT) | |
| $(BOOTSTRAP) $(BASEEXT).bso | |
| $(BASEEXT).def lib$(BASEEXT).def | |
| $(BASEEXT).exp $(BASEEXT).x | |
| ]); | |
| push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all')); | |
| push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld')); | |
| # core files | |
| push(@files, qw[core core.*perl.*.? *perl.core]); | |
| push(@files, map { "core." . "[0-9]"x$_ } (1..5)); | |
| # OS specific things to clean up. Use @dirs since we don't know | |
| # what might be in here. | |
| push @dirs, $self->extra_clean_files; | |
| # Occasionally files are repeated several times from different sources | |
| { my(%f) = map { ($_ => 1) } @files; @files = keys %f; } | |
| { my(%d) = map { ($_ => 1) } @dirs; @dirs = keys %d; } | |
| push @m, map "\t$_\n", $self->split_command('- $(RM_F)', @files); | |
| push @m, map "\t$_\n", $self->split_command('- $(RM_RF)', @dirs); | |
| # Leave Makefile.old around for realclean | |
| push @m, <<'MAKE'; | |
| - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) | |
| MAKE | |
| push(@m, "\t$attribs{POSTOP}\n") if $attribs{POSTOP}; | |
| join("", @m); | |
| } | |
| =head3 clean_subdirs_target | |
| my $make_frag = $MM->clean_subdirs_target; | |
| Returns the clean_subdirs target. This is used by the clean target to | |
| call clean on any subdirectories which contain Makefiles. | |
| =cut | |
| sub clean_subdirs_target { | |
| my($self) = shift; | |
| # No subdirectories, no cleaning. | |
| return <<'NOOP_FRAG' unless @{$self->{DIR}}; | |
| clean_subdirs : | |
| $(NOECHO) $(NOOP) | |
| NOOP_FRAG | |
| my $clean = "clean_subdirs :\n"; | |
| for my $dir (@{$self->{DIR}}) { | |
| my $subclean = $self->oneliner(sprintf <<'CODE', $dir); | |
| chdir '%s'; system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)'; | |
| CODE | |
| $clean .= "\t$subclean\n"; | |
| } | |
| return $clean; | |
| } | |
| =head3 dir_target | |
| my $make_frag = $mm->dir_target(@directories); | |
| Generates targets to create the specified directories and set its | |
| permission to PERM_DIR. | |
| Because depending on a directory to just ensure it exists doesn't work | |
| too well (the modified time changes too often) dir_target() creates a | |
| .exists file in the created directory. It is this you should depend on. | |
| For portability purposes you should use the $(DIRFILESEP) macro rather | |
| than a '/' to seperate the directory from the file. | |
| yourdirectory$(DIRFILESEP).exists | |
| =cut | |
| sub dir_target { | |
| my($self, @dirs) = @_; | |
| my $make = ''; | |
| foreach my $dir (@dirs) { | |
| $make .= sprintf <<'MAKE', ($dir) x 7; | |
| %s$(DFSEP).exists :: Makefile.PL | |
| $(NOECHO) $(MKPATH) %s | |
| $(NOECHO) $(CHMOD) $(PERM_DIR) %s | |
| $(NOECHO) $(TOUCH) %s$(DFSEP).exists | |
| MAKE | |
| } | |
| return $make; | |
| } | |
| =head3 distdir | |
| Defines the scratch directory target that will hold the distribution | |
| before tar-ing (or shar-ing). | |
| =cut | |
| # For backwards compatibility. | |
| *dist_dir = *distdir; | |
| sub distdir { | |
| my($self) = shift; | |
| my $meta_target = $self->{NO_META} ? '' : 'distmeta'; | |
| my $sign_target = !$self->{SIGN} ? '' : 'distsignature'; | |
| return sprintf <<'MAKE_FRAG', $meta_target, $sign_target; | |
| create_distdir : | |
| $(RM_RF) $(DISTVNAME) | |
| $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ | |
| -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" | |
| distdir : create_distdir %s %s | |
| $(NOECHO) $(NOOP) | |
| MAKE_FRAG | |
| } | |
| =head3 dist_test | |
| Defines a target that produces the distribution in the | |
| scratchdirectory, and runs 'perl Makefile.PL; make ;make test' in that | |
| subdirectory. | |
| =cut | |
| sub dist_test { | |
| my($self) = shift; | |
| my $mpl_args = join " ", map qq["$_"], @ARGV; | |
| my $test = $self->cd('$(DISTVNAME)', | |
| '$(ABSPERLRUN) Makefile.PL '.$mpl_args, | |
| '$(MAKE) $(PASTHRU)', | |
| '$(MAKE) test $(PASTHRU)' | |
| ); | |
| return sprintf <<'MAKE_FRAG', $test; | |
| disttest : distdir | |
| %s | |
| MAKE_FRAG | |
| } | |
| =head3 dynamic (o) | |
| Defines the dynamic target. | |
| =cut | |
| sub dynamic { | |
| # --- Dynamic Loading Sections --- | |
| my($self) = shift; | |
| ' | |
| dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) | |
| $(NOECHO) $(NOOP) | |
| '; | |
| } | |
| =head3 makemakerdflt_target | |
| my $make_frag = $mm->makemakerdflt_target | |
| Returns a make fragment with the makemakerdeflt_target specified. | |
| This target is the first target in the Makefile, is the default target | |
| and simply points off to 'all' just in case any make variant gets | |
| confused or something gets snuck in before the real 'all' target. | |
| =cut | |
| sub makemakerdflt_target { | |
| return <<'MAKE_FRAG'; | |
| makemakerdflt : all | |
| $(NOECHO) $(NOOP) | |
| MAKE_FRAG | |
| } | |
| =head3 manifypods_target | |
| my $manifypods_target = $self->manifypods_target; | |
| Generates the manifypods target. This target generates man pages from | |
| all POD files in MAN1PODS and MAN3PODS. | |
| =cut | |
| sub manifypods_target { | |
| my($self) = shift; | |
| my $man1pods = ''; | |
| my $man3pods = ''; | |
| my $dependencies = ''; | |
| # populate manXpods & dependencies: | |
| foreach my $name (keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}) { | |
| $dependencies .= " \\\n\t$name"; | |
| } | |
| my $manify = <<END; | |
| manifypods : pure_all $dependencies | |
| END | |
| my @man_cmds; | |
| foreach my $section (qw(1 3)) { | |
| my $pods = $self->{"MAN${section}PODS"}; | |
| push @man_cmds, $self->split_command(<<CMD, %$pods); | |
| \$(NOECHO) \$(POD2MAN) --section=$section --perm_rw=\$(PERM_RW) | |
| CMD | |
| } | |
| $manify .= "\t\$(NOECHO) \$(NOOP)\n" unless @man_cmds; | |
| $manify .= join '', map { "$_\n" } @man_cmds; | |
| return $manify; | |
| } | |
| sub _has_cpan_meta { | |
| return eval { | |
| require CPAN::Meta; | |
| CPAN::Meta->VERSION(2.112150); | |
| 1; | |
| }; | |
| } | |
| =head3 metafile_target | |
| my $target = $mm->metafile_target; | |
| Generate the metafile target. | |
| Writes the file META.yml YAML encoded meta-data about the module in | |
| the distdir. The format follows Module::Build's as closely as | |
| possible. | |
| =cut | |
| sub metafile_target { | |
| my $self = shift; | |
| return <<'MAKE_FRAG' if $self->{NO_META} or ! _has_cpan_meta(); | |
| metafile : | |
| $(NOECHO) $(NOOP) | |
| MAKE_FRAG | |
| my %metadata = $self->metafile_data( | |
| $self->{META_ADD} || {}, | |
| $self->{META_MERGE} || {}, | |
| ); | |
| _fix_metadata_before_conversion( \%metadata ); | |
| # paper over validation issues, but still complain, necessary because | |
| # there's no guarantee that the above will fix ALL errors | |
| my $meta = eval { CPAN::Meta->create( \%metadata, { lazy_validation => 1 } ) }; | |
| warn $@ if $@ and | |
| $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/; | |
| # use the original metadata straight if the conversion failed | |
| # or if it can't be stringified. | |
| if( !$meta || | |
| !eval { $meta->as_string( { version => "1.4" } ) } || | |
| !eval { $meta->as_string } | |
| ) | |
| { | |
| $meta = bless \%metadata, 'CPAN::Meta'; | |
| } | |
| my @write_metayml = $self->echo( | |
| $meta->as_string({version => "1.4"}), 'META_new.yml' | |
| ); | |
| my @write_metajson = $self->echo( | |
| $meta->as_string(), 'META_new.json' | |
| ); | |
| my $metayml = join("\n\t", @write_metayml); | |
| my $metajson = join("\n\t", @write_metajson); | |
| return sprintf <<'MAKE_FRAG', $metayml, $metajson; | |
| metafile : create_distdir | |
| $(NOECHO) $(ECHO) Generating META.yml | |
| %s | |
| -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml | |
| $(NOECHO) $(ECHO) Generating META.json | |
| %s | |
| -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json | |
| MAKE_FRAG | |
| } | |
| =begin private | |
| =head3 _fix_metadata_before_conversion | |
| _fix_metadata_before_conversion( \%metadata ); | |
| Fixes errors in the metadata before it's handed off to CPAN::Meta for | |
| conversion. This hopefully results in something that can be used further | |
| on, no guarantee is made though. | |
| =end private | |
| =cut | |
| sub _fix_metadata_before_conversion { | |
| my ( $metadata ) = @_; | |
| # we should never be called unless this already passed but | |
| # prefer to be defensive in case somebody else calls this | |
| return unless _has_cpan_meta; | |
| my $bad_version = $metadata->{version} && | |
| !CPAN::Meta::Validator->new->version( 'version', $metadata->{version} ); | |
| # just delete all invalid versions | |
| if( $bad_version ) { | |
| warn "Can't parse version '$metadata->{version}'\n"; | |
| $metadata->{version} = ''; | |
| } | |
| my $validator = CPAN::Meta::Validator->new( $metadata ); | |
| return if $validator->is_valid; | |
| # fix non-camelcase custom resource keys (only other trick we know) | |
| for my $error ( $validator->errors ) { | |
| my ( $key ) = ( $error =~ /Custom resource '(.*)' must be in CamelCase./ ); | |
| next if !$key; | |
| # first try to remove all non-alphabetic chars | |
| ( my $new_key = $key ) =~ s/[^_a-zA-Z]//g; | |
| # if that doesn't work, uppercase first one | |
| $new_key = ucfirst $new_key if !$validator->custom_1( $new_key ); | |
| # copy to new key if that worked | |
| $metadata->{resources}{$new_key} = $metadata->{resources}{$key} | |
| if $validator->custom_1( $new_key ); | |
| # and delete old one in any case | |
| delete $metadata->{resources}{$key}; | |
| } | |
| return; | |
| } | |
| =begin private | |
| =head3 _sort_pairs | |
| my @pairs = _sort_pairs($sort_sub, \%hash); | |
| Sorts the pairs of a hash based on keys ordered according | |
| to C<$sort_sub>. | |
| =end private | |
| =cut | |
| sub _sort_pairs { | |
| my $sort = shift; | |
| my $pairs = shift; | |
| return map { $_ => $pairs->{$_} } | |
| sort $sort | |
| keys %$pairs; | |
| } | |
| # Taken from Module::Build::Base | |
| sub _hash_merge { | |
| my ($self, $h, $k, $v) = @_; | |
| if (ref $h->{$k} eq 'ARRAY') { | |
| push @{$h->{$k}}, ref $v ? @$v : $v; | |
| } elsif (ref $h->{$k} eq 'HASH') { | |
| $self->_hash_merge($h->{$k}, $_, $v->{$_}) foreach keys %$v; | |
| } else { | |
| $h->{$k} = $v; | |
| } | |
| } | |
| =head3 metafile_data | |
| my @metadata_pairs = $mm->metafile_data(\%meta_add, \%meta_merge); | |
| Returns the data which MakeMaker turns into the META.yml file. | |
| Values of %meta_add will overwrite any existing metadata in those | |
| keys. %meta_merge will be merged with them. | |
| =cut | |
| sub metafile_data { | |
| my $self = shift; | |
| my($meta_add, $meta_merge) = @_; | |
| my %meta = ( | |
| # required | |
| name => $self->{DISTNAME}, | |
| version => _normalize_version($self->{VERSION}), | |
| abstract => $self->{ABSTRACT} || 'unknown', | |
| license => $self->{LICENSE} || 'unknown', | |
| dynamic_config => 1, | |
| # optional | |
| distribution_type => $self->{PM} ? 'module' : 'script', | |
| no_index => { | |
| directory => [qw(t inc)] | |
| }, | |
| generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", | |
| 'meta-spec' => { | |
| url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', | |
| version => 1.4 | |
| }, | |
| ); | |
| # The author key is required and it takes a list. | |
| $meta{author} = defined $self->{AUTHOR} ? $self->{AUTHOR} : []; | |
| # Check the original args so we can tell between the user setting it | |
| # to an empty hash and it just being initialized. | |
| if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { | |
| $meta{configure_requires} | |
| = _normalize_prereqs($self->{CONFIGURE_REQUIRES}); | |
| } else { | |
| $meta{configure_requires} = { | |
| 'ExtUtils::MakeMaker' => 0, | |
| }; | |
| } | |
| %meta = $self->_add_requirements_to_meta( %meta ); | |
| while( my($key, $val) = each %$meta_add ) { | |
| $meta{$key} = $val; | |
| } | |
| while( my($key, $val) = each %$meta_merge ) { | |
| $self->_hash_merge(\%meta, $key, $val); | |
| } | |
| return %meta; | |
| } | |
| =begin private | |
| =cut | |
| sub _add_requirements_to_meta { | |
| my ( $self, %meta ) = @_; | |
| # Check the original args so we can tell between the user setting it | |
| # to an empty hash and it just being initialized. | |
| if( $self->{ARGS}{BUILD_REQUIRES} ) { | |
| $meta{build_requires} = _normalize_prereqs($self->{BUILD_REQUIRES}); | |
| } else { | |
| $meta{build_requires} = { | |
| 'ExtUtils::MakeMaker' => 0, | |
| }; | |
| } | |
| $meta{requires} = _normalize_prereqs($self->{PREREQ_PM}) | |
| if defined $self->{PREREQ_PM}; | |
| $meta{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) | |
| if $self->{MIN_PERL_VERSION}; | |
| return %meta; | |
| } | |
| sub _normalize_prereqs { | |
| my ($hash) = @_; | |
| my %prereqs; | |
| while ( my ($k,$v) = each %$hash ) { | |
| $prereqs{$k} = _normalize_version($v); | |
| } | |
| return \%prereqs; | |
| } | |
| # Adapted from Module::Build::Base | |
| sub _normalize_version { | |
| my ($version) = @_; | |
| $version = 0 unless defined $version; | |
| if ( ref $version eq 'version' ) { # version objects | |
| $version = $version->is_qv ? $version->normal : $version->stringify; | |
| } | |
| elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots | |
| # normalize string tuples without "v": "1.2.3" -> "v1.2.3" | |
| $version = "v$version"; | |
| } | |
| else { | |
| # leave alone | |
| } | |
| return $version; | |
| } | |
| =head3 _dump_hash | |
| $yaml = _dump_hash(\%options, %hash); | |
| Implements a fake YAML dumper for a hash given | |
| as a list of pairs. No quoting/escaping is done. Keys | |
| are supposed to be strings. Values are undef, strings, | |
| hash refs or array refs of strings. | |
| Supported options are: | |
| delta => STR - indentation delta | |
| use_header => BOOL - whether to include a YAML header | |
| indent => STR - a string of spaces | |
| default: '' | |
| max_key_length => INT - maximum key length used to align | |
| keys and values of the same hash | |
| default: 20 | |
| key_sort => CODE - a sort sub | |
| It may be undef, which means no sorting by keys | |
| default: sub { lc $a cmp lc $b } | |
| customs => HASH - special options for certain keys | |
| (whose values are hashes themselves) | |
| may contain: max_key_length, key_sort, customs | |
| =end private | |
| =cut | |
| sub _dump_hash { | |
| croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH'; | |
| my $options = shift; | |
| my %hash = @_; | |
| # Use a list to preserve order. | |
| my @pairs; | |
| my $k_sort | |
| = exists $options->{key_sort} ? $options->{key_sort} | |
| : sub { lc $a cmp lc $b }; | |
| if ($k_sort) { | |
| croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE'; | |
| @pairs = _sort_pairs($k_sort, \%hash); | |
| } else { # list of pairs, no sorting | |
| @pairs = @_; | |
| } | |
| my $yaml = $options->{use_header} ? "--- #YAML:1.0\n" : ''; | |
| my $indent = $options->{indent} || ''; | |
| my $k_length = min( | |
| ($options->{max_key_length} || 20), | |
| max(map { length($_) + 1 } grep { !ref $hash{$_} } keys %hash) | |
| ); | |
| my $customs = $options->{customs} || {}; | |
| # printf format for key | |
| my $k_format = "%-${k_length}s"; | |
| while( @pairs ) { | |
| my($key, $val) = splice @pairs, 0, 2; | |
| $val = '~' unless defined $val; | |
| if(ref $val eq 'HASH') { | |
| if ( keys %$val ) { | |
| my %k_options = ( # options for recursive call | |
| delta => $options->{delta}, | |
| use_header => 0, | |
| indent => $indent . $options->{delta}, | |
| ); | |
| if (exists $customs->{$key}) { | |
| my %k_custom = %{$customs->{$key}}; | |
| foreach my $k (qw(key_sort max_key_length customs)) { | |
| $k_options{$k} = $k_custom{$k} if exists $k_custom{$k}; | |
| } | |
| } | |
| $yaml .= $indent . "$key:\n" | |
| . _dump_hash(\%k_options, %$val); | |
| } | |
| else { | |
| $yaml .= $indent . "$key: {}\n"; | |
| } | |
| } | |
| elsif (ref $val eq 'ARRAY') { | |
| if( @$val ) { | |
| $yaml .= $indent . "$key:\n"; | |
| for (@$val) { | |
| croak "only nested arrays of non-refs are supported" if ref $_; | |
| $yaml .= $indent . $options->{delta} . "- $_\n"; | |
| } | |
| } | |
| else { | |
| $yaml .= $indent . "$key: []\n"; | |
| } | |
| } | |
| elsif( ref $val and !blessed($val) ) { | |
| croak "only nested hashes, arrays and objects are supported"; | |
| } | |
| else { # if it's an object, just stringify it | |
| $yaml .= $indent . sprintf "$k_format %s\n", "$key:", $val; | |
| } | |
| }; | |
| return $yaml; | |
| } | |
| sub blessed { | |
| return eval { $_[0]->isa("UNIVERSAL"); }; | |
| } | |
| sub max { | |
| return (sort { $b <=> $a } @_)[0]; | |
| } | |
| sub min { | |
| return (sort { $a <=> $b } @_)[0]; | |
| } | |
| =head3 metafile_file | |
| my $meta_yml = $mm->metafile_file(@metadata_pairs); | |
| Turns the @metadata_pairs into YAML. | |
| This method does not implement a complete YAML dumper, being limited | |
| to dump a hash with values which are strings, undef's or nested hashes | |
| and arrays of strings. No quoting/escaping is done. | |
| =cut | |
| sub metafile_file { | |
| my $self = shift; | |
| my %dump_options = ( | |
| use_header => 1, | |
| delta => ' ' x 4, | |
| key_sort => undef, | |
| ); | |
| return _dump_hash(\%dump_options, @_); | |
| } | |
| =head3 distmeta_target | |
| my $make_frag = $mm->distmeta_target; | |
| Generates the distmeta target to add META.yml to the MANIFEST in the | |
| distdir. | |
| =cut | |
| sub distmeta_target { | |
| my $self = shift; | |
| my @add_meta = ( | |
| $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']), | |
| exit unless -e q{META.yml}; | |
| eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) } | |
| or print "Could not add META.yml to MANIFEST: $${'@'}\n" | |
| CODE | |
| $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']) | |
| exit unless -f q{META.json}; | |
| eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) } | |
| or print "Could not add META.json to MANIFEST: $${'@'}\n" | |
| CODE | |
| ); | |
| my @add_meta_to_distdir = map { $self->cd('$(DISTVNAME)', $_) } @add_meta; | |
| return sprintf <<'MAKE', @add_meta_to_distdir; | |
| distmeta : create_distdir metafile | |
| $(NOECHO) %s | |
| $(NOECHO) %s | |
| MAKE | |
| } | |
| =head3 mymeta | |
| my $mymeta = $mm->mymeta; | |
| Generate MYMETA information as a hash either from an existing META.yml | |
| or from internal data. | |
| =cut | |
| sub mymeta { | |
| my $self = shift; | |
| my $file = shift || ''; # for testing | |
| my $mymeta = $self->_mymeta_from_meta($file); | |
| unless ( $mymeta ) { | |
| my @metadata = $self->metafile_data( | |
| $self->{META_ADD} || {}, | |
| $self->{META_MERGE} || {}, | |
| ); | |
| $mymeta = {@metadata}; | |
| } | |
| # Overwrite the non-configure dependency hashes | |
| $mymeta = { $self->_add_requirements_to_meta( %$mymeta ) }; | |
| $mymeta->{dynamic_config} = 0; | |
| return $mymeta; | |
| } | |
| sub _mymeta_from_meta { | |
| my $self = shift; | |
| my $metafile = shift || ''; # for testing | |
| return unless _has_cpan_meta(); | |
| my $meta; | |
| for my $file ( $metafile, "META.json", "META.yml" ) { | |
| next unless -e $file; | |
| eval { | |
| $meta = CPAN::Meta->load_file($file)->as_struct( {version => "1.4"} ); | |
| }; | |
| last if $meta; | |
| } | |
| return undef unless $meta; | |
| # META.yml before 6.25_01 cannot be trusted. META.yml lived in the source directory. | |
| # There was a good chance the author accidentally uploaded a stale META.yml if they | |
| # rolled their own tarball rather than using "make dist". | |
| if ($meta->{generated_by} && | |
| $meta->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) { | |
| my $eummv = do { local $^W = 0; $1+0; }; | |
| if ($eummv < 6.2501) { | |
| return undef; | |
| } | |
| } | |
| return $meta; | |
| } | |
| =head3 write_mymeta | |
| $self->write_mymeta( $mymeta ); | |
| Write MYMETA information to MYMETA.yml. | |
| This will probably be refactored into a more generic YAML dumping method. | |
| =cut | |
| sub write_mymeta { | |
| my $self = shift; | |
| my $mymeta = shift; | |
| return unless _has_cpan_meta(); | |
| _fix_metadata_before_conversion( $mymeta ); | |
| # this can still blow up | |
| # not sure if i should just eval this and skip file creation if it | |
| # blows up | |
| my $meta_obj = CPAN::Meta->new( $mymeta, { lazy_validation => 1 } ); | |
| $meta_obj->save( 'MYMETA.json' ); | |
| $meta_obj->save( 'MYMETA.yml', { version => "1.4" } ); | |
| return 1; | |
| } | |
| =head3 realclean (o) | |
| Defines the realclean target. | |
| =cut | |
| sub realclean { | |
| my($self, %attribs) = @_; | |
| my @dirs = qw($(DISTVNAME)); | |
| my @files = qw($(FIRST_MAKEFILE) $(MAKEFILE_OLD)); | |
| # Special exception for the perl core where INST_* is not in blib. | |
| # This cleans up the files built from the ext/ directory (all XS). | |
| if( $self->{PERL_CORE} ) { | |
| push @dirs, qw($(INST_AUTODIR) $(INST_ARCHAUTODIR)); | |
| push @files, values %{$self->{PM}}; | |
| } | |
| if( $self->has_link_code ){ | |
| push @files, qw($(OBJECT)); | |
| } | |
| if( $attribs{FILES} ) { | |
| if( ref $attribs{FILES} ) { | |
| push @dirs, @{ $attribs{FILES} }; | |
| } | |
| else { | |
| push @dirs, split /\s+/, $attribs{FILES}; | |
| } | |
| } | |
| # Occasionally files are repeated several times from different sources | |
| { my(%f) = map { ($_ => 1) } @files; @files = keys %f; } | |
| { my(%d) = map { ($_ => 1) } @dirs; @dirs = keys %d; } | |
| my $rm_cmd = join "\n\t", map { "$_" } | |
| $self->split_command('- $(RM_F)', @files); | |
| my $rmf_cmd = join "\n\t", map { "$_" } | |
| $self->split_command('- $(RM_RF)', @dirs); | |
| my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd; | |
| # Delete temporary files (via clean) and also delete dist files | |
| realclean purge :: clean realclean_subdirs | |
| %s | |
| %s | |
| MAKE | |
| $m .= "\t$attribs{POSTOP}\n" if $attribs{POSTOP}; | |
| return $m; | |
| } | |
| =head3 realclean_subdirs_target | |
| my $make_frag = $MM->realclean_subdirs_target; | |
| Returns the realclean_subdirs target. This is used by the realclean | |
| target to call realclean on any subdirectories which contain Makefiles. | |
| =cut | |
| sub realclean_subdirs_target { | |
| my $self = shift; | |
| return <<'NOOP_FRAG' unless @{$self->{DIR}}; | |
| realclean_subdirs : | |
| $(NOECHO) $(NOOP) | |
| NOOP_FRAG | |
| my $rclean = "realclean_subdirs :\n"; | |
| foreach my $dir (@{$self->{DIR}}) { | |
| foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) { | |
| my $subrclean .= $self->oneliner(sprintf <<'CODE', $dir, ($makefile) x 2); | |
| chdir '%s'; system '$(MAKE) $(USEMAKEFILE) %s realclean' if -f '%s'; | |
| CODE | |
| $rclean .= sprintf <<'RCLEAN', $subrclean; | |
| - %s | |
| RCLEAN | |
| } | |
| } | |
| return $rclean; | |
| } | |
| =head3 signature_target | |
| my $target = $mm->signature_target; | |
| Generate the signature target. | |
| Writes the file SIGNATURE with "cpansign -s". | |
| =cut | |
| sub signature_target { | |
| my $self = shift; | |
| return <<'MAKE_FRAG'; | |
| signature : | |
| cpansign -s | |
| MAKE_FRAG | |
| } | |
| =head3 distsignature_target | |
| my $make_frag = $mm->distsignature_target; | |
| Generates the distsignature target to add SIGNATURE to the MANIFEST in the | |
| distdir. | |
| =cut | |
| sub distsignature_target { | |
| my $self = shift; | |
| my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']); | |
| eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } | |
| or print "Could not add SIGNATURE to MANIFEST: $${'@'}\n" | |
| CODE | |
| my $sign_dist = $self->cd('$(DISTVNAME)' => 'cpansign -s'); | |
| # cpansign -s complains if SIGNATURE is in the MANIFEST yet does not | |
| # exist | |
| my $touch_sig = $self->cd('$(DISTVNAME)' => '$(TOUCH) SIGNATURE'); | |
| my $add_sign_to_dist = $self->cd('$(DISTVNAME)' => $add_sign ); | |
| return sprintf <<'MAKE', $add_sign_to_dist, $touch_sig, $sign_dist | |
| distsignature : create_distdir | |
| $(NOECHO) %s | |
| $(NOECHO) %s | |
| %s | |
| MAKE | |
| } | |
| =head3 special_targets | |
| my $make_frag = $mm->special_targets | |
| Returns a make fragment containing any targets which have special | |
| meaning to make. For example, .SUFFIXES and .PHONY. | |
| =cut | |
| sub special_targets { | |
| my $make_frag = <<'MAKE_FRAG'; | |
| .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) | |
| .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir | |
| MAKE_FRAG | |
| $make_frag .= <<'MAKE_FRAG' if $ENV{CLEARCASE_ROOT}; | |
| .NO_CONFIG_REC: Makefile | |
| MAKE_FRAG | |
| return $make_frag; | |
| } | |
| =head2 Init methods | |
| Methods which help initialize the MakeMaker object and macros. | |
| =head3 init_ABSTRACT | |
| $mm->init_ABSTRACT | |
| =cut | |
| sub init_ABSTRACT { | |
| my $self = shift; | |
| if( $self->{ABSTRACT_FROM} and $self->{ABSTRACT} ) { | |
| warn "Both ABSTRACT_FROM and ABSTRACT are set. ". | |
| "Ignoring ABSTRACT_FROM.\n"; | |
| return; | |
| } | |
| if ($self->{ABSTRACT_FROM}){ | |
| $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or | |
| carp "WARNING: Setting ABSTRACT via file ". | |
| "'$self->{ABSTRACT_FROM}' failed\n"; | |
| } | |
| } | |
| =head3 init_INST | |
| $mm->init_INST; | |
| Called by init_main. Sets up all INST_* variables except those related | |
| to XS code. Those are handled in init_xs. | |
| =cut | |
| sub init_INST { | |
| my($self) = shift; | |
| $self->{INST_ARCHLIB} ||= $self->catdir($Curdir,"blib","arch"); | |
| $self->{INST_BIN} ||= $self->catdir($Curdir,'blib','bin'); | |
| # INST_LIB typically pre-set if building an extension after | |
| # perl has been built and installed. Setting INST_LIB allows | |
| # you to build directly into, say $Config{privlibexp}. | |
| unless ($self->{INST_LIB}){ | |
| if ($self->{PERL_CORE}) { | |
| if (defined $Cross::platform) { | |
| $self->{INST_LIB} = $self->{INST_ARCHLIB} = | |
| $self->catdir($self->{PERL_LIB},"..","xlib", | |
| $Cross::platform); | |
| } | |
| else { | |
| $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB}; | |
| } | |
| } else { | |
| $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib"); | |
| } | |
| } | |
| my @parentdir = split(/::/, $self->{PARENT_NAME}); | |
| $self->{INST_LIBDIR} = $self->catdir('$(INST_LIB)', @parentdir); | |
| $self->{INST_ARCHLIBDIR} = $self->catdir('$(INST_ARCHLIB)', @parentdir); | |
| $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)', 'auto', | |
| '$(FULLEXT)'); | |
| $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto', | |
| '$(FULLEXT)'); | |
| $self->{INST_SCRIPT} ||= $self->catdir($Curdir,'blib','script'); | |
| $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1'); | |
| $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3'); | |
| return 1; | |
| } | |
| =head3 init_INSTALL | |
| $mm->init_INSTALL; | |
| Called by init_main. Sets up all INSTALL_* variables (except | |
| INSTALLDIRS) and *PREFIX. | |
| =cut | |
| sub init_INSTALL { | |
| my($self) = shift; | |
| if( $self->{ARGS}{INSTALL_BASE} and $self->{ARGS}{PREFIX} ) { | |
| die "Only one of PREFIX or INSTALL_BASE can be given. Not both.\n"; | |
| } | |
| if( $self->{ARGS}{INSTALL_BASE} ) { | |
| $self->init_INSTALL_from_INSTALL_BASE; | |
| } | |
| else { | |
| $self->init_INSTALL_from_PREFIX; | |
| } | |
| } | |
| =head3 init_INSTALL_from_PREFIX | |
| $mm->init_INSTALL_from_PREFIX; | |
| =cut | |
| sub init_INSTALL_from_PREFIX { | |
| my $self = shift; | |
| $self->init_lib2arch; | |
| # There are often no Config.pm defaults for these new man variables so | |
| # we fall back to the old behavior which is to use installman*dir | |
| foreach my $num (1, 3) { | |
| my $k = 'installsiteman'.$num.'dir'; | |
| $self->{uc $k} ||= uc "\$(installman${num}dir)" | |
| unless $Config{$k}; | |
| } | |
| foreach my $num (1, 3) { | |
| my $k = 'installvendorman'.$num.'dir'; | |
| unless( $Config{$k} ) { | |
| $self->{uc $k} ||= $Config{usevendorprefix} | |
| ? uc "\$(installman${num}dir)" | |
| : ''; | |
| } | |
| } | |
| $self->{INSTALLSITEBIN} ||= '$(INSTALLBIN)' | |
| unless $Config{installsitebin}; | |
| $self->{INSTALLSITESCRIPT} ||= '$(INSTALLSCRIPT)' | |
| unless $Config{installsitescript}; | |
| unless( $Config{installvendorbin} ) { | |
| $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix} | |
| ? $Config{installbin} | |
| : ''; | |
| } | |
| unless( $Config{installvendorscript} ) { | |
| $self->{INSTALLVENDORSCRIPT} ||= $Config{usevendorprefix} | |
| ? $Config{installscript} | |
| : ''; | |
| } | |
| my $iprefix = $Config{installprefixexp} || $Config{installprefix} || | |
| $Config{prefixexp} || $Config{prefix} || ''; | |
| my $vprefix = $Config{usevendorprefix} ? $Config{vendorprefixexp} : ''; | |
| my $sprefix = $Config{siteprefixexp} || ''; | |
| # 5.005_03 doesn't have a siteprefix. | |
| $sprefix = $iprefix unless $sprefix; | |
| $self->{PREFIX} ||= ''; | |
| if( $self->{PREFIX} ) { | |
| @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} = | |
| ('$(PREFIX)') x 3; | |
| } | |
| else { | |
| $self->{PERLPREFIX} ||= $iprefix; | |
| $self->{SITEPREFIX} ||= $sprefix; | |
| $self->{VENDORPREFIX} ||= $vprefix; | |
| # Lots of MM extension authors like to use $(PREFIX) so we | |
| # put something sensible in there no matter what. | |
| $self->{PREFIX} = '$('.uc $self->{INSTALLDIRS}.'PREFIX)'; | |
| } | |
| my $arch = $Config{archname}; | |
| my $version = $Config{version}; | |
| # default style | |
| my $libstyle = $Config{installstyle} || 'lib/perl5'; | |
| my $manstyle = ''; | |
| if( $self->{LIBSTYLE} ) { | |
| $libstyle = $self->{LIBSTYLE}; | |
| $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : ''; | |
| } | |
| # Some systems, like VOS, set installman*dir to '' if they can't | |
| # read man pages. | |
| for my $num (1, 3) { | |
| $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none' | |
| unless $Config{'installman'.$num.'dir'}; | |
| } | |
| my %bin_layouts = | |
| ( | |
| bin => { s => $iprefix, | |
| t => 'perl', | |
| d => 'bin' }, | |
| vendorbin => { s => $vprefix, | |
| t => 'vendor', | |
| d => 'bin' }, | |
| sitebin => { s => $sprefix, | |
| t => 'site', | |
| d => 'bin' }, | |
| script => { s => $iprefix, | |
| t => 'perl', | |
| d => 'bin' }, | |
| vendorscript=> { s => $vprefix, | |
| t => 'vendor', | |
| d => 'bin' }, | |
| sitescript => { s => $sprefix, | |
| t => 'site', | |
| d => 'bin' }, | |
| ); | |
| my %man_layouts = | |
| ( | |
| man1dir => { s => $iprefix, | |
| t => 'perl', | |
| d => 'man/man1', | |
| style => $manstyle, }, | |
| siteman1dir => { s => $sprefix, | |
| t => 'site', | |
| d => 'man/man1', | |
| style => $manstyle, }, | |
| vendorman1dir => { s => $vprefix, | |
| t => 'vendor', | |
| d => 'man/man1', | |
| style => $manstyle, }, | |
| man3dir => { s => $iprefix, | |
| t => 'perl', | |
| d => 'man/man3', | |
| style => $manstyle, }, | |
| siteman3dir => { s => $sprefix, | |
| t => 'site', | |
| d => 'man/man3', | |
| style => $manstyle, }, | |
| vendorman3dir => { s => $vprefix, | |
| t => 'vendor', | |
| d => 'man/man3', | |
| style => $manstyle, }, | |
| ); | |
| my %lib_layouts = | |
| ( | |
| privlib => { s => $iprefix, | |
| t => 'perl', | |
| d => '', | |
| style => $libstyle, }, | |
| vendorlib => { s => $vprefix, | |
| t => 'vendor', | |
| d => '', | |
| style => $libstyle, }, | |
| sitelib => { s => $sprefix, | |
| t => 'site', | |
| d => 'site_perl', | |
| style => $libstyle, }, | |
| archlib => { s => $iprefix, | |
| t => 'perl', | |
| d => "$version/$arch", | |
| style => $libstyle }, | |
| vendorarch => { s => $vprefix, | |
| t => 'vendor', | |
| d => "$version/$arch", | |
| style => $libstyle }, | |
| sitearch => { s => $sprefix, | |
| t => 'site', | |
| d => "site_perl/$version/$arch", | |
| style => $libstyle }, | |
| ); | |
| # Special case for LIB. | |
| if( $self->{LIB} ) { | |
| foreach my $var (keys %lib_layouts) { | |
| my $Installvar = uc "install$var"; | |
| if( $var =~ /arch/ ) { | |
| $self->{$Installvar} ||= | |
| $self->catdir($self->{LIB}, $Config{archname}); | |
| } | |
| else { | |
| $self->{$Installvar} ||= $self->{LIB}; | |
| } | |
| } | |
| } | |
| my %type2prefix = ( perl => 'PERLPREFIX', | |
| site => 'SITEPREFIX', | |
| vendor => 'VENDORPREFIX' | |
| ); | |
| my %layouts = (%bin_layouts, %man_layouts, %lib_layouts); | |
| while( my($var, $layout) = each(%layouts) ) { | |
| my($s, $t, $d, $style) = @{$layout}{qw(s t d style)}; | |
| my $r = '$('.$type2prefix{$t}.')'; | |
| print STDERR "Prefixing $var\n" if $Verbose >= 2; | |
| my $installvar = "install$var"; | |
| my $Installvar = uc $installvar; | |
| next if $self->{$Installvar}; | |
| $d = "$style/$d" if $style; | |
| $self->prefixify($installvar, $s, $r, $d); | |
| print STDERR " $Installvar == $self->{$Installvar}\n" | |
| if $Verbose >= 2; | |
| } | |
| # Generate these if they weren't figured out. | |
| $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH}; | |
| $self->{VENDORLIBEXP} ||= $self->{INSTALLVENDORLIB}; | |
| return 1; | |
| } | |
| =head3 init_from_INSTALL_BASE | |
| $mm->init_from_INSTALL_BASE | |
| =cut | |
| my %map = ( | |
| lib => [qw(lib perl5)], | |
| arch => [('lib', 'perl5', $Config{archname})], | |
| bin => [qw(bin)], | |
| man1dir => [qw(man man1)], | |
| man3dir => [qw(man man3)] | |
| ); | |
| $map{script} = $map{bin}; | |
| sub init_INSTALL_from_INSTALL_BASE { | |
| my $self = shift; | |
| @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} = | |
| '$(INSTALL_BASE)'; | |
| my %install; | |
| foreach my $thing (keys %map) { | |
| foreach my $dir (('', 'SITE', 'VENDOR')) { | |
| my $uc_thing = uc $thing; | |
| my $key = "INSTALL".$dir.$uc_thing; | |
| $install{$key} ||= | |
| $self->catdir('$(INSTALL_BASE)', @{$map{$thing}}); | |
| } | |
| } | |
| # Adjust for variable quirks. | |
| $install{INSTALLARCHLIB} ||= delete $install{INSTALLARCH}; | |
| $install{INSTALLPRIVLIB} ||= delete $install{INSTALLLIB}; | |
| foreach my $key (keys %install) { | |
| $self->{$key} ||= $install{$key}; | |
| } | |
| return 1; | |
| } | |
| =head3 init_VERSION I<Abstract> | |
| $mm->init_VERSION | |
| Initialize macros representing versions of MakeMaker and other tools | |
| MAKEMAKER: path to the MakeMaker module. | |
| MM_VERSION: ExtUtils::MakeMaker Version | |
| MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards | |
| compat) | |
| VERSION: version of your module | |
| VERSION_MACRO: which macro represents the version (usually 'VERSION') | |
| VERSION_SYM: like version but safe for use as an RCS revision number | |
| DEFINE_VERSION: -D line to set the module version when compiling | |
| XS_VERSION: version in your .xs file. Defaults to $(VERSION) | |
| XS_VERSION_MACRO: which macro represents the XS version. | |
| XS_DEFINE_VERSION: -D line to set the xs version when compiling. | |
| Called by init_main. | |
| =cut | |
| sub init_VERSION { | |
| my($self) = shift; | |
| $self->{MAKEMAKER} = $ExtUtils::MakeMaker::Filename; | |
| $self->{MM_VERSION} = $ExtUtils::MakeMaker::VERSION; | |
| $self->{MM_REVISION}= $ExtUtils::MakeMaker::Revision; | |
| $self->{VERSION_FROM} ||= ''; | |
| if ($self->{VERSION_FROM}){ | |
| $self->{VERSION} = $self->parse_version($self->{VERSION_FROM}); | |
| if( $self->{VERSION} eq 'undef' ) { | |
| carp("WARNING: Setting VERSION via file ". | |
| "'$self->{VERSION_FROM}' failed\n"); | |
| } | |
| } | |
| # strip blanks | |
| if (defined $self->{VERSION}) { | |
| $self->{VERSION} =~ s/^\s+//; | |
| $self->{VERSION} =~ s/\s+$//; | |
| } | |
| else { | |
| $self->{VERSION} = ''; | |
| } | |
| $self->{VERSION_MACRO} = 'VERSION'; | |
| ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g; | |
| $self->{DEFINE_VERSION} = '-D$(VERSION_MACRO)=\"$(VERSION)\"'; | |
| # Graham Barr and Paul Marquess had some ideas how to ensure | |
| # version compatibility between the *.pm file and the | |
| # corresponding *.xs file. The bottomline was, that we need an | |
| # XS_VERSION macro that defaults to VERSION: | |
| $self->{XS_VERSION} ||= $self->{VERSION}; | |
| $self->{XS_VERSION_MACRO} = 'XS_VERSION'; | |
| $self->{XS_DEFINE_VERSION} = '-D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"'; | |
| } | |
| =head3 init_others | |
| $MM->init_others(); | |
| Initializes the macro definitions used by tools_other() and places them | |
| in the $MM object. | |
| If there is no description, its the same as the parameter to | |
| WriteMakefile() documented in ExtUtils::MakeMaker. | |
| Defines at least these macros. | |
| Macro Description | |
| NOOP Do nothing | |
| NOECHO Tell make not to display the command itself | |
| MAKEFILE | |
| FIRST_MAKEFILE | |
| MAKEFILE_OLD | |
| MAKE_APERL_FILE File used by MAKE_APERL | |
| SHELL Program used to run shell commands | |
| ECHO Print text adding a newline on the end | |
| RM_F Remove a file | |
| RM_RF Remove a directory | |
| TOUCH Update a file's timestamp | |
| TEST_F Test for a file's existence | |
| CP Copy a file | |
| MV Move a file | |
| CHMOD Change permissions on a file | |
| FALSE Exit with non-zero | |
| TRUE Exit with zero | |
| UMASK_NULL Nullify umask | |
| DEV_NULL Suppress all command output | |
| =cut | |
| sub init_others { | |
| my $self = shift; | |
| $self->{ECHO} ||= $self->oneliner('print qq{@ARGV}', ['-l']); | |
| $self->{ECHO_N} ||= $self->oneliner('print qq{@ARGV}'); | |
| $self->{TOUCH} ||= $self->oneliner('touch', ["-MExtUtils::Command"]); | |
| $self->{CHMOD} ||= $self->oneliner('chmod', ["-MExtUtils::Command"]); | |
| $self->{RM_F} ||= $self->oneliner('rm_f', ["-MExtUtils::Command"]); | |
| $self->{RM_RF} ||= $self->oneliner('rm_rf', ["-MExtUtils::Command"]); | |
| $self->{TEST_F} ||= $self->oneliner('test_f', ["-MExtUtils::Command"]); | |
| $self->{FALSE} ||= $self->oneliner('exit 1'); | |
| $self->{TRUE} ||= $self->oneliner('exit 0'); | |
| $self->{MKPATH} ||= $self->oneliner('mkpath', ["-MExtUtils::Command"]); | |
| $self->{CP} ||= $self->oneliner('cp', ["-MExtUtils::Command"]); | |
| $self->{MV} ||= $self->oneliner('mv', ["-MExtUtils::Command"]); | |
| $self->{MOD_INSTALL} ||= | |
| $self->oneliner(<<'CODE', ['-MExtUtils::Install']); | |
| install([ from_to => {@ARGV}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]); | |
| CODE | |
| $self->{DOC_INSTALL} ||= $self->oneliner('perllocal_install', ["-MExtUtils::Command::MM"]); | |
| $self->{UNINSTALL} ||= $self->oneliner('uninstall', ["-MExtUtils::Command::MM"]); | |
| $self->{WARN_IF_OLD_PACKLIST} ||= | |
| $self->oneliner('warn_if_old_packlist', ["-MExtUtils::Command::MM"]); | |
| $self->{FIXIN} ||= $self->oneliner('MY->fixin(shift)', ["-MExtUtils::MY"]); | |
| $self->{EQUALIZE_TIMESTAMP} ||= $self->oneliner('eqtime', ["-MExtUtils::Command"]); | |
| $self->{UNINST} ||= 0; | |
| $self->{VERBINST} ||= 0; | |
| $self->{FIRST_MAKEFILE} ||= $self->{MAKEFILE} || 'Makefile'; | |
| $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE}; | |
| $self->{MAKEFILE_OLD} ||= $self->{MAKEFILE}.'.old'; | |
| $self->{MAKE_APERL_FILE} ||= $self->{MAKEFILE}.'.aperl'; | |
| # Not everybody uses -f to indicate "use this Makefile instead" | |
| $self->{USEMAKEFILE} ||= '-f'; | |
| # Some makes require a wrapper around macros passed in on the command | |
| # line. | |
| $self->{MACROSTART} ||= ''; | |
| $self->{MACROEND} ||= ''; | |
| $self->{SHELL} ||= $Config{sh}; | |
| # UMASK_NULL is not used by MakeMaker but some CPAN modules | |
| # make use of it. | |
| $self->{UMASK_NULL} ||= "umask 0"; | |
| # Not the greatest default, but its something. | |
| $self->{DEV_NULL} ||= "> /dev/null 2>&1"; | |
| $self->{NOOP} ||= '$(TRUE)'; | |
| $self->{NOECHO} = '@' unless defined $self->{NOECHO}; | |
| $self->{LD_RUN_PATH} = ""; | |
| $self->{LIBS} = $self->_fix_libs($self->{LIBS}); | |
| # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS} | |
| foreach my $libs ( @{$self->{LIBS}} ){ | |
| $libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace | |
| my(@libs) = $self->extliblist($libs); | |
| if ($libs[0] or $libs[1] or $libs[2]){ | |
| # LD_RUN_PATH now computed by ExtUtils::Liblist | |
| ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, | |
| $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs; | |
| last; | |
| } | |
| } | |
| if ( $self->{OBJECT} ) { | |
| $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; | |
| } else { | |
| # init_dirscan should have found out, if we have C files | |
| $self->{OBJECT} = ""; | |
| $self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]}; | |
| } | |
| $self->{OBJECT} =~ s/\n+/ \\\n\t/g; | |
| $self->{BOOTDEP} = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : ""; | |
| $self->{PERLMAINCC} ||= '$(CC)'; | |
| $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM}; | |
| # Sanity check: don't define LINKTYPE = dynamic if we're skipping | |
| # the 'dynamic' section of MM. We don't have this problem with | |
| # 'static', since we either must use it (%Config says we can't | |
| # use dynamic loading) or the caller asked for it explicitly. | |
| if (!$self->{LINKTYPE}) { | |
| $self->{LINKTYPE} = $self->{SKIPHASH}{'dynamic'} | |
| ? 'static' | |
| : ($Config{usedl} ? 'dynamic' : 'static'); | |
| } | |
| return 1; | |
| } | |
| # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or | |
| # undefined. In any case we turn it into an anon array | |
| sub _fix_libs { | |
| my($self, $libs) = @_; | |
| return !defined $libs ? [''] : | |
| !ref $libs ? [$libs] : | |
| !defined $libs->[0] ? [''] : | |
| $libs ; | |
| } | |
| =head3 tools_other | |
| my $make_frag = $MM->tools_other; | |
| Returns a make fragment containing definitions for the macros init_others() | |
| initializes. | |
| =cut | |
| sub tools_other { | |
| my($self) = shift; | |
| my @m; | |
| # We set PM_FILTER as late as possible so it can see all the earlier | |
| # on macro-order sensitive makes such as nmake. | |
| for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH | |
| UMASK_NULL DEV_NULL MKPATH EQUALIZE_TIMESTAMP | |
| FALSE TRUE | |
| ECHO ECHO_N | |
| UNINST VERBINST | |
| MOD_INSTALL DOC_INSTALL UNINSTALL | |
| WARN_IF_OLD_PACKLIST | |
| MACROSTART MACROEND | |
| USEMAKEFILE | |
| PM_FILTER | |
| FIXIN | |
| } ) | |
| { | |
| next unless defined $self->{$tool}; | |
| push @m, "$tool = $self->{$tool}\n"; | |
| } | |
| return join "", @m; | |
| } | |
| =head3 init_DIRFILESEP I<Abstract> | |
| $MM->init_DIRFILESEP; | |
| my $dirfilesep = $MM->{DIRFILESEP}; | |
| Initializes the DIRFILESEP macro which is the seperator between the | |
| directory and filename in a filepath. ie. / on Unix, \ on Win32 and | |
| nothing on VMS. | |
| For example: | |
| # instead of $(INST_ARCHAUTODIR)/extralibs.ld | |
| $(INST_ARCHAUTODIR)$(DIRFILESEP)extralibs.ld | |
| Something of a hack but it prevents a lot of code duplication between | |
| MM_* variants. | |
| Do not use this as a seperator between directories. Some operating | |
| systems use different seperators between subdirectories as between | |
| directories and filenames (for example: VOLUME:[dir1.dir2]file on VMS). | |
| =head3 init_linker I<Abstract> | |
| $mm->init_linker; | |
| Initialize macros which have to do with linking. | |
| PERL_ARCHIVE: path to libperl.a equivalent to be linked to dynamic | |
| extensions. | |
| PERL_ARCHIVE_AFTER: path to a library which should be put on the | |
| linker command line I<after> the external libraries to be linked to | |
| dynamic extensions. This may be needed if the linker is one-pass, and | |
| Perl includes some overrides for C RTL functions, such as malloc(). | |
| EXPORT_LIST: name of a file that is passed to linker to define symbols | |
| to be exported. | |
| Some OSes do not need these in which case leave it blank. | |
| =head3 init_platform | |
| $mm->init_platform | |
| Initialize any macros which are for platform specific use only. | |
| A typical one is the version number of your OS specific mocule. | |
| (ie. MM_Unix_VERSION or MM_VMS_VERSION). | |
| =cut | |
| sub init_platform { | |
| return ''; | |
| } | |
| =head3 init_MAKE | |
| $mm->init_MAKE | |
| Initialize MAKE from either a MAKE environment variable or $Config{make}. | |
| =cut | |
| sub init_MAKE { | |
| my $self = shift; | |
| $self->{MAKE} ||= $ENV{MAKE} || $Config{make}; | |
| } | |
| =head2 Tools | |
| A grab bag of methods to generate specific macros and commands. | |
| =head3 manifypods | |
| Defines targets and routines to translate the pods into manpages and | |
| put them into the INST_* directories. | |
| =cut | |
| sub manifypods { | |
| my $self = shift; | |
| my $POD2MAN_macro = $self->POD2MAN_macro(); | |
| my $manifypods_target = $self->manifypods_target(); | |
| return <<END_OF_TARGET; | |
| $POD2MAN_macro | |
| $manifypods_target | |
| END_OF_TARGET | |
| } | |
| =head3 POD2MAN_macro | |
| my $pod2man_macro = $self->POD2MAN_macro | |
| Returns a definition for the POD2MAN macro. This is a program | |
| which emulates the pod2man utility. You can add more switches to the | |
| command by simply appending them on the macro. | |
| Typical usage: | |
| $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) podfile1 man_page1 ... | |
| =cut | |
| sub POD2MAN_macro { | |
| my $self = shift; | |
| # Need the trailing '--' so perl stops gobbling arguments and - happens | |
| # to be an alternative end of line seperator on VMS so we quote it | |
| return <<'END_OF_DEF'; | |
| POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" | |
| POD2MAN = $(POD2MAN_EXE) | |
| END_OF_DEF | |
| } | |
| =head3 test_via_harness | |
| my $command = $mm->test_via_harness($perl, $tests); | |
| Returns a $command line which runs the given set of $tests with | |
| Test::Harness and the given $perl. | |
| Used on the t/*.t files. | |
| =cut | |
| sub test_via_harness { | |
| my($self, $perl, $tests) = @_; | |
| return qq{\t$perl "-MExtUtils::Command::MM" }. | |
| qq{"-e" "test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n}; | |
| } | |
| =head3 test_via_script | |
| my $command = $mm->test_via_script($perl, $script); | |
| Returns a $command line which just runs a single test without | |
| Test::Harness. No checks are done on the results, they're just | |
| printed. | |
| Used for test.pl, since they don't always follow Test::Harness | |
| formatting. | |
| =cut | |
| sub test_via_script { | |
| my($self, $perl, $script) = @_; | |
| return qq{\t$perl "-I\$(INST_LIB)" "-I\$(INST_ARCHLIB)" $script\n}; | |
| } | |
| =head3 tool_autosplit | |
| Defines a simple perl call that runs autosplit. May be deprecated by | |
| pm_to_blib soon. | |
| =cut | |
| sub tool_autosplit { | |
| my($self, %attribs) = @_; | |
| my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};' | |
| : ''; | |
| my $asplit = $self->oneliner(sprintf <<'PERL_CODE', $maxlen); | |
| use AutoSplit; %s autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) | |
| PERL_CODE | |
| return sprintf <<'MAKE_FRAG', $asplit; | |
| # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto | |
| AUTOSPLITFILE = %s | |
| MAKE_FRAG | |
| } | |
| =head3 arch_check | |
| my $arch_ok = $mm->arch_check( | |
| $INC{"Config.pm"}, | |
| File::Spec->catfile($Config{archlibexp}, "Config.pm") | |
| ); | |
| A sanity check that what Perl thinks the architecture is and what | |
| Config thinks the architecture is are the same. If they're not it | |
| will return false and show a diagnostic message. | |
| When building Perl it will always return true, as nothing is installed | |
| yet. | |
| The interface is a bit odd because this is the result of a | |
| quick refactoring. Don't rely on it. | |
| =cut | |
| sub arch_check { | |
| my $self = shift; | |
| my($pconfig, $cconfig) = @_; | |
| return 1 if $self->{PERL_SRC}; | |
| my($pvol, $pthinks) = $self->splitpath($pconfig); | |
| my($cvol, $cthinks) = $self->splitpath($cconfig); | |
| $pthinks = $self->canonpath($pthinks); | |
| $cthinks = $self->canonpath($cthinks); | |
| my $ret = 1; | |
| if ($pthinks ne $cthinks) { | |
| print "Have $pthinks\n"; | |
| print "Want $cthinks\n"; | |
| $ret = 0; | |
| my $arch = (grep length, $self->splitdir($pthinks))[-1]; | |
| print STDOUT <<END unless $self->{UNINSTALLED_PERL}; | |
| Your perl and your Config.pm seem to have different ideas about the | |
| architecture they are running on. | |
| Perl thinks: [$arch] | |
| Config says: [$Config{archname}] | |
| This may or may not cause problems. Please check your installation of perl | |
| if you have problems building this extension. | |
| END | |
| } | |
| return $ret; | |
| } | |
| =head2 File::Spec wrappers | |
| ExtUtils::MM_Any is a subclass of File::Spec. The methods noted here | |
| override File::Spec. | |
| =head3 catfile | |
| File::Spec <= 0.83 has a bug where the file part of catfile is not | |
| canonicalized. This override fixes that bug. | |
| =cut | |
| sub catfile { | |
| my $self = shift; | |
| return $self->canonpath($self->SUPER::catfile(@_)); | |
| } | |
| =head2 Misc | |
| Methods I can't really figure out where they should go yet. | |
| =head3 find_tests | |
| my $test = $mm->find_tests; | |
| Returns a string suitable for feeding to the shell to return all | |
| tests in t/*.t. | |
| =cut | |
| sub find_tests { | |
| my($self) = shift; | |
| return -d 't' ? 't/*.t' : ''; | |
| } | |
| =head3 extra_clean_files | |
| my @files_to_clean = $MM->extra_clean_files; | |
| Returns a list of OS specific files to be removed in the clean target in | |
| addition to the usual set. | |
| =cut | |
| # An empty method here tickled a perl 5.8.1 bug and would return its object. | |
| sub extra_clean_files { | |
| return; | |
| } | |
| =head3 installvars | |
| my @installvars = $mm->installvars; | |
| A list of all the INSTALL* variables without the INSTALL prefix. Useful | |
| for iteration or building related variable sets. | |
| =cut | |
| sub installvars { | |
| return qw(PRIVLIB SITELIB VENDORLIB | |
| ARCHLIB SITEARCH VENDORARCH | |
| BIN SITEBIN VENDORBIN | |
| SCRIPT SITESCRIPT VENDORSCRIPT | |
| MAN1DIR SITEMAN1DIR VENDORMAN1DIR | |
| MAN3DIR SITEMAN3DIR VENDORMAN3DIR | |
| ); | |
| } | |
| =head3 libscan | |
| my $wanted = $self->libscan($path); | |
| Takes a path to a file or dir and returns an empty string if we don't | |
| want to include this file in the library. Otherwise it returns the | |
| the $path unchanged. | |
| Mainly used to exclude version control administrative directories from | |
| installation. | |
| =cut | |
| sub libscan { | |
| my($self,$path) = @_; | |
| my($dirs,$file) = ($self->splitpath($path))[1,2]; | |
| return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/, | |
| $self->splitdir($dirs), $file; | |
| return $path; | |
| } | |
| =head3 platform_constants | |
| my $make_frag = $mm->platform_constants | |
| Returns a make fragment defining all the macros initialized in | |
| init_platform() rather than put them in constants(). | |
| =cut | |
| sub platform_constants { | |
| return ''; | |
| } | |
| =begin private | |
| =head3 _PREREQ_PRINT | |
| $self->_PREREQ_PRINT; | |
| Implements PREREQ_PRINT. | |
| Refactored out of MakeMaker->new(). | |
| =end private | |
| =cut | |
| sub _PREREQ_PRINT { | |
| my $self = shift; | |
| require Data::Dumper; | |
| my @what = ('PREREQ_PM'); | |
| push @what, 'MIN_PERL_VERSION' if $self->{MIN_PERL_VERSION}; | |
| push @what, 'BUILD_REQUIRES' if $self->{BUILD_REQUIRES}; | |
| print Data::Dumper->Dump([@{$self}{@what}], \@what); | |
| exit 0; | |
| } | |
| =begin private | |
| =head3 _PRINT_PREREQ | |
| $mm->_PRINT_PREREQ; | |
| Implements PRINT_PREREQ, a slightly different version of PREREQ_PRINT | |
| added by Redhat to, I think, support generating RPMs from Perl modules. | |
| Should not include BUILD_REQUIRES as RPMs do not incluide them. | |
| Refactored out of MakeMaker->new(). | |
| =end private | |
| =cut | |
| sub _PRINT_PREREQ { | |
| my $self = shift; | |
| my $prereqs= $self->{PREREQ_PM}; | |
| my @prereq = map { [$_, $prereqs->{$_}] } keys %$prereqs; | |
| if ( $self->{MIN_PERL_VERSION} ) { | |
| push @prereq, ['perl' => $self->{MIN_PERL_VERSION}]; | |
| } | |
| print join(" ", map { "perl($_->[0])>=$_->[1] " } | |
| sort { $a->[0] cmp $b->[0] } @prereq), "\n"; | |
| exit 0; | |
| } | |
| =begin private | |
| =head3 _all_prereqs | |
| my $prereqs = $self->_all_prereqs; | |
| Returns a hash ref of both PREREQ_PM and BUILD_REQUIRES. | |
| =end private | |
| =cut | |
| sub _all_prereqs { | |
| my $self = shift; | |
| return { %{$self->{PREREQ_PM}}, %{$self->{BUILD_REQUIRES}} }; | |
| } | |
| =head1 AUTHOR | |
| Michael G Schwern <[email protected]> and the denizens of | |
| [email protected] with code from ExtUtils::MM_Unix and | |
| ExtUtils::MM_Win32. | |
| =cut | |
| 1; | |
| EXTUTILS_MM_ANY | |
| $fatpacked{"ExtUtils/MM_BeOS.pm"} = <<'EXTUTILS_MM_BEOS'; | |
| package ExtUtils::MM_BeOS; | |
| use strict; | |
| =head1 NAME | |
| ExtUtils::MM_BeOS - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
| =head1 SYNOPSIS | |
| use ExtUtils::MM_BeOS; # Done internally by ExtUtils::MakeMaker if needed | |
| =head1 DESCRIPTION | |
| See ExtUtils::MM_Unix for a documentation of the methods provided | |
| there. This package overrides the implementation of these methods, not | |
| the semantics. | |
| =over 4 | |
| =cut | |
| use ExtUtils::MakeMaker::Config; | |
| use File::Spec; | |
| require ExtUtils::MM_Any; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); | |
| our $VERSION = '6.59'; | |
| =item os_flavor | |
| BeOS is BeOS. | |
| =cut | |
| sub os_flavor { | |
| return('BeOS'); | |
| } | |
| =item init_linker | |
| libperl.a equivalent to be linked to dynamic extensions. | |
| =cut | |
| sub init_linker { | |
| my($self) = shift; | |
| $self->{PERL_ARCHIVE} ||= | |
| File::Spec->catdir('$(PERL_INC)',$Config{libperl}); | |
| $self->{PERL_ARCHIVE_AFTER} ||= ''; | |
| $self->{EXPORT_LIST} ||= ''; | |
| } | |
| =back | |
| 1; | |
| __END__ | |
| EXTUTILS_MM_BEOS | |
| $fatpacked{"ExtUtils/MM_Cygwin.pm"} = <<'EXTUTILS_MM_CYGWIN'; | |
| package ExtUtils::MM_Cygwin; | |
| use strict; | |
| use ExtUtils::MakeMaker::Config; | |
| use File::Spec; | |
| require ExtUtils::MM_Unix; | |
| require ExtUtils::MM_Win32; | |
| our @ISA = qw( ExtUtils::MM_Unix ); | |
| our $VERSION = '6.59'; | |
| =head1 NAME | |
| ExtUtils::MM_Cygwin - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
| =head1 SYNOPSIS | |
| use ExtUtils::MM_Cygwin; # Done internally by ExtUtils::MakeMaker if needed | |
| =head1 DESCRIPTION | |
| See ExtUtils::MM_Unix for a documentation of the methods provided there. | |
| =over 4 | |
| =item os_flavor | |
| We're Unix and Cygwin. | |
| =cut | |
| sub os_flavor { | |
| return('Unix', 'Cygwin'); | |
| } | |
| =item cflags | |
| if configured for dynamic loading, triggers #define EXT in EXTERN.h | |
| =cut | |
| sub cflags { | |
| my($self,$libperl)=@_; | |
| return $self->{CFLAGS} if $self->{CFLAGS}; | |
| return '' unless $self->needs_linking(); | |
| my $base = $self->SUPER::cflags($libperl); | |
| foreach (split /\n/, $base) { | |
| /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2; | |
| }; | |
| $self->{CCFLAGS} .= " -DUSEIMPORTLIB" if ($Config{useshrplib} eq 'true'); | |
| return $self->{CFLAGS} = qq{ | |
| CCFLAGS = $self->{CCFLAGS} | |
| OPTIMIZE = $self->{OPTIMIZE} | |
| PERLTYPE = $self->{PERLTYPE} | |
| }; | |
| } | |
| =item replace_manpage_separator | |
| replaces strings '::' with '.' in MAN*POD man page names | |
| =cut | |
| sub replace_manpage_separator { | |
| my($self, $man) = @_; | |
| $man =~ s{/+}{.}g; | |
| return $man; | |
| } | |
| =item init_linker | |
| points to libperl.a | |
| =cut | |
| sub init_linker { | |
| my $self = shift; | |
| if ($Config{useshrplib} eq 'true') { | |
| my $libperl = '$(PERL_INC)' .'/'. "$Config{libperl}"; | |
| if( $] >= 5.006002 ) { | |
| $libperl =~ s/a$/dll.a/; | |
| } | |
| $self->{PERL_ARCHIVE} = $libperl; | |
| } else { | |
| $self->{PERL_ARCHIVE} = | |
| '$(PERL_INC)' .'/'. ("$Config{libperl}" or "libperl.a"); | |
| } | |
| $self->{PERL_ARCHIVE_AFTER} ||= ''; | |
| $self->{EXPORT_LIST} ||= ''; | |
| } | |
| =item maybe_command | |
| If our path begins with F</cygdrive/> then we use C<ExtUtils::MM_Win32> | |
| to determine if it may be a command. Otherwise we use the tests | |
| from C<ExtUtils::MM_Unix>. | |
| =cut | |
| sub maybe_command { | |
| my ($self, $file) = @_; | |
| if ($file =~ m{^/cygdrive/}i) { | |
| return ExtUtils::MM_Win32->maybe_command($file); | |
| } | |
| return $self->SUPER::maybe_command($file); | |
| } | |
| =item dynamic_lib | |
| Use the default to produce the *.dll's. | |
| But for new archdir dll's use the same rebase address if the old exists. | |
| =cut | |
| sub dynamic_lib { | |
| my($self, %attribs) = @_; | |
| my $s = ExtUtils::MM_Unix::dynamic_lib($self, %attribs); | |
| my $ori = "$self->{INSTALLARCHLIB}/auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{DLEXT}"; | |
| if (-e $ori) { | |
| my $imagebase = `/bin/objdump -p $ori | /bin/grep ImageBase | /bin/cut -c12-`; | |
| chomp $imagebase; | |
| if ($imagebase gt "40000000") { | |
| my $LDDLFLAGS = $self->{LDDLFLAGS}; | |
| $LDDLFLAGS =~ s/-Wl,--enable-auto-image-base/-Wl,--image-base=0x$imagebase/; | |
| $s =~ s/ \$\(LDDLFLAGS\) / $LDDLFLAGS /m; | |
| } | |
| } | |
| $s; | |
| } | |
| =item all_target | |
| Build man pages, too | |
| =cut | |
| sub all_target { | |
| ExtUtils::MM_Unix::all_target(shift); | |
| } | |
| =back | |
| =cut | |
| 1; | |
| EXTUTILS_MM_CYGWIN | |
| $fatpacked{"ExtUtils/MM_DOS.pm"} = <<'EXTUTILS_MM_DOS'; | |
| package ExtUtils::MM_DOS; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Any; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); | |
| =head1 NAME | |
| ExtUtils::MM_DOS - DOS specific subclass of ExtUtils::MM_Unix | |
| =head1 SYNOPSIS | |
| Don't use this module directly. | |
| Use ExtUtils::MM and let it choose. | |
| =head1 DESCRIPTION | |
| This is a subclass of ExtUtils::MM_Unix which contains functionality | |
| for DOS. | |
| Unless otherwise stated, it works just like ExtUtils::MM_Unix | |
| =head2 Overridden methods | |
| =over 4 | |
| =item os_flavor | |
| =cut | |
| sub os_flavor { | |
| return('DOS'); | |
| } | |
| =item B<replace_manpage_separator> | |
| Generates Foo__Bar.3 style man page names | |
| =cut | |
| sub replace_manpage_separator { | |
| my($self, $man) = @_; | |
| $man =~ s,/+,__,g; | |
| return $man; | |
| } | |
| =back | |
| =head1 AUTHOR | |
| Michael G Schwern <[email protected]> with code from ExtUtils::MM_Unix | |
| =head1 SEE ALSO | |
| L<ExtUtils::MM_Unix>, L<ExtUtils::MakeMaker> | |
| =cut | |
| 1; | |
| EXTUTILS_MM_DOS | |
| $fatpacked{"ExtUtils/MM_Darwin.pm"} = <<'EXTUTILS_MM_DARWIN'; | |
| package ExtUtils::MM_Darwin; | |
| use strict; | |
| BEGIN { | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw( ExtUtils::MM_Unix ); | |
| } | |
| our $VERSION = '6.59'; | |
| =head1 NAME | |
| ExtUtils::MM_Darwin - special behaviors for OS X | |
| =head1 SYNOPSIS | |
| For internal MakeMaker use only | |
| =head1 DESCRIPTION | |
| See L<ExtUtils::MM_Unix> for L<ExtUtils::MM_Any> for documention on the | |
| methods overridden here. | |
| =head2 Overriden Methods | |
| =head3 init_dist | |
| Turn off Apple tar's tendency to copy resource forks as "._foo" files. | |
| =cut | |
| sub init_dist { | |
| my $self = shift; | |
| # Thank you, Apple, for breaking tar and then breaking the work around. | |
| # 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE while 10.5 wants | |
| # COPYFILE_DISABLE. I'm not going to push my luck and instead just | |
| # set both. | |
| $self->{TAR} ||= | |
| 'COPY_EXTENDED_ATTRIBUTES_DISABLE=1 COPYFILE_DISABLE=1 tar'; | |
| $self->SUPER::init_dist(@_); | |
| } | |
| 1; | |
| EXTUTILS_MM_DARWIN | |
| $fatpacked{"ExtUtils/MM_MacOS.pm"} = <<'EXTUTILS_MM_MACOS'; | |
| package ExtUtils::MM_MacOS; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| sub new { | |
| die <<'UNSUPPORTED'; | |
| MacOS Classic (MacPerl) is no longer supported by MakeMaker. | |
| Please use Module::Build instead. | |
| UNSUPPORTED | |
| } | |
| =head1 NAME | |
| ExtUtils::MM_MacOS - once produced Makefiles for MacOS Classic | |
| =head1 SYNOPSIS | |
| # MM_MacOS no longer contains any code. This is just a stub. | |
| =head1 DESCRIPTION | |
| Once upon a time, MakeMaker could produce an approximation of a correct | |
| Makefile on MacOS Classic (MacPerl). Due to a lack of maintainers, this | |
| fell out of sync with the rest of MakeMaker and hadn't worked in years. | |
| Since there's little chance of it being repaired, MacOS Classic is fading | |
| away, and the code was icky to begin with, the code has been deleted to | |
| make maintenance easier. | |
| Those interested in writing modules for MacPerl should use Module::Build | |
| which works better than MakeMaker ever did. | |
| Anyone interested in resurrecting this file should pull the old version | |
| from the MakeMaker CVS repository and contact [email protected], but we | |
| really encourage you to work on Module::Build instead. | |
| =cut | |
| 1; | |
| EXTUTILS_MM_MACOS | |
| $fatpacked{"ExtUtils/MM_NW5.pm"} = <<'EXTUTILS_MM_NW5'; | |
| package ExtUtils::MM_NW5; | |
| =head1 NAME | |
| ExtUtils::MM_NW5 - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
| =head1 SYNOPSIS | |
| use ExtUtils::MM_NW5; # Done internally by ExtUtils::MakeMaker if needed | |
| =head1 DESCRIPTION | |
| See ExtUtils::MM_Unix for a documentation of the methods provided | |
| there. This package overrides the implementation of these methods, not | |
| the semantics. | |
| =over | |
| =cut | |
| use strict; | |
| use ExtUtils::MakeMaker::Config; | |
| use File::Basename; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Win32; | |
| our @ISA = qw(ExtUtils::MM_Win32); | |
| use ExtUtils::MakeMaker qw( &neatvalue ); | |
| $ENV{EMXSHELL} = 'sh'; # to run `commands` | |
| my $BORLAND = $Config{'cc'} =~ /^bcc/i; | |
| my $GCC = $Config{'cc'} =~ /^gcc/i; | |
| =item os_flavor | |
| We're Netware in addition to being Windows. | |
| =cut | |
| sub os_flavor { | |
| my $self = shift; | |
| return ($self->SUPER::os_flavor, 'Netware'); | |
| } | |
| =item init_platform | |
| Add Netware macros. | |
| LIBPTH, BASE_IMPORT, NLM_VERSION, MPKTOOL, TOOLPATH, BOOT_SYMBOL, | |
| NLM_SHORT_NAME, INCLUDE, PATH, MM_NW5_REVISION | |
| =item platform_constants | |
| Add Netware macros initialized above to the Makefile. | |
| =cut | |
| sub init_platform { | |
| my($self) = shift; | |
| # To get Win32's setup. | |
| $self->SUPER::init_platform; | |
| # incpath is copied to makefile var INCLUDE in constants sub, here just | |
| # make it empty | |
| my $libpth = $Config{'libpth'}; | |
| $libpth =~ s( )(;); | |
| $self->{'LIBPTH'} = $libpth; | |
| $self->{'BASE_IMPORT'} = $Config{'base_import'}; | |
| # Additional import file specified from Makefile.pl | |
| if($self->{'base_import'}) { | |
| $self->{'BASE_IMPORT'} .= ', ' . $self->{'base_import'}; | |
| } | |
| $self->{'NLM_VERSION'} = $Config{'nlm_version'}; | |
| $self->{'MPKTOOL'} = $Config{'mpktool'}; | |
| $self->{'TOOLPATH'} = $Config{'toolpath'}; | |
| (my $boot = $self->{'NAME'}) =~ s/:/_/g; | |
| $self->{'BOOT_SYMBOL'}=$boot; | |
| # If the final binary name is greater than 8 chars, | |
| # truncate it here. | |
| if(length($self->{'BASEEXT'}) > 8) { | |
| $self->{'NLM_SHORT_NAME'} = substr($self->{'BASEEXT'},0,8); | |
| } | |
| # Get the include path and replace the spaces with ; | |
| # Copy this to makefile as INCLUDE = d:\...;d:\; | |
| ($self->{INCLUDE} = $Config{'incpath'}) =~ s/([ ]*)-I/;/g; | |
| # Set the path to CodeWarrior binaries which might not have been set in | |
| # any other place | |
| $self->{PATH} = '$(PATH);$(TOOLPATH)'; | |
| $self->{MM_NW5_VERSION} = $VERSION; | |
| } | |
| sub platform_constants { | |
| my($self) = shift; | |
| my $make_frag = ''; | |
| # Setup Win32's constants. | |
| $make_frag .= $self->SUPER::platform_constants; | |
| foreach my $macro (qw(LIBPTH BASE_IMPORT NLM_VERSION MPKTOOL | |
| TOOLPATH BOOT_SYMBOL NLM_SHORT_NAME INCLUDE PATH | |
| MM_NW5_VERSION | |
| )) | |
| { | |
| next unless defined $self->{$macro}; | |
| $make_frag .= "$macro = $self->{$macro}\n"; | |
| } | |
| return $make_frag; | |
| } | |
| =item const_cccmd | |
| =cut | |
| sub const_cccmd { | |
| my($self,$libperl)=@_; | |
| return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; | |
| return '' unless $self->needs_linking(); | |
| return $self->{CONST_CCCMD} = <<'MAKE_FRAG'; | |
| CCCMD = $(CC) $(CCFLAGS) $(INC) $(OPTIMIZE) \ | |
| $(PERLTYPE) $(MPOLLUTE) -o $@ \ | |
| -DVERSION=\"$(VERSION)\" -DXS_VERSION=\"$(XS_VERSION)\" | |
| MAKE_FRAG | |
| } | |
| =item static_lib | |
| =cut | |
| sub static_lib { | |
| my($self) = @_; | |
| return '' unless $self->has_link_code; | |
| my $m = <<'END'; | |
| $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists | |
| $(RM_RF) $@ | |
| END | |
| # If this extension has it's own library (eg SDBM_File) | |
| # then copy that to $(INST_STATIC) and add $(OBJECT) into it. | |
| $m .= <<'END' if $self->{MYEXTLIB}; | |
| $self->{CP} $(MYEXTLIB) $@ | |
| END | |
| my $ar_arg; | |
| if( $BORLAND ) { | |
| $ar_arg = '$@ $(OBJECT:^"+")'; | |
| } | |
| elsif( $GCC ) { | |
| $ar_arg = '-ru $@ $(OBJECT)'; | |
| } | |
| else { | |
| $ar_arg = '-type library -o $@ $(OBJECT)'; | |
| } | |
| $m .= sprintf <<'END', $ar_arg; | |
| $(AR) %s | |
| $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld | |
| $(CHMOD) 755 $@ | |
| END | |
| $m .= <<'END' if $self->{PERL_SRC}; | |
| $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs | |
| END | |
| return $m; | |
| } | |
| =item dynamic_lib | |
| Defines how to produce the *.so (or equivalent) files. | |
| =cut | |
| sub dynamic_lib { | |
| my($self, %attribs) = @_; | |
| return '' unless $self->needs_linking(); #might be because of a subdir | |
| return '' unless $self->has_link_code; | |
| my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': ''); | |
| my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; | |
| my($ldfrom) = '$(LDFROM)'; | |
| (my $boot = $self->{NAME}) =~ s/:/_/g; | |
| my $m = <<'MAKE_FRAG'; | |
| # This section creates the dynamically loadable $(INST_DYNAMIC) | |
| # from $(OBJECT) and possibly $(MYEXTLIB). | |
| OTHERLDFLAGS = '.$otherldflags.' | |
| INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' | |
| # Create xdc data for an MT safe NLM in case of mpk build | |
| $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists | |
| $(NOECHO) $(ECHO) Export boot_$(BOOT_SYMBOL) > $(BASEEXT).def | |
| $(NOECHO) $(ECHO) $(BASE_IMPORT) >> $(BASEEXT).def | |
| $(NOECHO) $(ECHO) Import @$(PERL_INC)\perl.imp >> $(BASEEXT).def | |
| MAKE_FRAG | |
| if ( $self->{CCFLAGS} =~ m/ -DMPK_ON /) { | |
| $m .= <<'MAKE_FRAG'; | |
| $(MPKTOOL) $(XDCFLAGS) $(BASEEXT).xdc | |
| $(NOECHO) $(ECHO) xdcdata $(BASEEXT).xdc >> $(BASEEXT).def | |
| MAKE_FRAG | |
| } | |
| # Reconstruct the X.Y.Z version. | |
| my $version = join '.', map { sprintf "%d", $_ } | |
| $] =~ /(\d)\.(\d{3})(\d{2})/; | |
| $m .= sprintf ' $(LD) $(LDFLAGS) $(OBJECT:.obj=.obj) -desc "Perl %s Extension ($(BASEEXT)) XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION)', $version; | |
| # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc | |
| if($self->{NLM_SHORT_NAME}) { | |
| # In case of nlms with names exceeding 8 chars, build nlm in the | |
| # current dir, rename and move to auto\lib. | |
| $m .= q{ -o $(NLM_SHORT_NAME).$(DLEXT)} | |
| } else { | |
| $m .= q{ -o $(INST_AUTODIR)\\$(BASEEXT).$(DLEXT)} | |
| } | |
| # Add additional lib files if any (SDBM_File) | |
| $m .= q{ $(MYEXTLIB) } if $self->{MYEXTLIB}; | |
| $m .= q{ $(PERL_INC)\Main.lib -commandfile $(BASEEXT).def}."\n"; | |
| if($self->{NLM_SHORT_NAME}) { | |
| $m .= <<'MAKE_FRAG'; | |
| if exist $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) del $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) | |
| move $(NLM_SHORT_NAME).$(DLEXT) $(INST_AUTODIR) | |
| MAKE_FRAG | |
| } | |
| $m .= <<'MAKE_FRAG'; | |
| $(CHMOD) 755 $@ | |
| MAKE_FRAG | |
| return $m; | |
| } | |
| 1; | |
| __END__ | |
| =back | |
| =cut | |
| EXTUTILS_MM_NW5 | |
| $fatpacked{"ExtUtils/MM_OS2.pm"} = <<'EXTUTILS_MM_OS2'; | |
| package ExtUtils::MM_OS2; | |
| use strict; | |
| use ExtUtils::MakeMaker qw(neatvalue); | |
| use File::Spec; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Any; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw(ExtUtils::MM_Any ExtUtils::MM_Unix); | |
| =pod | |
| =head1 NAME | |
| ExtUtils::MM_OS2 - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
| =head1 SYNOPSIS | |
| use ExtUtils::MM_OS2; # Done internally by ExtUtils::MakeMaker if needed | |
| =head1 DESCRIPTION | |
| See ExtUtils::MM_Unix for a documentation of the methods provided | |
| there. This package overrides the implementation of these methods, not | |
| the semantics. | |
| =head1 METHODS | |
| =over 4 | |
| =item init_dist | |
| Define TO_UNIX to convert OS2 linefeeds to Unix style. | |
| =cut | |
| sub init_dist { | |
| my($self) = @_; | |
| $self->{TO_UNIX} ||= <<'MAKE_TEXT'; | |
| $(NOECHO) $(TEST_F) tmp.zip && $(RM_F) tmp.zip; $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM_F) tmp.zip | |
| MAKE_TEXT | |
| $self->SUPER::init_dist; | |
| } | |
| sub dlsyms { | |
| my($self,%attribs) = @_; | |
| my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; | |
| my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; | |
| my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; | |
| my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {}; | |
| my(@m); | |
| (my $boot = $self->{NAME}) =~ s/:/_/g; | |
| if (not $self->{SKIPHASH}{'dynamic'}) { | |
| push(@m," | |
| $self->{BASEEXT}.def: Makefile.PL | |
| ", | |
| ' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\ | |
| Mksymlists("NAME" => "$(NAME)", "DLBASE" => "$(DLBASE)", ', | |
| '"VERSION" => "$(VERSION)", "DISTNAME" => "$(DISTNAME)", ', | |
| '"INSTALLDIRS" => "$(INSTALLDIRS)", ', | |
| '"DL_FUNCS" => ',neatvalue($funcs), | |
| ', "FUNCLIST" => ',neatvalue($funclist), | |
| ', "IMPORTS" => ',neatvalue($imports), | |
| ', "DL_VARS" => ', neatvalue($vars), ');\' | |
| '); | |
| } | |
| if ($self->{IMPORTS} && %{$self->{IMPORTS}}) { | |
| # Make import files (needed for static build) | |
| -d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp"; | |
| open my $imp, '>', 'tmpimp.imp' or die "Can't open tmpimp.imp"; | |
| while (my($name, $exp) = each %{$self->{IMPORTS}}) { | |
| my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'"; | |
| print $imp "$name $lib $id ?\n"; | |
| } | |
| close $imp or die "Can't close tmpimp.imp"; | |
| # print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n"; | |
| system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp" | |
| and die "Cannot make import library: $!, \$?=$?"; | |
| # May be running under miniperl, so have no glob... | |
| eval "unlink <tmp_imp/*>; 1" or system "rm tmp_imp/*"; | |
| system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}" | |
| and die "Cannot extract import objects: $!, \$?=$?"; | |
| } | |
| join('',@m); | |
| } | |
| sub static_lib { | |
| my($self) = @_; | |
| my $old = $self->ExtUtils::MM_Unix::static_lib(); | |
| return $old unless $self->{IMPORTS} && %{$self->{IMPORTS}}; | |
| my @chunks = split /\n{2,}/, $old; | |
| shift @chunks unless length $chunks[0]; # Empty lines at the start | |
| $chunks[0] .= <<'EOC'; | |
| $(AR) $(AR_STATIC_ARGS) $@ tmp_imp/* && $(RANLIB) $@ | |
| EOC | |
| return join "\n\n". '', @chunks; | |
| } | |
| sub replace_manpage_separator { | |
| my($self,$man) = @_; | |
| $man =~ s,/+,.,g; | |
| $man; | |
| } | |
| sub maybe_command { | |
| my($self,$file) = @_; | |
| $file =~ s,[/\\]+,/,g; | |
| return $file if -x $file && ! -d _; | |
| return "$file.exe" if -x "$file.exe" && ! -d _; | |
| return "$file.cmd" if -x "$file.cmd" && ! -d _; | |
| return; | |
| } | |
| =item init_linker | |
| =cut | |
| sub init_linker { | |
| my $self = shift; | |
| $self->{PERL_ARCHIVE} = "\$(PERL_INC)/libperl\$(LIB_EXT)"; | |
| $self->{PERL_ARCHIVE_AFTER} = $OS2::is_aout | |
| ? '' | |
| : '$(PERL_INC)/libperl_override$(LIB_EXT)'; | |
| $self->{EXPORT_LIST} = '$(BASEEXT).def'; | |
| } | |
| =item os_flavor | |
| OS/2 is OS/2 | |
| =cut | |
| sub os_flavor { | |
| return('OS/2'); | |
| } | |
| =back | |
| =cut | |
| 1; | |
| EXTUTILS_MM_OS2 | |
| $fatpacked{"ExtUtils/MM_QNX.pm"} = <<'EXTUTILS_MM_QNX'; | |
| package ExtUtils::MM_QNX; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw(ExtUtils::MM_Unix); | |
| =head1 NAME | |
| ExtUtils::MM_QNX - QNX specific subclass of ExtUtils::MM_Unix | |
| =head1 SYNOPSIS | |
| Don't use this module directly. | |
| Use ExtUtils::MM and let it choose. | |
| =head1 DESCRIPTION | |
| This is a subclass of ExtUtils::MM_Unix which contains functionality for | |
| QNX. | |
| Unless otherwise stated it works just like ExtUtils::MM_Unix | |
| =head2 Overridden methods | |
| =head3 extra_clean_files | |
| Add .err files corresponding to each .c file. | |
| =cut | |
| sub extra_clean_files { | |
| my $self = shift; | |
| my @errfiles = @{$self->{C}}; | |
| for ( @errfiles ) { | |
| s/.c$/.err/; | |
| } | |
| return( @errfiles, 'perlmain.err' ); | |
| } | |
| =head1 AUTHOR | |
| Michael G Schwern <[email protected]> with code from ExtUtils::MM_Unix | |
| =head1 SEE ALSO | |
| L<ExtUtils::MakeMaker> | |
| =cut | |
| 1; | |
| EXTUTILS_MM_QNX | |
| $fatpacked{"ExtUtils/MM_UWIN.pm"} = <<'EXTUTILS_MM_UWIN'; | |
| package ExtUtils::MM_UWIN; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw(ExtUtils::MM_Unix); | |
| =head1 NAME | |
| ExtUtils::MM_UWIN - U/WIN specific subclass of ExtUtils::MM_Unix | |
| =head1 SYNOPSIS | |
| Don't use this module directly. | |
| Use ExtUtils::MM and let it choose. | |
| =head1 DESCRIPTION | |
| This is a subclass of ExtUtils::MM_Unix which contains functionality for | |
| the AT&T U/WIN UNIX on Windows environment. | |
| Unless otherwise stated it works just like ExtUtils::MM_Unix | |
| =head2 Overridden methods | |
| =over 4 | |
| =item os_flavor | |
| In addition to being Unix, we're U/WIN. | |
| =cut | |
| sub os_flavor { | |
| return('Unix', 'U/WIN'); | |
| } | |
| =item B<replace_manpage_separator> | |
| =cut | |
| sub replace_manpage_separator { | |
| my($self, $man) = @_; | |
| $man =~ s,/+,.,g; | |
| return $man; | |
| } | |
| =back | |
| =head1 AUTHOR | |
| Michael G Schwern <[email protected]> with code from ExtUtils::MM_Unix | |
| =head1 SEE ALSO | |
| L<ExtUtils::MM_Win32>, L<ExtUtils::MakeMaker> | |
| =cut | |
| 1; | |
| EXTUTILS_MM_UWIN | |
| $fatpacked{"ExtUtils/MM_Unix.pm"} = <<'EXTUTILS_MM_UNIX'; | |
| package ExtUtils::MM_Unix; | |
| require 5.006; | |
| use strict; | |
| use Carp; | |
| use ExtUtils::MakeMaker::Config; | |
| use File::Basename qw(basename dirname); | |
| use DirHandle; | |
| our %Config_Override; | |
| use ExtUtils::MakeMaker qw($Verbose neatvalue); | |
| # If we make $VERSION an our variable parse_version() breaks | |
| use vars qw($VERSION); | |
| $VERSION = '6.59'; | |
| $VERSION = eval $VERSION; | |
| require ExtUtils::MM_Any; | |
| our @ISA = qw(ExtUtils::MM_Any); | |
| my %Is; | |
| BEGIN { | |
| $Is{OS2} = $^O eq 'os2'; | |
| $Is{Win32} = $^O eq 'MSWin32' || $Config{osname} eq 'NetWare'; | |
| $Is{Dos} = $^O eq 'dos'; | |
| $Is{VMS} = $^O eq 'VMS'; | |
| $Is{OSF} = $^O eq 'dec_osf'; | |
| $Is{IRIX} = $^O eq 'irix'; | |
| $Is{NetBSD} = $^O eq 'netbsd'; | |
| $Is{Interix} = $^O eq 'interix'; | |
| $Is{SunOS4} = $^O eq 'sunos'; | |
| $Is{Solaris} = $^O eq 'solaris'; | |
| $Is{SunOS} = $Is{SunOS4} || $Is{Solaris}; | |
| $Is{BSD} = ($^O =~ /^(?:free|net|open)bsd$/ or | |
| grep( $^O eq $_, qw(bsdos interix dragonfly) ) | |
| ); | |
| } | |
| BEGIN { | |
| if( $Is{VMS} ) { | |
| # For things like vmsify() | |
| require VMS::Filespec; | |
| VMS::Filespec->import; | |
| } | |
| } | |
| =head1 NAME | |
| ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker | |
| =head1 SYNOPSIS | |
| C<require ExtUtils::MM_Unix;> | |
| =head1 DESCRIPTION | |
| The methods provided by this package are designed to be used in | |
| conjunction with ExtUtils::MakeMaker. When MakeMaker writes a | |
| Makefile, it creates one or more objects that inherit their methods | |
| from a package C<MM>. MM itself doesn't provide any methods, but it | |
| ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating | |
| specific packages take the responsibility for all the methods provided | |
| by MM_Unix. We are trying to reduce the number of the necessary | |
| overrides by defining rather primitive operations within | |
| ExtUtils::MM_Unix. | |
| If you are going to write a platform specific MM package, please try | |
| to limit the necessary overrides to primitive methods, and if it is not | |
| possible to do so, let's work out how to achieve that gain. | |
| If you are overriding any of these methods in your Makefile.PL (in the | |
| MY class), please report that to the makemaker mailing list. We are | |
| trying to minimize the necessary method overrides and switch to data | |
| driven Makefile.PLs wherever possible. In the long run less methods | |
| will be overridable via the MY class. | |
| =head1 METHODS | |
| The following description of methods is still under | |
| development. Please refer to the code for not suitably documented | |
| sections and complain loudly to the [email protected] mailing list. | |
| Better yet, provide a patch. | |
| Not all of the methods below are overridable in a | |
| Makefile.PL. Overridable methods are marked as (o). All methods are | |
| overridable by a platform specific MM_*.pm file. | |
| Cross-platform methods are being moved into MM_Any. If you can't find | |
| something that used to be in here, look in MM_Any. | |
| =cut | |
| # So we don't have to keep calling the methods over and over again, | |
| # we have these globals to cache the values. Faster and shrtr. | |
| my $Curdir = __PACKAGE__->curdir; | |
| my $Rootdir = __PACKAGE__->rootdir; | |
| my $Updir = __PACKAGE__->updir; | |
| =head2 Methods | |
| =over 4 | |
| =item os_flavor | |
| Simply says that we're Unix. | |
| =cut | |
| sub os_flavor { | |
| return('Unix'); | |
| } | |
| =item c_o (o) | |
| Defines the suffix rules to compile different flavors of C files to | |
| object files. | |
| =cut | |
| sub c_o { | |
| # --- Translation Sections --- | |
| my($self) = shift; | |
| return '' unless $self->needs_linking(); | |
| my(@m); | |
| my $command = '$(CCCMD)'; | |
| my $flags = '$(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE)'; | |
| if (my $cpp = $Config{cpprun}) { | |
| my $cpp_cmd = $self->const_cccmd; | |
| $cpp_cmd =~ s/^CCCMD\s*=\s*\$\(CC\)/$cpp/; | |
| push @m, qq{ | |
| .c.i: | |
| $cpp_cmd $flags \$*.c > \$*.i | |
| }; | |
| } | |
| push @m, qq{ | |
| .c.s: | |
| $command -S $flags \$*.c | |
| .c\$(OBJ_EXT): | |
| $command $flags \$*.c | |
| .cpp\$(OBJ_EXT): | |
| $command $flags \$*.cpp | |
| .cxx\$(OBJ_EXT): | |
| $command $flags \$*.cxx | |
| .cc\$(OBJ_EXT): | |
| $command $flags \$*.cc | |
| }; | |
| push @m, qq{ | |
| .C\$(OBJ_EXT): | |
| $command $flags \$*.C | |
| } if !$Is{OS2} and !$Is{Win32} and !$Is{Dos}; #Case-specific | |
| return join "", @m; | |
| } | |
| =item cflags (o) | |
| Does very much the same as the cflags script in the perl | |
| distribution. It doesn't return the whole compiler command line, but | |
| initializes all of its parts. The const_cccmd method then actually | |
| returns the definition of the CCCMD macro which uses these parts. | |
| =cut | |
| #' | |
| sub cflags { | |
| my($self,$libperl)=@_; | |
| return $self->{CFLAGS} if $self->{CFLAGS}; | |
| return '' unless $self->needs_linking(); | |
| my($prog, $uc, $perltype, %cflags); | |
| $libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ; | |
| $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/; | |
| @cflags{qw(cc ccflags optimize shellflags)} | |
| = @Config{qw(cc ccflags optimize shellflags)}; | |
| my($optdebug) = ""; | |
| $cflags{shellflags} ||= ''; | |
| my(%map) = ( | |
| D => '-DDEBUGGING', | |
| E => '-DEMBED', | |
| DE => '-DDEBUGGING -DEMBED', | |
| M => '-DEMBED -DMULTIPLICITY', | |
| DM => '-DDEBUGGING -DEMBED -DMULTIPLICITY', | |
| ); | |
| if ($libperl =~ /libperl(\w*)\Q$self->{LIB_EXT}/){ | |
| $uc = uc($1); | |
| } else { | |
| $uc = ""; # avoid warning | |
| } | |
| $perltype = $map{$uc} ? $map{$uc} : ""; | |
| if ($uc =~ /^D/) { | |
| $optdebug = "-g"; | |
| } | |
| my($name); | |
| ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ; | |
| if ($prog = $Config{$name}) { | |
| # Expand hints for this extension via the shell | |
| print STDOUT "Processing $name hint:\n" if $Verbose; | |
| my(@o)=`cc=\"$cflags{cc}\" | |
| ccflags=\"$cflags{ccflags}\" | |
| optimize=\"$cflags{optimize}\" | |
| perltype=\"$cflags{perltype}\" | |
| optdebug=\"$cflags{optdebug}\" | |
| eval '$prog' | |
| echo cc=\$cc | |
| echo ccflags=\$ccflags | |
| echo optimize=\$optimize | |
| echo perltype=\$perltype | |
| echo optdebug=\$optdebug | |
| `; | |
| foreach my $line (@o){ | |
| chomp $line; | |
| if ($line =~ /(.*?)=\s*(.*)\s*$/){ | |
| $cflags{$1} = $2; | |
| print STDOUT " $1 = $2\n" if $Verbose; | |
| } else { | |
| print STDOUT "Unrecognised result from hint: '$line'\n"; | |
| } | |
| } | |
| } | |
| if ($optdebug) { | |
| $cflags{optimize} = $optdebug; | |
| } | |
| for (qw(ccflags optimize perltype)) { | |
| $cflags{$_} ||= ''; | |
| $cflags{$_} =~ s/^\s+//; | |
| $cflags{$_} =~ s/\s+/ /g; | |
| $cflags{$_} =~ s/\s+$//; | |
| $self->{uc $_} ||= $cflags{$_}; | |
| } | |
| if ($self->{POLLUTE}) { | |
| $self->{CCFLAGS} .= ' -DPERL_POLLUTE '; | |
| } | |
| my $pollute = ''; | |
| if ($Config{usemymalloc} and not $Config{bincompat5005} | |
| and not $Config{ccflags} =~ /-DPERL_POLLUTE_MALLOC\b/ | |
| and $self->{PERL_MALLOC_OK}) { | |
| $pollute = '$(PERL_MALLOC_DEF)'; | |
| } | |
| $self->{CCFLAGS} = quote_paren($self->{CCFLAGS}); | |
| $self->{OPTIMIZE} = quote_paren($self->{OPTIMIZE}); | |
| return $self->{CFLAGS} = qq{ | |
| CCFLAGS = $self->{CCFLAGS} | |
| OPTIMIZE = $self->{OPTIMIZE} | |
| PERLTYPE = $self->{PERLTYPE} | |
| MPOLLUTE = $pollute | |
| }; | |
| } | |
| =item const_cccmd (o) | |
| Returns the full compiler call for C programs and stores the | |
| definition in CONST_CCCMD. | |
| =cut | |
| sub const_cccmd { | |
| my($self,$libperl)=@_; | |
| return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; | |
| return '' unless $self->needs_linking(); | |
| return $self->{CONST_CCCMD} = | |
| q{CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \\ | |
| $(CCFLAGS) $(OPTIMIZE) \\ | |
| $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \\ | |
| $(XS_DEFINE_VERSION)}; | |
| } | |
| =item const_config (o) | |
| Defines a couple of constants in the Makefile that are imported from | |
| %Config. | |
| =cut | |
| sub const_config { | |
| # --- Constants Sections --- | |
| my($self) = shift; | |
| my @m = <<"END"; | |
| # These definitions are from config.sh (via $INC{'Config.pm'}). | |
| # They may have been overridden via Makefile.PL or on the command line. | |
| END | |
| my(%once_only); | |
| foreach my $key (@{$self->{CONFIG}}){ | |
| # SITE*EXP macros are defined in &constants; avoid duplicates here | |
| next if $once_only{$key}; | |
| $self->{uc $key} = quote_paren($self->{uc $key}); | |
| push @m, uc($key) , ' = ' , $self->{uc $key}, "\n"; | |
| $once_only{$key} = 1; | |
| } | |
| join('', @m); | |
| } | |
| =item const_loadlibs (o) | |
| Defines EXTRALIBS, LDLOADLIBS, BSLOADLIBS, LD_RUN_PATH. See | |
| L<ExtUtils::Liblist> for details. | |
| =cut | |
| sub const_loadlibs { | |
| my($self) = shift; | |
| return "" unless $self->needs_linking; | |
| my @m; | |
| push @m, qq{ | |
| # $self->{NAME} might depend on some other libraries: | |
| # See ExtUtils::Liblist for details | |
| # | |
| }; | |
| for my $tmp (qw/ | |
| EXTRALIBS LDLOADLIBS BSLOADLIBS | |
| /) { | |
| next unless defined $self->{$tmp}; | |
| push @m, "$tmp = $self->{$tmp}\n"; | |
| } | |
| # don't set LD_RUN_PATH if empty | |
| for my $tmp (qw/ | |
| LD_RUN_PATH | |
| /) { | |
| next unless $self->{$tmp}; | |
| push @m, "$tmp = $self->{$tmp}\n"; | |
| } | |
| return join "", @m; | |
| } | |
| =item constants (o) | |
| my $make_frag = $mm->constants; | |
| Prints out macros for lots of constants. | |
| =cut | |
| sub constants { | |
| my($self) = @_; | |
| my @m = (); | |
| $self->{DFSEP} = '$(DIRFILESEP)'; # alias for internal use | |
| for my $macro (qw( | |
| AR_STATIC_ARGS DIRFILESEP DFSEP | |
| NAME NAME_SYM | |
| VERSION VERSION_MACRO VERSION_SYM DEFINE_VERSION | |
| XS_VERSION XS_VERSION_MACRO XS_DEFINE_VERSION | |
| INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB | |
| INST_MAN1DIR INST_MAN3DIR | |
| MAN1EXT MAN3EXT | |
| INSTALLDIRS INSTALL_BASE DESTDIR PREFIX | |
| PERLPREFIX SITEPREFIX VENDORPREFIX | |
| ), | |
| (map { ("INSTALL".$_, | |
| "DESTINSTALL".$_) | |
| } $self->installvars), | |
| qw( | |
| PERL_LIB | |
| PERL_ARCHLIB | |
| LIBPERL_A MYEXTLIB | |
| FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE | |
| PERLMAINCC PERL_SRC PERL_INC | |
| PERL FULLPERL ABSPERL | |
| PERLRUN FULLPERLRUN ABSPERLRUN | |
| PERLRUNINST FULLPERLRUNINST ABSPERLRUNINST | |
| PERL_CORE | |
| PERM_DIR PERM_RW PERM_RWX | |
| ) ) | |
| { | |
| next unless defined $self->{$macro}; | |
| # pathnames can have sharp signs in them; escape them so | |
| # make doesn't think it is a comment-start character. | |
| $self->{$macro} =~ s/#/\\#/g; | |
| push @m, "$macro = $self->{$macro}\n"; | |
| } | |
| push @m, qq{ | |
| MAKEMAKER = $self->{MAKEMAKER} | |
| MM_VERSION = $self->{MM_VERSION} | |
| MM_REVISION = $self->{MM_REVISION} | |
| }; | |
| push @m, q{ | |
| # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). | |
| # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) | |
| # PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) | |
| # DLBASE = Basename part of dynamic library. May be just equal BASEEXT. | |
| }; | |
| for my $macro (qw/ | |
| MAKE | |
| FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT | |
| LDFROM LINKTYPE BOOTDEP | |
| / ) | |
| { | |
| next unless defined $self->{$macro}; | |
| push @m, "$macro = $self->{$macro}\n"; | |
| } | |
| push @m, " | |
| # Handy lists of source code files: | |
| XS_FILES = ".$self->wraplist(sort keys %{$self->{XS}})." | |
| C_FILES = ".$self->wraplist(@{$self->{C}})." | |
| O_FILES = ".$self->wraplist(@{$self->{O_FILES}})." | |
| H_FILES = ".$self->wraplist(@{$self->{H}})." | |
| MAN1PODS = ".$self->wraplist(sort keys %{$self->{MAN1PODS}})." | |
| MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})." | |
| "; | |
| push @m, q{ | |
| # Where is the Config information that we are using/depend on | |
| CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h | |
| }; | |
| push @m, qq{ | |
| # Where to build things | |
| INST_LIBDIR = $self->{INST_LIBDIR} | |
| INST_ARCHLIBDIR = $self->{INST_ARCHLIBDIR} | |
| INST_AUTODIR = $self->{INST_AUTODIR} | |
| INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR} | |
| INST_STATIC = $self->{INST_STATIC} | |
| INST_DYNAMIC = $self->{INST_DYNAMIC} | |
| INST_BOOT = $self->{INST_BOOT} | |
| }; | |
| push @m, qq{ | |
| # Extra linker info | |
| EXPORT_LIST = $self->{EXPORT_LIST} | |
| PERL_ARCHIVE = $self->{PERL_ARCHIVE} | |
| PERL_ARCHIVE_AFTER = $self->{PERL_ARCHIVE_AFTER} | |
| }; | |
| push @m, " | |
| TO_INST_PM = ".$self->wraplist(sort keys %{$self->{PM}})." | |
| PM_TO_BLIB = ".$self->wraplist(%{$self->{PM}})." | |
| "; | |
| join('',@m); | |
| } | |
| =item depend (o) | |
| Same as macro for the depend attribute. | |
| =cut | |
| sub depend { | |
| my($self,%attribs) = @_; | |
| my(@m,$key,$val); | |
| while (($key,$val) = each %attribs){ | |
| last unless defined $key; | |
| push @m, "$key : $val\n"; | |
| } | |
| join "", @m; | |
| } | |
| =item init_DEST | |
| $mm->init_DEST | |
| Defines the DESTDIR and DEST* variables paralleling the INSTALL*. | |
| =cut | |
| sub init_DEST { | |
| my $self = shift; | |
| # Initialize DESTDIR | |
| $self->{DESTDIR} ||= ''; | |
| # Make DEST variables. | |
| foreach my $var ($self->installvars) { | |
| my $destvar = 'DESTINSTALL'.$var; | |
| $self->{$destvar} ||= '$(DESTDIR)$(INSTALL'.$var.')'; | |
| } | |
| } | |
| =item init_dist | |
| $mm->init_dist; | |
| Defines a lot of macros for distribution support. | |
| macro description default | |
| TAR tar command to use tar | |
| TARFLAGS flags to pass to TAR cvf | |
| ZIP zip command to use zip | |
| ZIPFLAGS flags to pass to ZIP -r | |
| COMPRESS compression command to gzip --best | |
| use for tarfiles | |
| SUFFIX suffix to put on .gz | |
| compressed files | |
| SHAR shar command to use shar | |
| PREOP extra commands to run before | |
| making the archive | |
| POSTOP extra commands to run after | |
| making the archive | |
| TO_UNIX a command to convert linefeeds | |
| to Unix style in your archive | |
| CI command to checkin your ci -u | |
| sources to version control | |
| RCS_LABEL command to label your sources rcs -Nv$(VERSION_SYM): -q | |
| just after CI is run | |
| DIST_CP $how argument to manicopy() best | |
| when the distdir is created | |
| DIST_DEFAULT default target to use to tardist | |
| create a distribution | |
| DISTVNAME name of the resulting archive $(DISTNAME)-$(VERSION) | |
| (minus suffixes) | |
| =cut | |
| sub init_dist { | |
| my $self = shift; | |
| $self->{TAR} ||= 'tar'; | |
| $self->{TARFLAGS} ||= 'cvf'; | |
| $self->{ZIP} ||= 'zip'; | |
| $self->{ZIPFLAGS} ||= '-r'; | |
| $self->{COMPRESS} ||= 'gzip --best'; | |
| $self->{SUFFIX} ||= '.gz'; | |
| $self->{SHAR} ||= 'shar'; | |
| $self->{PREOP} ||= '$(NOECHO) $(NOOP)'; # eg update MANIFEST | |
| $self->{POSTOP} ||= '$(NOECHO) $(NOOP)'; # eg remove the distdir | |
| $self->{TO_UNIX} ||= '$(NOECHO) $(NOOP)'; | |
| $self->{CI} ||= 'ci -u'; | |
| $self->{RCS_LABEL}||= 'rcs -Nv$(VERSION_SYM): -q'; | |
| $self->{DIST_CP} ||= 'best'; | |
| $self->{DIST_DEFAULT} ||= 'tardist'; | |
| ($self->{DISTNAME} = $self->{NAME}) =~ s{::}{-}g unless $self->{DISTNAME}; | |
| $self->{DISTVNAME} ||= $self->{DISTNAME}.'-'.$self->{VERSION}; | |
| } | |
| =item dist (o) | |
| my $dist_macros = $mm->dist(%overrides); | |
| Generates a make fragment defining all the macros initialized in | |
| init_dist. | |
| %overrides can be used to override any of the above. | |
| =cut | |
| sub dist { | |
| my($self, %attribs) = @_; | |
| my $make = ''; | |
| foreach my $key (qw( | |
| TAR TARFLAGS ZIP ZIPFLAGS COMPRESS SUFFIX SHAR | |
| PREOP POSTOP TO_UNIX | |
| CI RCS_LABEL DIST_CP DIST_DEFAULT | |
| DISTNAME DISTVNAME | |
| )) | |
| { | |
| my $value = $attribs{$key} || $self->{$key}; | |
| $make .= "$key = $value\n"; | |
| } | |
| return $make; | |
| } | |
| =item dist_basics (o) | |
| Defines the targets distclean, distcheck, skipcheck, manifest, veryclean. | |
| =cut | |
| sub dist_basics { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| distclean :: realclean distcheck | |
| $(NOECHO) $(NOOP) | |
| distcheck : | |
| $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck | |
| skipcheck : | |
| $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck | |
| manifest : | |
| $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest | |
| veryclean : realclean | |
| $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old | |
| MAKE_FRAG | |
| } | |
| =item dist_ci (o) | |
| Defines a check in target for RCS. | |
| =cut | |
| sub dist_ci { | |
| my($self) = shift; | |
| return q{ | |
| ci : | |
| $(PERLRUN) "-MExtUtils::Manifest=maniread" \\ | |
| -e "@all = keys %{ maniread() };" \\ | |
| -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \\ | |
| -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" | |
| }; | |
| } | |
| =item dist_core (o) | |
| my $dist_make_fragment = $MM->dist_core; | |
| Puts the targets necessary for 'make dist' together into one make | |
| fragment. | |
| =cut | |
| sub dist_core { | |
| my($self) = shift; | |
| my $make_frag = ''; | |
| foreach my $target (qw(dist tardist uutardist tarfile zipdist zipfile | |
| shdist)) | |
| { | |
| my $method = $target.'_target'; | |
| $make_frag .= "\n"; | |
| $make_frag .= $self->$method(); | |
| } | |
| return $make_frag; | |
| } | |
| =item B<dist_target> | |
| my $make_frag = $MM->dist_target; | |
| Returns the 'dist' target to make an archive for distribution. This | |
| target simply checks to make sure the Makefile is up-to-date and | |
| depends on $(DIST_DEFAULT). | |
| =cut | |
| sub dist_target { | |
| my($self) = shift; | |
| my $date_check = $self->oneliner(<<'CODE', ['-l']); | |
| print 'Warning: Makefile possibly out of date with $(VERSION_FROM)' | |
| if -e '$(VERSION_FROM)' and -M '$(VERSION_FROM)' < -M '$(FIRST_MAKEFILE)'; | |
| CODE | |
| return sprintf <<'MAKE_FRAG', $date_check; | |
| dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) | |
| $(NOECHO) %s | |
| MAKE_FRAG | |
| } | |
| =item B<tardist_target> | |
| my $make_frag = $MM->tardist_target; | |
| Returns the 'tardist' target which is simply so 'make tardist' works. | |
| The real work is done by the dynamically named tardistfile_target() | |
| method, tardist should have that as a dependency. | |
| =cut | |
| sub tardist_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| tardist : $(DISTVNAME).tar$(SUFFIX) | |
| $(NOECHO) $(NOOP) | |
| MAKE_FRAG | |
| } | |
| =item B<zipdist_target> | |
| my $make_frag = $MM->zipdist_target; | |
| Returns the 'zipdist' target which is simply so 'make zipdist' works. | |
| The real work is done by the dynamically named zipdistfile_target() | |
| method, zipdist should have that as a dependency. | |
| =cut | |
| sub zipdist_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| zipdist : $(DISTVNAME).zip | |
| $(NOECHO) $(NOOP) | |
| MAKE_FRAG | |
| } | |
| =item B<tarfile_target> | |
| my $make_frag = $MM->tarfile_target; | |
| The name of this target is the name of the tarball generated by | |
| tardist. This target does the actual work of turning the distdir into | |
| a tarball. | |
| =cut | |
| sub tarfile_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| $(DISTVNAME).tar$(SUFFIX) : distdir | |
| $(PREOP) | |
| $(TO_UNIX) | |
| $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) | |
| $(RM_RF) $(DISTVNAME) | |
| $(COMPRESS) $(DISTVNAME).tar | |
| $(POSTOP) | |
| MAKE_FRAG | |
| } | |
| =item zipfile_target | |
| my $make_frag = $MM->zipfile_target; | |
| The name of this target is the name of the zip file generated by | |
| zipdist. This target does the actual work of turning the distdir into | |
| a zip file. | |
| =cut | |
| sub zipfile_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| $(DISTVNAME).zip : distdir | |
| $(PREOP) | |
| $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) | |
| $(RM_RF) $(DISTVNAME) | |
| $(POSTOP) | |
| MAKE_FRAG | |
| } | |
| =item uutardist_target | |
| my $make_frag = $MM->uutardist_target; | |
| Converts the tarfile into a uuencoded file | |
| =cut | |
| sub uutardist_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| uutardist : $(DISTVNAME).tar$(SUFFIX) | |
| uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu | |
| MAKE_FRAG | |
| } | |
| =item shdist_target | |
| my $make_frag = $MM->shdist_target; | |
| Converts the distdir into a shell archive. | |
| =cut | |
| sub shdist_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| shdist : distdir | |
| $(PREOP) | |
| $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar | |
| $(RM_RF) $(DISTVNAME) | |
| $(POSTOP) | |
| MAKE_FRAG | |
| } | |
| =item dlsyms (o) | |
| Used by some OS' to define DL_FUNCS and DL_VARS and write the *.exp files. | |
| Normally just returns an empty string. | |
| =cut | |
| sub dlsyms { | |
| return ''; | |
| } | |
| =item dynamic_bs (o) | |
| Defines targets for bootstrap files. | |
| =cut | |
| sub dynamic_bs { | |
| my($self, %attribs) = @_; | |
| return ' | |
| BOOTSTRAP = | |
| ' unless $self->has_link_code(); | |
| my $target = $Is{VMS} ? '$(MMS$TARGET)' : '$@'; | |
| return sprintf <<'MAKE_FRAG', ($target) x 5; | |
| BOOTSTRAP = $(BASEEXT).bs | |
| # As Mkbootstrap might not write a file (if none is required) | |
| # we use touch to prevent make continually trying to remake it. | |
| # The DynaLoader only reads a non-empty file. | |
| $(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists | |
| $(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" | |
| $(NOECHO) $(PERLRUN) \ | |
| "-MExtUtils::Mkbootstrap" \ | |
| -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');" | |
| $(NOECHO) $(TOUCH) %s | |
| $(CHMOD) $(PERM_RW) %s | |
| $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists | |
| $(NOECHO) $(RM_RF) %s | |
| - $(CP) $(BOOTSTRAP) %s | |
| $(CHMOD) $(PERM_RW) %s | |
| MAKE_FRAG | |
| } | |
| =item dynamic_lib (o) | |
| Defines how to produce the *.so (or equivalent) files. | |
| =cut | |
| sub dynamic_lib { | |
| my($self, %attribs) = @_; | |
| return '' unless $self->needs_linking(); #might be because of a subdir | |
| return '' unless $self->has_link_code; | |
| my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; | |
| my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; | |
| my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":"; | |
| my($ldfrom) = '$(LDFROM)'; | |
| $armaybe = 'ar' if ($Is{OSF} and $armaybe eq ':'); | |
| my(@m); | |
| my $ld_opt = $Is{OS2} ? '$(OPTIMIZE) ' : ''; # Useful on other systems too? | |
| my $ld_fix = $Is{OS2} ? '|| ( $(RM_F) $@ && sh -c false )' : ''; | |
| push(@m,' | |
| # This section creates the dynamically loadable $(INST_DYNAMIC) | |
| # from $(OBJECT) and possibly $(MYEXTLIB). | |
| ARMAYBE = '.$armaybe.' | |
| OTHERLDFLAGS = '.$ld_opt.$otherldflags.' | |
| INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' | |
| INST_DYNAMIC_FIX = '.$ld_fix.' | |
| $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) | |
| '); | |
| if ($armaybe ne ':'){ | |
| $ldfrom = 'tmp$(LIB_EXT)'; | |
| push(@m,' $(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n"); | |
| push(@m,' $(RANLIB) '."$ldfrom\n"); | |
| } | |
| $ldfrom = "-all $ldfrom -none" if $Is{OSF}; | |
| # The IRIX linker doesn't use LD_RUN_PATH | |
| my $ldrun = $Is{IRIX} && $self->{LD_RUN_PATH} ? | |
| qq{-rpath "$self->{LD_RUN_PATH}"} : ''; | |
| # For example in AIX the shared objects/libraries from previous builds | |
| # linger quite a while in the shared dynalinker cache even when nobody | |
| # is using them. This is painful if one for instance tries to restart | |
| # a failed build because the link command will fail unnecessarily 'cos | |
| # the shared object/library is 'busy'. | |
| push(@m,' $(RM_F) $@ | |
| '); | |
| my $libs = '$(LDLOADLIBS)'; | |
| if (($Is{NetBSD} || $Is{Interix}) && $Config{'useshrplib'} eq 'true') { | |
| # Use nothing on static perl platforms, and to the flags needed | |
| # to link against the shared libperl library on shared perl | |
| # platforms. We peek at lddlflags to see if we need -Wl,-R | |
| # or -R to add paths to the run-time library search path. | |
| if ($Config{'lddlflags'} =~ /-Wl,-R/) { | |
| $libs .= ' -L$(PERL_INC) -Wl,-R$(INSTALLARCHLIB)/CORE -Wl,-R$(PERL_ARCHLIB)/CORE -lperl'; | |
| } elsif ($Config{'lddlflags'} =~ /-R/) { | |
| $libs .= ' -L$(PERL_INC) -R$(INSTALLARCHLIB)/CORE -R$(PERL_ARCHLIB)/CORE -lperl'; | |
| } | |
| } | |
| my $ld_run_path_shell = ""; | |
| if ($self->{LD_RUN_PATH} ne "") { | |
| $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" '; | |
| } | |
| push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $ldfrom, $libs; | |
| %s$(LD) %s $(LDDLFLAGS) %s $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) \ | |
| $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) \ | |
| $(INST_DYNAMIC_FIX) | |
| MAKE | |
| push @m, <<'MAKE'; | |
| $(CHMOD) $(PERM_RWX) $@ | |
| MAKE | |
| return join('',@m); | |
| } | |
| =item exescan | |
| Deprecated method. Use libscan instead. | |
| =cut | |
| sub exescan { | |
| my($self,$path) = @_; | |
| $path; | |
| } | |
| =item extliblist | |
| Called by init_others, and calls ext ExtUtils::Liblist. See | |
| L<ExtUtils::Liblist> for details. | |
| =cut | |
| sub extliblist { | |
| my($self,$libs) = @_; | |
| require ExtUtils::Liblist; | |
| $self->ext($libs, $Verbose); | |
| } | |
| =item find_perl | |
| Finds the executables PERL and FULLPERL | |
| =cut | |
| sub find_perl { | |
| my($self, $ver, $names, $dirs, $trace) = @_; | |
| if ($trace >= 2){ | |
| print "Looking for perl $ver by these names: | |
| @$names | |
| in these dirs: | |
| @$dirs | |
| "; | |
| } | |
| my $stderr_duped = 0; | |
| local *STDERR_COPY; | |
| unless ($Is{BSD}) { | |
| # >& and lexical filehandles together give 5.6.2 indigestion | |
| if( open(STDERR_COPY, '>&STDERR') ) { ## no critic | |
| $stderr_duped = 1; | |
| } | |
| else { | |
| warn <<WARNING; | |
| find_perl() can't dup STDERR: $! | |
| You might see some garbage while we search for Perl | |
| WARNING | |
| } | |
| } | |
| foreach my $name (@$names){ | |
| foreach my $dir (@$dirs){ | |
| next unless defined $dir; # $self->{PERL_SRC} may be undefined | |
| my ($abs, $val); | |
| if ($self->file_name_is_absolute($name)) { # /foo/bar | |
| $abs = $name; | |
| } elsif ($self->canonpath($name) eq | |
| $self->canonpath(basename($name))) { # foo | |
| $abs = $self->catfile($dir, $name); | |
| } else { # foo/bar | |
| $abs = $self->catfile($Curdir, $name); | |
| } | |
| print "Checking $abs\n" if ($trace >= 2); | |
| next unless $self->maybe_command($abs); | |
| print "Executing $abs\n" if ($trace >= 2); | |
| my $version_check = qq{$abs -le "require $ver; print qq{VER_OK}"}; | |
| $version_check = "$Config{run} $version_check" | |
| if defined $Config{run} and length $Config{run}; | |
| # To avoid using the unportable 2>&1 to suppress STDERR, | |
| # we close it before running the command. | |
| # However, thanks to a thread library bug in many BSDs | |
| # ( http://www.freebsd.org/cgi/query-pr.cgi?pr=51535 ) | |
| # we cannot use the fancier more portable way in here | |
| # but instead need to use the traditional 2>&1 construct. | |
| if ($Is{BSD}) { | |
| $val = `$version_check 2>&1`; | |
| } else { | |
| close STDERR if $stderr_duped; | |
| $val = `$version_check`; | |
| # 5.6.2's 3-arg open doesn't work with >& | |
| open STDERR, ">&STDERR_COPY" ## no critic | |
| if $stderr_duped; | |
| } | |
| if ($val =~ /^VER_OK/m) { | |
| print "Using PERL=$abs\n" if $trace; | |
| return $abs; | |
| } elsif ($trace >= 2) { | |
| print "Result: '$val' ".($? >> 8)."\n"; | |
| } | |
| } | |
| } | |
| print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; | |
| 0; # false and not empty | |
| } | |
| =item fixin | |
| $mm->fixin(@files); | |
| Inserts the sharpbang or equivalent magic number to a set of @files. | |
| =cut | |
| sub fixin { # stolen from the pink Camel book, more or less | |
| my ( $self, @files ) = @_; | |
| for my $file (@files) { | |
| my $file_new = "$file.new"; | |
| my $file_bak = "$file.bak"; | |
| open( my $fixin, '<', $file ) or croak "Can't process '$file': $!"; | |
| local $/ = "\n"; | |
| chomp( my $line = <$fixin> ); | |
| next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file. | |
| my $shb = $self->_fixin_replace_shebang( $file, $line ); | |
| next unless defined $shb; | |
| open( my $fixout, ">", "$file_new" ) or do { | |
| warn "Can't create new $file: $!\n"; | |
| next; | |
| }; | |
| # Print out the new #! line (or equivalent). | |
| local $\; | |
| local $/; | |
| print $fixout $shb, <$fixin>; | |
| close $fixin; | |
| close $fixout; | |
| chmod 0666, $file_bak; | |
| unlink $file_bak; | |
| unless ( _rename( $file, $file_bak ) ) { | |
| warn "Can't rename $file to $file_bak: $!"; | |
| next; | |
| } | |
| unless ( _rename( $file_new, $file ) ) { | |
| warn "Can't rename $file_new to $file: $!"; | |
| unless ( _rename( $file_bak, $file ) ) { | |
| warn "Can't rename $file_bak back to $file either: $!"; | |
| warn "Leaving $file renamed as $file_bak\n"; | |
| } | |
| next; | |
| } | |
| unlink $file_bak; | |
| } | |
| continue { | |
| system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; | |
| } | |
| } | |
| sub _rename { | |
| my($old, $new) = @_; | |
| foreach my $file ($old, $new) { | |
| if( $Is{VMS} and basename($file) !~ /\./ ) { | |
| # rename() in 5.8.0 on VMS will not rename a file if it | |
| # does not contain a dot yet it returns success. | |
| $file = "$file."; | |
| } | |
| } | |
| return rename($old, $new); | |
| } | |
| sub _fixin_replace_shebang { | |
| my ( $self, $file, $line ) = @_; | |
| # Now figure out the interpreter name. | |
| my ( $cmd, $arg ) = split ' ', $line, 2; | |
| $cmd =~ s!^.*/!!; | |
| # Now look (in reverse) for interpreter in absolute PATH (unless perl). | |
| my $interpreter; | |
| if ( $cmd =~ m{^perl(?:\z|[^a-z])} ) { | |
| if ( $Config{startperl} =~ m,^\#!.*/perl, ) { | |
| $interpreter = $Config{startperl}; | |
| $interpreter =~ s,^\#!,,; | |
| } | |
| else { | |
| $interpreter = $Config{perlpath}; | |
| } | |
| } | |
| else { | |
| my (@absdirs) | |
| = reverse grep { $self->file_name_is_absolute($_) } $self->path; | |
| $interpreter = ''; | |
| foreach my $dir (@absdirs) { | |
| if ( $self->maybe_command($cmd) ) { | |
| warn "Ignoring $interpreter in $file\n" | |
| if $Verbose && $interpreter; | |
| $interpreter = $self->catfile( $dir, $cmd ); | |
| } | |
| } | |
| } | |
| # Figure out how to invoke interpreter on this machine. | |
| my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/; | |
| my ($shb) = ""; | |
| if ($interpreter) { | |
| print STDOUT "Changing sharpbang in $file to $interpreter" | |
| if $Verbose; | |
| # this is probably value-free on DOSISH platforms | |
| if ($does_shbang) { | |
| $shb .= "$Config{'sharpbang'}$interpreter"; | |
| $shb .= ' ' . $arg if defined $arg; | |
| $shb .= "\n"; | |
| } | |
| $shb .= qq{ | |
| eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' | |
| if 0; # not running under some shell | |
| } unless $Is{Win32}; # this won't work on win32, so don't | |
| } | |
| else { | |
| warn "Can't find $cmd in PATH, $file unchanged" | |
| if $Verbose; | |
| return undef; | |
| } | |
| return $shb | |
| } | |
| =item force (o) | |
| Writes an empty FORCE: target. | |
| =cut | |
| sub force { | |
| my($self) = shift; | |
| '# Phony target to force checking subdirectories. | |
| FORCE : | |
| $(NOECHO) $(NOOP) | |
| '; | |
| } | |
| =item guess_name | |
| Guess the name of this package by examining the working directory's | |
| name. MakeMaker calls this only if the developer has not supplied a | |
| NAME attribute. | |
| =cut | |
| # '; | |
| sub guess_name { | |
| my($self) = @_; | |
| use Cwd 'cwd'; | |
| my $name = basename(cwd()); | |
| $name =~ s|[\-_][\d\.\-]+\z||; # this is new with MM 5.00, we | |
| # strip minus or underline | |
| # followed by a float or some such | |
| print "Warning: Guessing NAME [$name] from current directory name.\n"; | |
| $name; | |
| } | |
| =item has_link_code | |
| Returns true if C, XS, MYEXTLIB or similar objects exist within this | |
| object that need a compiler. Does not descend into subdirectories as | |
| needs_linking() does. | |
| =cut | |
| sub has_link_code { | |
| my($self) = shift; | |
| return $self->{HAS_LINK_CODE} if defined $self->{HAS_LINK_CODE}; | |
| if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}){ | |
| $self->{HAS_LINK_CODE} = 1; | |
| return 1; | |
| } | |
| return $self->{HAS_LINK_CODE} = 0; | |
| } | |
| =item init_dirscan | |
| Scans the directory structure and initializes DIR, XS, XS_FILES, | |
| C, C_FILES, O_FILES, H, H_FILES, PL_FILES, EXE_FILES. | |
| Called by init_main. | |
| =cut | |
| sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) | |
| my($self) = @_; | |
| my(%dir, %xs, %c, %h, %pl_files, %pm); | |
| my %ignore = map {( $_ => 1 )} qw(Makefile.PL Build.PL test.pl t); | |
| # ignore the distdir | |
| $Is{VMS} ? $ignore{"$self->{DISTVNAME}.dir"} = 1 | |
| : $ignore{$self->{DISTVNAME}} = 1; | |
| @ignore{map lc, keys %ignore} = values %ignore if $Is{VMS}; | |
| foreach my $name ($self->lsdir($Curdir)){ | |
| next if $name =~ /\#/; | |
| next if $name eq $Curdir or $name eq $Updir or $ignore{$name}; | |
| next unless $self->libscan($name); | |
| if (-d $name){ | |
| next if -l $name; # We do not support symlinks at all | |
| next if $self->{NORECURS}; | |
| $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL")); | |
| } elsif ($name =~ /\.xs\z/){ | |
| my($c); ($c = $name) =~ s/\.xs\z/.c/; | |
| $xs{$name} = $c; | |
| $c{$c} = 1; | |
| } elsif ($name =~ /\.c(pp|xx|c)?\z/i){ # .c .C .cpp .cxx .cc | |
| $c{$name} = 1 | |
| unless $name =~ m/perlmain\.c/; # See MAP_TARGET | |
| } elsif ($name =~ /\.h\z/i){ | |
| $h{$name} = 1; | |
| } elsif ($name =~ /\.PL\z/) { | |
| ($pl_files{$name} = $name) =~ s/\.PL\z// ; | |
| } elsif (($Is{VMS} || $Is{Dos}) && $name =~ /[._]pl$/i) { | |
| # case-insensitive filesystem, one dot per name, so foo.h.PL | |
| # under Unix appears as foo.h_pl under VMS or fooh.pl on Dos | |
| local($/); open(my $pl, '<', $name); my $txt = <$pl>; close $pl; | |
| if ($txt =~ /Extracting \S+ \(with variable substitutions/) { | |
| ($pl_files{$name} = $name) =~ s/[._]pl\z//i ; | |
| } | |
| else { | |
| $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); | |
| } | |
| } elsif ($name =~ /\.(p[ml]|pod)\z/){ | |
| $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); | |
| } | |
| } | |
| $self->{PL_FILES} ||= \%pl_files; | |
| $self->{DIR} ||= [sort keys %dir]; | |
| $self->{XS} ||= \%xs; | |
| $self->{C} ||= [sort keys %c]; | |
| $self->{H} ||= [sort keys %h]; | |
| $self->{PM} ||= \%pm; | |
| my @o_files = @{$self->{C}}; | |
| $self->{O_FILES} = [grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files]; | |
| } | |
| =item init_MANPODS | |
| Determines if man pages should be generated and initializes MAN1PODS | |
| and MAN3PODS as appropriate. | |
| =cut | |
| sub init_MANPODS { | |
| my $self = shift; | |
| # Set up names of manual pages to generate from pods | |
| foreach my $man (qw(MAN1 MAN3)) { | |
| if ( $self->{"${man}PODS"} | |
| or $self->{"INSTALL${man}DIR"} =~ /^(none|\s*)$/ | |
| ) { | |
| $self->{"${man}PODS"} ||= {}; | |
| } | |
| else { | |
| my $init_method = "init_${man}PODS"; | |
| $self->$init_method(); | |
| } | |
| } | |
| } | |
| sub _has_pod { | |
| my($self, $file) = @_; | |
| my($ispod)=0; | |
| if (open( my $fh, '<', $file )) { | |
| while (<$fh>) { | |
| if (/^=(?:head\d+|item|pod)\b/) { | |
| $ispod=1; | |
| last; | |
| } | |
| } | |
| close $fh; | |
| } else { | |
| # If it doesn't exist yet, we assume, it has pods in it | |
| $ispod = 1; | |
| } | |
| return $ispod; | |
| } | |
| =item init_MAN1PODS | |
| Initializes MAN1PODS from the list of EXE_FILES. | |
| =cut | |
| sub init_MAN1PODS { | |
| my($self) = @_; | |
| if ( exists $self->{EXE_FILES} ) { | |
| foreach my $name (@{$self->{EXE_FILES}}) { | |
| next unless $self->_has_pod($name); | |
| $self->{MAN1PODS}->{$name} = | |
| $self->catfile("\$(INST_MAN1DIR)", | |
| basename($name).".\$(MAN1EXT)"); | |
| } | |
| } | |
| } | |
| =item init_MAN3PODS | |
| Initializes MAN3PODS from the list of PM files. | |
| =cut | |
| sub init_MAN3PODS { | |
| my $self = shift; | |
| my %manifypods = (); # we collect the keys first, i.e. the files | |
| # we have to convert to pod | |
| foreach my $name (keys %{$self->{PM}}) { | |
| if ($name =~ /\.pod\z/ ) { | |
| $manifypods{$name} = $self->{PM}{$name}; | |
| } elsif ($name =~ /\.p[ml]\z/ ) { | |
| if( $self->_has_pod($name) ) { | |
| $manifypods{$name} = $self->{PM}{$name}; | |
| } | |
| } | |
| } | |
| my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}}; | |
| # Remove "Configure.pm" and similar, if it's not the only pod listed | |
| # To force inclusion, just name it "Configure.pod", or override | |
| # MAN3PODS | |
| foreach my $name (keys %manifypods) { | |
| if ($self->{PERL_CORE} and $name =~ /(config|setup).*\.pm/is) { | |
| delete $manifypods{$name}; | |
| next; | |
| } | |
| my($manpagename) = $name; | |
| $manpagename =~ s/\.p(od|m|l)\z//; | |
| # everything below lib is ok | |
| unless($manpagename =~ s!^\W*($parentlibs_re)\W+!!s) { | |
| $manpagename = $self->catfile( | |
| split(/::/,$self->{PARENT_NAME}),$manpagename | |
| ); | |
| } | |
| $manpagename = $self->replace_manpage_separator($manpagename); | |
| $self->{MAN3PODS}->{$name} = | |
| $self->catfile("\$(INST_MAN3DIR)", "$manpagename.\$(MAN3EXT)"); | |
| } | |
| } | |
| =item init_PM | |
| Initializes PMLIBDIRS and PM from PMLIBDIRS. | |
| =cut | |
| sub init_PM { | |
| my $self = shift; | |
| # Some larger extensions often wish to install a number of *.pm/pl | |
| # files into the library in various locations. | |
| # The attribute PMLIBDIRS holds an array reference which lists | |
| # subdirectories which we should search for library files to | |
| # install. PMLIBDIRS defaults to [ 'lib', $self->{BASEEXT} ]. We | |
| # recursively search through the named directories (skipping any | |
| # which don't exist or contain Makefile.PL files). | |
| # For each *.pm or *.pl file found $self->libscan() is called with | |
| # the default installation path in $_[1]. The return value of | |
| # libscan defines the actual installation location. The default | |
| # libscan function simply returns the path. The file is skipped | |
| # if libscan returns false. | |
| # The default installation location passed to libscan in $_[1] is: | |
| # | |
| # ./*.pm => $(INST_LIBDIR)/*.pm | |
| # ./xyz/... => $(INST_LIBDIR)/xyz/... | |
| # ./lib/... => $(INST_LIB)/... | |
| # | |
| # In this way the 'lib' directory is seen as the root of the actual | |
| # perl library whereas the others are relative to INST_LIBDIR | |
| # (which includes PARENT_NAME). This is a subtle distinction but one | |
| # that's important for nested modules. | |
| unless( $self->{PMLIBDIRS} ) { | |
| if( $Is{VMS} ) { | |
| # Avoid logical name vs directory collisions | |
| $self->{PMLIBDIRS} = ['./lib', "./$self->{BASEEXT}"]; | |
| } | |
| else { | |
| $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}]; | |
| } | |
| } | |
| #only existing directories that aren't in $dir are allowed | |
| # Avoid $_ wherever possible: | |
| # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}}; | |
| my (@pmlibdirs) = @{$self->{PMLIBDIRS}}; | |
| @{$self->{PMLIBDIRS}} = (); | |
| my %dir = map { ($_ => $_) } @{$self->{DIR}}; | |
| foreach my $pmlibdir (@pmlibdirs) { | |
| -d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir; | |
| } | |
| unless( $self->{PMLIBPARENTDIRS} ) { | |
| @{$self->{PMLIBPARENTDIRS}} = ('lib'); | |
| } | |
| return if $self->{PM} and $self->{ARGS}{PM}; | |
| if (@{$self->{PMLIBDIRS}}){ | |
| print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n" | |
| if ($Verbose >= 2); | |
| require File::Find; | |
| File::Find::find(sub { | |
| if (-d $_){ | |
| unless ($self->libscan($_)){ | |
| $File::Find::prune = 1; | |
| } | |
| return; | |
| } | |
| return if /\#/; | |
| return if /~$/; # emacs temp files | |
| return if /,v$/; # RCS files | |
| return if m{\.swp$}; # vim swap files | |
| my $path = $File::Find::name; | |
| my $prefix = $self->{INST_LIBDIR}; | |
| my $striplibpath; | |
| my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}}; | |
| $prefix = $self->{INST_LIB} | |
| if ($striplibpath = $path) =~ s{^(\W*)($parentlibs_re)\W} | |
| {$1}i; | |
| my($inst) = $self->catfile($prefix,$striplibpath); | |
| local($_) = $inst; # for backwards compatibility | |
| $inst = $self->libscan($inst); | |
| print "libscan($path) => '$inst'\n" if ($Verbose >= 2); | |
| return unless $inst; | |
| $self->{PM}{$path} = $inst; | |
| }, @{$self->{PMLIBDIRS}}); | |
| } | |
| } | |
| =item init_DIRFILESEP | |
| Using / for Unix. Called by init_main. | |
| =cut | |
| sub init_DIRFILESEP { | |
| my($self) = shift; | |
| $self->{DIRFILESEP} = '/'; | |
| } | |
| =item init_main | |
| Initializes AR, AR_STATIC_ARGS, BASEEXT, CONFIG, DISTNAME, DLBASE, | |
| EXE_EXT, FULLEXT, FULLPERL, FULLPERLRUN, FULLPERLRUNINST, INST_*, | |
| INSTALL*, INSTALLDIRS, LIB_EXT, LIBPERL_A, MAP_TARGET, NAME, | |
| OBJ_EXT, PARENT_NAME, PERL, PERL_ARCHLIB, PERL_INC, PERL_LIB, | |
| PERL_SRC, PERLRUN, PERLRUNINST, PREFIX, VERSION, | |
| VERSION_SYM, XS_VERSION. | |
| =cut | |
| sub init_main { | |
| my($self) = @_; | |
| # --- Initialize Module Name and Paths | |
| # NAME = Foo::Bar::Oracle | |
| # FULLEXT = Foo/Bar/Oracle | |
| # BASEEXT = Oracle | |
| # PARENT_NAME = Foo::Bar | |
| ### Only UNIX: | |
| ### ($self->{FULLEXT} = | |
| ### $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket | |
| $self->{FULLEXT} = $self->catdir(split /::/, $self->{NAME}); | |
| # Copied from DynaLoader: | |
| my(@modparts) = split(/::/,$self->{NAME}); | |
| my($modfname) = $modparts[-1]; | |
| # Some systems have restrictions on files names for DLL's etc. | |
| # mod2fname returns appropriate file base name (typically truncated) | |
| # It may also edit @modparts if required. | |
| if (defined &DynaLoader::mod2fname) { | |
| $modfname = &DynaLoader::mod2fname(\@modparts); | |
| } | |
| ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!(?:([\w:]+)::)?(\w+)\z! ; | |
| $self->{PARENT_NAME} ||= ''; | |
| if (defined &DynaLoader::mod2fname) { | |
| # As of 5.001m, dl_os2 appends '_' | |
| $self->{DLBASE} = $modfname; | |
| } else { | |
| $self->{DLBASE} = '$(BASEEXT)'; | |
| } | |
| # --- Initialize PERL_LIB, PERL_SRC | |
| # *Real* information: where did we get these two from? ... | |
| my $inc_config_dir = dirname($INC{'Config.pm'}); | |
| my $inc_carp_dir = dirname($INC{'Carp.pm'}); | |
| unless ($self->{PERL_SRC}){ | |
| foreach my $dir_count (1..8) { # 8 is the VMS limit for nesting | |
| my $dir = $self->catdir(($Updir) x $dir_count); | |
| if (-f $self->catfile($dir,"config_h.SH") && | |
| -f $self->catfile($dir,"perl.h") && | |
| -f $self->catfile($dir,"lib","strict.pm") | |
| ) { | |
| $self->{PERL_SRC}=$dir ; | |
| last; | |
| } | |
| } | |
| } | |
| warn "PERL_CORE is set but I can't find your PERL_SRC!\n" if | |
| $self->{PERL_CORE} and !$self->{PERL_SRC}; | |
| if ($self->{PERL_SRC}){ | |
| $self->{PERL_LIB} ||= $self->catdir("$self->{PERL_SRC}","lib"); | |
| if (defined $Cross::platform) { | |
| $self->{PERL_ARCHLIB} = | |
| $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform); | |
| $self->{PERL_INC} = | |
| $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform, | |
| $Is{Win32}?("CORE"):()); | |
| } | |
| else { | |
| $self->{PERL_ARCHLIB} = $self->{PERL_LIB}; | |
| $self->{PERL_INC} = ($Is{Win32}) ? | |
| $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC}; | |
| } | |
| # catch a situation that has occurred a few times in the past: | |
| unless ( | |
| -s $self->catfile($self->{PERL_SRC},'cflags') | |
| or | |
| $Is{VMS} | |
| && | |
| -s $self->catfile($self->{PERL_SRC},'vmsish.h') | |
| or | |
| $Is{Win32} | |
| ){ | |
| warn qq{ | |
| You cannot build extensions below the perl source tree after executing | |
| a 'make clean' in the perl source tree. | |
| To rebuild extensions distributed with the perl source you should | |
| simply Configure (to include those extensions) and then build perl as | |
| normal. After installing perl the source tree can be deleted. It is | |
| not needed for building extensions by running 'perl Makefile.PL' | |
| usually without extra arguments. | |
| It is recommended that you unpack and build additional extensions away | |
| from the perl source tree. | |
| }; | |
| } | |
| } else { | |
| # we should also consider $ENV{PERL5LIB} here | |
| my $old = $self->{PERL_LIB} || $self->{PERL_ARCHLIB} || $self->{PERL_INC}; | |
| $self->{PERL_LIB} ||= $Config{privlibexp}; | |
| $self->{PERL_ARCHLIB} ||= $Config{archlibexp}; | |
| $self->{PERL_INC} = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now | |
| my $perl_h; | |
| if (not -f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h")) | |
| and not $old){ | |
| # Maybe somebody tries to build an extension with an | |
| # uninstalled Perl outside of Perl build tree | |
| my $lib; | |
| for my $dir (@INC) { | |
| $lib = $dir, last if -e $self->catfile($dir, "Config.pm"); | |
| } | |
| if ($lib) { | |
| # Win32 puts its header files in /perl/src/lib/CORE. | |
| # Unix leaves them in /perl/src. | |
| my $inc = $Is{Win32} ? $self->catdir($lib, "CORE" ) | |
| : dirname $lib; | |
| if (-e $self->catfile($inc, "perl.h")) { | |
| $self->{PERL_LIB} = $lib; | |
| $self->{PERL_ARCHLIB} = $lib; | |
| $self->{PERL_INC} = $inc; | |
| $self->{UNINSTALLED_PERL} = 1; | |
| print STDOUT <<EOP; | |
| ... Detected uninstalled Perl. Trying to continue. | |
| EOP | |
| } | |
| } | |
| } | |
| } | |
| # We get SITELIBEXP and SITEARCHEXP directly via | |
| # Get_from_Config. When we are running standard modules, these | |
| # won't matter, we will set INSTALLDIRS to "perl". Otherwise we | |
| # set it to "site". I prefer that INSTALLDIRS be set from outside | |
| # MakeMaker. | |
| $self->{INSTALLDIRS} ||= "site"; | |
| $self->{MAN1EXT} ||= $Config{man1ext}; | |
| $self->{MAN3EXT} ||= $Config{man3ext}; | |
| # Get some stuff out of %Config if we haven't yet done so | |
| print STDOUT "CONFIG must be an array ref\n" | |
| if ($self->{CONFIG} and ref $self->{CONFIG} ne 'ARRAY'); | |
| $self->{CONFIG} = [] unless (ref $self->{CONFIG}); | |
| push(@{$self->{CONFIG}}, @ExtUtils::MakeMaker::Get_from_Config); | |
| push(@{$self->{CONFIG}}, 'shellflags') if $Config{shellflags}; | |
| my(%once_only); | |
| foreach my $m (@{$self->{CONFIG}}){ | |
| next if $once_only{$m}; | |
| print STDOUT "CONFIG key '$m' does not exist in Config.pm\n" | |
| unless exists $Config{$m}; | |
| $self->{uc $m} ||= $Config{$m}; | |
| $once_only{$m} = 1; | |
| } | |
| # This is too dangerous: | |
| # if ($^O eq "next") { | |
| # $self->{AR} = "libtool"; | |
| # $self->{AR_STATIC_ARGS} = "-o"; | |
| # } | |
| # But I leave it as a placeholder | |
| $self->{AR_STATIC_ARGS} ||= "cr"; | |
| # These should never be needed | |
| $self->{OBJ_EXT} ||= '.o'; | |
| $self->{LIB_EXT} ||= '.a'; | |
| $self->{MAP_TARGET} ||= "perl"; | |
| $self->{LIBPERL_A} ||= "libperl$self->{LIB_EXT}"; | |
| # make a simple check if we find strict | |
| warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory | |
| (strict.pm not found)" | |
| unless -f $self->catfile("$self->{PERL_LIB}","strict.pm") || | |
| $self->{NAME} eq "ExtUtils::MakeMaker"; | |
| } | |
| =item init_others | |
| Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH, LD, | |
| OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, SHELL, NOOP, | |
| FIRST_MAKEFILE, MAKEFILE_OLD, NOECHO, RM_F, RM_RF, TEST_F, | |
| TOUCH, CP, MV, CHMOD, UMASK_NULL, ECHO, ECHO_N | |
| =cut | |
| sub init_others { # --- Initialize Other Attributes | |
| my($self) = shift; | |
| $self->{ECHO} ||= 'echo'; | |
| $self->{ECHO_N} ||= 'echo -n'; | |
| $self->{RM_F} ||= "rm -f"; | |
| $self->{RM_RF} ||= "rm -rf"; | |
| $self->{TOUCH} ||= "touch"; | |
| $self->{TEST_F} ||= "test -f"; | |
| $self->{CP} ||= "cp"; | |
| $self->{MV} ||= "mv"; | |
| $self->{CHMOD} ||= "chmod"; | |
| $self->{FALSE} ||= 'false'; | |
| $self->{TRUE} ||= 'true'; | |
| $self->{LD} ||= 'ld'; | |
| $self->SUPER::init_others(@_); | |
| # After SUPER::init_others so $Config{shell} has a | |
| # chance to get set. | |
| $self->{SHELL} ||= '/bin/sh'; | |
| return 1; | |
| } | |
| =item init_linker | |
| Unix has no need of special linker flags. | |
| =cut | |
| sub init_linker { | |
| my($self) = shift; | |
| $self->{PERL_ARCHIVE} ||= ''; | |
| $self->{PERL_ARCHIVE_AFTER} ||= ''; | |
| $self->{EXPORT_LIST} ||= ''; | |
| } | |
| =begin _protected | |
| =item init_lib2arch | |
| $mm->init_lib2arch | |
| =end _protected | |
| =cut | |
| sub init_lib2arch { | |
| my($self) = shift; | |
| # The user who requests an installation directory explicitly | |
| # should not have to tell us an architecture installation directory | |
| # as well. We look if a directory exists that is named after the | |
| # architecture. If not we take it as a sign that it should be the | |
| # same as the requested installation directory. Otherwise we take | |
| # the found one. | |
| for my $libpair ({l=>"privlib", a=>"archlib"}, | |
| {l=>"sitelib", a=>"sitearch"}, | |
| {l=>"vendorlib", a=>"vendorarch"}, | |
| ) | |
| { | |
| my $lib = "install$libpair->{l}"; | |
| my $Lib = uc $lib; | |
| my $Arch = uc "install$libpair->{a}"; | |
| if( $self->{$Lib} && ! $self->{$Arch} ){ | |
| my($ilib) = $Config{$lib}; | |
| $self->prefixify($Arch,$ilib,$self->{$Lib}); | |
| unless (-d $self->{$Arch}) { | |
| print STDOUT "Directory $self->{$Arch} not found\n" | |
| if $Verbose; | |
| $self->{$Arch} = $self->{$Lib}; | |
| } | |
| print STDOUT "Defaulting $Arch to $self->{$Arch}\n" if $Verbose; | |
| } | |
| } | |
| } | |
| =item init_PERL | |
| $mm->init_PERL; | |
| Called by init_main. Sets up ABSPERL, PERL, FULLPERL and all the | |
| *PERLRUN* permutations. | |
| PERL is allowed to be miniperl | |
| FULLPERL must be a complete perl | |
| ABSPERL is PERL converted to an absolute path | |
| *PERLRUN contains everything necessary to run perl, find it's | |
| libraries, etc... | |
| *PERLRUNINST is *PERLRUN + everything necessary to find the | |
| modules being built. | |
| =cut | |
| sub init_PERL { | |
| my($self) = shift; | |
| my @defpath = (); | |
| foreach my $component ($self->{PERL_SRC}, $self->path(), | |
| $Config{binexp}) | |
| { | |
| push @defpath, $component if defined $component; | |
| } | |
| # Build up a set of file names (not command names). | |
| my $thisperl = $self->canonpath($^X); | |
| $thisperl .= $Config{exe_ext} unless | |
| # VMS might have a file version # at the end | |
| $Is{VMS} ? $thisperl =~ m/$Config{exe_ext}(;\d+)?$/i | |
| : $thisperl =~ m/$Config{exe_ext}$/i; | |
| # We need a relative path to perl when in the core. | |
| $thisperl = $self->abs2rel($thisperl) if $self->{PERL_CORE}; | |
| my @perls = ($thisperl); | |
| push @perls, map { "$_$Config{exe_ext}" } | |
| ('perl', 'perl5', "perl$Config{version}"); | |
| # miniperl has priority over all but the cannonical perl when in the | |
| # core. Otherwise its a last resort. | |
| my $miniperl = "miniperl$Config{exe_ext}"; | |
| if( $self->{PERL_CORE} ) { | |
| splice @perls, 1, 0, $miniperl; | |
| } | |
| else { | |
| push @perls, $miniperl; | |
| } | |
| $self->{PERL} ||= | |
| $self->find_perl(5.0, \@perls, \@defpath, $Verbose ); | |
| # don't check if perl is executable, maybe they have decided to | |
| # supply switches with perl | |
| # When built for debugging, VMS doesn't create perl.exe but ndbgperl.exe. | |
| my $perl_name = 'perl'; | |
| $perl_name = 'ndbgperl' if $Is{VMS} && | |
| defined $Config{usevmsdebug} && $Config{usevmsdebug} eq 'define'; | |
| # XXX This logic is flawed. If "miniperl" is anywhere in the path | |
| # it will get confused. It should be fixed to work only on the filename. | |
| # Define 'FULLPERL' to be a non-miniperl (used in test: target) | |
| ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/$perl_name/i | |
| unless $self->{FULLPERL}; | |
| # Little hack to get around VMS's find_perl putting "MCR" in front | |
| # sometimes. | |
| $self->{ABSPERL} = $self->{PERL}; | |
| my $has_mcr = $self->{ABSPERL} =~ s/^MCR\s*//; | |
| if( $self->file_name_is_absolute($self->{ABSPERL}) ) { | |
| $self->{ABSPERL} = '$(PERL)'; | |
| } | |
| else { | |
| $self->{ABSPERL} = $self->rel2abs($self->{ABSPERL}); | |
| # Quote the perl command if it contains whitespace | |
| $self->{ABSPERL} = $self->quote_literal($self->{ABSPERL}) | |
| if $self->{ABSPERL} =~ /\s/; | |
| $self->{ABSPERL} = 'MCR '.$self->{ABSPERL} if $has_mcr; | |
| } | |
| # Are we building the core? | |
| $self->{PERL_CORE} = $ENV{PERL_CORE} unless exists $self->{PERL_CORE}; | |
| $self->{PERL_CORE} = 0 unless defined $self->{PERL_CORE}; | |
| # How do we run perl? | |
| foreach my $perl (qw(PERL FULLPERL ABSPERL)) { | |
| my $run = $perl.'RUN'; | |
| $self->{$run} = "\$($perl)"; | |
| # Make sure perl can find itself before it's installed. | |
| $self->{$run} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} | |
| if $self->{UNINSTALLED_PERL} || $self->{PERL_CORE}; | |
| $self->{$perl.'RUNINST'} = | |
| sprintf q{$(%sRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"}, $perl; | |
| } | |
| return 1; | |
| } | |
| =item init_platform | |
| =item platform_constants | |
| Add MM_Unix_VERSION. | |
| =cut | |
| sub init_platform { | |
| my($self) = shift; | |
| $self->{MM_Unix_VERSION} = $VERSION; | |
| $self->{PERL_MALLOC_DEF} = '-DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc '. | |
| '-Dfree=Perl_mfree -Drealloc=Perl_realloc '. | |
| '-Dcalloc=Perl_calloc'; | |
| } | |
| sub platform_constants { | |
| my($self) = shift; | |
| my $make_frag = ''; | |
| foreach my $macro (qw(MM_Unix_VERSION PERL_MALLOC_DEF)) | |
| { | |
| next unless defined $self->{$macro}; | |
| $make_frag .= "$macro = $self->{$macro}\n"; | |
| } | |
| return $make_frag; | |
| } | |
| =item init_PERM | |
| $mm->init_PERM | |
| Called by init_main. Initializes PERL_* | |
| =cut | |
| sub init_PERM { | |
| my($self) = shift; | |
| $self->{PERM_DIR} = 755 unless defined $self->{PERM_DIR}; | |
| $self->{PERM_RW} = 644 unless defined $self->{PERM_RW}; | |
| $self->{PERM_RWX} = 755 unless defined $self->{PERM_RWX}; | |
| return 1; | |
| } | |
| =item init_xs | |
| $mm->init_xs | |
| Sets up macros having to do with XS code. Currently just INST_STATIC, | |
| INST_DYNAMIC and INST_BOOT. | |
| =cut | |
| sub init_xs { | |
| my $self = shift; | |
| if ($self->has_link_code()) { | |
| $self->{INST_STATIC} = | |
| $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT)$(LIB_EXT)'); | |
| $self->{INST_DYNAMIC} = | |
| $self->catfile('$(INST_ARCHAUTODIR)', '$(DLBASE).$(DLEXT)'); | |
| $self->{INST_BOOT} = | |
| $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT).bs'); | |
| } else { | |
| $self->{INST_STATIC} = ''; | |
| $self->{INST_DYNAMIC} = ''; | |
| $self->{INST_BOOT} = ''; | |
| } | |
| } | |
| =item install (o) | |
| Defines the install target. | |
| =cut | |
| sub install { | |
| my($self, %attribs) = @_; | |
| my(@m); | |
| push @m, q{ | |
| install :: pure_install doc_install | |
| $(NOECHO) $(NOOP) | |
| install_perl :: pure_perl_install doc_perl_install | |
| $(NOECHO) $(NOOP) | |
| install_site :: pure_site_install doc_site_install | |
| $(NOECHO) $(NOOP) | |
| install_vendor :: pure_vendor_install doc_vendor_install | |
| $(NOECHO) $(NOOP) | |
| pure_install :: pure_$(INSTALLDIRS)_install | |
| $(NOECHO) $(NOOP) | |
| doc_install :: doc_$(INSTALLDIRS)_install | |
| $(NOECHO) $(NOOP) | |
| pure__install : pure_site_install | |
| $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site | |
| doc__install : doc_site_install | |
| $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site | |
| pure_perl_install :: all | |
| $(NOECHO) $(MOD_INSTALL) \ | |
| read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \ | |
| write }.$self->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \ | |
| $(INST_LIB) $(DESTINSTALLPRIVLIB) \ | |
| $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ | |
| $(INST_BIN) $(DESTINSTALLBIN) \ | |
| $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ | |
| $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ | |
| $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) | |
| $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ | |
| }.$self->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{ | |
| pure_site_install :: all | |
| $(NOECHO) $(MOD_INSTALL) \ | |
| read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \ | |
| write }.$self->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{ \ | |
| $(INST_LIB) $(DESTINSTALLSITELIB) \ | |
| $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ | |
| $(INST_BIN) $(DESTINSTALLSITEBIN) \ | |
| $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \ | |
| $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ | |
| $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) | |
| $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ | |
| }.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{ | |
| pure_vendor_install :: all | |
| $(NOECHO) $(MOD_INSTALL) \ | |
| read }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \ | |
| write }.$self->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').q{ \ | |
| $(INST_LIB) $(DESTINSTALLVENDORLIB) \ | |
| $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ | |
| $(INST_BIN) $(DESTINSTALLVENDORBIN) \ | |
| $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \ | |
| $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ | |
| $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) | |
| doc_perl_install :: all | |
| $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod | |
| -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| -$(NOECHO) $(DOC_INSTALL) \ | |
| "Module" "$(NAME)" \ | |
| "installed into" "$(INSTALLPRIVLIB)" \ | |
| LINKTYPE "$(LINKTYPE)" \ | |
| VERSION "$(VERSION)" \ | |
| EXE_FILES "$(EXE_FILES)" \ | |
| >> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{ | |
| doc_site_install :: all | |
| $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod | |
| -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| -$(NOECHO) $(DOC_INSTALL) \ | |
| "Module" "$(NAME)" \ | |
| "installed into" "$(INSTALLSITELIB)" \ | |
| LINKTYPE "$(LINKTYPE)" \ | |
| VERSION "$(VERSION)" \ | |
| EXE_FILES "$(EXE_FILES)" \ | |
| >> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{ | |
| doc_vendor_install :: all | |
| $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod | |
| -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| -$(NOECHO) $(DOC_INSTALL) \ | |
| "Module" "$(NAME)" \ | |
| "installed into" "$(INSTALLVENDORLIB)" \ | |
| LINKTYPE "$(LINKTYPE)" \ | |
| VERSION "$(VERSION)" \ | |
| EXE_FILES "$(EXE_FILES)" \ | |
| >> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{ | |
| }; | |
| push @m, q{ | |
| uninstall :: uninstall_from_$(INSTALLDIRS)dirs | |
| $(NOECHO) $(NOOP) | |
| uninstall_from_perldirs :: | |
| $(NOECHO) $(UNINSTALL) }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ | |
| uninstall_from_sitedirs :: | |
| $(NOECHO) $(UNINSTALL) }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ | |
| uninstall_from_vendordirs :: | |
| $(NOECHO) $(UNINSTALL) }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{ | |
| }; | |
| join("",@m); | |
| } | |
| =item installbin (o) | |
| Defines targets to make and to install EXE_FILES. | |
| =cut | |
| sub installbin { | |
| my($self) = shift; | |
| return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY"; | |
| my @exefiles = @{$self->{EXE_FILES}}; | |
| return "" unless @exefiles; | |
| @exefiles = map vmsify($_), @exefiles if $Is{VMS}; | |
| my %fromto; | |
| for my $from (@exefiles) { | |
| my($path)= $self->catfile('$(INST_SCRIPT)', basename($from)); | |
| local($_) = $path; # for backwards compatibility | |
| my $to = $self->libscan($path); | |
| print "libscan($from) => '$to'\n" if ($Verbose >=2); | |
| $to = vmsify($to) if $Is{VMS}; | |
| $fromto{$from} = $to; | |
| } | |
| my @to = values %fromto; | |
| my @m; | |
| push(@m, qq{ | |
| EXE_FILES = @exefiles | |
| pure_all :: @to | |
| \$(NOECHO) \$(NOOP) | |
| realclean :: | |
| }); | |
| # realclean can get rather large. | |
| push @m, map "\t$_\n", $self->split_command('$(RM_F)', @to); | |
| push @m, "\n"; | |
| # A target for each exe file. | |
| while (my($from,$to) = each %fromto) { | |
| last unless defined $from; | |
| push @m, sprintf <<'MAKE', $to, $from, $to, $from, $to, $to, $to; | |
| %s : %s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists | |
| $(NOECHO) $(RM_F) %s | |
| $(CP) %s %s | |
| $(FIXIN) %s | |
| -$(NOECHO) $(CHMOD) $(PERM_RWX) %s | |
| MAKE | |
| } | |
| join "", @m; | |
| } | |
| =item linkext (o) | |
| Defines the linkext target which in turn defines the LINKTYPE. | |
| =cut | |
| sub linkext { | |
| my($self, %attribs) = @_; | |
| # LINKTYPE => static or dynamic or '' | |
| my($linktype) = defined $attribs{LINKTYPE} ? | |
| $attribs{LINKTYPE} : '$(LINKTYPE)'; | |
| " | |
| linkext :: $linktype | |
| \$(NOECHO) \$(NOOP) | |
| "; | |
| } | |
| =item lsdir | |
| Takes as arguments a directory name and a regular expression. Returns | |
| all entries in the directory that match the regular expression. | |
| =cut | |
| sub lsdir { | |
| my($self) = shift; | |
| my($dir, $regex) = @_; | |
| my(@ls); | |
| my $dh = new DirHandle; | |
| $dh->open($dir || ".") or return (); | |
| @ls = $dh->read; | |
| $dh->close; | |
| @ls = grep(/$regex/, @ls) if $regex; | |
| @ls; | |
| } | |
| =item macro (o) | |
| Simple subroutine to insert the macros defined by the macro attribute | |
| into the Makefile. | |
| =cut | |
| sub macro { | |
| my($self,%attribs) = @_; | |
| my(@m,$key,$val); | |
| while (($key,$val) = each %attribs){ | |
| last unless defined $key; | |
| push @m, "$key = $val\n"; | |
| } | |
| join "", @m; | |
| } | |
| =item makeaperl (o) | |
| Called by staticmake. Defines how to write the Makefile to produce a | |
| static new perl. | |
| By default the Makefile produced includes all the static extensions in | |
| the perl library. (Purified versions of library files, e.g., | |
| DynaLoader_pure_p1_c0_032.a are automatically ignored to avoid link errors.) | |
| =cut | |
| sub makeaperl { | |
| my($self, %attribs) = @_; | |
| my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = | |
| @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; | |
| my(@m); | |
| push @m, " | |
| # --- MakeMaker makeaperl section --- | |
| MAP_TARGET = $target | |
| FULLPERL = $self->{FULLPERL} | |
| "; | |
| return join '', @m if $self->{PARENT}; | |
| my($dir) = join ":", @{$self->{DIR}}; | |
| unless ($self->{MAKEAPERL}) { | |
| push @m, q{ | |
| $(MAP_TARGET) :: static $(MAKE_APERL_FILE) | |
| $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ | |
| $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib | |
| $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) | |
| $(NOECHO) $(PERLRUNINST) \ | |
| Makefile.PL DIR=}, $dir, q{ \ | |
| MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ | |
| MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=}; | |
| foreach (@ARGV){ | |
| if( /\s/ ){ | |
| s/=(.*)/='$1'/; | |
| } | |
| push @m, " \\\n\t\t$_"; | |
| } | |
| # push @m, map( " \\\n\t\t$_", @ARGV ); | |
| push @m, "\n"; | |
| return join '', @m; | |
| } | |
| my($cccmd, $linkcmd, $lperl); | |
| $cccmd = $self->const_cccmd($libperl); | |
| $cccmd =~ s/^CCCMD\s*=\s*//; | |
| $cccmd =~ s/\$\(INC\)/ "-I$self->{PERL_INC}" /; | |
| $cccmd .= " $Config{cccdlflags}" | |
| if ($Config{useshrplib} eq 'true'); | |
| $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/; | |
| # The front matter of the linkcommand... | |
| $linkcmd = join ' ', "\$(CC)", | |
| grep($_, @Config{qw(ldflags ccdlflags)}); | |
| $linkcmd =~ s/\s+/ /g; | |
| $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,; | |
| # Which *.a files could we make use of... | |
| my %static; | |
| require File::Find; | |
| File::Find::find(sub { | |
| return unless m/\Q$self->{LIB_EXT}\E$/; | |
| # Skip perl's libraries. | |
| return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/; | |
| # Skip purified versions of libraries | |
| # (e.g., DynaLoader_pure_p1_c0_032.a) | |
| return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure"; | |
| if( exists $self->{INCLUDE_EXT} ){ | |
| my $found = 0; | |
| (my $xx = $File::Find::name) =~ s,.*?/auto/,,s; | |
| $xx =~ s,/?$_,,; | |
| $xx =~ s,/,::,g; | |
| # Throw away anything not explicitly marked for inclusion. | |
| # DynaLoader is implied. | |
| foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){ | |
| if( $xx eq $incl ){ | |
| $found++; | |
| last; | |
| } | |
| } | |
| return unless $found; | |
| } | |
| elsif( exists $self->{EXCLUDE_EXT} ){ | |
| (my $xx = $File::Find::name) =~ s,.*?/auto/,,s; | |
| $xx =~ s,/?$_,,; | |
| $xx =~ s,/,::,g; | |
| # Throw away anything explicitly marked for exclusion | |
| foreach my $excl (@{$self->{EXCLUDE_EXT}}){ | |
| return if( $xx eq $excl ); | |
| } | |
| } | |
| # don't include the installed version of this extension. I | |
| # leave this line here, although it is not necessary anymore: | |
| # I patched minimod.PL instead, so that Miniperl.pm won't | |
| # enclude duplicates | |
| # Once the patch to minimod.PL is in the distribution, I can | |
| # drop it | |
| return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}\z:; | |
| use Cwd 'cwd'; | |
| $static{cwd() . "/" . $_}++; | |
| }, grep( -d $_, @{$searchdirs || []}) ); | |
| # We trust that what has been handed in as argument, will be buildable | |
| $static = [] unless $static; | |
| @static{@{$static}} = (1) x @{$static}; | |
| $extra = [] unless $extra && ref $extra eq 'ARRAY'; | |
| for (sort keys %static) { | |
| next unless /\Q$self->{LIB_EXT}\E\z/; | |
| $_ = dirname($_) . "/extralibs.ld"; | |
| push @$extra, $_; | |
| } | |
| s/^(.*)/"-I$1"/ for @{$perlinc || []}; | |
| $target ||= "perl"; | |
| $tmp ||= "."; | |
| # MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we | |
| # regenerate the Makefiles, MAP_STATIC and the dependencies for | |
| # extralibs.all are computed correctly | |
| push @m, " | |
| MAP_LINKCMD = $linkcmd | |
| MAP_PERLINC = @{$perlinc || []} | |
| MAP_STATIC = ", | |
| join(" \\\n\t", reverse sort keys %static), " | |
| MAP_PRELIBS = $Config{perllibs} $Config{cryptlib} | |
| "; | |
| if (defined $libperl) { | |
| ($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/; | |
| } | |
| unless ($libperl && -f $lperl) { # Ilya's code... | |
| my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE"; | |
| $dir = "$self->{PERL_ARCHLIB}/.." if $self->{UNINSTALLED_PERL}; | |
| $libperl ||= "libperl$self->{LIB_EXT}"; | |
| $libperl = "$dir/$libperl"; | |
| $lperl ||= "libperl$self->{LIB_EXT}"; | |
| $lperl = "$dir/$lperl"; | |
| if (! -f $libperl and ! -f $lperl) { | |
| # We did not find a static libperl. Maybe there is a shared one? | |
| if ($Is{SunOS}) { | |
| $lperl = $libperl = "$dir/$Config{libperl}"; | |
| # SUNOS ld does not take the full path to a shared library | |
| $libperl = '' if $Is{SunOS4}; | |
| } | |
| } | |
| print STDOUT "Warning: $libperl not found | |
| If you're going to build a static perl binary, make sure perl is installed | |
| otherwise ignore this warning\n" | |
| unless (-f $lperl || defined($self->{PERL_SRC})); | |
| } | |
| # SUNOS ld does not take the full path to a shared library | |
| my $llibperl = $libperl ? '$(MAP_LIBPERL)' : '-lperl'; | |
| push @m, " | |
| MAP_LIBPERL = $libperl | |
| LLIBPERL = $llibperl | |
| "; | |
| push @m, ' | |
| $(INST_ARCHAUTODIR)/extralibs.all : $(INST_ARCHAUTODIR)$(DFSEP).exists '.join(" \\\n\t", @$extra).' | |
| $(NOECHO) $(RM_F) $@ | |
| $(NOECHO) $(TOUCH) $@ | |
| '; | |
| foreach my $catfile (@$extra){ | |
| push @m, "\tcat $catfile >> \$\@\n"; | |
| } | |
| push @m, " | |
| \$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all | |
| \$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) \$(LLIBPERL) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS) | |
| \$(NOECHO) \$(ECHO) 'To install the new \"\$(MAP_TARGET)\" binary, call' | |
| \$(NOECHO) \$(ECHO) ' \$(MAKE) \$(USEMAKEFILE) $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)' | |
| \$(NOECHO) \$(ECHO) 'To remove the intermediate files say' | |
| \$(NOECHO) \$(ECHO) ' \$(MAKE) \$(USEMAKEFILE) $makefilename map_clean' | |
| $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c | |
| "; | |
| push @m, "\t".$self->cd($tmp, qq[$cccmd "-I\$(PERL_INC)" perlmain.c])."\n"; | |
| push @m, qq{ | |
| $tmp/perlmain.c: $makefilename}, q{ | |
| $(NOECHO) $(ECHO) Writing $@ | |
| $(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \\ | |
| -e "writemain(grep s#.*/auto/##s, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@ | |
| }; | |
| push @m, "\t", q{$(NOECHO) $(PERL) $(INSTALLSCRIPT)/fixpmain | |
| } if (defined (&Dos::UseLFN) && Dos::UseLFN()==0); | |
| push @m, q{ | |
| doc_inst_perl : | |
| $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod | |
| -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| -$(NOECHO) $(DOC_INSTALL) \ | |
| "Perl binary" "$(MAP_TARGET)" \ | |
| MAP_STATIC "$(MAP_STATIC)" \ | |
| MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \ | |
| MAP_LIBPERL "$(MAP_LIBPERL)" \ | |
| >> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{ | |
| }; | |
| push @m, q{ | |
| inst_perl : pure_inst_perl doc_inst_perl | |
| pure_inst_perl : $(MAP_TARGET) | |
| }.$self->{CP}.q{ $(MAP_TARGET) }.$self->catfile('$(DESTINSTALLBIN)','$(MAP_TARGET)').q{ | |
| clean :: map_clean | |
| map_clean : | |
| }.$self->{RM_F}.qq{ $tmp/perlmain\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all | |
| }; | |
| join '', @m; | |
| } | |
| =item makefile (o) | |
| Defines how to rewrite the Makefile. | |
| =cut | |
| sub makefile { | |
| my($self) = shift; | |
| my $m; | |
| # We do not know what target was originally specified so we | |
| # must force a manual rerun to be sure. But as it should only | |
| # happen very rarely it is not a significant problem. | |
| $m = ' | |
| $(OBJECT) : $(FIRST_MAKEFILE) | |
| ' if $self->{OBJECT}; | |
| my $newer_than_target = $Is{VMS} ? '$(MMS$SOURCE_LIST)' : '$?'; | |
| my $mpl_args = join " ", map qq["$_"], @ARGV; | |
| $m .= sprintf <<'MAKE_FRAG', $newer_than_target, $mpl_args; | |
| # We take a very conservative approach here, but it's worth it. | |
| # We move Makefile to Makefile.old here to avoid gnu make looping. | |
| $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) | |
| $(NOECHO) $(ECHO) "Makefile out-of-date with respect to %s" | |
| $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." | |
| -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) | |
| -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) | |
| - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) | |
| $(PERLRUN) Makefile.PL %s | |
| $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" | |
| $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" | |
| $(FALSE) | |
| MAKE_FRAG | |
| return $m; | |
| } | |
| =item maybe_command | |
| Returns true, if the argument is likely to be a command. | |
| =cut | |
| sub maybe_command { | |
| my($self,$file) = @_; | |
| return $file if -x $file && ! -d $file; | |
| return; | |
| } | |
| =item needs_linking (o) | |
| Does this module need linking? Looks into subdirectory objects (see | |
| also has_link_code()) | |
| =cut | |
| sub needs_linking { | |
| my($self) = shift; | |
| my $caller = (caller(0))[3]; | |
| confess("needs_linking called too early") if | |
| $caller =~ /^ExtUtils::MakeMaker::/; | |
| return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING}; | |
| if ($self->has_link_code or $self->{MAKEAPERL}){ | |
| $self->{NEEDS_LINKING} = 1; | |
| return 1; | |
| } | |
| foreach my $child (keys %{$self->{CHILDREN}}) { | |
| if ($self->{CHILDREN}->{$child}->needs_linking) { | |
| $self->{NEEDS_LINKING} = 1; | |
| return 1; | |
| } | |
| } | |
| return $self->{NEEDS_LINKING} = 0; | |
| } | |
| =item parse_abstract | |
| parse a file and return what you think is the ABSTRACT | |
| =cut | |
| sub parse_abstract { | |
| my($self,$parsefile) = @_; | |
| my $result; | |
| local $/ = "\n"; | |
| open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!"; | |
| my $inpod = 0; | |
| my $package = $self->{DISTNAME}; | |
| $package =~ s/-/::/g; | |
| while (<$fh>) { | |
| $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; | |
| next if !$inpod; | |
| chop; | |
| next unless /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x; | |
| $result = $2; | |
| last; | |
| } | |
| close $fh; | |
| return $result; | |
| } | |
| =item parse_version | |
| my $version = MM->parse_version($file); | |
| Parse a $file and return what $VERSION is set to by the first assignment. | |
| It will return the string "undef" if it can't figure out what $VERSION | |
| is. $VERSION should be for all to see, so C<our $VERSION> or plain $VERSION | |
| are okay, but C<my $VERSION> is not. | |
| C<<package Foo VERSION>> is also checked for. The first version | |
| declaration found is used, but this may change as it differs from how | |
| Perl does it. | |
| parse_version() will try to C<use version> before checking for | |
| C<$VERSION> so the following will work. | |
| $VERSION = qv(1.2.3); | |
| =cut | |
| sub parse_version { | |
| my($self,$parsefile) = @_; | |
| my $result; | |
| local $/ = "\n"; | |
| local $_; | |
| open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!"; | |
| my $inpod = 0; | |
| while (<$fh>) { | |
| $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; | |
| next if $inpod || /^\s*#/; | |
| chop; | |
| next if /^\s*(if|unless|elsif)/; | |
| if ( m{^ \s* package \s+ \w[\w\:\']* \s+ (v?[0-9._]+) \s* ; }x ) { | |
| local $^W = 0; | |
| $result = $1; | |
| } | |
| elsif ( m{(?<!\\) ([\$*]) (([\w\:\']*) \bVERSION)\b .* =}x ) { | |
| my $eval = qq{ | |
| package ExtUtils::MakeMaker::_version; | |
| no strict; | |
| BEGIN { eval { | |
| # Ensure any version() routine which might have leaked | |
| # into this package has been deleted. Interferes with | |
| # version->import() | |
| undef *version; | |
| require version; | |
| "version"->import; | |
| } } | |
| local $1$2; | |
| \$$2=undef; | |
| do { | |
| $_ | |
| }; | |
| \$$2; | |
| }; | |
| local $^W = 0; | |
| $result = eval($eval); ## no critic | |
| warn "Could not eval '$eval' in $parsefile: $@" if $@; | |
| } | |
| else { | |
| next; | |
| } | |
| last if defined $result; | |
| } | |
| close $fh; | |
| $result = "undef" unless defined $result; | |
| return $result; | |
| } | |
| =item pasthru (o) | |
| Defines the string that is passed to recursive make calls in | |
| subdirectories. | |
| =cut | |
| sub pasthru { | |
| my($self) = shift; | |
| my(@m); | |
| my(@pasthru); | |
| my($sep) = $Is{VMS} ? ',' : ''; | |
| $sep .= "\\\n\t"; | |
| foreach my $key (qw(LIB LIBPERL_A LINKTYPE OPTIMIZE | |
| PREFIX INSTALL_BASE) | |
| ) | |
| { | |
| next unless defined $self->{$key}; | |
| push @pasthru, "$key=\"\$($key)\""; | |
| } | |
| foreach my $key (qw(DEFINE INC)) { | |
| next unless defined $self->{$key}; | |
| push @pasthru, "PASTHRU_$key=\"\$(PASTHRU_$key)\""; | |
| } | |
| push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n"; | |
| join "", @m; | |
| } | |
| =item perl_script | |
| Takes one argument, a file name, and returns the file name, if the | |
| argument is likely to be a perl script. On MM_Unix this is true for | |
| any ordinary, readable file. | |
| =cut | |
| sub perl_script { | |
| my($self,$file) = @_; | |
| return $file if -r $file && -f _; | |
| return; | |
| } | |
| =item perldepend (o) | |
| Defines the dependency from all *.h files that come with the perl | |
| distribution. | |
| =cut | |
| sub perldepend { | |
| my($self) = shift; | |
| my(@m); | |
| my $make_config = $self->cd('$(PERL_SRC)', '$(MAKE) lib/Config.pm'); | |
| push @m, sprintf <<'MAKE_FRAG', $make_config if $self->{PERL_SRC}; | |
| # Check for unpropogated config.sh changes. Should never happen. | |
| # We do NOT just update config.h because that is not sufficient. | |
| # An out of date config.h is not fatal but complains loudly! | |
| $(PERL_INC)/config.h: $(PERL_SRC)/config.sh | |
| -$(NOECHO) $(ECHO) "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; $(FALSE) | |
| $(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh | |
| $(NOECHO) $(ECHO) "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh" | |
| %s | |
| MAKE_FRAG | |
| return join "", @m unless $self->needs_linking; | |
| push @m, q{ | |
| PERL_HDRS = \ | |
| $(PERL_INC)/EXTERN.h \ | |
| $(PERL_INC)/INTERN.h \ | |
| $(PERL_INC)/XSUB.h \ | |
| $(PERL_INC)/av.h \ | |
| $(PERL_INC)/config.h \ | |
| $(PERL_INC)/cop.h \ | |
| $(PERL_INC)/cv.h \ | |
| $(PERL_INC)/dosish.h \ | |
| $(PERL_INC)/embed.h \ | |
| $(PERL_INC)/embedvar.h \ | |
| $(PERL_INC)/fakethr.h \ | |
| $(PERL_INC)/form.h \ | |
| $(PERL_INC)/gv.h \ | |
| $(PERL_INC)/handy.h \ | |
| $(PERL_INC)/hv.h \ | |
| $(PERL_INC)/intrpvar.h \ | |
| $(PERL_INC)/iperlsys.h \ | |
| $(PERL_INC)/keywords.h \ | |
| $(PERL_INC)/mg.h \ | |
| $(PERL_INC)/nostdio.h \ | |
| $(PERL_INC)/op.h \ | |
| $(PERL_INC)/opcode.h \ | |
| $(PERL_INC)/patchlevel.h \ | |
| $(PERL_INC)/perl.h \ | |
| $(PERL_INC)/perlio.h \ | |
| $(PERL_INC)/perlsdio.h \ | |
| $(PERL_INC)/perlsfio.h \ | |
| $(PERL_INC)/perlvars.h \ | |
| $(PERL_INC)/perly.h \ | |
| $(PERL_INC)/pp.h \ | |
| $(PERL_INC)/pp_proto.h \ | |
| $(PERL_INC)/proto.h \ | |
| $(PERL_INC)/regcomp.h \ | |
| $(PERL_INC)/regexp.h \ | |
| $(PERL_INC)/regnodes.h \ | |
| $(PERL_INC)/scope.h \ | |
| $(PERL_INC)/sv.h \ | |
| $(PERL_INC)/thread.h \ | |
| $(PERL_INC)/unixish.h \ | |
| $(PERL_INC)/util.h | |
| $(OBJECT) : $(PERL_HDRS) | |
| } if $self->{OBJECT}; | |
| push @m, join(" ", values %{$self->{XS}})." : \$(XSUBPPDEPS)\n" if %{$self->{XS}}; | |
| join "\n", @m; | |
| } | |
| =item pm_to_blib | |
| Defines target that copies all files in the hash PM to their | |
| destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION> | |
| =cut | |
| sub pm_to_blib { | |
| my $self = shift; | |
| my($autodir) = $self->catdir('$(INST_LIB)','auto'); | |
| my $r = q{ | |
| pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) | |
| }; | |
| # VMS will swallow '' and PM_FILTER is often empty. So use q[] | |
| my $pm_to_blib = $self->oneliner(<<CODE, ['-MExtUtils::Install']); | |
| pm_to_blib({\@ARGV}, '$autodir', q[\$(PM_FILTER)], '\$(PERM_DIR)') | |
| CODE | |
| my @cmds = $self->split_command($pm_to_blib, %{$self->{PM}}); | |
| $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds; | |
| $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n}; | |
| return $r; | |
| } | |
| =item post_constants (o) | |
| Returns an empty string per default. Dedicated to overrides from | |
| within Makefile.PL after all constants have been defined. | |
| =cut | |
| sub post_constants{ | |
| ""; | |
| } | |
| =item post_initialize (o) | |
| Returns an empty string per default. Used in Makefile.PLs to add some | |
| chunk of text to the Makefile after the object is initialized. | |
| =cut | |
| sub post_initialize { | |
| ""; | |
| } | |
| =item postamble (o) | |
| Returns an empty string. Can be used in Makefile.PLs to write some | |
| text to the Makefile at the end. | |
| =cut | |
| sub postamble { | |
| ""; | |
| } | |
| # transform dot-separated version string into comma-separated quadruple | |
| # examples: '1.2.3.4.5' => '1,2,3,4' | |
| # '1.2.3' => '1,2,3,0' | |
| sub _ppd_version { | |
| my ($self, $string) = @_; | |
| return join ',', ((split /\./, $string), (0) x 4)[0..3]; | |
| } | |
| =item ppd | |
| Defines target that creates a PPD (Perl Package Description) file | |
| for a binary distribution. | |
| =cut | |
| sub ppd { | |
| my($self) = @_; | |
| my $abstract = $self->{ABSTRACT} || ''; | |
| $abstract =~ s/\n/\\n/sg; | |
| $abstract =~ s/</</g; | |
| $abstract =~ s/>/>/g; | |
| my $author = join(', ',@{$self->{AUTHOR} || []}); | |
| $author =~ s/</</g; | |
| $author =~ s/>/>/g; | |
| my $ppd_xml = sprintf <<'PPD_HTML', $self->{VERSION}, $abstract, $author; | |
| <SOFTPKG NAME="$(DISTNAME)" VERSION="%s"> | |
| <ABSTRACT>%s</ABSTRACT> | |
| <AUTHOR>%s</AUTHOR> | |
| PPD_HTML | |
| $ppd_xml .= " <IMPLEMENTATION>\n"; | |
| if ( $self->{MIN_PERL_VERSION} ) { | |
| my $min_perl_version = $self->_ppd_version($self->{MIN_PERL_VERSION}); | |
| $ppd_xml .= sprintf <<'PPD_PERLVERS', $min_perl_version; | |
| <PERLCORE VERSION="%s" /> | |
| PPD_PERLVERS | |
| } | |
| # Don't add "perl" to requires. perl dependencies are | |
| # handles by ARCHITECTURE. | |
| my %prereqs = %{$self->{PREREQ_PM}}; | |
| delete $prereqs{perl}; | |
| # Build up REQUIRE | |
| foreach my $prereq (sort keys %prereqs) { | |
| my $name = $prereq; | |
| $name .= '::' unless $name =~ /::/; | |
| my $version = $prereqs{$prereq}+0; # force numification | |
| my %attrs = ( NAME => $name ); | |
| $attrs{VERSION} = $version if $version; | |
| my $attrs = join " ", map { qq[$_="$attrs{$_}"] } keys %attrs; | |
| $ppd_xml .= qq( <REQUIRE $attrs />\n); | |
| } | |
| my $archname = $Config{archname}; | |
| if ($] >= 5.008) { | |
| # archname did not change from 5.6 to 5.8, but those versions may | |
| # not be not binary compatible so now we append the part of the | |
| # version that changes when binary compatibility may change | |
| $archname .= "-$Config{PERL_REVISION}.$Config{PERL_VERSION}"; | |
| } | |
| $ppd_xml .= sprintf <<'PPD_OUT', $archname; | |
| <ARCHITECTURE NAME="%s" /> | |
| PPD_OUT | |
| if ($self->{PPM_INSTALL_SCRIPT}) { | |
| if ($self->{PPM_INSTALL_EXEC}) { | |
| $ppd_xml .= sprintf qq{ <INSTALL EXEC="%s">%s</INSTALL>\n}, | |
| $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT}; | |
| } | |
| else { | |
| $ppd_xml .= sprintf qq{ <INSTALL>%s</INSTALL>\n}, | |
| $self->{PPM_INSTALL_SCRIPT}; | |
| } | |
| } | |
| my ($bin_location) = $self->{BINARY_LOCATION} || ''; | |
| $bin_location =~ s/\\/\\\\/g; | |
| $ppd_xml .= sprintf <<'PPD_XML', $bin_location; | |
| <CODEBASE HREF="%s" /> | |
| </IMPLEMENTATION> | |
| </SOFTPKG> | |
| PPD_XML | |
| my @ppd_cmds = $self->echo($ppd_xml, '$(DISTNAME).ppd'); | |
| return sprintf <<'PPD_OUT', join "\n\t", @ppd_cmds; | |
| # Creates a PPD (Perl Package Description) for a binary distribution. | |
| ppd : | |
| %s | |
| PPD_OUT | |
| } | |
| =item prefixify | |
| $MM->prefixify($var, $prefix, $new_prefix, $default); | |
| Using either $MM->{uc $var} || $Config{lc $var}, it will attempt to | |
| replace it's $prefix with a $new_prefix. | |
| Should the $prefix fail to match I<AND> a PREFIX was given as an | |
| argument to WriteMakefile() it will set it to the $new_prefix + | |
| $default. This is for systems whose file layouts don't neatly fit into | |
| our ideas of prefixes. | |
| This is for heuristics which attempt to create directory structures | |
| that mirror those of the installed perl. | |
| For example: | |
| $MM->prefixify('installman1dir', '/usr', '/home/foo', 'man/man1'); | |
| this will attempt to remove '/usr' from the front of the | |
| $MM->{INSTALLMAN1DIR} path (initializing it to $Config{installman1dir} | |
| if necessary) and replace it with '/home/foo'. If this fails it will | |
| simply use '/home/foo/man/man1'. | |
| =cut | |
| sub prefixify { | |
| my($self,$var,$sprefix,$rprefix,$default) = @_; | |
| my $path = $self->{uc $var} || | |
| $Config_Override{lc $var} || $Config{lc $var} || ''; | |
| $rprefix .= '/' if $sprefix =~ m|/$|; | |
| print STDERR " prefixify $var => $path\n" if $Verbose >= 2; | |
| print STDERR " from $sprefix to $rprefix\n" if $Verbose >= 2; | |
| if( $self->{ARGS}{PREFIX} && | |
| $path !~ s{^\Q$sprefix\E\b}{$rprefix}s ) | |
| { | |
| print STDERR " cannot prefix, using default.\n" if $Verbose >= 2; | |
| print STDERR " no default!\n" if !$default && $Verbose >= 2; | |
| $path = $self->catdir($rprefix, $default) if $default; | |
| } | |
| print " now $path\n" if $Verbose >= 2; | |
| return $self->{uc $var} = $path; | |
| } | |
| =item processPL (o) | |
| Defines targets to run *.PL files. | |
| =cut | |
| sub processPL { | |
| my $self = shift; | |
| my $pl_files = $self->{PL_FILES}; | |
| return "" unless $pl_files; | |
| my $m = ''; | |
| foreach my $plfile (sort keys %$pl_files) { | |
| my $list = ref($pl_files->{$plfile}) | |
| ? $pl_files->{$plfile} | |
| : [$pl_files->{$plfile}]; | |
| foreach my $target (@$list) { | |
| if( $Is{VMS} ) { | |
| $plfile = vmsify($self->eliminate_macros($plfile)); | |
| $target = vmsify($self->eliminate_macros($target)); | |
| } | |
| # Normally a .PL file runs AFTER pm_to_blib so it can have | |
| # blib in its @INC and load the just built modules. BUT if | |
| # the generated module is something in $(TO_INST_PM) which | |
| # pm_to_blib depends on then it can't depend on pm_to_blib | |
| # else we have a dependency loop. | |
| my $pm_dep; | |
| my $perlrun; | |
| if( defined $self->{PM}{$target} ) { | |
| $pm_dep = ''; | |
| $perlrun = 'PERLRUN'; | |
| } | |
| else { | |
| $pm_dep = 'pm_to_blib'; | |
| $perlrun = 'PERLRUNINST'; | |
| } | |
| $m .= <<MAKE_FRAG; | |
| all :: $target | |
| \$(NOECHO) \$(NOOP) | |
| $target :: $plfile $pm_dep | |
| \$($perlrun) $plfile $target | |
| MAKE_FRAG | |
| } | |
| } | |
| return $m; | |
| } | |
| =item quote_paren | |
| Backslashes parentheses C<()> in command line arguments. | |
| Doesn't handle recursive Makefile C<$(...)> constructs, | |
| but handles simple ones. | |
| =cut | |
| sub quote_paren { | |
| my $arg = shift; | |
| $arg =~ s{\$\((.+?)\)}{\$\\\\($1\\\\)}g; # protect $(...) | |
| $arg =~ s{(?<!\\)([()])}{\\$1}g; # quote unprotected | |
| $arg =~ s{\$\\\\\((.+?)\\\\\)}{\$($1)}g; # unprotect $(...) | |
| return $arg; | |
| } | |
| =item replace_manpage_separator | |
| my $man_name = $MM->replace_manpage_separator($file_path); | |
| Takes the name of a package, which may be a nested package, in the | |
| form 'Foo/Bar.pm' and replaces the slash with C<::> or something else | |
| safe for a man page file name. Returns the replacement. | |
| =cut | |
| sub replace_manpage_separator { | |
| my($self,$man) = @_; | |
| $man =~ s,/+,::,g; | |
| return $man; | |
| } | |
| =item cd | |
| =cut | |
| sub cd { | |
| my($self, $dir, @cmds) = @_; | |
| # No leading tab and no trailing newline makes for easier embedding | |
| my $make_frag = join "\n\t", map { "cd $dir && $_" } @cmds; | |
| return $make_frag; | |
| } | |
| =item oneliner | |
| =cut | |
| sub oneliner { | |
| my($self, $cmd, $switches) = @_; | |
| $switches = [] unless defined $switches; | |
| # Strip leading and trailing newlines | |
| $cmd =~ s{^\n+}{}; | |
| $cmd =~ s{\n+$}{}; | |
| my @cmds = split /\n/, $cmd; | |
| $cmd = join " \n\t -e ", map $self->quote_literal($_), @cmds; | |
| $cmd = $self->escape_newlines($cmd); | |
| $switches = join ' ', @$switches; | |
| return qq{\$(ABSPERLRUN) $switches -e $cmd --}; | |
| } | |
| =item quote_literal | |
| =cut | |
| sub quote_literal { | |
| my($self, $text) = @_; | |
| # I think all we have to quote is single quotes and I think | |
| # this is a safe way to do it. | |
| $text =~ s{'}{'\\''}g; | |
| return "'$text'"; | |
| } | |
| =item escape_newlines | |
| =cut | |
| sub escape_newlines { | |
| my($self, $text) = @_; | |
| $text =~ s{\n}{\\\n}g; | |
| return $text; | |
| } | |
| =item max_exec_len | |
| Using POSIX::ARG_MAX. Otherwise falling back to 4096. | |
| =cut | |
| sub max_exec_len { | |
| my $self = shift; | |
| if (!defined $self->{_MAX_EXEC_LEN}) { | |
| if (my $arg_max = eval { require POSIX; &POSIX::ARG_MAX }) { | |
| $self->{_MAX_EXEC_LEN} = $arg_max; | |
| } | |
| else { # POSIX minimum exec size | |
| $self->{_MAX_EXEC_LEN} = 4096; | |
| } | |
| } | |
| return $self->{_MAX_EXEC_LEN}; | |
| } | |
| =item static (o) | |
| Defines the static target. | |
| =cut | |
| sub static { | |
| # --- Static Loading Sections --- | |
| my($self) = shift; | |
| ' | |
| ## $(INST_PM) has been moved to the all: target. | |
| ## It remains here for awhile to allow for old usage: "make static" | |
| static :: $(FIRST_MAKEFILE) $(INST_STATIC) | |
| $(NOECHO) $(NOOP) | |
| '; | |
| } | |
| =item static_lib (o) | |
| Defines how to produce the *.a (or equivalent) files. | |
| =cut | |
| sub static_lib { | |
| my($self) = @_; | |
| return '' unless $self->has_link_code; | |
| my(@m); | |
| push(@m, <<'END'); | |
| $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists | |
| $(RM_RF) $@ | |
| END | |
| # If this extension has its own library (eg SDBM_File) | |
| # then copy that to $(INST_STATIC) and add $(OBJECT) into it. | |
| push(@m, <<'MAKE_FRAG') if $self->{MYEXTLIB}; | |
| $(CP) $(MYEXTLIB) $@ | |
| MAKE_FRAG | |
| my $ar; | |
| if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) { | |
| # Prefer the absolute pathed ar if available so that PATH | |
| # doesn't confuse us. Perl itself is built with the full_ar. | |
| $ar = 'FULL_AR'; | |
| } else { | |
| $ar = 'AR'; | |
| } | |
| push @m, sprintf <<'MAKE_FRAG', $ar; | |
| $(%s) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ | |
| $(CHMOD) $(PERM_RWX) $@ | |
| $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld | |
| MAKE_FRAG | |
| # Old mechanism - still available: | |
| push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS}; | |
| $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs | |
| MAKE_FRAG | |
| join('', @m); | |
| } | |
| =item staticmake (o) | |
| Calls makeaperl. | |
| =cut | |
| sub staticmake { | |
| my($self, %attribs) = @_; | |
| my(@static); | |
| my(@searchdirs)=($self->{PERL_ARCHLIB}, $self->{SITEARCHEXP}, $self->{INST_ARCHLIB}); | |
| # And as it's not yet built, we add the current extension | |
| # but only if it has some C code (or XS code, which implies C code) | |
| if (@{$self->{C}}) { | |
| @static = $self->catfile($self->{INST_ARCHLIB}, | |
| "auto", | |
| $self->{FULLEXT}, | |
| "$self->{BASEEXT}$self->{LIB_EXT}" | |
| ); | |
| } | |
| # Either we determine now, which libraries we will produce in the | |
| # subdirectories or we do it at runtime of the make. | |
| # We could ask all subdir objects, but I cannot imagine, why it | |
| # would be necessary. | |
| # Instead we determine all libraries for the new perl at | |
| # runtime. | |
| my(@perlinc) = ($self->{INST_ARCHLIB}, $self->{INST_LIB}, $self->{PERL_ARCHLIB}, $self->{PERL_LIB}); | |
| $self->makeaperl(MAKE => $self->{MAKEFILE}, | |
| DIRS => \@searchdirs, | |
| STAT => \@static, | |
| INCL => \@perlinc, | |
| TARGET => $self->{MAP_TARGET}, | |
| TMP => "", | |
| LIBPERL => $self->{LIBPERL_A} | |
| ); | |
| } | |
| =item subdir_x (o) | |
| Helper subroutine for subdirs | |
| =cut | |
| sub subdir_x { | |
| my($self, $subdir) = @_; | |
| my $subdir_cmd = $self->cd($subdir, | |
| '$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU)' | |
| ); | |
| return sprintf <<'EOT', $subdir_cmd; | |
| subdirs :: | |
| $(NOECHO) %s | |
| EOT | |
| } | |
| =item subdirs (o) | |
| Defines targets to process subdirectories. | |
| =cut | |
| sub subdirs { | |
| # --- Sub-directory Sections --- | |
| my($self) = shift; | |
| my(@m); | |
| # This method provides a mechanism to automatically deal with | |
| # subdirectories containing further Makefile.PL scripts. | |
| # It calls the subdir_x() method for each subdirectory. | |
| foreach my $dir (@{$self->{DIR}}){ | |
| push(@m, $self->subdir_x($dir)); | |
| #### print "Including $dir subdirectory\n"; | |
| } | |
| if (@m){ | |
| unshift(@m, " | |
| # The default clean, realclean and test targets in this Makefile | |
| # have automatically been given entries for each subdir. | |
| "); | |
| } else { | |
| push(@m, "\n# none") | |
| } | |
| join('',@m); | |
| } | |
| =item test (o) | |
| Defines the test targets. | |
| =cut | |
| sub test { | |
| # --- Test and Installation Sections --- | |
| my($self, %attribs) = @_; | |
| my $tests = $attribs{TESTS} || ''; | |
| if (!$tests && -d 't') { | |
| $tests = $self->find_tests; | |
| } | |
| # note: 'test.pl' name is also hardcoded in init_dirscan() | |
| my(@m); | |
| push(@m," | |
| TEST_VERBOSE=0 | |
| TEST_TYPE=test_\$(LINKTYPE) | |
| TEST_FILE = test.pl | |
| TEST_FILES = $tests | |
| TESTDB_SW = -d | |
| testdb :: testdb_\$(LINKTYPE) | |
| test :: \$(TEST_TYPE) subdirs-test | |
| subdirs-test :: | |
| \$(NOECHO) \$(NOOP) | |
| "); | |
| foreach my $dir (@{ $self->{DIR} }) { | |
| my $test = $self->cd($dir, '$(MAKE) test $(PASTHRU)'); | |
| push @m, <<END | |
| subdirs-test :: | |
| \$(NOECHO) $test | |
| END | |
| } | |
| push(@m, "\t\$(NOECHO) \$(ECHO) 'No tests defined for \$(NAME) extension.'\n") | |
| unless $tests or -f "test.pl" or @{$self->{DIR}}; | |
| push(@m, "\n"); | |
| push(@m, "test_dynamic :: pure_all\n"); | |
| push(@m, $self->test_via_harness('$(FULLPERLRUN)', '$(TEST_FILES)')) | |
| if $tests; | |
| push(@m, $self->test_via_script('$(FULLPERLRUN)', '$(TEST_FILE)')) | |
| if -f "test.pl"; | |
| push(@m, "\n"); | |
| push(@m, "testdb_dynamic :: pure_all\n"); | |
| push(@m, $self->test_via_script('$(FULLPERLRUN) $(TESTDB_SW)', | |
| '$(TEST_FILE)')); | |
| push(@m, "\n"); | |
| # Occasionally we may face this degenerate target: | |
| push @m, "test_ : test_dynamic\n\n"; | |
| if ($self->needs_linking()) { | |
| push(@m, "test_static :: pure_all \$(MAP_TARGET)\n"); | |
| push(@m, $self->test_via_harness('./$(MAP_TARGET)', '$(TEST_FILES)')) if $tests; | |
| push(@m, $self->test_via_script('./$(MAP_TARGET)', '$(TEST_FILE)')) if -f "test.pl"; | |
| push(@m, "\n"); | |
| push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n"); | |
| push(@m, $self->test_via_script('./$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)')); | |
| push(@m, "\n"); | |
| } else { | |
| push @m, "test_static :: test_dynamic\n"; | |
| push @m, "testdb_static :: testdb_dynamic\n"; | |
| } | |
| join("", @m); | |
| } | |
| =item test_via_harness (override) | |
| For some reason which I forget, Unix machines like to have | |
| PERL_DL_NONLAZY set for tests. | |
| =cut | |
| sub test_via_harness { | |
| my($self, $perl, $tests) = @_; | |
| return $self->SUPER::test_via_harness("PERL_DL_NONLAZY=1 $perl", $tests); | |
| } | |
| =item test_via_script (override) | |
| Again, the PERL_DL_NONLAZY thing. | |
| =cut | |
| sub test_via_script { | |
| my($self, $perl, $script) = @_; | |
| return $self->SUPER::test_via_script("PERL_DL_NONLAZY=1 $perl", $script); | |
| } | |
| =item tool_xsubpp (o) | |
| Determines typemaps, xsubpp version, prototype behaviour. | |
| =cut | |
| sub tool_xsubpp { | |
| my($self) = shift; | |
| return "" unless $self->needs_linking; | |
| my $xsdir; | |
| my @xsubpp_dirs = @INC; | |
| # Make sure we pick up the new xsubpp if we're building perl. | |
| unshift @xsubpp_dirs, $self->{PERL_LIB} if $self->{PERL_CORE}; | |
| foreach my $dir (@xsubpp_dirs) { | |
| $xsdir = $self->catdir($dir, 'ExtUtils'); | |
| if( -r $self->catfile($xsdir, "xsubpp") ) { | |
| last; | |
| } | |
| } | |
| my $tmdir = File::Spec->catdir($self->{PERL_LIB},"ExtUtils"); | |
| my(@tmdeps) = $self->catfile($tmdir,'typemap'); | |
| if( $self->{TYPEMAPS} ){ | |
| foreach my $typemap (@{$self->{TYPEMAPS}}){ | |
| if( ! -f $typemap ) { | |
| warn "Typemap $typemap not found.\n"; | |
| } | |
| else { | |
| push(@tmdeps, $typemap); | |
| } | |
| } | |
| } | |
| push(@tmdeps, "typemap") if -f "typemap"; | |
| my(@tmargs) = map("-typemap $_", @tmdeps); | |
| if( exists $self->{XSOPT} ){ | |
| unshift( @tmargs, $self->{XSOPT} ); | |
| } | |
| if ($Is{VMS} && | |
| $Config{'ldflags'} && | |
| $Config{'ldflags'} =~ m!/Debug!i && | |
| (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/) | |
| ) | |
| { | |
| unshift(@tmargs,'-nolinenumbers'); | |
| } | |
| $self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG}; | |
| return qq{ | |
| XSUBPPDIR = $xsdir | |
| XSUBPP = \$(XSUBPPDIR)\$(DFSEP)xsubpp | |
| XSUBPPRUN = \$(PERLRUN) \$(XSUBPP) | |
| XSPROTOARG = $self->{XSPROTOARG} | |
| XSUBPPDEPS = @tmdeps \$(XSUBPP) | |
| XSUBPPARGS = @tmargs | |
| XSUBPP_EXTRA_ARGS = | |
| }; | |
| }; | |
| =item all_target | |
| Build man pages, too | |
| =cut | |
| sub all_target { | |
| my $self = shift; | |
| return <<'MAKE_EXT'; | |
| all :: pure_all manifypods | |
| $(NOECHO) $(NOOP) | |
| MAKE_EXT | |
| } | |
| =item top_targets (o) | |
| Defines the targets all, subdirs, config, and O_FILES | |
| =cut | |
| sub top_targets { | |
| # --- Target Sections --- | |
| my($self) = shift; | |
| my(@m); | |
| push @m, $self->all_target, "\n" unless $self->{SKIPHASH}{'all'}; | |
| push @m, ' | |
| pure_all :: config pm_to_blib subdirs linkext | |
| $(NOECHO) $(NOOP) | |
| subdirs :: $(MYEXTLIB) | |
| $(NOECHO) $(NOOP) | |
| config :: $(FIRST_MAKEFILE) blibdirs | |
| $(NOECHO) $(NOOP) | |
| '; | |
| push @m, ' | |
| $(O_FILES): $(H_FILES) | |
| ' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; | |
| push @m, q{ | |
| help : | |
| perldoc ExtUtils::MakeMaker | |
| }; | |
| join('',@m); | |
| } | |
| =item writedoc | |
| Obsolete, deprecated method. Not used since Version 5.21. | |
| =cut | |
| sub writedoc { | |
| # --- perllocal.pod section --- | |
| my($self,$what,$name,@attribs)=@_; | |
| my $time = localtime; | |
| print "=head2 $time: $what C<$name>\n\n=over 4\n\n=item *\n\n"; | |
| print join "\n\n=item *\n\n", map("C<$_>",@attribs); | |
| print "\n\n=back\n\n"; | |
| } | |
| =item xs_c (o) | |
| Defines the suffix rules to compile XS files to C. | |
| =cut | |
| sub xs_c { | |
| my($self) = shift; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs.c: | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c | |
| '; | |
| } | |
| =item xs_cpp (o) | |
| Defines the suffix rules to compile XS files to C++. | |
| =cut | |
| sub xs_cpp { | |
| my($self) = shift; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs.cpp: | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp | |
| '; | |
| } | |
| =item xs_o (o) | |
| Defines suffix rules to go from XS to object files directly. This is | |
| only intended for broken make implementations. | |
| =cut | |
| sub xs_o { # many makes are too dumb to use xs_c then c_o | |
| my($self) = shift; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs$(OBJ_EXT): | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c | |
| $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c | |
| '; | |
| } | |
| 1; | |
| =back | |
| =head1 SEE ALSO | |
| L<ExtUtils::MakeMaker> | |
| =cut | |
| __END__ | |
| EXTUTILS_MM_UNIX | |
| $fatpacked{"ExtUtils/MM_VMS.pm"} = <<'EXTUTILS_MM_VMS'; | |
| package ExtUtils::MM_VMS; | |
| use strict; | |
| use ExtUtils::MakeMaker::Config; | |
| require Exporter; | |
| BEGIN { | |
| # so we can compile the thing on non-VMS platforms. | |
| if( $^O eq 'VMS' ) { | |
| require VMS::Filespec; | |
| VMS::Filespec->import; | |
| } | |
| } | |
| use File::Basename; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Any; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); | |
| use ExtUtils::MakeMaker qw($Verbose neatvalue); | |
| our $Revision = $ExtUtils::MakeMaker::Revision; | |
| =head1 NAME | |
| ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
| =head1 SYNOPSIS | |
| Do not use this directly. | |
| Instead, use ExtUtils::MM and it will figure out which MM_* | |
| class to use for you. | |
| =head1 DESCRIPTION | |
| See ExtUtils::MM_Unix for a documentation of the methods provided | |
| there. This package overrides the implementation of these methods, not | |
| the semantics. | |
| =head2 Methods always loaded | |
| =over 4 | |
| =item wraplist | |
| Converts a list into a string wrapped at approximately 80 columns. | |
| =cut | |
| sub wraplist { | |
| my($self) = shift; | |
| my($line,$hlen) = ('',0); | |
| foreach my $word (@_) { | |
| # Perl bug -- seems to occasionally insert extra elements when | |
| # traversing array (scalar(@array) doesn't show them, but | |
| # foreach(@array) does) (5.00307) | |
| next unless $word =~ /\w/; | |
| $line .= ' ' if length($line); | |
| if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; } | |
| $line .= $word; | |
| $hlen += length($word) + 2; | |
| } | |
| $line; | |
| } | |
| # This isn't really an override. It's just here because ExtUtils::MM_VMS | |
| # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext() | |
| # in MM_VMS, then AUTOLOAD is called, and bad things happen. So, we just | |
| # mimic inheritance here and hand off to ExtUtils::Liblist::Kid. | |
| # XXX This hackery will die soon. --Schwern | |
| sub ext { | |
| require ExtUtils::Liblist::Kid; | |
| goto &ExtUtils::Liblist::Kid::ext; | |
| } | |
| =back | |
| =head2 Methods | |
| Those methods which override default MM_Unix methods are marked | |
| "(override)", while methods unique to MM_VMS are marked "(specific)". | |
| For overridden methods, documentation is limited to an explanation | |
| of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix | |
| documentation for more details. | |
| =over 4 | |
| =item guess_name (override) | |
| Try to determine name of extension being built. We begin with the name | |
| of the current directory. Since VMS filenames are case-insensitive, | |
| however, we look for a F<.pm> file whose name matches that of the current | |
| directory (presumably the 'main' F<.pm> file for this extension), and try | |
| to find a C<package> statement from which to obtain the Mixed::Case | |
| package name. | |
| =cut | |
| sub guess_name { | |
| my($self) = @_; | |
| my($defname,$defpm,@pm,%xs); | |
| local *PM; | |
| $defname = basename(fileify($ENV{'DEFAULT'})); | |
| $defname =~ s![\d\-_]*\.dir.*$!!; # Clip off .dir;1 suffix, and package version | |
| $defpm = $defname; | |
| # Fallback in case for some reason a user has copied the files for an | |
| # extension into a working directory whose name doesn't reflect the | |
| # extension's name. We'll use the name of a unique .pm file, or the | |
| # first .pm file with a matching .xs file. | |
| if (not -e "${defpm}.pm") { | |
| @pm = glob('*.pm'); | |
| s/.pm$// for @pm; | |
| if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; } | |
| elsif (@pm) { | |
| %xs = map { s/.xs$//; ($_,1) } glob('*.xs'); ## no critic | |
| if (keys %xs) { | |
| foreach my $pm (@pm) { | |
| $defpm = $pm, last if exists $xs{$pm}; | |
| } | |
| } | |
| } | |
| } | |
| if (open(my $pm, '<', "${defpm}.pm")){ | |
| while (<$pm>) { | |
| if (/^\s*package\s+([^;]+)/i) { | |
| $defname = $1; | |
| last; | |
| } | |
| } | |
| print STDOUT "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t", | |
| "defaulting package name to $defname\n" | |
| if eof($pm); | |
| close $pm; | |
| } | |
| else { | |
| print STDOUT "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t", | |
| "defaulting package name to $defname\n"; | |
| } | |
| $defname =~ s#[\d.\-_]+$##; | |
| $defname; | |
| } | |
| =item find_perl (override) | |
| Use VMS file specification syntax and CLI commands to find and | |
| invoke Perl images. | |
| =cut | |
| sub find_perl { | |
| my($self, $ver, $names, $dirs, $trace) = @_; | |
| my($vmsfile,@sdirs,@snames,@cand); | |
| my($rslt); | |
| my($inabs) = 0; | |
| local *TCF; | |
| if( $self->{PERL_CORE} ) { | |
| # Check in relative directories first, so we pick up the current | |
| # version of Perl if we're running MakeMaker as part of the main build. | |
| @sdirs = sort { my($absa) = $self->file_name_is_absolute($a); | |
| my($absb) = $self->file_name_is_absolute($b); | |
| if ($absa && $absb) { return $a cmp $b } | |
| else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); } | |
| } @$dirs; | |
| # Check miniperl before perl, and check names likely to contain | |
| # version numbers before "generic" names, so we pick up an | |
| # executable that's less likely to be from an old installation. | |
| @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!; # basename | |
| my($bb) = $b =~ m!([^:>\]/]+)$!; | |
| my($ahasdir) = (length($a) - length($ba) > 0); | |
| my($bhasdir) = (length($b) - length($bb) > 0); | |
| if ($ahasdir and not $bhasdir) { return 1; } | |
| elsif ($bhasdir and not $ahasdir) { return -1; } | |
| else { $bb =~ /\d/ <=> $ba =~ /\d/ | |
| or substr($ba,0,1) cmp substr($bb,0,1) | |
| or length($bb) <=> length($ba) } } @$names; | |
| } | |
| else { | |
| @sdirs = @$dirs; | |
| @snames = @$names; | |
| } | |
| # Image names containing Perl version use '_' instead of '.' under VMS | |
| s/\.(\d+)$/_$1/ for @snames; | |
| if ($trace >= 2){ | |
| print "Looking for perl $ver by these names:\n"; | |
| print "\t@snames,\n"; | |
| print "in these dirs:\n"; | |
| print "\t@sdirs\n"; | |
| } | |
| foreach my $dir (@sdirs){ | |
| next unless defined $dir; # $self->{PERL_SRC} may be undefined | |
| $inabs++ if $self->file_name_is_absolute($dir); | |
| if ($inabs == 1) { | |
| # We've covered relative dirs; everything else is an absolute | |
| # dir (probably an installed location). First, we'll try | |
| # potential command names, to see whether we can avoid a long | |
| # MCR expression. | |
| foreach my $name (@snames) { | |
| push(@cand,$name) if $name =~ /^[\w\-\$]+$/; | |
| } | |
| $inabs++; # Should happen above in next $dir, but just in case... | |
| } | |
| foreach my $name (@snames){ | |
| push @cand, ($name !~ m![/:>\]]!) ? $self->catfile($dir,$name) | |
| : $self->fixpath($name,0); | |
| } | |
| } | |
| foreach my $name (@cand) { | |
| print "Checking $name\n" if $trace >= 2; | |
| # If it looks like a potential command, try it without the MCR | |
| if ($name =~ /^[\w\-\$]+$/) { | |
| open(my $tcf, ">", "temp_mmvms.com") | |
| or die('unable to open temp file'); | |
| print $tcf "\$ set message/nofacil/nosever/noident/notext\n"; | |
| print $tcf "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n"; | |
| close $tcf; | |
| $rslt = `\@temp_mmvms.com` ; | |
| unlink('temp_mmvms.com'); | |
| if ($rslt =~ /VER_OK/) { | |
| print "Using PERL=$name\n" if $trace; | |
| return $name; | |
| } | |
| } | |
| next unless $vmsfile = $self->maybe_command($name); | |
| $vmsfile =~ s/;[\d\-]*$//; # Clip off version number; we can use a newer version as well | |
| print "Executing $vmsfile\n" if ($trace >= 2); | |
| open(my $tcf, '>', "temp_mmvms.com") | |
| or die('unable to open temp file'); | |
| print $tcf "\$ set message/nofacil/nosever/noident/notext\n"; | |
| print $tcf "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n"; | |
| close $tcf; | |
| $rslt = `\@temp_mmvms.com`; | |
| unlink('temp_mmvms.com'); | |
| if ($rslt =~ /VER_OK/) { | |
| print "Using PERL=MCR $vmsfile\n" if $trace; | |
| return "MCR $vmsfile"; | |
| } | |
| } | |
| print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; | |
| 0; # false and not empty | |
| } | |
| =item _fixin_replace_shebang (override) | |
| Helper routine for MM->fixin(), overridden because there's no such thing as an | |
| actual shebang line that will be intepreted by the shell, so we just prepend | |
| $Config{startperl} and preserve the shebang line argument for any switches it | |
| may contain. | |
| =cut | |
| sub _fixin_replace_shebang { | |
| my ( $self, $file, $line ) = @_; | |
| my ( undef, $arg ) = split ' ', $line, 2; | |
| return $Config{startperl} . "\n" . $Config{sharpbang} . "perl $arg\n"; | |
| } | |
| =item maybe_command (override) | |
| Follows VMS naming conventions for executable files. | |
| If the name passed in doesn't exactly match an executable file, | |
| appends F<.Exe> (or equivalent) to check for executable image, and F<.Com> | |
| to check for DCL procedure. If this fails, checks directories in DCL$PATH | |
| and finally F<Sys$System:> for an executable file having the name specified, | |
| with or without the F<.Exe>-equivalent suffix. | |
| =cut | |
| sub maybe_command { | |
| my($self,$file) = @_; | |
| return $file if -x $file && ! -d _; | |
| my(@dirs) = (''); | |
| my(@exts) = ('',$Config{'exe_ext'},'.exe','.com'); | |
| if ($file !~ m![/:>\]]!) { | |
| for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) { | |
| my $dir = $ENV{"DCL\$PATH;$i"}; | |
| $dir .= ':' unless $dir =~ m%[\]:]$%; | |
| push(@dirs,$dir); | |
| } | |
| push(@dirs,'Sys$System:'); | |
| foreach my $dir (@dirs) { | |
| my $sysfile = "$dir$file"; | |
| foreach my $ext (@exts) { | |
| return $file if -x "$sysfile$ext" && ! -d _; | |
| } | |
| } | |
| } | |
| return 0; | |
| } | |
| =item pasthru (override) | |
| VMS has $(MMSQUALIFIERS) which is a listing of all the original command line | |
| options. This is used in every invocation of make in the VMS Makefile so | |
| PASTHRU should not be necessary. Using PASTHRU tends to blow commands past | |
| the 256 character limit. | |
| =cut | |
| sub pasthru { | |
| return "PASTHRU=\n"; | |
| } | |
| =item pm_to_blib (override) | |
| VMS wants a dot in every file so we can't have one called 'pm_to_blib', | |
| it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when | |
| you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'. | |
| So in VMS its pm_to_blib.ts. | |
| =cut | |
| sub pm_to_blib { | |
| my $self = shift; | |
| my $make = $self->SUPER::pm_to_blib; | |
| $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m; | |
| $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts}; | |
| $make = <<'MAKE' . $make; | |
| # Dummy target to match Unix target name; we use pm_to_blib.ts as | |
| # timestamp file to avoid repeated invocations under VMS | |
| pm_to_blib : pm_to_blib.ts | |
| $(NOECHO) $(NOOP) | |
| MAKE | |
| return $make; | |
| } | |
| =item perl_script (override) | |
| If name passed in doesn't specify a readable file, appends F<.com> or | |
| F<.pl> and tries again, since it's customary to have file types on all files | |
| under VMS. | |
| =cut | |
| sub perl_script { | |
| my($self,$file) = @_; | |
| return $file if -r $file && ! -d _; | |
| return "$file.com" if -r "$file.com"; | |
| return "$file.pl" if -r "$file.pl"; | |
| return ''; | |
| } | |
| =item replace_manpage_separator | |
| Use as separator a character which is legal in a VMS-syntax file name. | |
| =cut | |
| sub replace_manpage_separator { | |
| my($self,$man) = @_; | |
| $man = unixify($man); | |
| $man =~ s#/+#__#g; | |
| $man; | |
| } | |
| =item init_DEST | |
| (override) Because of the difficulty concatenating VMS filepaths we | |
| must pre-expand the DEST* variables. | |
| =cut | |
| sub init_DEST { | |
| my $self = shift; | |
| $self->SUPER::init_DEST; | |
| # Expand DEST variables. | |
| foreach my $var ($self->installvars) { | |
| my $destvar = 'DESTINSTALL'.$var; | |
| $self->{$destvar} = $self->eliminate_macros($self->{$destvar}); | |
| } | |
| } | |
| =item init_DIRFILESEP | |
| No seperator between a directory path and a filename on VMS. | |
| =cut | |
| sub init_DIRFILESEP { | |
| my($self) = shift; | |
| $self->{DIRFILESEP} = ''; | |
| return 1; | |
| } | |
| =item init_main (override) | |
| =cut | |
| sub init_main { | |
| my($self) = shift; | |
| $self->SUPER::init_main; | |
| $self->{DEFINE} ||= ''; | |
| if ($self->{DEFINE} ne '') { | |
| my(@terms) = split(/\s+/,$self->{DEFINE}); | |
| my(@defs,@udefs); | |
| foreach my $def (@terms) { | |
| next unless $def; | |
| my $targ = \@defs; | |
| if ($def =~ s/^-([DU])//) { # If it was a Unix-style definition | |
| $targ = \@udefs if $1 eq 'U'; | |
| $def =~ s/='(.*)'$/=$1/; # then remove shell-protection '' | |
| $def =~ s/^'(.*)'$/$1/; # from entire term or argument | |
| } | |
| if ($def =~ /=/) { | |
| $def =~ s/"/""/g; # Protect existing " from DCL | |
| $def = qq["$def"]; # and quote to prevent parsing of = | |
| } | |
| push @$targ, $def; | |
| } | |
| $self->{DEFINE} = ''; | |
| if (@defs) { | |
| $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')'; | |
| } | |
| if (@udefs) { | |
| $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')'; | |
| } | |
| } | |
| } | |
| =item init_others (override) | |
| Provide VMS-specific forms of various utility commands, then hand | |
| off to the default MM_Unix method. | |
| DEV_NULL should probably be overriden with something. | |
| Also changes EQUALIZE_TIMESTAMP to set revision date of target file to | |
| one second later than source file, since MMK interprets precisely | |
| equal revision dates for a source and target file as a sign that the | |
| target needs to be updated. | |
| =cut | |
| sub init_others { | |
| my($self) = @_; | |
| $self->{NOOP} = 'Continue'; | |
| $self->{NOECHO} ||= '@ '; | |
| $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE} || 'Descrip.MMS'; | |
| $self->{FIRST_MAKEFILE} ||= $self->{MAKEFILE}; | |
| $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS'; | |
| $self->{MAKEFILE_OLD} ||= $self->eliminate_macros('$(FIRST_MAKEFILE)_old'); | |
| # | |
| # If an extension is not specified, then MMS/MMK assumes an | |
| # an extension of .MMS. If there really is no extension, | |
| # then a trailing "." needs to be appended to specify a | |
| # a null extension. | |
| # | |
| $self->{MAKEFILE} .= '.' unless $self->{MAKEFILE} =~ m/\./; | |
| $self->{FIRST_MAKEFILE} .= '.' unless $self->{FIRST_MAKEFILE} =~ m/\./; | |
| $self->{MAKE_APERL_FILE} .= '.' unless $self->{MAKE_APERL_FILE} =~ m/\./; | |
| $self->{MAKEFILE_OLD} .= '.' unless $self->{MAKEFILE_OLD} =~ m/\./; | |
| $self->{MACROSTART} ||= '/Macro=('; | |
| $self->{MACROEND} ||= ')'; | |
| $self->{USEMAKEFILE} ||= '/Descrip='; | |
| $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"'; | |
| $self->{MOD_INSTALL} ||= | |
| $self->oneliner(<<'CODE', ['-MExtUtils::Install']); | |
| install([ from_to => {split(' ', <STDIN>)}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]); | |
| CODE | |
| $self->SUPER::init_others; | |
| $self->{SHELL} ||= 'Posix'; | |
| $self->{UMASK_NULL} = '! '; | |
| # Redirection on VMS goes before the command, not after as on Unix. | |
| # $(DEV_NULL) is used once and its not worth going nuts over making | |
| # it work. However, Unix's DEV_NULL is quite wrong for VMS. | |
| $self->{DEV_NULL} = ''; | |
| if ($self->{OBJECT} =~ /\s/) { | |
| $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g; | |
| $self->{OBJECT} = $self->wraplist( | |
| map $self->fixpath($_,0), split /,?\s+/, $self->{OBJECT} | |
| ); | |
| } | |
| $self->{LDFROM} = $self->wraplist( | |
| map $self->fixpath($_,0), split /,?\s+/, $self->{LDFROM} | |
| ); | |
| } | |
| =item init_platform (override) | |
| Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION. | |
| MM_VMS_REVISION is for backwards compatibility before MM_VMS had a | |
| $VERSION. | |
| =cut | |
| sub init_platform { | |
| my($self) = shift; | |
| $self->{MM_VMS_REVISION} = $Revision; | |
| $self->{MM_VMS_VERSION} = $VERSION; | |
| $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS') | |
| if $self->{PERL_SRC}; | |
| } | |
| =item platform_constants | |
| =cut | |
| sub platform_constants { | |
| my($self) = shift; | |
| my $make_frag = ''; | |
| foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION)) | |
| { | |
| next unless defined $self->{$macro}; | |
| $make_frag .= "$macro = $self->{$macro}\n"; | |
| } | |
| return $make_frag; | |
| } | |
| =item init_VERSION (override) | |
| Override the *DEFINE_VERSION macros with VMS semantics. Translate the | |
| MAKEMAKER filepath to VMS style. | |
| =cut | |
| sub init_VERSION { | |
| my $self = shift; | |
| $self->SUPER::init_VERSION; | |
| $self->{DEFINE_VERSION} = '"$(VERSION_MACRO)=""$(VERSION)"""'; | |
| $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""'; | |
| $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'}); | |
| } | |
| =item constants (override) | |
| Fixes up numerous file and directory macros to insure VMS syntax | |
| regardless of input syntax. Also makes lists of files | |
| comma-separated. | |
| =cut | |
| sub constants { | |
| my($self) = @_; | |
| # Be kind about case for pollution | |
| for (@ARGV) { $_ = uc($_) if /POLLUTE/i; } | |
| # Cleanup paths for directories in MMS macros. | |
| foreach my $macro ( qw [ | |
| INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB | |
| PERL_LIB PERL_ARCHLIB | |
| PERL_INC PERL_SRC ], | |
| (map { 'INSTALL'.$_ } $self->installvars) | |
| ) | |
| { | |
| next unless defined $self->{$macro}; | |
| next if $macro =~ /MAN/ && $self->{$macro} eq 'none'; | |
| $self->{$macro} = $self->fixpath($self->{$macro},1); | |
| } | |
| # Cleanup paths for files in MMS macros. | |
| foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD | |
| MAKE_APERL_FILE MYEXTLIB] ) | |
| { | |
| next unless defined $self->{$macro}; | |
| $self->{$macro} = $self->fixpath($self->{$macro},0); | |
| } | |
| # Fixup files for MMS macros | |
| # XXX is this list complete? | |
| for my $macro (qw/ | |
| FULLEXT VERSION_FROM OBJECT LDFROM | |
| / ) { | |
| next unless defined $self->{$macro}; | |
| $self->{$macro} = $self->fixpath($self->{$macro},0); | |
| } | |
| for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) { | |
| # Where is the space coming from? --jhi | |
| next unless $self ne " " && defined $self->{$macro}; | |
| my %tmp = (); | |
| for my $key (keys %{$self->{$macro}}) { | |
| $tmp{$self->fixpath($key,0)} = | |
| $self->fixpath($self->{$macro}{$key},0); | |
| } | |
| $self->{$macro} = \%tmp; | |
| } | |
| for my $macro (qw/ C O_FILES H /) { | |
| next unless defined $self->{$macro}; | |
| my @tmp = (); | |
| for my $val (@{$self->{$macro}}) { | |
| push(@tmp,$self->fixpath($val,0)); | |
| } | |
| $self->{$macro} = \@tmp; | |
| } | |
| # mms/k does not define a $(MAKE) macro. | |
| $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)'; | |
| return $self->SUPER::constants; | |
| } | |
| =item special_targets | |
| Clear the default .SUFFIXES and put in our own list. | |
| =cut | |
| sub special_targets { | |
| my $self = shift; | |
| my $make_frag .= <<'MAKE_FRAG'; | |
| .SUFFIXES : | |
| .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs | |
| MAKE_FRAG | |
| return $make_frag; | |
| } | |
| =item cflags (override) | |
| Bypass shell script and produce qualifiers for CC directly (but warn | |
| user if a shell script for this extension exists). Fold multiple | |
| /Defines into one, since some C compilers pay attention to only one | |
| instance of this qualifier on the command line. | |
| =cut | |
| sub cflags { | |
| my($self,$libperl) = @_; | |
| my($quals) = $self->{CCFLAGS} || $Config{'ccflags'}; | |
| my($definestr,$undefstr,$flagoptstr) = ('','',''); | |
| my($incstr) = '/Include=($(PERL_INC)'; | |
| my($name,$sys,@m); | |
| ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ; | |
| print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}. | |
| " required to modify CC command for $self->{'BASEEXT'}\n" | |
| if ($Config{$name}); | |
| if ($quals =~ / -[DIUOg]/) { | |
| while ($quals =~ / -([Og])(\d*)\b/) { | |
| my($type,$lvl) = ($1,$2); | |
| $quals =~ s/ -$type$lvl\b\s*//; | |
| if ($type eq 'g') { $flagoptstr = '/NoOptimize'; } | |
| else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); } | |
| } | |
| while ($quals =~ / -([DIU])(\S+)/) { | |
| my($type,$def) = ($1,$2); | |
| $quals =~ s/ -$type$def\s*//; | |
| $def =~ s/"/""/g; | |
| if ($type eq 'D') { $definestr .= qq["$def",]; } | |
| elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); } | |
| else { $undefstr .= qq["$def",]; } | |
| } | |
| } | |
| if (length $quals and $quals !~ m!/!) { | |
| warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n"; | |
| $quals = ''; | |
| } | |
| $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE}; | |
| if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; } | |
| if (length $undefstr) { chop($undefstr); $quals .= "/Undef=($undefstr)"; } | |
| # Deal with $self->{DEFINE} here since some C compilers pay attention | |
| # to only one /Define clause on command line, so we have to | |
| # conflate the ones from $Config{'ccflags'} and $self->{DEFINE} | |
| # ($self->{DEFINE} has already been VMSified in constants() above) | |
| if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; } | |
| for my $type (qw(Def Undef)) { | |
| my(@terms); | |
| while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) { | |
| my $term = $1; | |
| $term =~ s:^\((.+)\)$:$1:; | |
| push @terms, $term; | |
| } | |
| if ($type eq 'Def') { | |
| push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ]; | |
| } | |
| if (@terms) { | |
| $quals =~ s:/${type}i?n?e?=[^/]+::ig; | |
| $quals .= "/${type}ine=(" . join(',',@terms) . ')'; | |
| } | |
| } | |
| $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb"; | |
| # Likewise with $self->{INC} and /Include | |
| if ($self->{'INC'}) { | |
| my(@includes) = split(/\s+/,$self->{INC}); | |
| foreach (@includes) { | |
| s/^-I//; | |
| $incstr .= ','.$self->fixpath($_,1); | |
| } | |
| } | |
| $quals .= "$incstr)"; | |
| # $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g; | |
| $self->{CCFLAGS} = $quals; | |
| $self->{PERLTYPE} ||= ''; | |
| $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'}; | |
| if ($self->{OPTIMIZE} !~ m!/!) { | |
| if ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' } | |
| elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) { | |
| $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : ''); | |
| } | |
| else { | |
| warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE}; | |
| $self->{OPTIMIZE} = '/Optimize'; | |
| } | |
| } | |
| return $self->{CFLAGS} = qq{ | |
| CCFLAGS = $self->{CCFLAGS} | |
| OPTIMIZE = $self->{OPTIMIZE} | |
| PERLTYPE = $self->{PERLTYPE} | |
| }; | |
| } | |
| =item const_cccmd (override) | |
| Adds directives to point C preprocessor to the right place when | |
| handling #include E<lt>sys/foo.hE<gt> directives. Also constructs CC | |
| command line a bit differently than MM_Unix method. | |
| =cut | |
| sub const_cccmd { | |
| my($self,$libperl) = @_; | |
| my(@m); | |
| return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; | |
| return '' unless $self->needs_linking(); | |
| if ($Config{'vms_cc_type'} eq 'gcc') { | |
| push @m,' | |
| .FIRST | |
| ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]'; | |
| } | |
| elsif ($Config{'vms_cc_type'} eq 'vaxc') { | |
| push @m,' | |
| .FIRST | |
| ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library | |
| ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include'; | |
| } | |
| else { | |
| push @m,' | |
| .FIRST | |
| ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ', | |
| ($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),' | |
| ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include'; | |
| } | |
| push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n"); | |
| $self->{CONST_CCCMD} = join('',@m); | |
| } | |
| =item tools_other (override) | |
| Throw in some dubious extra macros for Makefile args. | |
| Also keep around the old $(SAY) macro in case somebody's using it. | |
| =cut | |
| sub tools_other { | |
| my($self) = @_; | |
| # XXX Are these necessary? Does anyone override them? They're longer | |
| # than just typing the literal string. | |
| my $extra_tools = <<'EXTRA_TOOLS'; | |
| # Just in case anyone is using the old macro. | |
| USEMACROS = $(MACROSTART) | |
| SAY = $(ECHO) | |
| EXTRA_TOOLS | |
| return $self->SUPER::tools_other . $extra_tools; | |
| } | |
| =item init_dist (override) | |
| VMSish defaults for some values. | |
| macro description default | |
| ZIPFLAGS flags to pass to ZIP -Vu | |
| COMPRESS compression command to gzip | |
| use for tarfiles | |
| SUFFIX suffix to put on -gz | |
| compressed files | |
| SHAR shar command to use vms_share | |
| DIST_DEFAULT default target to use to tardist | |
| create a distribution | |
| DISTVNAME Use VERSION_SYM instead of $(DISTNAME)-$(VERSION_SYM) | |
| VERSION for the name | |
| =cut | |
| sub init_dist { | |
| my($self) = @_; | |
| $self->{ZIPFLAGS} ||= '-Vu'; | |
| $self->{COMPRESS} ||= 'gzip'; | |
| $self->{SUFFIX} ||= '-gz'; | |
| $self->{SHAR} ||= 'vms_share'; | |
| $self->{DIST_DEFAULT} ||= 'zipdist'; | |
| $self->SUPER::init_dist; | |
| $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION_SYM}" | |
| unless $self->{ARGS}{DISTVNAME}; | |
| return; | |
| } | |
| =item c_o (override) | |
| Use VMS syntax on command line. In particular, $(DEFINE) and | |
| $(PERL_INC) have been pulled into $(CCCMD). Also use MM[SK] macros. | |
| =cut | |
| sub c_o { | |
| my($self) = @_; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .c$(OBJ_EXT) : | |
| $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c | |
| .cpp$(OBJ_EXT) : | |
| $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp | |
| .cxx$(OBJ_EXT) : | |
| $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx | |
| '; | |
| } | |
| =item xs_c (override) | |
| Use MM[SK] macros. | |
| =cut | |
| sub xs_c { | |
| my($self) = @_; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs.c : | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET) | |
| '; | |
| } | |
| =item xs_o (override) | |
| Use MM[SK] macros, and VMS command line for C compiler. | |
| =cut | |
| sub xs_o { # many makes are too dumb to use xs_c then c_o | |
| my($self) = @_; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs$(OBJ_EXT) : | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c | |
| $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c | |
| '; | |
| } | |
| =item dlsyms (override) | |
| Create VMS linker options files specifying universal symbols for this | |
| extension's shareable image, and listing other shareable images or | |
| libraries to which it should be linked. | |
| =cut | |
| sub dlsyms { | |
| my($self,%attribs) = @_; | |
| return '' unless $self->needs_linking(); | |
| my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; | |
| my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; | |
| my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; | |
| my(@m); | |
| unless ($self->{SKIPHASH}{'dynamic'}) { | |
| push(@m,' | |
| dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt | |
| $(NOECHO) $(NOOP) | |
| '); | |
| } | |
| push(@m,' | |
| static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt | |
| $(NOECHO) $(NOOP) | |
| ') unless $self->{SKIPHASH}{'static'}; | |
| push @m,' | |
| $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt | |
| $(CP) $(MMS$SOURCE) $(MMS$TARGET) | |
| $(BASEEXT).opt : Makefile.PL | |
| $(PERLRUN) -e "use ExtUtils::Mksymlists;" - | |
| ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ], | |
| neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars), | |
| q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n]; | |
| push @m, ' $(PERL) -e "print ""$(INST_STATIC)/Include='; | |
| if ($self->{OBJECT} =~ /\bBASEEXT\b/ or | |
| $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { | |
| push @m, ($Config{d_vms_case_sensitive_symbols} | |
| ? uc($self->{BASEEXT}) :'$(BASEEXT)'); | |
| } | |
| else { # We don't have a "main" object file, so pull 'em all in | |
| # Upcase module names if linker is being case-sensitive | |
| my($upcase) = $Config{d_vms_case_sensitive_symbols}; | |
| my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT}); | |
| for (@omods) { | |
| s/\.[^.]*$//; # Trim off file type | |
| s[\$\(\w+_EXT\)][]; # even as a macro | |
| s/.*[:>\/\]]//; # Trim off dir spec | |
| $_ = uc if $upcase; | |
| }; | |
| my(@lines); | |
| my $tmp = shift @omods; | |
| foreach my $elt (@omods) { | |
| $tmp .= ",$elt"; | |
| if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } | |
| } | |
| push @lines, $tmp; | |
| push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')'; | |
| } | |
| push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n"; | |
| if (length $self->{LDLOADLIBS}) { | |
| my($line) = ''; | |
| foreach my $lib (split ' ', $self->{LDLOADLIBS}) { | |
| $lib =~ s%\$%\\\$%g; # Escape '$' in VMS filespecs | |
| if (length($line) + length($lib) > 160) { | |
| push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n"; | |
| $line = $lib . '\n'; | |
| } | |
| else { $line .= $lib . '\n'; } | |
| } | |
| push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line; | |
| } | |
| join('',@m); | |
| } | |
| =item dynamic_lib (override) | |
| Use VMS Link command. | |
| =cut | |
| sub dynamic_lib { | |
| my($self, %attribs) = @_; | |
| return '' unless $self->needs_linking(); #might be because of a subdir | |
| return '' unless $self->has_link_code(); | |
| my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; | |
| my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; | |
| my $shr = $Config{'dbgprefix'} . 'PerlShr'; | |
| my(@m); | |
| push @m," | |
| OTHERLDFLAGS = $otherldflags | |
| INST_DYNAMIC_DEP = $inst_dynamic_dep | |
| "; | |
| push @m, ' | |
| $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) | |
| If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' | |
| Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option | |
| '; | |
| join('',@m); | |
| } | |
| =item static_lib (override) | |
| Use VMS commands to manipulate object library. | |
| =cut | |
| sub static_lib { | |
| my($self) = @_; | |
| return '' unless $self->needs_linking(); | |
| return ' | |
| $(INST_STATIC) : | |
| $(NOECHO) $(NOOP) | |
| ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}); | |
| my(@m); | |
| push @m,' | |
| # Rely on suffix rule for update action | |
| $(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists | |
| $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) | |
| '; | |
| # If this extension has its own library (eg SDBM_File) | |
| # then copy that to $(INST_STATIC) and add $(OBJECT) into it. | |
| push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB}; | |
| push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n"); | |
| # if there was a library to copy, then we can't use MMS$SOURCE_LIST, | |
| # 'cause it's a library and you can't stick them in other libraries. | |
| # In that case, we use $OBJECT instead and hope for the best | |
| if ($self->{MYEXTLIB}) { | |
| push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); | |
| } else { | |
| push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); | |
| } | |
| push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n"; | |
| foreach my $lib (split ' ', $self->{EXTRALIBS}) { | |
| push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n"); | |
| } | |
| join('',@m); | |
| } | |
| =item extra_clean_files | |
| Clean up some OS specific files. Plus the temp file used to shorten | |
| a lot of commands. And the name mangler database. | |
| =cut | |
| sub extra_clean_files { | |
| return qw( | |
| *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso | |
| .MM_Tmp cxx_repository | |
| ); | |
| } | |
| =item zipfile_target | |
| =item tarfile_target | |
| =item shdist_target | |
| Syntax for invoking shar, tar and zip differs from that for Unix. | |
| =cut | |
| sub zipfile_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| $(DISTVNAME).zip : distdir | |
| $(PREOP) | |
| $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*; | |
| $(RM_RF) $(DISTVNAME) | |
| $(POSTOP) | |
| MAKE_FRAG | |
| } | |
| sub tarfile_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| $(DISTVNAME).tar$(SUFFIX) : distdir | |
| $(PREOP) | |
| $(TO_UNIX) | |
| $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...] | |
| $(RM_RF) $(DISTVNAME) | |
| $(COMPRESS) $(DISTVNAME).tar | |
| $(POSTOP) | |
| MAKE_FRAG | |
| } | |
| sub shdist_target { | |
| my($self) = shift; | |
| return <<'MAKE_FRAG'; | |
| shdist : distdir | |
| $(PREOP) | |
| $(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share | |
| $(RM_RF) $(DISTVNAME) | |
| $(POSTOP) | |
| MAKE_FRAG | |
| } | |
| # --- Test and Installation Sections --- | |
| =item install (override) | |
| Work around DCL's 255 character limit several times,and use | |
| VMS-style command line quoting in a few cases. | |
| =cut | |
| sub install { | |
| my($self, %attribs) = @_; | |
| my(@m); | |
| push @m, q[ | |
| install :: all pure_install doc_install | |
| $(NOECHO) $(NOOP) | |
| install_perl :: all pure_perl_install doc_perl_install | |
| $(NOECHO) $(NOOP) | |
| install_site :: all pure_site_install doc_site_install | |
| $(NOECHO) $(NOOP) | |
| pure_install :: pure_$(INSTALLDIRS)_install | |
| $(NOECHO) $(NOOP) | |
| doc_install :: doc_$(INSTALLDIRS)_install | |
| $(NOECHO) $(NOOP) | |
| pure__install : pure_site_install | |
| $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" | |
| doc__install : doc_site_install | |
| $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" | |
| # This hack brought to you by DCL's 255-character command line limit | |
| pure_perl_install :: | |
| $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp | |
| $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLBIN) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) " >>.MM_tmp | |
| $(NOECHO) $(MOD_INSTALL) <.MM_tmp | |
| $(NOECHO) $(RM_F) .MM_tmp | |
| $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[ | |
| # Likewise | |
| pure_site_install :: | |
| $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp | |
| $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLSITEBIN) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) " >>.MM_tmp | |
| $(NOECHO) $(MOD_INSTALL) <.MM_tmp | |
| $(NOECHO) $(RM_F) .MM_tmp | |
| $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[ | |
| pure_vendor_install :: | |
| $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp | |
| $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLVENDORBIN) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) " >>.MM_tmp | |
| $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) " >>.MM_tmp | |
| $(NOECHO) $(MOD_INSTALL) <.MM_tmp | |
| $(NOECHO) $(RM_F) .MM_tmp | |
| # Ditto | |
| doc_perl_install :: | |
| $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" | |
| $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| $(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp | |
| $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp | |
| $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ | |
| $(NOECHO) $(RM_F) .MM_tmp | |
| # And again | |
| doc_site_install :: | |
| $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" | |
| $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| $(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp | |
| $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp | |
| $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ | |
| $(NOECHO) $(RM_F) .MM_tmp | |
| doc_vendor_install :: | |
| $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" | |
| $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| $(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp | |
| $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp | |
| $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ | |
| $(NOECHO) $(RM_F) .MM_tmp | |
| ]; | |
| push @m, q[ | |
| uninstall :: uninstall_from_$(INSTALLDIRS)dirs | |
| $(NOECHO) $(NOOP) | |
| uninstall_from_perldirs :: | |
| $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[ | |
| $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes." | |
| $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove" | |
| $(NOECHO) $(ECHO) "the appropriate files. Sorry for the inconvenience." | |
| uninstall_from_sitedirs :: | |
| $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[ | |
| $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes." | |
| $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove" | |
| $(NOECHO) $(ECHO) "the appropriate files. Sorry for the inconvenience." | |
| ]; | |
| join('',@m); | |
| } | |
| =item perldepend (override) | |
| Use VMS-style syntax for files; it's cheaper to just do it directly here | |
| than to have the MM_Unix method call C<catfile> repeatedly. Also, if | |
| we have to rebuild Config.pm, use MM[SK] to do it. | |
| =cut | |
| sub perldepend { | |
| my($self) = @_; | |
| my(@m); | |
| push @m, ' | |
| $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h | |
| $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)config.h | |
| $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h | |
| $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h | |
| $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h | |
| $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h | |
| $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h | |
| $(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h | |
| $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlio.h | |
| $(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlvars.h | |
| $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h | |
| $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h | |
| $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h | |
| $(OBJECT) : $(PERL_INC)thread.h, $(PERL_INC)util.h, $(PERL_INC)vmsish.h | |
| ' if $self->{OBJECT}; | |
| if ($self->{PERL_SRC}) { | |
| my(@macros); | |
| my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)'; | |
| push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP'; | |
| push(@macros,'DECC=1') if $Config{'vms_cc_type'} eq 'decc'; | |
| push(@macros,'GNUC=1') if $Config{'vms_cc_type'} eq 'gcc'; | |
| push(@macros,'SOCKET=1') if $Config{'d_has_sockets'}; | |
| push(@macros,qq["CC=$Config{'cc'}"]) if $Config{'cc'} =~ m!/!; | |
| $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros; | |
| push(@m,q[ | |
| # Check for unpropagated config.sh changes. Should never happen. | |
| # We do NOT just update config.h because that is not sufficient. | |
| # An out of date config.h is not fatal but complains loudly! | |
| $(PERL_INC)config.h : $(PERL_SRC)config.sh | |
| $(NOOP) | |
| $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh | |
| $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl" | |
| olddef = F$Environment("Default") | |
| Set Default $(PERL_SRC) | |
| $(MMS)],$mmsquals,); | |
| if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) { | |
| my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0)); | |
| $target =~ s/\Q$prefix/[/; | |
| push(@m," $target"); | |
| } | |
| else { push(@m,' $(MMS$TARGET)'); } | |
| push(@m,q[ | |
| Set Default 'olddef' | |
| ]); | |
| } | |
| push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") | |
| if %{$self->{XS}}; | |
| join('',@m); | |
| } | |
| =item makeaperl (override) | |
| Undertake to build a new set of Perl images using VMS commands. Since | |
| VMS does dynamic loading, it's not necessary to statically link each | |
| extension into the Perl image, so this isn't the normal build path. | |
| Consequently, it hasn't really been tested, and may well be incomplete. | |
| =cut | |
| our %olbs; # needs to be localized | |
| sub makeaperl { | |
| my($self, %attribs) = @_; | |
| my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = | |
| @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; | |
| my(@m); | |
| push @m, " | |
| # --- MakeMaker makeaperl section --- | |
| MAP_TARGET = $target | |
| "; | |
| return join '', @m if $self->{PARENT}; | |
| my($dir) = join ":", @{$self->{DIR}}; | |
| unless ($self->{MAKEAPERL}) { | |
| push @m, q{ | |
| $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) | |
| $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)" | |
| $(NOECHO) $(PERLRUNINST) \ | |
| Makefile.PL DIR=}, $dir, q{ \ | |
| FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ | |
| MAKEAPERL=1 NORECURS=1 }; | |
| push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{ | |
| $(MAP_TARGET) :: $(MAKE_APERL_FILE) | |
| $(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET) | |
| }; | |
| push @m, "\n"; | |
| return join '', @m; | |
| } | |
| my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen); | |
| local($_); | |
| # The front matter of the linkcommand... | |
| $linkcmd = join ' ', $Config{'ld'}, | |
| grep($_, @Config{qw(large split ldflags ccdlflags)}); | |
| $linkcmd =~ s/\s+/ /g; | |
| # Which *.olb files could we make use of... | |
| local(%olbs); # XXX can this be lexical? | |
| $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)"; | |
| require File::Find; | |
| File::Find::find(sub { | |
| return unless m/\Q$self->{LIB_EXT}\E$/; | |
| return if m/^libperl/; | |
| if( exists $self->{INCLUDE_EXT} ){ | |
| my $found = 0; | |
| (my $xx = $File::Find::name) =~ s,.*?/auto/,,; | |
| $xx =~ s,/?$_,,; | |
| $xx =~ s,/,::,g; | |
| # Throw away anything not explicitly marked for inclusion. | |
| # DynaLoader is implied. | |
| foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){ | |
| if( $xx eq $incl ){ | |
| $found++; | |
| last; | |
| } | |
| } | |
| return unless $found; | |
| } | |
| elsif( exists $self->{EXCLUDE_EXT} ){ | |
| (my $xx = $File::Find::name) =~ s,.*?/auto/,,; | |
| $xx =~ s,/?$_,,; | |
| $xx =~ s,/,::,g; | |
| # Throw away anything explicitly marked for exclusion | |
| foreach my $excl (@{$self->{EXCLUDE_EXT}}){ | |
| return if( $xx eq $excl ); | |
| } | |
| } | |
| $olbs{$ENV{DEFAULT}} = $_; | |
| }, grep( -d $_, @{$searchdirs || []})); | |
| # We trust that what has been handed in as argument will be buildable | |
| $static = [] unless $static; | |
| @olbs{@{$static}} = (1) x @{$static}; | |
| $extra = [] unless $extra && ref $extra eq 'ARRAY'; | |
| # Sort the object libraries in inverse order of | |
| # filespec length to try to insure that dependent extensions | |
| # will appear before their parents, so the linker will | |
| # search the parent library to resolve references. | |
| # (e.g. Intuit::DWIM will precede Intuit, so unresolved | |
| # references from [.intuit.dwim]dwim.obj can be found | |
| # in [.intuit]intuit.olb). | |
| for (sort { length($a) <=> length($b) } keys %olbs) { | |
| next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/; | |
| my($dir) = $self->fixpath($_,1); | |
| my($extralibs) = $dir . "extralibs.ld"; | |
| my($extopt) = $dir . $olbs{$_}; | |
| $extopt =~ s/$self->{LIB_EXT}$/.opt/; | |
| push @optlibs, "$dir$olbs{$_}"; | |
| # Get external libraries this extension will need | |
| if (-f $extralibs ) { | |
| my %seenthis; | |
| open my $list, "<", $extralibs or warn $!,next; | |
| while (<$list>) { | |
| chomp; | |
| # Include a library in the link only once, unless it's mentioned | |
| # multiple times within a single extension's options file, in which | |
| # case we assume the builder needed to search it again later in the | |
| # link. | |
| my $skip = exists($libseen{$_}) && !exists($seenthis{$_}); | |
| $libseen{$_}++; $seenthis{$_}++; | |
| next if $skip; | |
| push @$extra,$_; | |
| } | |
| } | |
| # Get full name of extension for ExtUtils::Miniperl | |
| if (-f $extopt) { | |
| open my $opt, '<', $extopt or die $!; | |
| while (<$opt>) { | |
| next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/; | |
| my $pkg = $1; | |
| $pkg =~ s#__*#::#g; | |
| push @staticpkgs,$pkg; | |
| } | |
| } | |
| } | |
| # Place all of the external libraries after all of the Perl extension | |
| # libraries in the final link, in order to maximize the opportunity | |
| # for XS code from multiple extensions to resolve symbols against the | |
| # same external library while only including that library once. | |
| push @optlibs, @$extra; | |
| $target = "Perl$Config{'exe_ext'}" unless $target; | |
| my $shrtarget; | |
| ($shrtarget,$targdir) = fileparse($target); | |
| $shrtarget =~ s/^([^.]*)/$1Shr/; | |
| $shrtarget = $targdir . $shrtarget; | |
| $target = "Perlshr.$Config{'dlext'}" unless $target; | |
| $tmpdir = "[]" unless $tmpdir; | |
| $tmpdir = $self->fixpath($tmpdir,1); | |
| if (@optlibs) { $extralist = join(' ',@optlibs); } | |
| else { $extralist = ''; } | |
| # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr) | |
| # that's what we're building here). | |
| push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2]; | |
| if ($libperl) { | |
| unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) { | |
| print STDOUT "Warning: $libperl not found\n"; | |
| undef $libperl; | |
| } | |
| } | |
| unless ($libperl) { | |
| if (defined $self->{PERL_SRC}) { | |
| $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}"); | |
| } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) { | |
| } else { | |
| print STDOUT "Warning: $libperl not found | |
| If you're going to build a static perl binary, make sure perl is installed | |
| otherwise ignore this warning\n"; | |
| } | |
| } | |
| $libperldir = $self->fixpath((fileparse($libperl))[1],1); | |
| push @m, ' | |
| # Fill in the target you want to produce if it\'s not perl | |
| MAP_TARGET = ',$self->fixpath($target,0),' | |
| MAP_SHRTARGET = ',$self->fixpath($shrtarget,0)," | |
| MAP_LINKCMD = $linkcmd | |
| MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : ''," | |
| MAP_EXTRA = $extralist | |
| MAP_LIBPERL = ",$self->fixpath($libperl,0),' | |
| '; | |
| push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n"; | |
| foreach (@optlibs) { | |
| push @m,' $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n"; | |
| } | |
| push @m,"\n${tmpdir}PerlShr.Opt :\n\t"; | |
| push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n"; | |
| push @m,' | |
| $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",' | |
| $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",' | |
| $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",' | |
| $(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option | |
| $(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say" | |
| $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" | |
| $(NOECHO) $(ECHO) "To remove the intermediate files, say | |
| $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean" | |
| '; | |
| push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n"; | |
| push @m, "# More from the 255-char line length limit\n"; | |
| foreach (@staticpkgs) { | |
| push @m,' $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n]; | |
| } | |
| push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir; | |
| $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET) | |
| $(NOECHO) $(RM_F) %sWritemain.tmp | |
| MAKE_FRAG | |
| push @m, q[ | |
| # Still more from the 255-char line length limit | |
| doc_inst_perl : | |
| $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
| $(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp | |
| $(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp | |
| $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp | |
| $(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp | |
| $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[ | |
| $(NOECHO) $(RM_F) .MM_tmp | |
| ]; | |
| push @m, " | |
| inst_perl : pure_inst_perl doc_inst_perl | |
| \$(NOECHO) \$(NOOP) | |
| pure_inst_perl : \$(MAP_TARGET) | |
| $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1)," | |
| $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1)," | |
| clean :: map_clean | |
| \$(NOECHO) \$(NOOP) | |
| map_clean : | |
| \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE) | |
| \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET) | |
| "; | |
| join '', @m; | |
| } | |
| # --- Output postprocessing section --- | |
| =item maketext_filter (override) | |
| Insure that colons marking targets are preceded by space, in order | |
| to distinguish the target delimiter from a colon appearing as | |
| part of a filespec. | |
| =cut | |
| sub maketext_filter { | |
| my($self, $text) = @_; | |
| $text =~ s/^([^\s:=]+)(:+\s)/$1 $2/mg; | |
| return $text; | |
| } | |
| =item prefixify (override) | |
| prefixifying on VMS is simple. Each should simply be: | |
| perl_root:[some.dir] | |
| which can just be converted to: | |
| volume:[your.prefix.some.dir] | |
| otherwise you get the default layout. | |
| In effect, your search prefix is ignored and $Config{vms_prefix} is | |
| used instead. | |
| =cut | |
| sub prefixify { | |
| my($self, $var, $sprefix, $rprefix, $default) = @_; | |
| # Translate $(PERLPREFIX) to a real path. | |
| $rprefix = $self->eliminate_macros($rprefix); | |
| $rprefix = vmspath($rprefix) if $rprefix; | |
| $sprefix = vmspath($sprefix) if $sprefix; | |
| $default = vmsify($default) | |
| unless $default =~ /\[.*\]/; | |
| (my $var_no_install = $var) =~ s/^install//; | |
| my $path = $self->{uc $var} || | |
| $ExtUtils::MM_Unix::Config_Override{lc $var} || | |
| $Config{lc $var} || $Config{lc $var_no_install}; | |
| if( !$path ) { | |
| print STDERR " no Config found for $var.\n" if $Verbose >= 2; | |
| $path = $self->_prefixify_default($rprefix, $default); | |
| } | |
| elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) { | |
| # do nothing if there's no prefix or if its relative | |
| } | |
| elsif( $sprefix eq $rprefix ) { | |
| print STDERR " no new prefix.\n" if $Verbose >= 2; | |
| } | |
| else { | |
| print STDERR " prefixify $var => $path\n" if $Verbose >= 2; | |
| print STDERR " from $sprefix to $rprefix\n" if $Verbose >= 2; | |
| my($path_vol, $path_dirs) = $self->splitpath( $path ); | |
| if( $path_vol eq $Config{vms_prefix}.':' ) { | |
| print STDERR " $Config{vms_prefix}: seen\n" if $Verbose >= 2; | |
| $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.}; | |
| $path = $self->_catprefix($rprefix, $path_dirs); | |
| } | |
| else { | |
| $path = $self->_prefixify_default($rprefix, $default); | |
| } | |
| } | |
| print " now $path\n" if $Verbose >= 2; | |
| return $self->{uc $var} = $path; | |
| } | |
| sub _prefixify_default { | |
| my($self, $rprefix, $default) = @_; | |
| print STDERR " cannot prefix, using default.\n" if $Verbose >= 2; | |
| if( !$default ) { | |
| print STDERR "No default!\n" if $Verbose >= 1; | |
| return; | |
| } | |
| if( !$rprefix ) { | |
| print STDERR "No replacement prefix!\n" if $Verbose >= 1; | |
| return ''; | |
| } | |
| return $self->_catprefix($rprefix, $default); | |
| } | |
| sub _catprefix { | |
| my($self, $rprefix, $default) = @_; | |
| my($rvol, $rdirs) = $self->splitpath($rprefix); | |
| if( $rvol ) { | |
| return $self->catpath($rvol, | |
| $self->catdir($rdirs, $default), | |
| '' | |
| ) | |
| } | |
| else { | |
| return $self->catdir($rdirs, $default); | |
| } | |
| } | |
| =item cd | |
| =cut | |
| sub cd { | |
| my($self, $dir, @cmds) = @_; | |
| $dir = vmspath($dir); | |
| my $cmd = join "\n\t", map "$_", @cmds; | |
| # No leading tab makes it look right when embedded | |
| my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd; | |
| startdir = F$Environment("Default") | |
| Set Default %s | |
| %s | |
| Set Default 'startdir' | |
| MAKE_FRAG | |
| # No trailing newline makes this easier to embed | |
| chomp $make_frag; | |
| return $make_frag; | |
| } | |
| =item oneliner | |
| =cut | |
| sub oneliner { | |
| my($self, $cmd, $switches) = @_; | |
| $switches = [] unless defined $switches; | |
| # Strip leading and trailing newlines | |
| $cmd =~ s{^\n+}{}; | |
| $cmd =~ s{\n+$}{}; | |
| $cmd = $self->quote_literal($cmd); | |
| $cmd = $self->escape_newlines($cmd); | |
| # Switches must be quoted else they will be lowercased. | |
| $switches = join ' ', map { qq{"$_"} } @$switches; | |
| return qq{\$(ABSPERLRUN) $switches -e $cmd "--"}; | |
| } | |
| =item B<echo> | |
| perl trips up on "<foo>" thinking it's an input redirect. So we use the | |
| native Write command instead. Besides, its faster. | |
| =cut | |
| sub echo { | |
| my($self, $text, $file, $appending) = @_; | |
| $appending ||= 0; | |
| my $opencmd = $appending ? 'Open/Append' : 'Open/Write'; | |
| my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file "); | |
| push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) } | |
| split /\n/, $text; | |
| push @cmds, '$(NOECHO) Close MMECHOFILE'; | |
| return @cmds; | |
| } | |
| =item quote_literal | |
| =cut | |
| sub quote_literal { | |
| my($self, $text) = @_; | |
| # I believe this is all we should need. | |
| $text =~ s{"}{""}g; | |
| return qq{"$text"}; | |
| } | |
| =item escape_newlines | |
| =cut | |
| sub escape_newlines { | |
| my($self, $text) = @_; | |
| $text =~ s{\n}{-\n}g; | |
| return $text; | |
| } | |
| =item max_exec_len | |
| 256 characters. | |
| =cut | |
| sub max_exec_len { | |
| my $self = shift; | |
| return $self->{_MAX_EXEC_LEN} ||= 256; | |
| } | |
| =item init_linker | |
| =cut | |
| sub init_linker { | |
| my $self = shift; | |
| $self->{EXPORT_LIST} ||= '$(BASEEXT).opt'; | |
| my $shr = $Config{dbgprefix} . 'PERLSHR'; | |
| if ($self->{PERL_SRC}) { | |
| $self->{PERL_ARCHIVE} ||= | |
| $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}"); | |
| } | |
| else { | |
| $self->{PERL_ARCHIVE} ||= | |
| $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"; | |
| } | |
| $self->{PERL_ARCHIVE_AFTER} ||= ''; | |
| } | |
| =item catdir (override) | |
| =item catfile (override) | |
| Eliminate the macros in the output to the MMS/MMK file. | |
| (File::Spec::VMS used to do this for us, but it's being removed) | |
| =cut | |
| sub catdir { | |
| my $self = shift; | |
| # Process the macros on VMS MMS/MMK | |
| my @args = map { m{\$\(} ? $self->eliminate_macros($_) : $_ } @_; | |
| my $dir = $self->SUPER::catdir(@args); | |
| # Fix up the directory and force it to VMS format. | |
| $dir = $self->fixpath($dir, 1); | |
| return $dir; | |
| } | |
| sub catfile { | |
| my $self = shift; | |
| # Process the macros on VMS MMS/MMK | |
| my @args = map { m{\$\(} ? $self->eliminate_macros($_) : $_ } @_; | |
| my $file = $self->SUPER::catfile(@args); | |
| $file = vmsify($file); | |
| return $file | |
| } | |
| =item eliminate_macros | |
| Expands MM[KS]/Make macros in a text string, using the contents of | |
| identically named elements of C<%$self>, and returns the result | |
| as a file specification in Unix syntax. | |
| NOTE: This is the canonical version of the method. The version in | |
| File::Spec::VMS is deprecated. | |
| =cut | |
| sub eliminate_macros { | |
| my($self,$path) = @_; | |
| return '' unless $path; | |
| $self = {} unless ref $self; | |
| if ($path =~ /\s/) { | |
| return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path; | |
| } | |
| my($npath) = unixify($path); | |
| # sometimes unixify will return a string with an off-by-one trailing null | |
| $npath =~ s{\0$}{}; | |
| my($complex) = 0; | |
| my($head,$macro,$tail); | |
| # perform m##g in scalar context so it acts as an iterator | |
| while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { | |
| if (defined $self->{$2}) { | |
| ($head,$macro,$tail) = ($1,$2,$3); | |
| if (ref $self->{$macro}) { | |
| if (ref $self->{$macro} eq 'ARRAY') { | |
| $macro = join ' ', @{$self->{$macro}}; | |
| } | |
| else { | |
| print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), | |
| "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; | |
| $macro = "\cB$macro\cB"; | |
| $complex = 1; | |
| } | |
| } | |
| else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; } | |
| $npath = "$head$macro$tail"; | |
| } | |
| } | |
| if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; } | |
| $npath; | |
| } | |
| =item fixpath | |
| my $path = $mm->fixpath($path); | |
| my $path = $mm->fixpath($path, $is_dir); | |
| Catchall routine to clean up problem MM[SK]/Make macros. Expands macros | |
| in any directory specification, in order to avoid juxtaposing two | |
| VMS-syntax directories when MM[SK] is run. Also expands expressions which | |
| are all macro, so that we can tell how long the expansion is, and avoid | |
| overrunning DCL's command buffer when MM[KS] is running. | |
| fixpath() checks to see whether the result matches the name of a | |
| directory in the current default directory and returns a directory or | |
| file specification accordingly. C<$is_dir> can be set to true to | |
| force fixpath() to consider the path to be a directory or false to force | |
| it to be a file. | |
| NOTE: This is the canonical version of the method. The version in | |
| File::Spec::VMS is deprecated. | |
| =cut | |
| sub fixpath { | |
| my($self,$path,$force_path) = @_; | |
| return '' unless $path; | |
| $self = bless {}, $self unless ref $self; | |
| my($fixedpath,$prefix,$name); | |
| if ($path =~ /[ \t]/) { | |
| return join ' ', | |
| map { $self->fixpath($_,$force_path) } | |
| split /[ \t]+/, $path; | |
| } | |
| if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { | |
| if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { | |
| $fixedpath = vmspath($self->eliminate_macros($path)); | |
| } | |
| else { | |
| $fixedpath = vmsify($self->eliminate_macros($path)); | |
| } | |
| } | |
| elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) { | |
| my($vmspre) = $self->eliminate_macros("\$($prefix)"); | |
| # is it a dir or just a name? | |
| $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : ''; | |
| $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; | |
| $fixedpath = vmspath($fixedpath) if $force_path; | |
| } | |
| else { | |
| $fixedpath = $path; | |
| $fixedpath = vmspath($fixedpath) if $force_path; | |
| } | |
| # No hints, so we try to guess | |
| if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) { | |
| $fixedpath = vmspath($fixedpath) if -d $fixedpath; | |
| } | |
| # Trim off root dirname if it's had other dirs inserted in front of it. | |
| $fixedpath =~ s/\.000000([\]>])/$1/; | |
| # Special case for VMS absolute directory specs: these will have had device | |
| # prepended during trip through Unix syntax in eliminate_macros(), since | |
| # Unix syntax has no way to express "absolute from the top of this device's | |
| # directory tree". | |
| if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; } | |
| return $fixedpath; | |
| } | |
| =item os_flavor | |
| VMS is VMS. | |
| =cut | |
| sub os_flavor { | |
| return('VMS'); | |
| } | |
| =back | |
| =head1 AUTHOR | |
| Original author Charles Bailey F<[email protected]> | |
| Maintained by Michael G Schwern F<[email protected]> | |
| See L<ExtUtils::MakeMaker> for patching and contact information. | |
| =cut | |
| 1; | |
| EXTUTILS_MM_VMS | |
| $fatpacked{"ExtUtils/MM_VOS.pm"} = <<'EXTUTILS_MM_VOS'; | |
| package ExtUtils::MM_VOS; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw(ExtUtils::MM_Unix); | |
| =head1 NAME | |
| ExtUtils::MM_VOS - VOS specific subclass of ExtUtils::MM_Unix | |
| =head1 SYNOPSIS | |
| Don't use this module directly. | |
| Use ExtUtils::MM and let it choose. | |
| =head1 DESCRIPTION | |
| This is a subclass of ExtUtils::MM_Unix which contains functionality for | |
| VOS. | |
| Unless otherwise stated it works just like ExtUtils::MM_Unix | |
| =head2 Overridden methods | |
| =head3 extra_clean_files | |
| Cleanup VOS core files | |
| =cut | |
| sub extra_clean_files { | |
| return qw(*.kp); | |
| } | |
| =head1 AUTHOR | |
| Michael G Schwern <[email protected]> with code from ExtUtils::MM_Unix | |
| =head1 SEE ALSO | |
| L<ExtUtils::MakeMaker> | |
| =cut | |
| 1; | |
| EXTUTILS_MM_VOS | |
| $fatpacked{"ExtUtils/MM_Win32.pm"} = <<'EXTUTILS_MM_WIN32'; | |
| package ExtUtils::MM_Win32; | |
| use strict; | |
| =head1 NAME | |
| ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
| =head1 SYNOPSIS | |
| use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed | |
| =head1 DESCRIPTION | |
| See ExtUtils::MM_Unix for a documentation of the methods provided | |
| there. This package overrides the implementation of these methods, not | |
| the semantics. | |
| =cut | |
| use ExtUtils::MakeMaker::Config; | |
| use File::Basename; | |
| use File::Spec; | |
| use ExtUtils::MakeMaker qw( neatvalue ); | |
| require ExtUtils::MM_Any; | |
| require ExtUtils::MM_Unix; | |
| our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); | |
| our $VERSION = '6.59'; | |
| $ENV{EMXSHELL} = 'sh'; # to run `commands` | |
| my ( $BORLAND, $GCC, $DLLTOOL ) = _identify_compiler_environment( \%Config ); | |
| sub _identify_compiler_environment { | |
| my ( $config ) = @_; | |
| my $BORLAND = $config->{cc} =~ /^bcc/i ? 1 : 0; | |
| my $GCC = $config->{cc} =~ /\bgcc\b/i ? 1 : 0; | |
| my $DLLTOOL = $config->{dlltool} || 'dlltool'; | |
| return ( $BORLAND, $GCC, $DLLTOOL ); | |
| } | |
| =head2 Overridden methods | |
| =over 4 | |
| =item B<dlsyms> | |
| =cut | |
| sub dlsyms { | |
| my($self,%attribs) = @_; | |
| my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; | |
| my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; | |
| my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; | |
| my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {}; | |
| my(@m); | |
| if (not $self->{SKIPHASH}{'dynamic'}) { | |
| push(@m," | |
| $self->{BASEEXT}.def: Makefile.PL | |
| ", | |
| q! $(PERLRUN) -MExtUtils::Mksymlists \\ | |
| -e "Mksymlists('NAME'=>\"!, $self->{NAME}, | |
| q!\", 'DLBASE' => '!,$self->{DLBASE}, | |
| # The above two lines quoted differently to work around | |
| # a bug in the 4DOS/4NT command line interpreter. The visible | |
| # result of the bug was files named q('extension_name',) *with the | |
| # single quotes and the comma* in the extension build directories. | |
| q!', 'DL_FUNCS' => !,neatvalue($funcs), | |
| q!, 'FUNCLIST' => !,neatvalue($funclist), | |
| q!, 'IMPORTS' => !,neatvalue($imports), | |
| q!, 'DL_VARS' => !, neatvalue($vars), q!);" | |
| !); | |
| } | |
| join('',@m); | |
| } | |
| =item replace_manpage_separator | |
| Changes the path separator with . | |
| =cut | |
| sub replace_manpage_separator { | |
| my($self,$man) = @_; | |
| $man =~ s,/+,.,g; | |
| $man; | |
| } | |
| =item B<maybe_command> | |
| Since Windows has nothing as simple as an executable bit, we check the | |
| file extension. | |
| The PATHEXT env variable will be used to get a list of extensions that | |
| might indicate a command, otherwise .com, .exe, .bat and .cmd will be | |
| used by default. | |
| =cut | |
| sub maybe_command { | |
| my($self,$file) = @_; | |
| my @e = exists($ENV{'PATHEXT'}) | |
| ? split(/;/, $ENV{PATHEXT}) | |
| : qw(.com .exe .bat .cmd); | |
| my $e = ''; | |
| for (@e) { $e .= "\Q$_\E|" } | |
| chop $e; | |
| # see if file ends in one of the known extensions | |
| if ($file =~ /($e)$/i) { | |
| return $file if -e $file; | |
| } | |
| else { | |
| for (@e) { | |
| return "$file$_" if -e "$file$_"; | |
| } | |
| } | |
| return; | |
| } | |
| =item B<init_DIRFILESEP> | |
| Using \ for Windows. | |
| =cut | |
| sub init_DIRFILESEP { | |
| my($self) = shift; | |
| # The ^ makes sure its not interpreted as an escape in nmake | |
| $self->{DIRFILESEP} = $self->is_make_type('nmake') ? '^\\' : | |
| $self->is_make_type('dmake') ? '\\\\' | |
| : '\\'; | |
| } | |
| =item B<init_others> | |
| Override some of the Unix specific commands with portable | |
| ExtUtils::Command ones. | |
| Also provide defaults for LD and AR in case the %Config values aren't | |
| set. | |
| LDLOADLIBS's default is changed to $Config{libs}. | |
| Adjustments are made for Borland's quirks needing -L to come first. | |
| =cut | |
| sub init_others { | |
| my ($self) = @_; | |
| $self->{NOOP} ||= 'rem'; | |
| $self->{DEV_NULL} ||= '> NUL'; | |
| $self->{FIXIN} ||= $self->{PERL_CORE} ? | |
| "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : | |
| 'pl2bat.bat'; | |
| $self->{LD} ||= 'link'; | |
| $self->{AR} ||= 'lib'; | |
| $self->SUPER::init_others; | |
| # Setting SHELL from $Config{sh} can break dmake. Its ok without it. | |
| delete $self->{SHELL}; | |
| $self->{LDLOADLIBS} ||= $Config{libs}; | |
| # -Lfoo must come first for Borland, so we put it in LDDLFLAGS | |
| if ($BORLAND) { | |
| my $libs = $self->{LDLOADLIBS}; | |
| my $libpath = ''; | |
| while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) { | |
| $libpath .= ' ' if length $libpath; | |
| $libpath .= $1; | |
| } | |
| $self->{LDLOADLIBS} = $libs; | |
| $self->{LDDLFLAGS} ||= $Config{lddlflags}; | |
| $self->{LDDLFLAGS} .= " $libpath"; | |
| } | |
| return 1; | |
| } | |
| =item init_platform | |
| Add MM_Win32_VERSION. | |
| =item platform_constants | |
| =cut | |
| sub init_platform { | |
| my($self) = shift; | |
| $self->{MM_Win32_VERSION} = $VERSION; | |
| return; | |
| } | |
| sub platform_constants { | |
| my($self) = shift; | |
| my $make_frag = ''; | |
| foreach my $macro (qw(MM_Win32_VERSION)) | |
| { | |
| next unless defined $self->{$macro}; | |
| $make_frag .= "$macro = $self->{$macro}\n"; | |
| } | |
| return $make_frag; | |
| } | |
| =item constants | |
| Add MAXLINELENGTH for dmake before all the constants are output. | |
| =cut | |
| sub constants { | |
| my $self = shift; | |
| my $make_text = $self->SUPER::constants; | |
| return $make_text unless $self->is_make_type('dmake'); | |
| # dmake won't read any single "line" (even those with escaped newlines) | |
| # larger than a certain size which can be as small as 8k. PM_TO_BLIB | |
| # on large modules like DateTime::TimeZone can create lines over 32k. | |
| # So we'll crank it up to a <ironic>WHOPPING</ironic> 64k. | |
| # | |
| # This has to come here before all the constants and not in | |
| # platform_constants which is after constants. | |
| my $size = $self->{MAXLINELENGTH} || 64 * 1024; | |
| my $prefix = qq{ | |
| # Get dmake to read long commands like PM_TO_BLIB | |
| MAXLINELENGTH = $size | |
| }; | |
| return $prefix . $make_text; | |
| } | |
| =item special_targets | |
| Add .USESHELL target for dmake. | |
| =cut | |
| sub special_targets { | |
| my($self) = @_; | |
| my $make_frag = $self->SUPER::special_targets; | |
| $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake'); | |
| .USESHELL : | |
| MAKE_FRAG | |
| return $make_frag; | |
| } | |
| =item static_lib | |
| Changes how to run the linker. | |
| The rest is duplicate code from MM_Unix. Should move the linker code | |
| to its own method. | |
| =cut | |
| sub static_lib { | |
| my($self) = @_; | |
| return '' unless $self->has_link_code; | |
| my(@m); | |
| push(@m, <<'END'); | |
| $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists | |
| $(RM_RF) $@ | |
| END | |
| # If this extension has its own library (eg SDBM_File) | |
| # then copy that to $(INST_STATIC) and add $(OBJECT) into it. | |
| push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB}; | |
| $(CP) $(MYEXTLIB) $@ | |
| MAKE_FRAG | |
| push @m, | |
| q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")' | |
| : ($GCC ? '-ru $@ $(OBJECT)' | |
| : '-out:$@ $(OBJECT)')).q{ | |
| $(CHMOD) $(PERM_RWX) $@ | |
| $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld | |
| }; | |
| # Old mechanism - still available: | |
| push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS}; | |
| $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs | |
| MAKE_FRAG | |
| join('', @m); | |
| } | |
| =item dynamic_lib | |
| Complicated stuff for Win32 that I don't understand. :( | |
| =cut | |
| sub dynamic_lib { | |
| my($self, %attribs) = @_; | |
| return '' unless $self->needs_linking(); #might be because of a subdir | |
| return '' unless $self->has_link_code; | |
| my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': ''); | |
| my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; | |
| my($ldfrom) = '$(LDFROM)'; | |
| my(@m); | |
| push(@m,' | |
| # This section creates the dynamically loadable $(INST_DYNAMIC) | |
| # from $(OBJECT) and possibly $(MYEXTLIB). | |
| OTHERLDFLAGS = '.$otherldflags.' | |
| INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' | |
| $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) | |
| '); | |
| if ($GCC) { | |
| push(@m, | |
| q{ }.$DLLTOOL.q{ --def $(EXPORT_LIST) --output-exp dll.exp | |
| $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp | |
| }.$DLLTOOL.q{ --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp | |
| $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp }); | |
| } elsif ($BORLAND) { | |
| push(@m, | |
| q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,} | |
| .($self->is_make_type('dmake') | |
| ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) } | |
| .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)} | |
| : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) } | |
| .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))}) | |
| .q{,$(RESFILES)}); | |
| } else { # VC | |
| push(@m, | |
| q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) } | |
| .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)}); | |
| # Embed the manifest file if it exists | |
| push(@m, q{ | |
| if exist [email protected] mt -nologo -manifest [email protected] -outputresource:$@;2 | |
| if exist [email protected] del [email protected]}); | |
| } | |
| push @m, ' | |
| $(CHMOD) $(PERM_RWX) $@ | |
| '; | |
| join('',@m); | |
| } | |
| =item extra_clean_files | |
| Clean out some extra dll.{base,exp} files which might be generated by | |
| gcc. Otherwise, take out all *.pdb files. | |
| =cut | |
| sub extra_clean_files { | |
| my $self = shift; | |
| return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb'); | |
| } | |
| =item init_linker | |
| =cut | |
| sub init_linker { | |
| my $self = shift; | |
| $self->{PERL_ARCHIVE} = "\$(PERL_INC)\\$Config{libperl}"; | |
| $self->{PERL_ARCHIVE_AFTER} = ''; | |
| $self->{EXPORT_LIST} = '$(BASEEXT).def'; | |
| } | |
| =item perl_script | |
| Checks for the perl program under several common perl extensions. | |
| =cut | |
| sub perl_script { | |
| my($self,$file) = @_; | |
| return $file if -r $file && -f _; | |
| return "$file.pl" if -r "$file.pl" && -f _; | |
| return "$file.plx" if -r "$file.plx" && -f _; | |
| return "$file.bat" if -r "$file.bat" && -f _; | |
| return; | |
| } | |
| =item xs_o | |
| This target is stubbed out. Not sure why. | |
| =cut | |
| sub xs_o { | |
| return '' | |
| } | |
| =item pasthru | |
| All we send is -nologo to nmake to prevent it from printing its damned | |
| banner. | |
| =cut | |
| sub pasthru { | |
| my($self) = shift; | |
| return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : ""); | |
| } | |
| =item arch_check (override) | |
| Normalize all arguments for consistency of comparison. | |
| =cut | |
| sub arch_check { | |
| my $self = shift; | |
| # Win32 is an XS module, minperl won't have it. | |
| # arch_check() is not critical, so just fake it. | |
| return 1 unless $self->can_load_xs; | |
| return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_); | |
| } | |
| sub _normalize_path_name { | |
| my $self = shift; | |
| my $file = shift; | |
| require Win32; | |
| my $short = Win32::GetShortPathName($file); | |
| return defined $short ? lc $short : lc $file; | |
| } | |
| =item oneliner | |
| These are based on what command.com does on Win98. They may be wrong | |
| for other Windows shells, I don't know. | |
| =cut | |
| sub oneliner { | |
| my($self, $cmd, $switches) = @_; | |
| $switches = [] unless defined $switches; | |
| # Strip leading and trailing newlines | |
| $cmd =~ s{^\n+}{}; | |
| $cmd =~ s{\n+$}{}; | |
| $cmd = $self->quote_literal($cmd); | |
| $cmd = $self->escape_newlines($cmd); | |
| $switches = join ' ', @$switches; | |
| return qq{\$(ABSPERLRUN) $switches -e $cmd --}; | |
| } | |
| sub quote_literal { | |
| my($self, $text) = @_; | |
| # DOS batch processing is hilarious: | |
| # Quotes need to be converted into triple quotes. | |
| # Certain special characters need to be escaped with a caret if an odd | |
| # number of quotes came before them. | |
| my @text = split '', $text; | |
| my $quote_count = 0; | |
| my %caret_chars = map { $_ => 1 } qw( < > | ); | |
| for my $char ( @text ) { | |
| if ( $char eq '"' ) { | |
| $quote_count++; | |
| $char = '"""'; | |
| } | |
| elsif ( $caret_chars{$char} and $quote_count % 2 ) { | |
| $char = "^$char"; | |
| } | |
| elsif ( $char eq "\\" ) { | |
| $char = "\\\\"; | |
| } | |
| } | |
| $text = join '', @text; | |
| # There is a terribly confusing edge case here, where this will do entirely the wrong thing: | |
| # perl -e "use Data::Dumper; @ARGV = '%PATH%'; print Dumper( \@ARGV );print qq{@ARGV};" -- | |
| # I have no idea how to fix this manually, much less programmatically. | |
| # However as it is such a rare edge case i'll just leave this documentation here and hope it never happens. | |
| # dmake eats '{' inside double quotes and leaves alone { outside double | |
| # quotes; however it transforms {{ into { either inside and outside double | |
| # quotes. It also translates }} into }. The escaping below is not | |
| # 100% correct. | |
| if( $self->is_make_type('dmake') ) { | |
| $text =~ s/{/{{/g; | |
| $text =~ s/}}/}}}/g; | |
| } | |
| return qq{"$text"}; | |
| } | |
| sub escape_newlines { | |
| my($self, $text) = @_; | |
| # Escape newlines | |
| $text =~ s{\n}{\\\n}g; | |
| return $text; | |
| } | |
| =item cd | |
| dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot. It | |
| wants: | |
| cd dir1\dir2 | |
| command | |
| another_command | |
| cd ..\.. | |
| =cut | |
| sub cd { | |
| my($self, $dir, @cmds) = @_; | |
| return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake'); | |
| my $cmd = join "\n\t", map "$_", @cmds; | |
| my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir)); | |
| # No leading tab and no trailing newline makes for easier embedding. | |
| my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs; | |
| cd %s | |
| %s | |
| cd %s | |
| MAKE_FRAG | |
| chomp $make_frag; | |
| return $make_frag; | |
| } | |
| =item max_exec_len | |
| nmake 1.50 limits command length to 2048 characters. | |
| =cut | |
| sub max_exec_len { | |
| my $self = shift; | |
| return $self->{_MAX_EXEC_LEN} ||= 2 * 1024; | |
| } | |
| =item os_flavor | |
| Windows is Win32. | |
| =cut | |
| sub os_flavor { | |
| return('Win32'); | |
| } | |
| =item cflags | |
| Defines the PERLDLL symbol if we are configured for static building since all | |
| code destined for the perl5xx.dll must be compiled with the PERLDLL symbol | |
| defined. | |
| =cut | |
| sub cflags { | |
| my($self,$libperl)=@_; | |
| return $self->{CFLAGS} if $self->{CFLAGS}; | |
| return '' unless $self->needs_linking(); | |
| my $base = $self->SUPER::cflags($libperl); | |
| foreach (split /\n/, $base) { | |
| /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2; | |
| }; | |
| $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static'); | |
| return $self->{CFLAGS} = qq{ | |
| CCFLAGS = $self->{CCFLAGS} | |
| OPTIMIZE = $self->{OPTIMIZE} | |
| PERLTYPE = $self->{PERLTYPE} | |
| }; | |
| } | |
| sub is_make_type { | |
| my($self, $type) = @_; | |
| return !! ($self->make =~ /\b$type(?:\.exe)?$/); | |
| } | |
| 1; | |
| __END__ | |
| =back | |
| =cut | |
| EXTUTILS_MM_WIN32 | |
| $fatpacked{"ExtUtils/MM_Win95.pm"} = <<'EXTUTILS_MM_WIN95'; | |
| package ExtUtils::MM_Win95; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| require ExtUtils::MM_Win32; | |
| our @ISA = qw(ExtUtils::MM_Win32); | |
| use ExtUtils::MakeMaker::Config; | |
| =head1 NAME | |
| ExtUtils::MM_Win95 - method to customize MakeMaker for Win9X | |
| =head1 SYNOPSIS | |
| You should not be using this module directly. | |
| =head1 DESCRIPTION | |
| This is a subclass of ExtUtils::MM_Win32 containing changes necessary | |
| to get MakeMaker playing nice with command.com and other Win9Xisms. | |
| =head2 Overridden methods | |
| Most of these make up for limitations in the Win9x/nmake command shell. | |
| Mostly its lack of &&. | |
| =over 4 | |
| =item xs_c | |
| The && problem. | |
| =cut | |
| sub xs_c { | |
| my($self) = shift; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs.c: | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c | |
| ' | |
| } | |
| =item xs_cpp | |
| The && problem | |
| =cut | |
| sub xs_cpp { | |
| my($self) = shift; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs.cpp: | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp | |
| '; | |
| } | |
| =item xs_o | |
| The && problem. | |
| =cut | |
| sub xs_o { | |
| my($self) = shift; | |
| return '' unless $self->needs_linking(); | |
| ' | |
| .xs$(OBJ_EXT): | |
| $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c | |
| $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c | |
| '; | |
| } | |
| =item max_exec_len | |
| Win98 chokes on things like Encode if we set the max length to nmake's max | |
| of 2K. So we go for a more conservative value of 1K. | |
| =cut | |
| sub max_exec_len { | |
| my $self = shift; | |
| return $self->{_MAX_EXEC_LEN} ||= 1024; | |
| } | |
| =item os_flavor | |
| Win95 and Win98 and WinME are collectively Win9x and Win32 | |
| =cut | |
| sub os_flavor { | |
| my $self = shift; | |
| return ($self->SUPER::os_flavor, 'Win9x'); | |
| } | |
| =back | |
| =head1 AUTHOR | |
| Code originally inside MM_Win32. Original author unknown. | |
| Currently maintained by Michael G Schwern C<[email protected]>. | |
| Send patches and ideas to C<[email protected]>. | |
| See http://www.makemaker.org. | |
| =cut | |
| 1; | |
| EXTUTILS_MM_WIN95 | |
| $fatpacked{"ExtUtils/MY.pm"} = <<'EXTUTILS_MY'; | |
| package ExtUtils::MY; | |
| use strict; | |
| require ExtUtils::MM; | |
| our $VERSION = '6.59'; | |
| our @ISA = qw(ExtUtils::MM); | |
| { | |
| package MY; | |
| our @ISA = qw(ExtUtils::MY); | |
| } | |
| sub DESTROY {} | |
| =head1 NAME | |
| ExtUtils::MY - ExtUtils::MakeMaker subclass for customization | |
| =head1 SYNOPSIS | |
| # in your Makefile.PL | |
| sub MY::whatever { | |
| ... | |
| } | |
| =head1 DESCRIPTION | |
| B<FOR INTERNAL USE ONLY> | |
| ExtUtils::MY is a subclass of ExtUtils::MM. Its provided in your | |
| Makefile.PL for you to add and override MakeMaker functionality. | |
| It also provides a convenient alias via the MY class. | |
| ExtUtils::MY might turn out to be a temporary solution, but MY won't | |
| go away. | |
| =cut | |
| EXTUTILS_MY | |
| $fatpacked{"ExtUtils/MakeMaker.pm"} = <<'EXTUTILS_MAKEMAKER'; | |
| # $Id$ | |
| package ExtUtils::MakeMaker; | |
| use strict; | |
| BEGIN {require 5.006;} | |
| require Exporter; | |
| use ExtUtils::MakeMaker::Config; | |
| use Carp; | |
| use File::Path; | |
| our $Verbose = 0; # exported | |
| our @Parent; # needs to be localized | |
| our @Get_from_Config; # referenced by MM_Unix | |
| our @MM_Sections; | |
| our @Overridable; | |
| my @Prepend_parent; | |
| my %Recognized_Att_Keys; | |
| our $VERSION = '6.59'; | |
| $VERSION = eval $VERSION; | |
| # Emulate something resembling CVS $Revision$ | |
| (our $Revision = $VERSION) =~ s{_}{}; | |
| $Revision = int $Revision * 10000; | |
| our $Filename = __FILE__; # referenced outside MakeMaker | |
| our @ISA = qw(Exporter); | |
| our @EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt); | |
| our @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists | |
| &WriteEmptyMakefile); | |
| # These will go away once the last of the Win32 & VMS specific code is | |
| # purged. | |
| my $Is_VMS = $^O eq 'VMS'; | |
| my $Is_Win32 = $^O eq 'MSWin32'; | |
| full_setup(); | |
| require ExtUtils::MM; # Things like CPAN assume loading ExtUtils::MakeMaker | |
| # will give them MM. | |
| require ExtUtils::MY; # XXX pre-5.8 versions of ExtUtils::Embed expect | |
| # loading ExtUtils::MakeMaker will give them MY. | |
| # This will go when Embed is its own CPAN module. | |
| sub WriteMakefile { | |
| croak "WriteMakefile: Need even number of args" if @_ % 2; | |
| require ExtUtils::MY; | |
| my %att = @_; | |
| _convert_compat_attrs(\%att); | |
| _verify_att(\%att); | |
| my $mm = MM->new(\%att); | |
| $mm->flush; | |
| return $mm; | |
| } | |
| # Basic signatures of the attributes WriteMakefile takes. Each is the | |
| # reference type. Empty value indicate it takes a non-reference | |
| # scalar. | |
| my %Att_Sigs; | |
| my %Special_Sigs = ( | |
| AUTHOR => 'ARRAY', | |
| C => 'ARRAY', | |
| CONFIG => 'ARRAY', | |
| CONFIGURE => 'CODE', | |
| DIR => 'ARRAY', | |
| DL_FUNCS => 'HASH', | |
| DL_VARS => 'ARRAY', | |
| EXCLUDE_EXT => 'ARRAY', | |
| EXE_FILES => 'ARRAY', | |
| FUNCLIST => 'ARRAY', | |
| H => 'ARRAY', | |
| IMPORTS => 'HASH', | |
| INCLUDE_EXT => 'ARRAY', | |
| LIBS => ['ARRAY',''], | |
| MAN1PODS => 'HASH', | |
| MAN3PODS => 'HASH', | |
| META_ADD => 'HASH', | |
| META_MERGE => 'HASH', | |
| PL_FILES => 'HASH', | |
| PM => 'HASH', | |
| PMLIBDIRS => 'ARRAY', | |
| PMLIBPARENTDIRS => 'ARRAY', | |
| PREREQ_PM => 'HASH', | |
| BUILD_REQUIRES => 'HASH', | |
| CONFIGURE_REQUIRES => 'HASH', | |
| SKIP => 'ARRAY', | |
| TYPEMAPS => 'ARRAY', | |
| XS => 'HASH', | |
| VERSION => ['version',''], | |
| _KEEP_AFTER_FLUSH => '', | |
| clean => 'HASH', | |
| depend => 'HASH', | |
| dist => 'HASH', | |
| dynamic_lib=> 'HASH', | |
| linkext => 'HASH', | |
| macro => 'HASH', | |
| postamble => 'HASH', | |
| realclean => 'HASH', | |
| test => 'HASH', | |
| tool_autosplit => 'HASH', | |
| ); | |
| @Att_Sigs{keys %Recognized_Att_Keys} = ('') x keys %Recognized_Att_Keys; | |
| @Att_Sigs{keys %Special_Sigs} = values %Special_Sigs; | |
| sub _convert_compat_attrs { #result of running several times should be same | |
| my($att) = @_; | |
| if (exists $att->{AUTHOR}) { | |
| if ($att->{AUTHOR}) { | |
| if (!ref($att->{AUTHOR})) { | |
| my $t = $att->{AUTHOR}; | |
| $att->{AUTHOR} = [$t]; | |
| } | |
| } else { | |
| $att->{AUTHOR} = []; | |
| } | |
| } | |
| } | |
| sub _verify_att { | |
| my($att) = @_; | |
| while( my($key, $val) = each %$att ) { | |
| my $sig = $Att_Sigs{$key}; | |
| unless( defined $sig ) { | |
| warn "WARNING: $key is not a known parameter.\n"; | |
| next; | |
| } | |
| my @sigs = ref $sig ? @$sig : $sig; | |
| my $given = ref $val; | |
| unless( grep { _is_of_type($val, $_) } @sigs ) { | |
| my $takes = join " or ", map { _format_att($_) } @sigs; | |
| my $has = _format_att($given); | |
| warn "WARNING: $key takes a $takes not a $has.\n". | |
| " Please inform the author.\n"; | |
| } | |
| } | |
| } | |
| # Check if a given thing is a reference or instance of $type | |
| sub _is_of_type { | |
| my($thing, $type) = @_; | |
| return 1 if ref $thing eq $type; | |
| local $SIG{__DIE__}; | |
| return 1 if eval{ $thing->isa($type) }; | |
| return 0; | |
| } | |
| sub _format_att { | |
| my $given = shift; | |
| return $given eq '' ? "string/number" | |
| : uc $given eq $given ? "$given reference" | |
| : "$given object" | |
| ; | |
| } | |
| sub prompt ($;$) { ## no critic | |
| my($mess, $def) = @_; | |
| confess("prompt function called without an argument") | |
| unless defined $mess; | |
| my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; | |
| my $dispdef = defined $def ? "[$def] " : " "; | |
| $def = defined $def ? $def : ""; | |
| local $|=1; | |
| local $\; | |
| print "$mess $dispdef"; | |
| my $ans; | |
| if ($ENV{PERL_MM_USE_DEFAULT} || (!$isa_tty && eof STDIN)) { | |
| print "$def\n"; | |
| } | |
| else { | |
| $ans = <STDIN>; | |
| if( defined $ans ) { | |
| chomp $ans; | |
| } | |
| else { # user hit ctrl-D | |
| print "\n"; | |
| } | |
| } | |
| return (!defined $ans || $ans eq '') ? $def : $ans; | |
| } | |
| sub eval_in_subdirs { | |
| my($self) = @_; | |
| use Cwd qw(cwd abs_path); | |
| my $pwd = cwd() || die "Can't figure out your cwd!"; | |
| local @INC = map eval {abs_path($_) if -e} || $_, @INC; | |
| push @INC, '.'; # '.' has to always be at the end of @INC | |
| foreach my $dir (@{$self->{DIR}}){ | |
| my($abs) = $self->catdir($pwd,$dir); | |
| eval { $self->eval_in_x($abs); }; | |
| last if $@; | |
| } | |
| chdir $pwd; | |
| die $@ if $@; | |
| } | |
| sub eval_in_x { | |
| my($self,$dir) = @_; | |
| chdir $dir or carp("Couldn't change to directory $dir: $!"); | |
| { | |
| package main; | |
| do './Makefile.PL'; | |
| }; | |
| if ($@) { | |
| # if ($@ =~ /prerequisites/) { | |
| # die "MakeMaker WARNING: $@"; | |
| # } else { | |
| # warn "WARNING from evaluation of $dir/Makefile.PL: $@"; | |
| # } | |
| die "ERROR from evaluation of $dir/Makefile.PL: $@"; | |
| } | |
| } | |
| # package name for the classes into which the first object will be blessed | |
| my $PACKNAME = 'PACK000'; | |
| sub full_setup { | |
| $Verbose ||= 0; | |
| my @attrib_help = qw/ | |
| AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION | |
| C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DISTVNAME | |
| DL_FUNCS DL_VARS | |
| EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE | |
| FULLPERL FULLPERLRUN FULLPERLRUNINST | |
| FUNCLIST H IMPORTS | |
| INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB INST_MAN1DIR INST_MAN3DIR | |
| INSTALLDIRS | |
| DESTDIR PREFIX INSTALL_BASE | |
| PERLPREFIX SITEPREFIX VENDORPREFIX | |
| INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB | |
| INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH | |
| INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN | |
| INSTALLMAN1DIR INSTALLMAN3DIR | |
| INSTALLSITEMAN1DIR INSTALLSITEMAN3DIR | |
| INSTALLVENDORMAN1DIR INSTALLVENDORMAN3DIR | |
| INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT | |
| PERL_LIB PERL_ARCHLIB | |
| SITELIBEXP SITEARCHEXP | |
| INC INCLUDE_EXT LDFROM LIB LIBPERL_A LIBS LICENSE | |
| LINKTYPE MAKE MAKEAPERL MAKEFILE MAKEFILE_OLD MAN1PODS MAN3PODS MAP_TARGET | |
| META_ADD META_MERGE MIN_PERL_VERSION BUILD_REQUIRES CONFIGURE_REQUIRES | |
| MYEXTLIB NAME NEEDS_LINKING NOECHO NO_META NO_MYMETA NORECURS NO_VC OBJECT | |
| OPTIMIZE PERL_MALLOC_OK PERL PERLMAINCC PERLRUN PERLRUNINST PERL_CORE | |
| PERL_SRC PERM_DIR PERM_RW PERM_RWX | |
| PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PPM_INSTALL_EXEC | |
| PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ | |
| SIGN SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG | |
| XS_VERSION clean depend dist dynamic_lib linkext macro realclean | |
| tool_autosplit | |
| MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC | |
| MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED | |
| /; | |
| # IMPORTS is used under OS/2 and Win32 | |
| # @Overridable is close to @MM_Sections but not identical. The | |
| # order is important. Many subroutines declare macros. These | |
| # depend on each other. Let's try to collect the macros up front, | |
| # then pasthru, then the rules. | |
| # MM_Sections are the sections we have to call explicitly | |
| # in Overridable we have subroutines that are used indirectly | |
| @MM_Sections = | |
| qw( | |
| post_initialize const_config constants platform_constants | |
| tool_autosplit tool_xsubpp tools_other | |
| makemakerdflt | |
| dist macro depend cflags const_loadlibs const_cccmd | |
| post_constants | |
| pasthru | |
| special_targets | |
| c_o xs_c xs_o | |
| top_targets blibdirs linkext dlsyms dynamic dynamic_bs | |
| dynamic_lib static static_lib manifypods processPL | |
| installbin subdirs | |
| clean_subdirs clean realclean_subdirs realclean | |
| metafile signature | |
| dist_basics dist_core distdir dist_test dist_ci distmeta distsignature | |
| install force perldepend makefile staticmake test ppd | |
| ); # loses section ordering | |
| @Overridable = @MM_Sections; | |
| push @Overridable, qw[ | |
| libscan makeaperl needs_linking | |
| subdir_x test_via_harness test_via_script | |
| init_VERSION init_dist init_INST init_INSTALL init_DEST init_dirscan | |
| init_PM init_MANPODS init_xs init_PERL init_DIRFILESEP init_linker | |
| ]; | |
| push @MM_Sections, qw[ | |
| pm_to_blib selfdocument | |
| ]; | |
| # Postamble needs to be the last that was always the case | |
| push @MM_Sections, "postamble"; | |
| push @Overridable, "postamble"; | |
| # All sections are valid keys. | |
| @Recognized_Att_Keys{@MM_Sections} = (1) x @MM_Sections; | |
| # we will use all these variables in the Makefile | |
| @Get_from_Config = | |
| qw( | |
| ar cc cccdlflags ccdlflags dlext dlsrc exe_ext full_ar ld | |
| lddlflags ldflags libc lib_ext obj_ext osname osvers ranlib | |
| sitelibexp sitearchexp so | |
| ); | |
| # 5.5.3 doesn't have any concept of vendor libs | |
| push @Get_from_Config, qw( vendorarchexp vendorlibexp ) if $] >= 5.006; | |
| foreach my $item (@attrib_help){ | |
| $Recognized_Att_Keys{$item} = 1; | |
| } | |
| foreach my $item (@Get_from_Config) { | |
| $Recognized_Att_Keys{uc $item} = $Config{$item}; | |
| print "Attribute '\U$item\E' => '$Config{$item}'\n" | |
| if ($Verbose >= 2); | |
| } | |
| # | |
| # When we eval a Makefile.PL in a subdirectory, that one will ask | |
| # us (the parent) for the values and will prepend "..", so that | |
| # all files to be installed end up below OUR ./blib | |
| # | |
| @Prepend_parent = qw( | |
| INST_BIN INST_LIB INST_ARCHLIB INST_SCRIPT | |
| MAP_TARGET INST_MAN1DIR INST_MAN3DIR PERL_SRC | |
| PERL FULLPERL | |
| ); | |
| } | |
| sub writeMakefile { | |
| die <<END; | |
| The extension you are trying to build apparently is rather old and | |
| most probably outdated. We detect that from the fact, that a | |
| subroutine "writeMakefile" is called, and this subroutine is not | |
| supported anymore since about October 1994. | |
| Please contact the author or look into CPAN (details about CPAN can be | |
| found in the FAQ and at http:/www.perl.com) for a more recent version | |
| of the extension. If you're really desperate, you can try to change | |
| the subroutine name from writeMakefile to WriteMakefile and rerun | |
| 'perl Makefile.PL', but you're most probably left alone, when you do | |
| so. | |
| The MakeMaker team | |
| END | |
| } | |
| sub new { | |
| my($class,$self) = @_; | |
| my($key); | |
| _convert_compat_attrs($self) if defined $self && $self; | |
| # Store the original args passed to WriteMakefile() | |
| foreach my $k (keys %$self) { | |
| $self->{ARGS}{$k} = $self->{$k}; | |
| } | |
| $self = {} unless defined $self; | |
| # Temporarily bless it into MM so it can be used as an | |
| # object. It will be blessed into a temp package later. | |
| bless $self, "MM"; | |
| # Cleanup all the module requirement bits | |
| for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES)) { | |
| $self->{$key} ||= {}; | |
| $self->clean_versions( $key ); | |
| } | |
| if ("@ARGV" =~ /\bPREREQ_PRINT\b/) { | |
| $self->_PREREQ_PRINT; | |
| } | |
| # PRINT_PREREQ is RedHatism. | |
| if ("@ARGV" =~ /\bPRINT_PREREQ\b/) { | |
| $self->_PRINT_PREREQ; | |
| } | |
| print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose; | |
| if (-f "MANIFEST" && ! -f "Makefile" && ! $ENV{PERL_CORE}){ | |
| check_manifest(); | |
| } | |
| check_hints($self); | |
| # Translate X.Y.Z to X.00Y00Z | |
| if( defined $self->{MIN_PERL_VERSION} ) { | |
| $self->{MIN_PERL_VERSION} =~ s{ ^ (\d+) \. (\d+) \. (\d+) $ } | |
| {sprintf "%d.%03d%03d", $1, $2, $3}ex; | |
| } | |
| my $perl_version_ok = eval { | |
| local $SIG{__WARN__} = sub { | |
| # simulate "use warnings FATAL => 'all'" for vintage perls | |
| die @_; | |
| }; | |
| !$self->{MIN_PERL_VERSION} or $self->{MIN_PERL_VERSION} <= $] | |
| }; | |
| if (!$perl_version_ok) { | |
| if (!defined $perl_version_ok) { | |
| die <<'END'; | |
| Warning: MIN_PERL_VERSION is not in a recognized format. | |
| Recommended is a quoted numerical value like '5.005' or '5.008001'. | |
| END | |
| } | |
| elsif ($self->{PREREQ_FATAL}) { | |
| die sprintf <<"END", $self->{MIN_PERL_VERSION}, $]; | |
| MakeMaker FATAL: perl version too low for this distribution. | |
| Required is %s. We run %s. | |
| END | |
| } | |
| else { | |
| warn sprintf | |
| "Warning: Perl version %s or higher required. We run %s.\n", | |
| $self->{MIN_PERL_VERSION}, $]; | |
| } | |
| } | |
| my %configure_att; # record &{$self->{CONFIGURE}} attributes | |
| my(%initial_att) = %$self; # record initial attributes | |
| my(%unsatisfied) = (); | |
| my $prereqs = $self->_all_prereqs; | |
| foreach my $prereq (sort keys %$prereqs) { | |
| my $required_version = $prereqs->{$prereq}; | |
| my $installed_file = MM->_installed_file_for_module($prereq); | |
| my $pr_version = 0; | |
| $pr_version = MM->parse_version($installed_file) if $installed_file; | |
| $pr_version = 0 if $pr_version eq 'undef'; | |
| # convert X.Y_Z alpha version #s to X.YZ for easier comparisons | |
| $pr_version =~ s/(\d+)\.(\d+)_(\d+)/$1.$2$3/; | |
| if (!$installed_file) { | |
| warn sprintf "Warning: prerequisite %s %s not found.\n", | |
| $prereq, $required_version | |
| unless $self->{PREREQ_FATAL} | |
| or $ENV{PERL_CORE}; | |
| $unsatisfied{$prereq} = 'not installed'; | |
| } | |
| elsif ($pr_version < $required_version ){ | |
| warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n", | |
| $prereq, $required_version, ($pr_version || 'unknown version') | |
| unless $self->{PREREQ_FATAL} | |
| or $ENV{PERL_CORE}; | |
| $unsatisfied{$prereq} = $required_version ? $required_version : 'unknown version' ; | |
| } | |
| } | |
| if (%unsatisfied && $self->{PREREQ_FATAL}){ | |
| my $failedprereqs = join "\n", map {" $_ $unsatisfied{$_}"} | |
| sort { $a cmp $b } keys %unsatisfied; | |
| die <<"END"; | |
| MakeMaker FATAL: prerequisites not found. | |
| $failedprereqs | |
| Please install these modules first and rerun 'perl Makefile.PL'. | |
| END | |
| } | |
| if (defined $self->{CONFIGURE}) { | |
| if (ref $self->{CONFIGURE} eq 'CODE') { | |
| %configure_att = %{&{$self->{CONFIGURE}}}; | |
| _convert_compat_attrs(\%configure_att); | |
| $self = { %$self, %configure_att }; | |
| } else { | |
| croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n"; | |
| } | |
| } | |
| # This is for old Makefiles written pre 5.00, will go away | |
| if ( Carp::longmess("") =~ /runsubdirpl/s ){ | |
| carp("WARNING: Please rerun 'perl Makefile.PL' to regenerate your Makefiles\n"); | |
| } | |
| my $newclass = ++$PACKNAME; | |
| local @Parent = @Parent; # Protect against non-local exits | |
| { | |
| print "Blessing Object into class [$newclass]\n" if $Verbose>=2; | |
| mv_all_methods("MY",$newclass); | |
| bless $self, $newclass; | |
| push @Parent, $self; | |
| require ExtUtils::MY; | |
| no strict 'refs'; ## no critic; | |
| @{"$newclass\:\:ISA"} = 'MM'; | |
| } | |
| if (defined $Parent[-2]){ | |
| $self->{PARENT} = $Parent[-2]; | |
| for my $key (@Prepend_parent) { | |
| next unless defined $self->{PARENT}{$key}; | |
| # Don't stomp on WriteMakefile() args. | |
| next if defined $self->{ARGS}{$key} and | |
| $self->{ARGS}{$key} eq $self->{$key}; | |
| $self->{$key} = $self->{PARENT}{$key}; | |
| unless ($Is_VMS && $key =~ /PERL$/) { | |
| $self->{$key} = $self->catdir("..",$self->{$key}) | |
| unless $self->file_name_is_absolute($self->{$key}); | |
| } else { | |
| # PERL or FULLPERL will be a command verb or even a | |
| # command with an argument instead of a full file | |
| # specification under VMS. So, don't turn the command | |
| # into a filespec, but do add a level to the path of | |
| # the argument if not already absolute. | |
| my @cmd = split /\s+/, $self->{$key}; | |
| $cmd[1] = $self->catfile('[-]',$cmd[1]) | |
| unless (@cmd < 2) || $self->file_name_is_absolute($cmd[1]); | |
| $self->{$key} = join(' ', @cmd); | |
| } | |
| } | |
| if ($self->{PARENT}) { | |
| $self->{PARENT}->{CHILDREN}->{$newclass} = $self; | |
| foreach my $opt (qw(POLLUTE PERL_CORE LINKTYPE)) { | |
| if (exists $self->{PARENT}->{$opt} | |
| and not exists $self->{$opt}) | |
| { | |
| # inherit, but only if already unspecified | |
| $self->{$opt} = $self->{PARENT}->{$opt}; | |
| } | |
| } | |
| } | |
| my @fm = grep /^FIRST_MAKEFILE=/, @ARGV; | |
| parse_args($self,@fm) if @fm; | |
| } else { | |
| parse_args($self,split(' ', $ENV{PERL_MM_OPT} || ''),@ARGV); | |
| } | |
| $self->{NAME} ||= $self->guess_name; | |
| ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g; | |
| $self->init_MAKE; | |
| $self->init_main; | |
| $self->init_VERSION; | |
| $self->init_dist; | |
| $self->init_INST; | |
| $self->init_INSTALL; | |
| $self->init_DEST; | |
| $self->init_dirscan; | |
| $self->init_PM; | |
| $self->init_MANPODS; | |
| $self->init_xs; | |
| $self->init_PERL; | |
| $self->init_DIRFILESEP; | |
| $self->init_linker; | |
| $self->init_ABSTRACT; | |
| $self->arch_check( | |
| $INC{'Config.pm'}, | |
| $self->catfile($Config{'archlibexp'}, "Config.pm") | |
| ); | |
| $self->init_others(); | |
| $self->init_platform(); | |
| $self->init_PERM(); | |
| my($argv) = neatvalue(\@ARGV); | |
| $argv =~ s/^\[/(/; | |
| $argv =~ s/\]$/)/; | |
| push @{$self->{RESULT}}, <<END; | |
| # This Makefile is for the $self->{NAME} extension to perl. | |
| # | |
| # It was generated automatically by MakeMaker version | |
| # $VERSION (Revision: $Revision) from the contents of | |
| # Makefile.PL. Don't edit this file, edit Makefile.PL instead. | |
| # | |
| # ANY CHANGES MADE HERE WILL BE LOST! | |
| # | |
| # MakeMaker ARGV: $argv | |
| # | |
| END | |
| push @{$self->{RESULT}}, $self->_MakeMaker_Parameters_section(\%initial_att); | |
| if (defined $self->{CONFIGURE}) { | |
| push @{$self->{RESULT}}, <<END; | |
| # MakeMaker 'CONFIGURE' Parameters: | |
| END | |
| if (scalar(keys %configure_att) > 0) { | |
| foreach my $key (sort keys %configure_att){ | |
| next if $key eq 'ARGS'; | |
| my($v) = neatvalue($configure_att{$key}); | |
| $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; | |
| $v =~ tr/\n/ /s; | |
| push @{$self->{RESULT}}, "# $key => $v"; | |
| } | |
| } | |
| else | |
| { | |
| push @{$self->{RESULT}}, "# no values returned"; | |
| } | |
| undef %configure_att; # free memory | |
| } | |
| # turn the SKIP array into a SKIPHASH hash | |
| for my $skip (@{$self->{SKIP} || []}) { | |
| $self->{SKIPHASH}{$skip} = 1; | |
| } | |
| delete $self->{SKIP}; # free memory | |
| if ($self->{PARENT}) { | |
| for (qw/install dist dist_basics dist_core distdir dist_test dist_ci/) { | |
| $self->{SKIPHASH}{$_} = 1; | |
| } | |
| } | |
| # We run all the subdirectories now. They don't have much to query | |
| # from the parent, but the parent has to query them: if they need linking! | |
| unless ($self->{NORECURS}) { | |
| $self->eval_in_subdirs if @{$self->{DIR}}; | |
| } | |
| foreach my $section ( @MM_Sections ){ | |
| # Support for new foo_target() methods. | |
| my $method = $section; | |
| $method .= '_target' unless $self->can($method); | |
| print "Processing Makefile '$section' section\n" if ($Verbose >= 2); | |
| my($skipit) = $self->skipcheck($section); | |
| if ($skipit){ | |
| push @{$self->{RESULT}}, "\n# --- MakeMaker $section section $skipit."; | |
| } else { | |
| my(%a) = %{$self->{$section} || {}}; | |
| push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:"; | |
| push @{$self->{RESULT}}, "# " . join ", ", %a if $Verbose && %a; | |
| push @{$self->{RESULT}}, $self->maketext_filter( | |
| $self->$method( %a ) | |
| ); | |
| } | |
| } | |
| push @{$self->{RESULT}}, "\n# End."; | |
| $self; | |
| } | |
| sub WriteEmptyMakefile { | |
| croak "WriteEmptyMakefile: Need an even number of args" if @_ % 2; | |
| my %att = @_; | |
| my $self = MM->new(\%att); | |
| my $new = $self->{MAKEFILE}; | |
| my $old = $self->{MAKEFILE_OLD}; | |
| if (-f $old) { | |
| _unlink($old) or warn "unlink $old: $!"; | |
| } | |
| if ( -f $new ) { | |
| _rename($new, $old) or warn "rename $new => $old: $!" | |
| } | |
| open my $mfh, '>', $new or die "open $new for write: $!"; | |
| print $mfh <<'EOP'; | |
| all : | |
| clean : | |
| install : | |
| makemakerdflt : | |
| test : | |
| EOP | |
| close $mfh or die "close $new for write: $!"; | |
| } | |
| =begin private | |
| =head3 _installed_file_for_module | |
| my $file = MM->_installed_file_for_module($module); | |
| Return the first installed .pm $file associated with the $module. The | |
| one which will show up when you C<use $module>. | |
| $module is something like "strict" or "Test::More". | |
| =end private | |
| =cut | |
| sub _installed_file_for_module { | |
| my $class = shift; | |
| my $prereq = shift; | |
| my $file = "$prereq.pm"; | |
| $file =~ s{::}{/}g; | |
| my $path; | |
| for my $dir (@INC) { | |
| my $tmp = File::Spec->catfile($dir, $file); | |
| if ( -r $tmp ) { | |
| $path = $tmp; | |
| last; | |
| } | |
| } | |
| return $path; | |
| } | |
| # Extracted from MakeMaker->new so we can test it | |
| sub _MakeMaker_Parameters_section { | |
| my $self = shift; | |
| my $att = shift; | |
| my @result = <<'END'; | |
| # MakeMaker Parameters: | |
| END | |
| foreach my $key (sort keys %$att){ | |
| next if $key eq 'ARGS'; | |
| my ($v) = neatvalue($att->{$key}); | |
| if ($key eq 'PREREQ_PM') { | |
| # CPAN.pm takes prereqs from this field in 'Makefile' | |
| # and does not know about BUILD_REQUIRES | |
| $v = neatvalue({ %{ $att->{PREREQ_PM} || {} }, %{ $att->{BUILD_REQUIRES} || {} } }); | |
| } else { | |
| $v = neatvalue($att->{$key}); | |
| } | |
| $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; | |
| $v =~ tr/\n/ /s; | |
| push @result, "# $key => $v"; | |
| } | |
| return @result; | |
| } | |
| sub check_manifest { | |
| print STDOUT "Checking if your kit is complete...\n"; | |
| require ExtUtils::Manifest; | |
| # avoid warning | |
| $ExtUtils::Manifest::Quiet = $ExtUtils::Manifest::Quiet = 1; | |
| my(@missed) = ExtUtils::Manifest::manicheck(); | |
| if (@missed) { | |
| print STDOUT "Warning: the following files are missing in your kit:\n"; | |
| print "\t", join "\n\t", @missed; | |
| print STDOUT "\n"; | |
| print STDOUT "Please inform the author.\n"; | |
| } else { | |
| print STDOUT "Looks good\n"; | |
| } | |
| } | |
| sub parse_args{ | |
| my($self, @args) = @_; | |
| foreach (@args) { | |
| unless (m/(.*?)=(.*)/) { | |
| ++$Verbose if m/^verb/; | |
| next; | |
| } | |
| my($name, $value) = ($1, $2); | |
| if ($value =~ m/^~(\w+)?/) { # tilde with optional username | |
| $value =~ s [^~(\w*)] | |
| [$1 ? | |
| ((getpwnam($1))[7] || "~$1") : | |
| (getpwuid($>))[7] | |
| ]ex; | |
| } | |
| # Remember the original args passed it. It will be useful later. | |
| $self->{ARGS}{uc $name} = $self->{uc $name} = $value; | |
| } | |
| # catch old-style 'potential_libs' and inform user how to 'upgrade' | |
| if (defined $self->{potential_libs}){ | |
| my($msg)="'potential_libs' => '$self->{potential_libs}' should be"; | |
| if ($self->{potential_libs}){ | |
| print STDOUT "$msg changed to:\n\t'LIBS' => ['$self->{potential_libs}']\n"; | |
| } else { | |
| print STDOUT "$msg deleted.\n"; | |
| } | |
| $self->{LIBS} = [$self->{potential_libs}]; | |
| delete $self->{potential_libs}; | |
| } | |
| # catch old-style 'ARMAYBE' and inform user how to 'upgrade' | |
| if (defined $self->{ARMAYBE}){ | |
| my($armaybe) = $self->{ARMAYBE}; | |
| print STDOUT "ARMAYBE => '$armaybe' should be changed to:\n", | |
| "\t'dynamic_lib' => {ARMAYBE => '$armaybe'}\n"; | |
| my(%dl) = %{$self->{dynamic_lib} || {}}; | |
| $self->{dynamic_lib} = { %dl, ARMAYBE => $armaybe}; | |
| delete $self->{ARMAYBE}; | |
| } | |
| if (defined $self->{LDTARGET}){ | |
| print STDOUT "LDTARGET should be changed to LDFROM\n"; | |
| $self->{LDFROM} = $self->{LDTARGET}; | |
| delete $self->{LDTARGET}; | |
| } | |
| # Turn a DIR argument on the command line into an array | |
| if (defined $self->{DIR} && ref \$self->{DIR} eq 'SCALAR') { | |
| # So they can choose from the command line, which extensions they want | |
| # the grep enables them to have some colons too much in case they | |
| # have to build a list with the shell | |
| $self->{DIR} = [grep $_, split ":", $self->{DIR}]; | |
| } | |
| # Turn a INCLUDE_EXT argument on the command line into an array | |
| if (defined $self->{INCLUDE_EXT} && ref \$self->{INCLUDE_EXT} eq 'SCALAR') { | |
| $self->{INCLUDE_EXT} = [grep $_, split '\s+', $self->{INCLUDE_EXT}]; | |
| } | |
| # Turn a EXCLUDE_EXT argument on the command line into an array | |
| if (defined $self->{EXCLUDE_EXT} && ref \$self->{EXCLUDE_EXT} eq 'SCALAR') { | |
| $self->{EXCLUDE_EXT} = [grep $_, split '\s+', $self->{EXCLUDE_EXT}]; | |
| } | |
| foreach my $mmkey (sort keys %$self){ | |
| next if $mmkey eq 'ARGS'; | |
| print STDOUT " $mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose; | |
| print STDOUT "'$mmkey' is not a known MakeMaker parameter name.\n" | |
| unless exists $Recognized_Att_Keys{$mmkey}; | |
| } | |
| $| = 1 if $Verbose; | |
| } | |
| sub check_hints { | |
| my($self) = @_; | |
| # We allow extension-specific hints files. | |
| require File::Spec; | |
| my $curdir = File::Spec->curdir; | |
| my $hint_dir = File::Spec->catdir($curdir, "hints"); | |
| return unless -d $hint_dir; | |
| # First we look for the best hintsfile we have | |
| my($hint)="${^O}_$Config{osvers}"; | |
| $hint =~ s/\./_/g; | |
| $hint =~ s/_$//; | |
| return unless $hint; | |
| # Also try without trailing minor version numbers. | |
| while (1) { | |
| last if -f File::Spec->catfile($hint_dir, "$hint.pl"); # found | |
| } continue { | |
| last unless $hint =~ s/_[^_]*$//; # nothing to cut off | |
| } | |
| my $hint_file = File::Spec->catfile($hint_dir, "$hint.pl"); | |
| return unless -f $hint_file; # really there | |
| _run_hintfile($self, $hint_file); | |
| } | |
| sub _run_hintfile { | |
| our $self; | |
| local($self) = shift; # make $self available to the hint file. | |
| my($hint_file) = shift; | |
| local($@, $!); | |
| print STDERR "Processing hints file $hint_file\n"; | |
| # Just in case the ./ isn't on the hint file, which File::Spec can | |
| # often strip off, we bung the curdir into @INC | |
| local @INC = (File::Spec->curdir, @INC); | |
| my $ret = do $hint_file; | |
| if( !defined $ret ) { | |
| my $error = $@ || $!; | |
| print STDERR $error; | |
| } | |
| } | |
| sub mv_all_methods { | |
| my($from,$to) = @_; | |
| # Here you see the *current* list of methods that are overridable | |
| # from Makefile.PL via MY:: subroutines. As of VERSION 5.07 I'm | |
| # still trying to reduce the list to some reasonable minimum -- | |
| # because I want to make it easier for the user. A.K. | |
| local $SIG{__WARN__} = sub { | |
| # can't use 'no warnings redefined', 5.6 only | |
| warn @_ unless $_[0] =~ /^Subroutine .* redefined/ | |
| }; | |
| foreach my $method (@Overridable) { | |
| # We cannot say "next" here. Nick might call MY->makeaperl | |
| # which isn't defined right now | |
| # Above statement was written at 4.23 time when Tk-b8 was | |
| # around. As Tk-b9 only builds with 5.002something and MM 5 is | |
| # standard, we try to enable the next line again. It was | |
| # commented out until MM 5.23 | |
| next unless defined &{"${from}::$method"}; | |
| { | |
| no strict 'refs'; ## no critic | |
| *{"${to}::$method"} = \&{"${from}::$method"}; | |
| # If we delete a method, then it will be undefined and cannot | |
| # be called. But as long as we have Makefile.PLs that rely on | |
| # %MY:: being intact, we have to fill the hole with an | |
| # inheriting method: | |
| { | |
| package MY; | |
| my $super = "SUPER::".$method; | |
| *{$method} = sub { | |
| shift->$super(@_); | |
| }; | |
| } | |
| } | |
| } | |
| # We have to clean out %INC also, because the current directory is | |
| # changed frequently and Graham Barr prefers to get his version | |
| # out of a History.pl file which is "required" so woudn't get | |
| # loaded again in another extension requiring a History.pl | |
| # With perl5.002_01 the deletion of entries in %INC caused Tk-b11 | |
| # to core dump in the middle of a require statement. The required | |
| # file was Tk/MMutil.pm. The consequence is, we have to be | |
| # extremely careful when we try to give perl a reason to reload a | |
| # library with same name. The workaround prefers to drop nothing | |
| # from %INC and teach the writers not to use such libraries. | |
| # my $inc; | |
| # foreach $inc (keys %INC) { | |
| # #warn "***$inc*** deleted"; | |
| # delete $INC{$inc}; | |
| # } | |
| } | |
| sub skipcheck { | |
| my($self) = shift; | |
| my($section) = @_; | |
| if ($section eq 'dynamic') { | |
| print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ", | |
| "in skipped section 'dynamic_bs'\n" | |
| if $self->{SKIPHASH}{dynamic_bs} && $Verbose; | |
| print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ", | |
| "in skipped section 'dynamic_lib'\n" | |
| if $self->{SKIPHASH}{dynamic_lib} && $Verbose; | |
| } | |
| if ($section eq 'dynamic_lib') { | |
| print STDOUT "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on ", | |
| "targets in skipped section 'dynamic_bs'\n" | |
| if $self->{SKIPHASH}{dynamic_bs} && $Verbose; | |
| } | |
| if ($section eq 'static') { | |
| print STDOUT "Warning (non-fatal): Target 'static' depends on targets ", | |
| "in skipped section 'static_lib'\n" | |
| if $self->{SKIPHASH}{static_lib} && $Verbose; | |
| } | |
| return 'skipped' if $self->{SKIPHASH}{$section}; | |
| return ''; | |
| } | |
| sub flush { | |
| my $self = shift; | |
| my $finalname = $self->{MAKEFILE}; | |
| print STDOUT "Writing $finalname for $self->{NAME}\n"; | |
| unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ()); | |
| open(my $fh,">", "MakeMaker.tmp") | |
| or die "Unable to open MakeMaker.tmp: $!"; | |
| for my $chunk (@{$self->{RESULT}}) { | |
| print $fh "$chunk\n" | |
| or die "Can't write to MakeMaker.tmp: $!"; | |
| } | |
| close $fh | |
| or die "Can't write to MakeMaker.tmp: $!"; | |
| _rename("MakeMaker.tmp", $finalname) or | |
| warn "rename MakeMaker.tmp => $finalname: $!"; | |
| chmod 0644, $finalname unless $Is_VMS; | |
| unless ($self->{NO_MYMETA}) { | |
| # Write MYMETA.yml to communicate metadata up to the CPAN clients | |
| if ( $self->write_mymeta( $self->mymeta ) ) {; | |
| print STDOUT "Writing MYMETA.yml and MYMETA.json\n"; | |
| } | |
| } | |
| my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE); | |
| if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) { | |
| foreach (keys %$self) { # safe memory | |
| delete $self->{$_} unless $keep{$_}; | |
| } | |
| } | |
| system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":"; | |
| } | |
| # This is a rename for OS's where the target must be unlinked first. | |
| sub _rename { | |
| my($src, $dest) = @_; | |
| chmod 0666, $dest; | |
| unlink $dest; | |
| return rename $src, $dest; | |
| } | |
| # This is an unlink for OS's where the target must be writable first. | |
| sub _unlink { | |
| my @files = @_; | |
| chmod 0666, @files; | |
| return unlink @files; | |
| } | |
| # The following mkbootstrap() is only for installations that are calling | |
| # the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker | |
| # writes Makefiles, that use ExtUtils::Mkbootstrap directly. | |
| sub mkbootstrap { | |
| die <<END; | |
| !!! Your Makefile has been built such a long time ago, !!! | |
| !!! that is unlikely to work with current MakeMaker. !!! | |
| !!! Please rebuild your Makefile !!! | |
| END | |
| } | |
| # Ditto for mksymlists() as of MakeMaker 5.17 | |
| sub mksymlists { | |
| die <<END; | |
| !!! Your Makefile has been built such a long time ago, !!! | |
| !!! that is unlikely to work with current MakeMaker. !!! | |
| !!! Please rebuild your Makefile !!! | |
| END | |
| } | |
| sub neatvalue { | |
| my($v) = @_; | |
| return "undef" unless defined $v; | |
| my($t) = ref $v; | |
| return "q[$v]" unless $t; | |
| if ($t eq 'ARRAY') { | |
| my(@m, @neat); | |
| push @m, "["; | |
| foreach my $elem (@$v) { | |
| push @neat, "q[$elem]"; | |
| } | |
| push @m, join ", ", @neat; | |
| push @m, "]"; | |
| return join "", @m; | |
| } | |
| return "$v" unless $t eq 'HASH'; | |
| my(@m, $key, $val); | |
| while (($key,$val) = each %$v){ | |
| last unless defined $key; # cautious programming in case (undef,undef) is true | |
| push(@m,"$key=>".neatvalue($val)) ; | |
| } | |
| return "{ ".join(', ',@m)." }"; | |
| } | |
| # Look for weird version numbers, warn about them and set them to 0 | |
| # before CPAN::Meta chokes. | |
| sub clean_versions { | |
| my($self, $key) = @_; | |
| my $reqs = $self->{$key}; | |
| for my $module (keys %$reqs) { | |
| my $version = $reqs->{$module}; | |
| if( !defined $version or $version !~ /^[\d_\.]+$/ ) { | |
| carp "Unparsable version '$version' for prerequisite $module"; | |
| $reqs->{$module} = 0; | |
| } | |
| } | |
| } | |
| sub selfdocument { | |
| my($self) = @_; | |
| my(@m); | |
| if ($Verbose){ | |
| push @m, "\n# Full list of MakeMaker attribute values:"; | |
| foreach my $key (sort keys %$self){ | |
| next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/; | |
| my($v) = neatvalue($self->{$key}); | |
| $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; | |
| $v =~ tr/\n/ /s; | |
| push @m, "# $key => $v"; | |
| } | |
| } | |
| join "\n", @m; | |
| } | |
| 1; | |
| __END__ | |
| =head1 NAME | |
| ExtUtils::MakeMaker - Create a module Makefile | |
| =head1 SYNOPSIS | |
| use ExtUtils::MakeMaker; | |
| WriteMakefile( ATTRIBUTE => VALUE [, ...] ); | |
| =head1 DESCRIPTION | |
| This utility is designed to write a Makefile for an extension module | |
| from a Makefile.PL. It is based on the Makefile.SH model provided by | |
| Andy Dougherty and the perl5-porters. | |
| It splits the task of generating the Makefile into several subroutines | |
| that can be individually overridden. Each subroutine returns the text | |
| it wishes to have written to the Makefile. | |
| MakeMaker is object oriented. Each directory below the current | |
| directory that contains a Makefile.PL is treated as a separate | |
| object. This makes it possible to write an unlimited number of | |
| Makefiles with a single invocation of WriteMakefile(). | |
| =head2 How To Write A Makefile.PL | |
| See ExtUtils::MakeMaker::Tutorial. | |
| The long answer is the rest of the manpage :-) | |
| =head2 Default Makefile Behaviour | |
| The generated Makefile enables the user of the extension to invoke | |
| perl Makefile.PL # optionally "perl Makefile.PL verbose" | |
| make | |
| make test # optionally set TEST_VERBOSE=1 | |
| make install # See below | |
| The Makefile to be produced may be altered by adding arguments of the | |
| form C<KEY=VALUE>. E.g. | |
| perl Makefile.PL INSTALL_BASE=~ | |
| Other interesting targets in the generated Makefile are | |
| make config # to check if the Makefile is up-to-date | |
| make clean # delete local temp files (Makefile gets renamed) | |
| make realclean # delete derived files (including ./blib) | |
| make ci # check in all the files in the MANIFEST file | |
| make dist # see below the Distribution Support section | |
| =head2 make test | |
| MakeMaker checks for the existence of a file named F<test.pl> in the | |
| current directory and if it exists it execute the script with the | |
| proper set of perl C<-I> options. | |
| MakeMaker also checks for any files matching glob("t/*.t"). It will | |
| execute all matching files in alphabetical order via the | |
| L<Test::Harness> module with the C<-I> switches set correctly. | |
| If you'd like to see the raw output of your tests, set the | |
| C<TEST_VERBOSE> variable to true. | |
| make test TEST_VERBOSE=1 | |
| =head2 make testdb | |
| A useful variation of the above is the target C<testdb>. It runs the | |
| test under the Perl debugger (see L<perldebug>). If the file | |
| F<test.pl> exists in the current directory, it is used for the test. | |
| If you want to debug some other testfile, set the C<TEST_FILE> variable | |
| thusly: | |
| make testdb TEST_FILE=t/mytest.t | |
| By default the debugger is called using C<-d> option to perl. If you | |
| want to specify some other option, set the C<TESTDB_SW> variable: | |
| make testdb TESTDB_SW=-Dx | |
| =head2 make install | |
| make alone puts all relevant files into directories that are named by | |
| the macros INST_LIB, INST_ARCHLIB, INST_SCRIPT, INST_MAN1DIR and | |
| INST_MAN3DIR. All these default to something below ./blib if you are | |
| I<not> building below the perl source directory. If you I<are> | |
| building below the perl source, INST_LIB and INST_ARCHLIB default to | |
| ../../lib, and INST_SCRIPT is not defined. | |
| The I<install> target of the generated Makefile copies the files found | |
| below each of the INST_* directories to their INSTALL* | |
| counterparts. Which counterparts are chosen depends on the setting of | |
| INSTALLDIRS according to the following table: | |
| INSTALLDIRS set to | |
| perl site vendor | |
| PERLPREFIX SITEPREFIX VENDORPREFIX | |
| INST_ARCHLIB INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH | |
| INST_LIB INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB | |
| INST_BIN INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN | |
| INST_SCRIPT INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT | |
| INST_MAN1DIR INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR | |
| INST_MAN3DIR INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR | |
| The INSTALL... macros in turn default to their %Config | |
| ($Config{installprivlib}, $Config{installarchlib}, etc.) counterparts. | |
| You can check the values of these variables on your system with | |
| perl '-V:install.*' | |
| And to check the sequence in which the library directories are | |
| searched by perl, run | |
| perl -le 'print join $/, @INC' | |
| Sometimes older versions of the module you're installing live in other | |
| directories in @INC. Because Perl loads the first version of a module it | |
| finds, not the newest, you might accidentally get one of these older | |
| versions even after installing a brand new version. To delete I<all other | |
| versions of the module you're installing> (not simply older ones) set the | |
| C<UNINST> variable. | |
| make install UNINST=1 | |
| =head2 INSTALL_BASE | |
| INSTALL_BASE can be passed into Makefile.PL to change where your | |
| module will be installed. INSTALL_BASE is more like what everyone | |
| else calls "prefix" than PREFIX is. | |
| To have everything installed in your home directory, do the following. | |
| # Unix users, INSTALL_BASE=~ works fine | |
| perl Makefile.PL INSTALL_BASE=/path/to/your/home/dir | |
| Like PREFIX, it sets several INSTALL* attributes at once. Unlike | |
| PREFIX it is easy to predict where the module will end up. The | |
| installation pattern looks like this: | |
| INSTALLARCHLIB INSTALL_BASE/lib/perl5/$Config{archname} | |
| INSTALLPRIVLIB INSTALL_BASE/lib/perl5 | |
| INSTALLBIN INSTALL_BASE/bin | |
| INSTALLSCRIPT INSTALL_BASE/bin | |
| INSTALLMAN1DIR INSTALL_BASE/man/man1 | |
| INSTALLMAN3DIR INSTALL_BASE/man/man3 | |
| INSTALL_BASE in MakeMaker and C<--install_base> in Module::Build (as | |
| of 0.28) install to the same location. If you want MakeMaker and | |
| Module::Build to install to the same location simply set INSTALL_BASE | |
| and C<--install_base> to the same location. | |
| INSTALL_BASE was added in 6.31. | |
| =head2 PREFIX and LIB attribute | |
| PREFIX and LIB can be used to set several INSTALL* attributes in one | |
| go. Here's an example for installing into your home directory. | |
| # Unix users, PREFIX=~ works fine | |
| perl Makefile.PL PREFIX=/path/to/your/home/dir | |
| This will install all files in the module under your home directory, | |
| with man pages and libraries going into an appropriate place (usually | |
| ~/man and ~/lib). How the exact location is determined is complicated | |
| and depends on how your Perl was configured. INSTALL_BASE works more | |
| like what other build systems call "prefix" than PREFIX and we | |
| recommend you use that instead. | |
| Another way to specify many INSTALL directories with a single | |
| parameter is LIB. | |
| perl Makefile.PL LIB=~/lib | |
| This will install the module's architecture-independent files into | |
| ~/lib, the architecture-dependent files into ~/lib/$archname. | |
| Note, that in both cases the tilde expansion is done by MakeMaker, not | |
| by perl by default, nor by make. | |
| Conflicts between parameters LIB, PREFIX and the various INSTALL* | |
| arguments are resolved so that: | |
| =over 4 | |
| =item * | |
| setting LIB overrides any setting of INSTALLPRIVLIB, INSTALLARCHLIB, | |
| INSTALLSITELIB, INSTALLSITEARCH (and they are not affected by PREFIX); | |
| =item * | |
| without LIB, setting PREFIX replaces the initial C<$Config{prefix}> | |
| part of those INSTALL* arguments, even if the latter are explicitly | |
| set (but are set to still start with C<$Config{prefix}>). | |
| =back | |
| If the user has superuser privileges, and is not working on AFS or | |
| relatives, then the defaults for INSTALLPRIVLIB, INSTALLARCHLIB, | |
| INSTALLSCRIPT, etc. will be appropriate, and this incantation will be | |
| the best: | |
| perl Makefile.PL; | |
| make; | |
| make test | |
| make install | |
| make install per default writes some documentation of what has been | |
| done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This feature | |
| can be bypassed by calling make pure_install. | |
| =head2 AFS users | |
| will have to specify the installation directories as these most | |
| probably have changed since perl itself has been installed. They will | |
| have to do this by calling | |
| perl Makefile.PL INSTALLSITELIB=/afs/here/today \ | |
| INSTALLSCRIPT=/afs/there/now INSTALLMAN3DIR=/afs/for/manpages | |
| make | |
| Be careful to repeat this procedure every time you recompile an | |
| extension, unless you are sure the AFS installation directories are | |
| still valid. | |
| =head2 Static Linking of a new Perl Binary | |
| An extension that is built with the above steps is ready to use on | |
| systems supporting dynamic loading. On systems that do not support | |
| dynamic loading, any newly created extension has to be linked together | |
| with the available resources. MakeMaker supports the linking process | |
| by creating appropriate targets in the Makefile whenever an extension | |
| is built. You can invoke the corresponding section of the makefile with | |
| make perl | |
| That produces a new perl binary in the current directory with all | |
| extensions linked in that can be found in INST_ARCHLIB, SITELIBEXP, | |
| and PERL_ARCHLIB. To do that, MakeMaker writes a new Makefile, on | |
| UNIX, this is called Makefile.aperl (may be system dependent). If you | |
| want to force the creation of a new perl, it is recommended, that you | |
| delete this Makefile.aperl, so the directories are searched-through | |
| for linkable libraries again. | |
| The binary can be installed into the directory where perl normally | |
| resides on your machine with | |
| make inst_perl | |
| To produce a perl binary with a different name than C<perl>, either say | |
| perl Makefile.PL MAP_TARGET=myperl | |
| make myperl | |
| make inst_perl | |
| or say | |
| perl Makefile.PL | |
| make myperl MAP_TARGET=myperl | |
| make inst_perl MAP_TARGET=myperl | |
| In any case you will be prompted with the correct invocation of the | |
| C<inst_perl> target that installs the new binary into INSTALLBIN. | |
| make inst_perl per default writes some documentation of what has been | |
| done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This | |
| can be bypassed by calling make pure_inst_perl. | |
| Warning: the inst_perl: target will most probably overwrite your | |
| existing perl binary. Use with care! | |
| Sometimes you might want to build a statically linked perl although | |
| your system supports dynamic loading. In this case you may explicitly | |
| set the linktype with the invocation of the Makefile.PL or make: | |
| perl Makefile.PL LINKTYPE=static # recommended | |
| or | |
| make LINKTYPE=static # works on most systems | |
| =head2 Determination of Perl Library and Installation Locations | |
| MakeMaker needs to know, or to guess, where certain things are | |
| located. Especially INST_LIB and INST_ARCHLIB (where to put the files | |
| during the make(1) run), PERL_LIB and PERL_ARCHLIB (where to read | |
| existing modules from), and PERL_INC (header files and C<libperl*.*>). | |
| Extensions may be built either using the contents of the perl source | |
| directory tree or from the installed perl library. The recommended way | |
| is to build extensions after you have run 'make install' on perl | |
| itself. You can do that in any directory on your hard disk that is not | |
| below the perl source tree. The support for extensions below the ext | |
| directory of the perl distribution is only good for the standard | |
| extensions that come with perl. | |
| If an extension is being built below the C<ext/> directory of the perl | |
| source then MakeMaker will set PERL_SRC automatically (e.g., | |
| C<../..>). If PERL_SRC is defined and the extension is recognized as | |
| a standard extension, then other variables default to the following: | |
| PERL_INC = PERL_SRC | |
| PERL_LIB = PERL_SRC/lib | |
| PERL_ARCHLIB = PERL_SRC/lib | |
| INST_LIB = PERL_LIB | |
| INST_ARCHLIB = PERL_ARCHLIB | |
| If an extension is being built away from the perl source then MakeMaker | |
| will leave PERL_SRC undefined and default to using the installed copy | |
| of the perl library. The other variables default to the following: | |
| PERL_INC = $archlibexp/CORE | |
| PERL_LIB = $privlibexp | |
| PERL_ARCHLIB = $archlibexp | |
| INST_LIB = ./blib/lib | |
| INST_ARCHLIB = ./blib/arch | |
| If perl has not yet been installed then PERL_SRC can be defined on the | |
| command line as shown in the previous section. | |
| =head2 Which architecture dependent directory? | |
| If you don't want to keep the defaults for the INSTALL* macros, | |
| MakeMaker helps you to minimize the typing needed: the usual | |
| relationship between INSTALLPRIVLIB and INSTALLARCHLIB is determined | |
| by Configure at perl compilation time. MakeMaker supports the user who | |
| sets INSTALLPRIVLIB. If INSTALLPRIVLIB is set, but INSTALLARCHLIB not, | |
| then MakeMaker defaults the latter to be the same subdirectory of | |
| INSTALLPRIVLIB as Configure decided for the counterparts in %Config , | |
| otherwise it defaults to INSTALLPRIVLIB. The same relationship holds | |
| for INSTALLSITELIB and INSTALLSITEARCH. | |
| MakeMaker gives you much more freedom than needed to configure | |
| internal variables and get different results. It is worth to mention, | |
| that make(1) also lets you configure most of the variables that are | |
| used in the Makefile. But in the majority of situations this will not | |
| be necessary, and should only be done if the author of a package | |
| recommends it (or you know what you're doing). | |
| =head2 Using Attributes and Parameters | |
| The following attributes may be specified as arguments to WriteMakefile() | |
| or as NAME=VALUE pairs on the command line. | |
| =over 2 | |
| =item ABSTRACT | |
| One line description of the module. Will be included in PPD file. | |
| =item ABSTRACT_FROM | |
| Name of the file that contains the package description. MakeMaker looks | |
| for a line in the POD matching /^($package\s-\s)(.*)/. This is typically | |
| the first line in the "=head1 NAME" section. $2 becomes the abstract. | |
| =item AUTHOR | |
| Array of strings containing name (and email address) of package author(s). | |
| Is used in CPAN Meta files (META.yml or META.json) and PPD | |
| (Perl Package Description) files for PPM (Perl Package Manager). | |
| =item BINARY_LOCATION | |
| Used when creating PPD files for binary packages. It can be set to a | |
| full or relative path or URL to the binary archive for a particular | |
| architecture. For example: | |
| perl Makefile.PL BINARY_LOCATION=x86/Agent.tar.gz | |
| builds a PPD package that references a binary of the C<Agent> package, | |
| located in the C<x86> directory relative to the PPD itself. | |
| =item BUILD_REQUIRES | |
| A hash of modules that are needed to build your module but not run it. | |
| This will go into the C<build_requires> field of your CPAN Meta file. | |
| (F<META.yml> or F<META.json>). | |
| The format is the same as PREREQ_PM. | |
| =item C | |
| Ref to array of *.c file names. Initialised from a directory scan | |
| and the values portion of the XS attribute hash. This is not | |
| currently used by MakeMaker but may be handy in Makefile.PLs. | |
| =item CCFLAGS | |
| String that will be included in the compiler call command line between | |
| the arguments INC and OPTIMIZE. | |
| =item CONFIG | |
| Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from | |
| config.sh. MakeMaker will add to CONFIG the following values anyway: | |
| ar | |
| cc | |
| cccdlflags | |
| ccdlflags | |
| dlext | |
| dlsrc | |
| ld | |
| lddlflags | |
| ldflags | |
| libc | |
| lib_ext | |
| obj_ext | |
| ranlib | |
| sitelibexp | |
| sitearchexp | |
| so | |
| =item CONFIGURE | |
| CODE reference. The subroutine should return a hash reference. The | |
| hash may contain further attributes, e.g. {LIBS =E<gt> ...}, that have to | |
| be determined by some evaluation method. | |
| =item CONFIGURE_REQUIRES | |
| A hash of modules that are required to run Makefile.PL itself, but not | |
| to run your distribution. | |
| This will go into the C<configure_requires> field of your CPAN Meta file | |
| (F<META.yml> or F<META.json>) | |
| Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> | |
| The format is the same as PREREQ_PM. | |
| =item DEFINE | |
| Something like C<"-DHAVE_UNISTD_H"> | |
| =item DESTDIR | |
| This is the root directory into which the code will be installed. It | |
| I<prepends itself to the normal prefix>. For example, if your code | |
| would normally go into F</usr/local/lib/perl> you could set DESTDIR=~/tmp/ | |
| and installation would go into F<~/tmp/usr/local/lib/perl>. | |
| This is primarily of use for people who repackage Perl modules. | |
| NOTE: Due to the nature of make, it is important that you put the trailing | |
| slash on your DESTDIR. F<~/tmp/> not F<~/tmp>. | |
| =item DIR | |
| Ref to array of subdirectories containing Makefile.PLs e.g. ['sdbm'] | |
| in ext/SDBM_File | |
| =item DISTNAME | |
| A safe filename for the package. | |
| Defaults to NAME above but with :: replaced with -. | |
| For example, Foo::Bar becomes Foo-Bar. | |
| =item DISTVNAME | |
| Your name for distributing the package with the version number | |
| included. This is used by 'make dist' to name the resulting archive | |
| file. | |
| Defaults to DISTNAME-VERSION. | |
| For example, version 1.04 of Foo::Bar becomes Foo-Bar-1.04. | |
| On some OS's where . has special meaning VERSION_SYM may be used in | |
| place of VERSION. | |
| =item DL_FUNCS | |
| Hashref of symbol names for routines to be made available as universal | |
| symbols. Each key/value pair consists of the package name and an | |
| array of routine names in that package. Used only under AIX, OS/2, | |
| VMS and Win32 at present. The routine names supplied will be expanded | |
| in the same way as XSUB names are expanded by the XS() macro. | |
| Defaults to | |
| {"$(NAME)" => ["boot_$(NAME)" ] } | |
| e.g. | |
| {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )], | |
| "NetconfigPtr" => [ 'DESTROY'] } | |
| Please see the L<ExtUtils::Mksymlists> documentation for more information | |
| about the DL_FUNCS, DL_VARS and FUNCLIST attributes. | |
| =item DL_VARS | |
| Array of symbol names for variables to be made available as universal symbols. | |
| Used only under AIX, OS/2, VMS and Win32 at present. Defaults to []. | |
| (e.g. [ qw(Foo_version Foo_numstreams Foo_tree ) ]) | |
| =item EXCLUDE_EXT | |
| Array of extension names to exclude when doing a static build. This | |
| is ignored if INCLUDE_EXT is present. Consult INCLUDE_EXT for more | |
| details. (e.g. [ qw( Socket POSIX ) ] ) | |
| This attribute may be most useful when specified as a string on the | |
| command line: perl Makefile.PL EXCLUDE_EXT='Socket Safe' | |
| =item EXE_FILES | |
| Ref to array of executable files. The files will be copied to the | |
| INST_SCRIPT directory. Make realclean will delete them from there | |
| again. | |
| If your executables start with something like #!perl or | |
| #!/usr/bin/perl MakeMaker will change this to the path of the perl | |
| 'Makefile.PL' was invoked with so the programs will be sure to run | |
| properly even if perl is not in /usr/bin/perl. | |
| =item FIRST_MAKEFILE | |
| The name of the Makefile to be produced. This is used for the second | |
| Makefile that will be produced for the MAP_TARGET. | |
| Defaults to 'Makefile' or 'Descrip.MMS' on VMS. | |
| (Note: we couldn't use MAKEFILE because dmake uses this for something | |
| else). | |
| =item FULLPERL | |
| Perl binary able to run this extension, load XS modules, etc... | |
| =item FULLPERLRUN | |
| Like PERLRUN, except it uses FULLPERL. | |
| =item FULLPERLRUNINST | |
| Like PERLRUNINST, except it uses FULLPERL. | |
| =item FUNCLIST | |
| This provides an alternate means to specify function names to be | |
| exported from the extension. Its value is a reference to an | |
| array of function names to be exported by the extension. These | |
| names are passed through unaltered to the linker options file. | |
| =item H | |
| Ref to array of *.h file names. Similar to C. | |
| =item IMPORTS | |
| This attribute is used to specify names to be imported into the | |
| extension. Takes a hash ref. | |
| It is only used on OS/2 and Win32. | |
| =item INC | |
| Include file dirs eg: C<"-I/usr/5include -I/path/to/inc"> | |
| =item INCLUDE_EXT | |
| Array of extension names to be included when doing a static build. | |
| MakeMaker will normally build with all of the installed extensions when | |
| doing a static build, and that is usually the desired behavior. If | |
| INCLUDE_EXT is present then MakeMaker will build only with those extensions | |
| which are explicitly mentioned. (e.g. [ qw( Socket POSIX ) ]) | |
| It is not necessary to mention DynaLoader or the current extension when | |
| filling in INCLUDE_EXT. If the INCLUDE_EXT is mentioned but is empty then | |
| only DynaLoader and the current extension will be included in the build. | |
| This attribute may be most useful when specified as a string on the | |
| command line: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek' | |
| =item INSTALLARCHLIB | |
| Used by 'make install', which copies files from INST_ARCHLIB to this | |
| directory if INSTALLDIRS is set to perl. | |
| =item INSTALLBIN | |
| Directory to install binary files (e.g. tkperl) into if | |
| INSTALLDIRS=perl. | |
| =item INSTALLDIRS | |
| Determines which of the sets of installation directories to choose: | |
| perl, site or vendor. Defaults to site. | |
| =item INSTALLMAN1DIR | |
| =item INSTALLMAN3DIR | |
| These directories get the man pages at 'make install' time if | |
| INSTALLDIRS=perl. Defaults to $Config{installman*dir}. | |
| If set to 'none', no man pages will be installed. | |
| =item INSTALLPRIVLIB | |
| Used by 'make install', which copies files from INST_LIB to this | |
| directory if INSTALLDIRS is set to perl. | |
| Defaults to $Config{installprivlib}. | |
| =item INSTALLSCRIPT | |
| Used by 'make install' which copies files from INST_SCRIPT to this | |
| directory if INSTALLDIRS=perl. | |
| =item INSTALLSITEARCH | |
| Used by 'make install', which copies files from INST_ARCHLIB to this | |
| directory if INSTALLDIRS is set to site (default). | |
| =item INSTALLSITEBIN | |
| Used by 'make install', which copies files from INST_BIN to this | |
| directory if INSTALLDIRS is set to site (default). | |
| =item INSTALLSITELIB | |
| Used by 'make install', which copies files from INST_LIB to this | |
| directory if INSTALLDIRS is set to site (default). | |
| =item INSTALLSITEMAN1DIR | |
| =item INSTALLSITEMAN3DIR | |
| These directories get the man pages at 'make install' time if | |
| INSTALLDIRS=site (default). Defaults to | |
| $(SITEPREFIX)/man/man$(MAN*EXT). | |
| If set to 'none', no man pages will be installed. | |
| =item INSTALLSITESCRIPT | |
| Used by 'make install' which copies files from INST_SCRIPT to this | |
| directory if INSTALLDIRS is set to site (default). | |
| =item INSTALLVENDORARCH | |
| Used by 'make install', which copies files from INST_ARCHLIB to this | |
| directory if INSTALLDIRS is set to vendor. | |
| =item INSTALLVENDORBIN | |
| Used by 'make install', which copies files from INST_BIN to this | |
| directory if INSTALLDIRS is set to vendor. | |
| =item INSTALLVENDORLIB | |
| Used by 'make install', which copies files from INST_LIB to this | |
| directory if INSTALLDIRS is set to vendor. | |
| =item INSTALLVENDORMAN1DIR | |
| =item INSTALLVENDORMAN3DIR | |
| These directories get the man pages at 'make install' time if | |
| INSTALLDIRS=vendor. Defaults to $(VENDORPREFIX)/man/man$(MAN*EXT). | |
| If set to 'none', no man pages will be installed. | |
| =item INSTALLVENDORSCRIPT | |
| Used by 'make install' which copies files from INST_SCRIPT to this | |
| directory if INSTALLDIRS is set to vendor. | |
| =item INST_ARCHLIB | |
| Same as INST_LIB for architecture dependent files. | |
| =item INST_BIN | |
| Directory to put real binary files during 'make'. These will be copied | |
| to INSTALLBIN during 'make install' | |
| =item INST_LIB | |
| Directory where we put library files of this extension while building | |
| it. | |
| =item INST_MAN1DIR | |
| Directory to hold the man pages at 'make' time | |
| =item INST_MAN3DIR | |
| Directory to hold the man pages at 'make' time | |
| =item INST_SCRIPT | |
| Directory, where executable files should be installed during | |
| 'make'. Defaults to "./blib/script", just to have a dummy location during | |
| testing. make install will copy the files in INST_SCRIPT to | |
| INSTALLSCRIPT. | |
| =item LD | |
| Program to be used to link libraries for dynamic loading. | |
| Defaults to $Config{ld}. | |
| =item LDDLFLAGS | |
| Any special flags that might need to be passed to ld to create a | |
| shared library suitable for dynamic loading. It is up to the makefile | |
| to use it. (See L<Config/lddlflags>) | |
| Defaults to $Config{lddlflags}. | |
| =item LDFROM | |
| Defaults to "$(OBJECT)" and is used in the ld command to specify | |
| what files to link/load from (also see dynamic_lib below for how to | |
| specify ld flags) | |
| =item LIB | |
| LIB should only be set at C<perl Makefile.PL> time but is allowed as a | |
| MakeMaker argument. It has the effect of setting both INSTALLPRIVLIB | |
| and INSTALLSITELIB to that value regardless any explicit setting of | |
| those arguments (or of PREFIX). INSTALLARCHLIB and INSTALLSITEARCH | |
| are set to the corresponding architecture subdirectory. | |
| =item LIBPERL_A | |
| The filename of the perllibrary that will be used together with this | |
| extension. Defaults to libperl.a. | |
| =item LIBS | |
| An anonymous array of alternative library | |
| specifications to be searched for (in order) until | |
| at least one library is found. E.g. | |
| 'LIBS' => ["-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs"] | |
| Mind, that any element of the array | |
| contains a complete set of arguments for the ld | |
| command. So do not specify | |
| 'LIBS' => ["-ltcl", "-ltk", "-lX11"] | |
| See ODBM_File/Makefile.PL for an example, where an array is needed. If | |
| you specify a scalar as in | |
| 'LIBS' => "-ltcl -ltk -lX11" | |
| MakeMaker will turn it into an array with one element. | |
| =item LICENSE | |
| The licensing terms of your distribution. Generally its "perl" for the | |
| same license as Perl itself. | |
| See L<Module::Build::API> for the list of options. | |
| Defaults to "unknown". | |
| =item LINKTYPE | |
| 'static' or 'dynamic' (default unless usedl=undef in | |
| config.sh). Should only be used to force static linking (also see | |
| linkext below). | |
| =item MAKE | |
| Variant of make you intend to run the generated Makefile with. This | |
| parameter lets Makefile.PL know what make quirks to account for when | |
| generating the Makefile. | |
| MakeMaker also honors the MAKE environment variable. This parameter | |
| takes precedent. | |
| Currently the only significant values are 'dmake' and 'nmake' for Windows | |
| users. | |
| Defaults to $Config{make}. | |
| =item MAKEAPERL | |
| Boolean which tells MakeMaker, that it should include the rules to | |
| make a perl. This is handled automatically as a switch by | |
| MakeMaker. The user normally does not need it. | |
| =item MAKEFILE_OLD | |
| When 'make clean' or similar is run, the $(FIRST_MAKEFILE) will be | |
| backed up at this location. | |
| Defaults to $(FIRST_MAKEFILE).old or $(FIRST_MAKEFILE)_old on VMS. | |
| =item MAN1PODS | |
| Hashref of pod-containing files. MakeMaker will default this to all | |
| EXE_FILES files that include POD directives. The files listed | |
| here will be converted to man pages and installed as was requested | |
| at Configure time. | |
| This hash should map POD files (or scripts containing POD) to the | |
| man file names under the C<blib/man1/> directory, as in the following | |
| example: | |
| MAN1PODS => { | |
| 'doc/command.pod' => 'blib/man1/command.1', | |
| 'scripts/script.pl' => 'blib/man1/script.1', | |
| } | |
| =item MAN3PODS | |
| Hashref that assigns to *.pm and *.pod files the files into which the | |
| manpages are to be written. MakeMaker parses all *.pod and *.pm files | |
| for POD directives. Files that contain POD will be the default keys of | |
| the MAN3PODS hashref. These will then be converted to man pages during | |
| C<make> and will be installed during C<make install>. | |
| Example similar to MAN1PODS. | |
| =item MAP_TARGET | |
| If it is intended, that a new perl binary be produced, this variable | |
| may hold a name for that binary. Defaults to perl | |
| =item META_ADD | |
| =item META_MERGE | |
| A hashrefs of items to add to the CPAN Meta file (F<META.yml> or | |
| F<META.json>). | |
| They differ in how they behave if they have the same key as the | |
| default metadata. META_ADD will override the default value with its | |
| own. META_MERGE will merge its value with the default. | |
| Unless you want to override the defaults, prefer META_MERGE so as to | |
| get the advantage of any future defaults. | |
| =item MIN_PERL_VERSION | |
| The minimum required version of Perl for this distribution. | |
| Either 5.006001 or 5.6.1 format is acceptable. | |
| =item MYEXTLIB | |
| If the extension links to a library that it builds set this to the | |
| name of the library (see SDBM_File) | |
| =item NAME | |
| Perl module name for this extension (DBD::Oracle). This will default | |
| to the directory name but should be explicitly defined in the | |
| Makefile.PL. | |
| =item NEEDS_LINKING | |
| MakeMaker will figure out if an extension contains linkable code | |
| anywhere down the directory tree, and will set this variable | |
| accordingly, but you can speed it up a very little bit if you define | |
| this boolean variable yourself. | |
| =item NOECHO | |
| Command so make does not print the literal commands its running. | |
| By setting it to an empty string you can generate a Makefile that | |
| prints all commands. Mainly used in debugging MakeMaker itself. | |
| Defaults to C<@>. | |
| =item NORECURS | |
| Boolean. Attribute to inhibit descending into subdirectories. | |
| =item NO_META | |
| When true, suppresses the generation and addition to the MANIFEST of | |
| the META.yml and META.json module meta-data files during 'make distdir'. | |
| Defaults to false. | |
| =item NO_MYMETA | |
| When true, suppresses the generation of MYMETA.yml and MYMETA.json module | |
| meta-data files during 'perl Makefile.PL'. | |
| Defaults to false. | |
| =item NO_VC | |
| In general, any generated Makefile checks for the current version of | |
| MakeMaker and the version the Makefile was built under. If NO_VC is | |
| set, the version check is neglected. Do not write this into your | |
| Makefile.PL, use it interactively instead. | |
| =item OBJECT | |
| List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long | |
| string containing all object files, e.g. "tkpBind.o | |
| tkpButton.o tkpCanvas.o" | |
| (Where BASEEXT is the last component of NAME, and OBJ_EXT is $Config{obj_ext}.) | |
| =item OPTIMIZE | |
| Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is | |
| passed to subdirectory makes. | |
| =item PERL | |
| Perl binary for tasks that can be done by miniperl | |
| =item PERL_CORE | |
| Set only when MakeMaker is building the extensions of the Perl core | |
| distribution. | |
| =item PERLMAINCC | |
| The call to the program that is able to compile perlmain.c. Defaults | |
| to $(CC). | |
| =item PERL_ARCHLIB | |
| Same as for PERL_LIB, but for architecture dependent files. | |
| Used only when MakeMaker is building the extensions of the Perl core | |
| distribution (because normally $(PERL_ARCHLIB) is automatically in @INC, | |
| and adding it would get in the way of PERL5LIB). | |
| =item PERL_LIB | |
| Directory containing the Perl library to use. | |
| Used only when MakeMaker is building the extensions of the Perl core | |
| distribution (because normally $(PERL_LIB) is automatically in @INC, | |
| and adding it would get in the way of PERL5LIB). | |
| =item PERL_MALLOC_OK | |
| defaults to 0. Should be set to TRUE if the extension can work with | |
| the memory allocation routines substituted by the Perl malloc() subsystem. | |
| This should be applicable to most extensions with exceptions of those | |
| =over 4 | |
| =item * | |
| with bugs in memory allocations which are caught by Perl's malloc(); | |
| =item * | |
| which interact with the memory allocator in other ways than via | |
| malloc(), realloc(), free(), calloc(), sbrk() and brk(); | |
| =item * | |
| which rely on special alignment which is not provided by Perl's malloc(). | |
| =back | |
| B<NOTE.> Negligence to set this flag in I<any one> of loaded extension | |
| nullifies many advantages of Perl's malloc(), such as better usage of | |
| system resources, error detection, memory usage reporting, catchable failure | |
| of memory allocations, etc. | |
| =item PERLPREFIX | |
| Directory under which core modules are to be installed. | |
| Defaults to $Config{installprefixexp} falling back to | |
| $Config{installprefix}, $Config{prefixexp} or $Config{prefix} should | |
| $Config{installprefixexp} not exist. | |
| Overridden by PREFIX. | |
| =item PERLRUN | |
| Use this instead of $(PERL) when you wish to run perl. It will set up | |
| extra necessary flags for you. | |
| =item PERLRUNINST | |
| Use this instead of $(PERL) when you wish to run perl to work with | |
| modules. It will add things like -I$(INST_ARCH) and other necessary | |
| flags so perl can see the modules you're about to install. | |
| =item PERL_SRC | |
| Directory containing the Perl source code (use of this should be | |
| avoided, it may be undefined) | |
| =item PERM_DIR | |
| Desired permission for directories. Defaults to C<755>. | |
| =item PERM_RW | |
| Desired permission for read/writable files. Defaults to C<644>. | |
| =item PERM_RWX | |
| Desired permission for executable files. Defaults to C<755>. | |
| =item PL_FILES | |
| MakeMaker can run programs to generate files for you at build time. | |
| By default any file named *.PL (except Makefile.PL and Build.PL) in | |
| the top level directory will be assumed to be a Perl program and run | |
| passing its own basename in as an argument. For example... | |
| perl foo.PL foo | |
| This behavior can be overridden by supplying your own set of files to | |
| search. PL_FILES accepts a hash ref, the key being the file to run | |
| and the value is passed in as the first argument when the PL file is run. | |
| PL_FILES => {'bin/foobar.PL' => 'bin/foobar'} | |
| Would run bin/foobar.PL like this: | |
| perl bin/foobar.PL bin/foobar | |
| If multiple files from one program are desired an array ref can be used. | |
| PL_FILES => {'bin/foobar.PL' => [qw(bin/foobar1 bin/foobar2)]} | |
| In this case the program will be run multiple times using each target file. | |
| perl bin/foobar.PL bin/foobar1 | |
| perl bin/foobar.PL bin/foobar2 | |
| PL files are normally run B<after> pm_to_blib and include INST_LIB and | |
| INST_ARCH in its C<@INC> so the just built modules can be | |
| accessed... unless the PL file is making a module (or anything else in | |
| PM) in which case it is run B<before> pm_to_blib and does not include | |
| INST_LIB and INST_ARCH in its C<@INC>. This apparently odd behavior | |
| is there for backwards compatibility (and its somewhat DWIM). | |
| =item PM | |
| Hashref of .pm files and *.pl files to be installed. e.g. | |
| {'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'} | |
| By default this will include *.pm and *.pl and the files found in | |
| the PMLIBDIRS directories. Defining PM in the | |
| Makefile.PL will override PMLIBDIRS. | |
| =item PMLIBDIRS | |
| Ref to array of subdirectories containing library files. Defaults to | |
| [ 'lib', $(BASEEXT) ]. The directories will be scanned and I<any> files | |
| they contain will be installed in the corresponding location in the | |
| library. A libscan() method can be used to alter the behaviour. | |
| Defining PM in the Makefile.PL will override PMLIBDIRS. | |
| (Where BASEEXT is the last component of NAME.) | |
| =item PM_FILTER | |
| A filter program, in the traditional Unix sense (input from stdin, output | |
| to stdout) that is passed on each .pm file during the build (in the | |
| pm_to_blib() phase). It is empty by default, meaning no filtering is done. | |
| Great care is necessary when defining the command if quoting needs to be | |
| done. For instance, you would need to say: | |
| {'PM_FILTER' => 'grep -v \\"^\\#\\"'} | |
| to remove all the leading comments on the fly during the build. The | |
| extra \\ are necessary, unfortunately, because this variable is interpolated | |
| within the context of a Perl program built on the command line, and double | |
| quotes are what is used with the -e switch to build that command line. The | |
| # is escaped for the Makefile, since what is going to be generated will then | |
| be: | |
| PM_FILTER = grep -v \"^\#\" | |
| Without the \\ before the #, we'd have the start of a Makefile comment, | |
| and the macro would be incorrectly defined. | |
| =item POLLUTE | |
| Release 5.005 grandfathered old global symbol names by providing preprocessor | |
| macros for extension source compatibility. As of release 5.6, these | |
| preprocessor definitions are not available by default. The POLLUTE flag | |
| specifies that the old names should still be defined: | |
| perl Makefile.PL POLLUTE=1 | |
| Please inform the module author if this is necessary to successfully install | |
| a module under 5.6 or later. | |
| =item PPM_INSTALL_EXEC | |
| Name of the executable used to run C<PPM_INSTALL_SCRIPT> below. (e.g. perl) | |
| =item PPM_INSTALL_SCRIPT | |
| Name of the script that gets executed by the Perl Package Manager after | |
| the installation of a package. | |
| =item PREFIX | |
| This overrides all the default install locations. Man pages, | |
| libraries, scripts, etc... MakeMaker will try to make an educated | |
| guess about where to place things under the new PREFIX based on your | |
| Config defaults. Failing that, it will fall back to a structure | |
| which should be sensible for your platform. | |
| If you specify LIB or any INSTALL* variables they will not be effected | |
| by the PREFIX. | |
| =item PREREQ_FATAL | |
| Bool. If this parameter is true, failing to have the required modules | |
| (or the right versions thereof) will be fatal. C<perl Makefile.PL> | |
| will C<die> instead of simply informing the user of the missing dependencies. | |
| It is I<extremely> rare to have to use C<PREREQ_FATAL>. Its use by module | |
| authors is I<strongly discouraged> and should never be used lightly. | |
| Module installation tools have ways of resolving umet dependencies but | |
| to do that they need a F<Makefile>. Using C<PREREQ_FATAL> breaks this. | |
| That's bad. | |
| Assuming you have good test coverage, your tests should fail with | |
| missing dependencies informing the user more strongly that something | |
| is wrong. You can write a F<t/00compile.t> test which will simply | |
| check that your code compiles and stop "make test" prematurely if it | |
| doesn't. See L<Test::More/BAIL_OUT> for more details. | |
| =item PREREQ_PM | |
| A hash of modules that are needed to run your module. The keys are | |
| the module names ie. Test::More, and the minimum version is the | |
| value. If the required version number is 0 any version will do. | |
| This will go into the C<requires> field of your CPAN Meta file | |
| (F<META.yml> or F<META.json>). | |
| PREREQ_PM => { | |
| # Require Test::More at least 0.47 | |
| "Test::More" => "0.47", | |
| # Require any version of Acme::Buffy | |
| "Acme::Buffy" => 0, | |
| } | |
| =item PREREQ_PRINT | |
| Bool. If this parameter is true, the prerequisites will be printed to | |
| stdout and MakeMaker will exit. The output format is an evalable hash | |
| ref. | |
| $PREREQ_PM = { | |
| 'A::B' => Vers1, | |
| 'C::D' => Vers2, | |
| ... | |
| }; | |
| If a distribution defines a minimal required perl version, this is | |
| added to the output as an additional line of the form: | |
| $MIN_PERL_VERSION = '5.008001'; | |
| If BUILD_REQUIRES is not empty, it will be dumped as $BUILD_REQUIRES hasref. | |
| =item PRINT_PREREQ | |
| RedHatism for C<PREREQ_PRINT>. The output format is different, though: | |
| perl(A::B)>=Vers1 perl(C::D)>=Vers2 ... | |
| A minimal required perl version, if present, will look like this: | |
| perl(perl)>=5.008001 | |
| =item SITEPREFIX | |
| Like PERLPREFIX, but only for the site install locations. | |
| Defaults to $Config{siteprefixexp}. Perls prior to 5.6.0 didn't have | |
| an explicit siteprefix in the Config. In those cases | |
| $Config{installprefix} will be used. | |
| Overridable by PREFIX | |
| =item SIGN | |
| When true, perform the generation and addition to the MANIFEST of the | |
| SIGNATURE file in the distdir during 'make distdir', via 'cpansign | |
| -s'. | |
| Note that you need to install the Module::Signature module to | |
| perform this operation. | |
| Defaults to false. | |
| =item SKIP | |
| Arrayref. E.g. [qw(name1 name2)] skip (do not write) sections of the | |
| Makefile. Caution! Do not use the SKIP attribute for the negligible | |
| speedup. It may seriously damage the resulting Makefile. Only use it | |
| if you really need it. | |
| =item TYPEMAPS | |
| Ref to array of typemap file names. Use this when the typemaps are | |
| in some directory other than the current directory or when they are | |
| not named B<typemap>. The last typemap in the list takes | |
| precedence. A typemap in the current directory has highest | |
| precedence, even if it isn't listed in TYPEMAPS. The default system | |
| typemap has lowest precedence. | |
| =item VENDORPREFIX | |
| Like PERLPREFIX, but only for the vendor install locations. | |
| Defaults to $Config{vendorprefixexp}. | |
| Overridable by PREFIX | |
| =item VERBINST | |
| If true, make install will be verbose | |
| =item VERSION | |
| Your version number for distributing the package. This defaults to | |
| 0.1. | |
| =item VERSION_FROM | |
| Instead of specifying the VERSION in the Makefile.PL you can let | |
| MakeMaker parse a file to determine the version number. The parsing | |
| routine requires that the file named by VERSION_FROM contains one | |
| single line to compute the version number. The first line in the file | |
| that contains something like a $VERSION assignment or C<package Name | |
| VERSION> will be used. The following lines will be parsed o.k.: | |
| # Good | |
| package Foo::Bar 1.23; # 1.23 | |
| $VERSION = '1.00'; # 1.00 | |
| *VERSION = \'1.01'; # 1.01 | |
| ($VERSION) = q$Revision$ =~ /(\d+)/g; # The digits in $Revision$ | |
| $FOO::VERSION = '1.10'; # 1.10 | |
| *FOO::VERSION = \'1.11'; # 1.11 | |
| but these will fail: | |
| # Bad | |
| my $VERSION = '1.01'; | |
| local $VERSION = '1.02'; | |
| local $FOO::VERSION = '1.30'; | |
| "Version strings" are incompatible should not be used. | |
| # Bad | |
| $VERSION = 1.2.3; | |
| $VERSION = v1.2.3; | |
| L<version> objects are fine. As of MakeMaker 6.35 version.pm will be | |
| automatically loaded, but you must declare the dependency on version.pm. | |
| For compatibility with older MakeMaker you should load on the same line | |
| as $VERSION is declared. | |
| # All on one line | |
| use version; our $VERSION = qv(1.2.3); | |
| (Putting C<my> or C<local> on the preceding line will work o.k.) | |
| The file named in VERSION_FROM is not added as a dependency to | |
| Makefile. This is not really correct, but it would be a major pain | |
| during development to have to rewrite the Makefile for any smallish | |
| change in that file. If you want to make sure that the Makefile | |
| contains the correct VERSION macro after any change of the file, you | |
| would have to do something like | |
| depend => { Makefile => '$(VERSION_FROM)' } | |
| See attribute C<depend> below. | |
| =item VERSION_SYM | |
| A sanitized VERSION with . replaced by _. For places where . has | |
| special meaning (some filesystems, RCS labels, etc...) | |
| =item XS | |
| Hashref of .xs files. MakeMaker will default this. e.g. | |
| {'name_of_file.xs' => 'name_of_file.c'} | |
| The .c files will automatically be included in the list of files | |
| deleted by a make clean. | |
| =item XSOPT | |
| String of options to pass to xsubpp. This might include C<-C++> or | |
| C<-extern>. Do not include typemaps here; the TYPEMAP parameter exists for | |
| that purpose. | |
| =item XSPROTOARG | |
| May be set to an empty string, which is identical to C<-prototypes>, or | |
| C<-noprototypes>. See the xsubpp documentation for details. MakeMaker | |
| defaults to the empty string. | |
| =item XS_VERSION | |
| Your version number for the .xs file of this package. This defaults | |
| to the value of the VERSION attribute. | |
| =back | |
| =head2 Additional lowercase attributes | |
| can be used to pass parameters to the methods which implement that | |
| part of the Makefile. Parameters are specified as a hash ref but are | |
| passed to the method as a hash. | |
| =over 2 | |
| =item clean | |
| {FILES => "*.xyz foo"} | |
| =item depend | |
| {ANY_TARGET => ANY_DEPENDENCY, ...} | |
| (ANY_TARGET must not be given a double-colon rule by MakeMaker.) | |
| =item dist | |
| {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => '.gz', | |
| SHAR => 'shar -m', DIST_CP => 'ln', ZIP => '/bin/zip', | |
| ZIPFLAGS => '-rl', DIST_DEFAULT => 'private tardist' } | |
| If you specify COMPRESS, then SUFFIX should also be altered, as it is | |
| needed to tell make the target file of the compression. Setting | |
| DIST_CP to ln can be useful, if you need to preserve the timestamps on | |
| your files. DIST_CP can take the values 'cp', which copies the file, | |
| 'ln', which links the file, and 'best' which copies symbolic links and | |
| links the rest. Default is 'best'. | |
| =item dynamic_lib | |
| {ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'} | |
| =item linkext | |
| {LINKTYPE => 'static', 'dynamic' or ''} | |
| NB: Extensions that have nothing but *.pm files had to say | |
| {LINKTYPE => ''} | |
| with Pre-5.0 MakeMakers. Since version 5.00 of MakeMaker such a line | |
| can be deleted safely. MakeMaker recognizes when there's nothing to | |
| be linked. | |
| =item macro | |
| {ANY_MACRO => ANY_VALUE, ...} | |
| =item postamble | |
| Anything put here will be passed to MY::postamble() if you have one. | |
| =item realclean | |
| {FILES => '$(INST_ARCHAUTODIR)/*.xyz'} | |
| =item test | |
| {TESTS => 't/*.t'} | |
| =item tool_autosplit | |
| {MAXLEN => 8} | |
| =back | |
| =head2 Overriding MakeMaker Methods | |
| If you cannot achieve the desired Makefile behaviour by specifying | |
| attributes you may define private subroutines in the Makefile.PL. | |
| Each subroutine returns the text it wishes to have written to | |
| the Makefile. To override a section of the Makefile you can | |
| either say: | |
| sub MY::c_o { "new literal text" } | |
| or you can edit the default by saying something like: | |
| package MY; # so that "SUPER" works right | |
| sub c_o { | |
| my $inherited = shift->SUPER::c_o(@_); | |
| $inherited =~ s/old text/new text/; | |
| $inherited; | |
| } | |
| If you are running experiments with embedding perl as a library into | |
| other applications, you might find MakeMaker is not sufficient. You'd | |
| better have a look at ExtUtils::Embed which is a collection of utilities | |
| for embedding. | |
| If you still need a different solution, try to develop another | |
| subroutine that fits your needs and submit the diffs to | |
| C<[email protected]> | |
| For a complete description of all MakeMaker methods see | |
| L<ExtUtils::MM_Unix>. | |
| Here is a simple example of how to add a new target to the generated | |
| Makefile: | |
| sub MY::postamble { | |
| return <<'MAKE_FRAG'; | |
| $(MYEXTLIB): sdbm/Makefile | |
| cd sdbm && $(MAKE) all | |
| MAKE_FRAG | |
| } | |
| =head2 The End Of Cargo Cult Programming | |
| WriteMakefile() now does some basic sanity checks on its parameters to | |
| protect against typos and malformatted values. This means some things | |
| which happened to work in the past will now throw warnings and | |
| possibly produce internal errors. | |
| Some of the most common mistakes: | |
| =over 2 | |
| =item C<< MAN3PODS => ' ' >> | |
| This is commonly used to suppress the creation of man pages. MAN3PODS | |
| takes a hash ref not a string, but the above worked by accident in old | |
| versions of MakeMaker. | |
| The correct code is C<< MAN3PODS => { } >>. | |
| =back | |
| =head2 Hintsfile support | |
| MakeMaker.pm uses the architecture specific information from | |
| Config.pm. In addition it evaluates architecture specific hints files | |
| in a C<hints/> directory. The hints files are expected to be named | |
| like their counterparts in C<PERL_SRC/hints>, but with an C<.pl> file | |
| name extension (eg. C<next_3_2.pl>). They are simply C<eval>ed by | |
| MakeMaker within the WriteMakefile() subroutine, and can be used to | |
| execute commands as well as to include special variables. The rules | |
| which hintsfile is chosen are the same as in Configure. | |
| The hintsfile is eval()ed immediately after the arguments given to | |
| WriteMakefile are stuffed into a hash reference $self but before this | |
| reference becomes blessed. So if you want to do the equivalent to | |
| override or create an attribute you would say something like | |
| $self->{LIBS} = ['-ldbm -lucb -lc']; | |
| =head2 Distribution Support | |
| For authors of extensions MakeMaker provides several Makefile | |
| targets. Most of the support comes from the ExtUtils::Manifest module, | |
| where additional documentation can be found. | |
| =over 4 | |
| =item make distcheck | |
| reports which files are below the build directory but not in the | |
| MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for | |
| details) | |
| =item make skipcheck | |
| reports which files are skipped due to the entries in the | |
| C<MANIFEST.SKIP> file (See ExtUtils::Manifest::skipcheck() for | |
| details) | |
| =item make distclean | |
| does a realclean first and then the distcheck. Note that this is not | |
| needed to build a new distribution as long as you are sure that the | |
| MANIFEST file is ok. | |
| =item make manifest | |
| rewrites the MANIFEST file, adding all remaining files found (See | |
| ExtUtils::Manifest::mkmanifest() for details) | |
| =item make distdir | |
| Copies all the files that are in the MANIFEST file to a newly created | |
| directory with the name C<$(DISTNAME)-$(VERSION)>. If that directory | |
| exists, it will be removed first. | |
| Additionally, it will create META.yml and META.json module meta-data file | |
| in the distdir and add this to the distdir's MANIFEST. You can shut this | |
| behavior off with the NO_META flag. | |
| =item make disttest | |
| Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and | |
| a make test in that directory. | |
| =item make tardist | |
| First does a distdir. Then a command $(PREOP) which defaults to a null | |
| command, followed by $(TO_UNIX), which defaults to a null command under | |
| UNIX, and will convert files in distribution directory to UNIX format | |
| otherwise. Next it runs C<tar> on that directory into a tarfile and | |
| deletes the directory. Finishes with a command $(POSTOP) which | |
| defaults to a null command. | |
| =item make dist | |
| Defaults to $(DIST_DEFAULT) which in turn defaults to tardist. | |
| =item make uutardist | |
| Runs a tardist first and uuencodes the tarfile. | |
| =item make shdist | |
| First does a distdir. Then a command $(PREOP) which defaults to a null | |
| command. Next it runs C<shar> on that directory into a sharfile and | |
| deletes the intermediate directory again. Finishes with a command | |
| $(POSTOP) which defaults to a null command. Note: For shdist to work | |
| properly a C<shar> program that can handle directories is mandatory. | |
| =item make zipdist | |
| First does a distdir. Then a command $(PREOP) which defaults to a null | |
| command. Runs C<$(ZIP) $(ZIPFLAGS)> on that directory into a | |
| zipfile. Then deletes that directory. Finishes with a command | |
| $(POSTOP) which defaults to a null command. | |
| =item make ci | |
| Does a $(CI) and a $(RCS_LABEL) on all files in the MANIFEST file. | |
| =back | |
| Customization of the dist targets can be done by specifying a hash | |
| reference to the dist attribute of the WriteMakefile call. The | |
| following parameters are recognized: | |
| CI ('ci -u') | |
| COMPRESS ('gzip --best') | |
| POSTOP ('@ :') | |
| PREOP ('@ :') | |
| TO_UNIX (depends on the system) | |
| RCS_LABEL ('rcs -q -Nv$(VERSION_SYM):') | |
| SHAR ('shar') | |
| SUFFIX ('.gz') | |
| TAR ('tar') | |
| TARFLAGS ('cvf') | |
| ZIP ('zip') | |
| ZIPFLAGS ('-r') | |
| An example: | |
| WriteMakefile( | |
| ...other options... | |
| dist => { | |
| COMPRESS => "bzip2", | |
| SUFFIX => ".bz2" | |
| } | |
| ); | |
| =head2 Module Meta-Data (META and MYMETA) | |
| Long plaguing users of MakeMaker based modules has been the problem of | |
| getting basic information about the module out of the sources | |
| I<without> running the F<Makefile.PL> and doing a bunch of messy | |
| heuristics on the resulting F<Makefile>. Over the years, it has become | |
| standard to keep this information in one or more CPAN Meta files | |
| distributed with each distribution. | |
| The original format of CPAN Meta files was L<YAML> and the corresponding | |
| file was called F<META.yml>. In 2010, version 2 of the L<CPAN::Meta::Spec> | |
| was released, which mandates JSON format for the metadata in order to | |
| overcome certain compatibility issues between YAML serializers and to | |
| avoid breaking older clients unable to handle a new version of the spec. | |
| The L<CPAN::Meta> library is now standard for accessing old and new-style | |
| Meta files. | |
| If L<CPAN::Meta> is installed, MakeMaker will automatically generate | |
| F<META.json> and F<META.yml> files for you and add them to your F<MANIFEST> as | |
| part of the 'distdir' target (and thus the 'dist' target). This is intended to | |
| seamlessly and rapidly populate CPAN with module meta-data. If you wish to | |
| shut this feature off, set the C<NO_META> C<WriteMakefile()> flag to true. | |
| At the 2008 QA Hackathon in Oslo, Perl module toolchain maintainers agrees | |
| to use the CPAN Meta format to communicate post-configuration requirements | |
| between toolchain components. These files, F<MYMETA.json> and F<MYMETA.yml>, | |
| are generated when F<Makefile.PL> generates a F<Makefile> (if L<CPAN::Meta> | |
| is installed). Clients like L<CPAN> or L<CPANPLUS> will read this | |
| files to see what prerequisites must be fulfilled before building or testing | |
| the distribution. If you with to shut this feature off, set the C<NO_MYMETA> | |
| C<WriteMakeFile()> flag to true. | |
| =head2 Disabling an extension | |
| If some events detected in F<Makefile.PL> imply that there is no way | |
| to create the Module, but this is a normal state of things, then you | |
| can create a F<Makefile> which does nothing, but succeeds on all the | |
| "usual" build targets. To do so, use | |
| use ExtUtils::MakeMaker qw(WriteEmptyMakefile); | |
| WriteEmptyMakefile(); | |
| instead of WriteMakefile(). | |
| This may be useful if other modules expect this module to be I<built> | |
| OK, as opposed to I<work> OK (say, this system-dependent module builds | |
| in a subdirectory of some other distribution, or is listed as a | |
| dependency in a CPAN::Bundle, but the functionality is supported by | |
| different means on the current architecture). | |
| =head2 Other Handy Functions | |
| =over 4 | |
| =item prompt | |
| my $value = prompt($message); | |
| my $value = prompt($message, $default); | |
| The C<prompt()> function provides an easy way to request user input | |
| used to write a makefile. It displays the $message as a prompt for | |
| input. If a $default is provided it will be used as a default. The | |
| function returns the $value selected by the user. | |
| If C<prompt()> detects that it is not running interactively and there | |
| is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable | |
| is set to true, the $default will be used without prompting. This | |
| prevents automated processes from blocking on user input. | |
| If no $default is provided an empty string will be used instead. | |
| =back | |
| =head1 ENVIRONMENT | |
| =over 4 | |
| =item PERL_MM_OPT | |
| Command line options used by C<MakeMaker-E<gt>new()>, and thus by | |
| C<WriteMakefile()>. The string is split on whitespace, and the result | |
| is processed before any actual command line arguments are processed. | |
| =item PERL_MM_USE_DEFAULT | |
| If set to a true value then MakeMaker's prompt function will | |
| always return the default without waiting for user input. | |
| =item PERL_CORE | |
| Same as the PERL_CORE parameter. The parameter overrides this. | |
| =back | |
| =head1 SEE ALSO | |
| L<Module::Build> is a pure-Perl alternative to MakeMaker which does | |
| not rely on make or any other external utility. It is easier to | |
| extend to suit your needs. | |
| L<Module::Install> is a wrapper around MakeMaker which adds features | |
| not normally available. | |
| L<ExtUtils::ModuleMaker> and L<Module::Starter> are both modules to | |
| help you setup your distribution. | |
| L<CPAN::Meta> and L<CPAN::Meta::Spec> explain CPAN Meta files in detail. | |
| =head1 AUTHORS | |
| Andy Dougherty C<[email protected]>, Andreas KE<ouml>nig | |
| C<[email protected]>, Tim Bunce C<[email protected]>. VMS | |
| support by Charles Bailey C<[email protected]>. OS/2 support | |
| by Ilya Zakharevich C<[email protected]>. | |
| Currently maintained by Michael G Schwern C<[email protected]> | |
| Send patches and ideas to C<[email protected]>. | |
| Send bug reports via http://rt.cpan.org/. Please send your | |
| generated Makefile along with your report. | |
| For more up-to-date information, see L<http://www.makemaker.org>. | |
| Repository available at L<https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker>. | |
| =head1 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 | |
| EXTUTILS_MAKEMAKER | |
| $fatpacked{"ExtUtils/MakeMaker/Config.pm"} = <<'EXTUTILS_MAKEMAKER_CONFIG'; | |
| package ExtUtils::MakeMaker::Config; | |
| use strict; | |
| our $VERSION = '6.59'; | |
| use Config (); | |
| # Give us an overridable config. | |
| our %Config = %Config::Config; | |
| sub import { | |
| my $caller = caller; | |
| no strict 'refs'; ## no critic | |
| *{$caller.'::Config'} = \%Config; | |
| } | |
| 1; | |
| =head1 NAME | |
| ExtUtils::MakeMaker::Config - Wrapper around Config.pm | |
| =head1 SYNOPSIS | |
| use ExtUtils::MakeMaker::Config; | |
| print $Config{installbin}; # or whatever | |
| =head1 DESCRIPTION | |
| B<FOR INTERNAL USE ONLY> | |
| A very thin wrapper around Config.pm so MakeMaker is easier to test. | |
| =cut | |
| EXTUTILS_MAKEMAKER_CONFIG | |
| $fatpacked{"ExtUtils/Mkbootstrap.pm"} = <<'EXTUTILS_MKBOOTSTRAP'; | |
| package ExtUtils::Mkbootstrap; | |
| # There's just too much Dynaloader incest here to turn on strict vars. | |
| use strict 'refs'; | |
| our $VERSION = '6.59'; | |
| require Exporter; | |
| our @ISA = ('Exporter'); | |
| our @EXPORT = ('&Mkbootstrap'); | |
| use Config; | |
| our $Verbose = 0; | |
| sub Mkbootstrap { | |
| my($baseext, @bsloadlibs)=@_; | |
| @bsloadlibs = grep($_, @bsloadlibs); # strip empty libs | |
| print STDOUT " bsloadlibs=@bsloadlibs\n" if $Verbose; | |
| # We need DynaLoader here because we and/or the *_BS file may | |
| # call dl_findfile(). We don't say `use' here because when | |
| # first building perl extensions the DynaLoader will not have | |
| # been built when MakeMaker gets first used. | |
| require DynaLoader; | |
| rename "$baseext.bs", "$baseext.bso" | |
| if -s "$baseext.bs"; | |
| if (-f "${baseext}_BS"){ | |
| $_ = "${baseext}_BS"; | |
| package DynaLoader; # execute code as if in DynaLoader | |
| local($osname, $dlsrc) = (); # avoid warnings | |
| ($osname, $dlsrc) = @Config::Config{qw(osname dlsrc)}; | |
| $bscode = ""; | |
| unshift @INC, "."; | |
| require $_; | |
| shift @INC; | |
| } | |
| if ($Config{'dlsrc'} =~ /^dl_dld/){ | |
| package DynaLoader; | |
| push(@dl_resolve_using, dl_findfile('-lc')); | |
| } | |
| my(@all) = (@bsloadlibs, @DynaLoader::dl_resolve_using); | |
| my($method) = ''; | |
| if (@all){ | |
| open my $bs, ">", "$baseext.bs" | |
| or die "Unable to open $baseext.bs: $!"; | |
| print STDOUT "Writing $baseext.bs\n"; | |
| print STDOUT " containing: @all" if $Verbose; | |
| print $bs "# $baseext DynaLoader bootstrap file for $^O architecture.\n"; | |
| print $bs "# Do not edit this file, changes will be lost.\n"; | |
| print $bs "# This file was automatically generated by the\n"; | |
| print $bs "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$VERSION).\n"; | |
| print $bs "\@DynaLoader::dl_resolve_using = "; | |
| # If @all contains names in the form -lxxx or -Lxxx then it's asking for | |
| # runtime library location so we automatically add a call to dl_findfile() | |
| if (" @all" =~ m/ -[lLR]/){ | |
| print $bs " dl_findfile(qw(\n @all\n ));\n"; | |
| }else{ | |
| print $bs " qw(@all);\n"; | |
| } | |
| # write extra code if *_BS says so | |
| print $bs $DynaLoader::bscode if $DynaLoader::bscode; | |
| print $bs "\n1;\n"; | |
| close $bs; | |
| } | |
| } | |
| 1; | |
| __END__ | |
| =head1 NAME | |
| ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader | |
| =head1 SYNOPSIS | |
| C<Mkbootstrap> | |
| =head1 DESCRIPTION | |
| Mkbootstrap typically gets called from an extension Makefile. | |
| There is no C<*.bs> file supplied with the extension. Instead, there may | |
| be a C<*_BS> file which has code for the special cases, like posix for | |
| berkeley db on the NeXT. | |
| This file will get parsed, and produce a maybe empty | |
| C<@DynaLoader::dl_resolve_using> array for the current architecture. | |
| That will be extended by $BSLOADLIBS, which was computed by | |
| ExtUtils::Liblist::ext(). If this array still is empty, we do nothing, | |
| else we write a .bs file with an C<@DynaLoader::dl_resolve_using> | |
| array. | |
| The C<*_BS> file can put some code into the generated C<*.bs> file by | |
| placing it in C<$bscode>. This is a handy 'escape' mechanism that may | |
| prove useful in complex situations. | |
| If @DynaLoader::dl_resolve_using contains C<-L*> or C<-l*> entries then | |
| Mkbootstrap will automatically add a dl_findfile() call to the | |
| generated C<*.bs> file. | |
| =cut | |
| EXTUTILS_MKBOOTSTRAP | |
| $fatpacked{"ExtUtils/Mksymlists.pm"} = <<'EXTUTILS_MKSYMLISTS'; | |
| package ExtUtils::Mksymlists; | |
| use 5.006; | |
| use strict qw[ subs refs ]; | |
| # no strict 'vars'; # until filehandles are exempted | |
| use Carp; | |
| use Exporter; | |
| use Config; | |
| our @ISA = qw(Exporter); | |
| our @EXPORT = qw(&Mksymlists); | |
| our $VERSION = '6.59'; | |
| sub Mksymlists { | |
| my(%spec) = @_; | |
| my($osname) = $^O; | |
| croak("Insufficient information specified to Mksymlists") | |
| unless ( $spec{NAME} or | |
| ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) ); | |
| $spec{DL_VARS} = [] unless $spec{DL_VARS}; | |
| ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE}; | |
| $spec{FUNCLIST} = [] unless $spec{FUNCLIST}; | |
| $spec{DL_FUNCS} = { $spec{NAME} => [] } | |
| unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or | |
| @{$spec{FUNCLIST}}); | |
| if (defined $spec{DL_FUNCS}) { | |
| foreach my $package (keys %{$spec{DL_FUNCS}}) { | |
| my($packprefix,$bootseen); | |
| ($packprefix = $package) =~ s/\W/_/g; | |
| foreach my $sym (@{$spec{DL_FUNCS}->{$package}}) { | |
| if ($sym =~ /^boot_/) { | |
| push(@{$spec{FUNCLIST}},$sym); | |
| $bootseen++; | |
| } | |
| else { | |
| push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); | |
| } | |
| } | |
| push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen; | |
| } | |
| } | |
| # We'll need this if we ever add any OS which uses mod2fname | |
| # not as pseudo-builtin. | |
| # require DynaLoader; | |
| if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) { | |
| $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]); | |
| } | |
| if ($osname eq 'aix') { _write_aix(\%spec); } | |
| elsif ($osname eq 'MacOS'){ _write_aix(\%spec) } | |
| elsif ($osname eq 'VMS') { _write_vms(\%spec) } | |
| elsif ($osname eq 'os2') { _write_os2(\%spec) } | |
| elsif ($osname eq 'MSWin32') { _write_win32(\%spec) } | |
| else { | |
| croak("Don't know how to create linker option file for $osname\n"); | |
| } | |
| } | |
| sub _write_aix { | |
| my($data) = @_; | |
| rename "$data->{FILE}.exp", "$data->{FILE}.exp_old"; | |
| open( my $exp, ">", "$data->{FILE}.exp") | |
| or croak("Can't create $data->{FILE}.exp: $!\n"); | |
| print $exp join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; | |
| print $exp join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; | |
| close $exp; | |
| } | |
| sub _write_os2 { | |
| my($data) = @_; | |
| require Config; | |
| my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : ""); | |
| if (not $data->{DLBASE}) { | |
| ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; | |
| $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; | |
| } | |
| my $distname = $data->{DISTNAME} || $data->{NAME}; | |
| $distname = "Distribution $distname"; | |
| my $patchlevel = " pl$Config{perl_patchlevel}" || ''; | |
| my $comment = sprintf "Perl (v%s%s%s) module %s", | |
| $Config::Config{version}, $threaded, $patchlevel, $data->{NAME}; | |
| chomp $comment; | |
| if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') { | |
| $distname = '[email protected]'; | |
| $comment = "Core $comment"; | |
| } | |
| $comment = "$comment (Perl-config: $Config{config_args})"; | |
| $comment = substr($comment, 0, 200) . "...)" if length $comment > 203; | |
| rename "$data->{FILE}.def", "$data->{FILE}_def.old"; | |
| open(my $def, ">", "$data->{FILE}.def") | |
| or croak("Can't create $data->{FILE}.def: $!\n"); | |
| print $def "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n"; | |
| print $def "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n"; | |
| print $def "CODE LOADONCALL\n"; | |
| print $def "DATA LOADONCALL NONSHARED MULTIPLE\n"; | |
| print $def "EXPORTS\n "; | |
| print $def join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; | |
| print $def join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; | |
| if (%{$data->{IMPORTS}}) { | |
| print $def "IMPORTS\n"; | |
| my ($name, $exp); | |
| while (($name, $exp)= each %{$data->{IMPORTS}}) { | |
| print $def " $name=$exp\n"; | |
| } | |
| } | |
| close $def; | |
| } | |
| sub _write_win32 { | |
| my($data) = @_; | |
| require Config; | |
| if (not $data->{DLBASE}) { | |
| ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; | |
| $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; | |
| } | |
| rename "$data->{FILE}.def", "$data->{FILE}_def.old"; | |
| open( my $def, ">", "$data->{FILE}.def" ) | |
| or croak("Can't create $data->{FILE}.def: $!\n"); | |
| # put library name in quotes (it could be a keyword, like 'Alias') | |
| if ($Config::Config{'cc'} !~ /^gcc/i) { | |
| print $def "LIBRARY \"$data->{DLBASE}\"\n"; | |
| } | |
| print $def "EXPORTS\n "; | |
| my @syms; | |
| # Export public symbols both with and without underscores to | |
| # ensure compatibility between DLLs from different compilers | |
| # NOTE: DynaLoader itself only uses the names without underscores, | |
| # so this is only to cover the case when the extension DLL may be | |
| # linked to directly from C. GSAR 97-07-10 | |
| if ($Config::Config{'cc'} =~ /^bcc/i) { | |
| for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { | |
| push @syms, "_$_", "$_ = _$_"; | |
| } | |
| } | |
| else { | |
| for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { | |
| push @syms, "$_", "_$_ = $_"; | |
| } | |
| } | |
| print $def join("\n ",@syms, "\n") if @syms; | |
| if (%{$data->{IMPORTS}}) { | |
| print $def "IMPORTS\n"; | |
| my ($name, $exp); | |
| while (($name, $exp)= each %{$data->{IMPORTS}}) { | |
| print $def " $name=$exp\n"; | |
| } | |
| } | |
| close $def; | |
| } | |
| sub _write_vms { | |
| my($data) = @_; | |
| require Config; # a reminder for once we do $^O | |
| require ExtUtils::XSSymSet; | |
| my($isvax) = $Config::Config{'archname'} =~ /VAX/i; | |
| my($set) = new ExtUtils::XSSymSet; | |
| rename "$data->{FILE}.opt", "$data->{FILE}.opt_old"; | |
| open(my $opt,">", "$data->{FILE}.opt") | |
| or croak("Can't create $data->{FILE}.opt: $!\n"); | |
| # Options file declaring universal symbols | |
| # Used when linking shareable image for dynamic extension, | |
| # or when linking PerlShr into which we've added this package | |
| # as a static extension | |
| # We don't do anything to preserve order, so we won't relax | |
| # the GSMATCH criteria for a dynamic extension | |
| print $opt "case_sensitive=yes\n" | |
| if $Config::Config{d_vms_case_sensitive_symbols}; | |
| foreach my $sym (@{$data->{FUNCLIST}}) { | |
| my $safe = $set->addsym($sym); | |
| if ($isvax) { print $opt "UNIVERSAL=$safe\n" } | |
| else { print $opt "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; } | |
| } | |
| foreach my $sym (@{$data->{DL_VARS}}) { | |
| my $safe = $set->addsym($sym); | |
| print $opt "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n"; | |
| if ($isvax) { print $opt "UNIVERSAL=$safe\n" } | |
| else { print $opt "SYMBOL_VECTOR=($safe=DATA)\n"; } | |
| } | |
| close $opt; | |
| } | |
| 1; | |
| __END__ | |
| =head1 NAME | |
| ExtUtils::Mksymlists - write linker options files for dynamic extension | |
| =head1 SYNOPSIS | |
| use ExtUtils::Mksymlists; | |
| Mksymlists({ NAME => $name , | |
| DL_VARS => [ $var1, $var2, $var3 ], | |
| DL_FUNCS => { $pkg1 => [ $func1, $func2 ], | |
| $pkg2 => [ $func3 ] }); | |
| =head1 DESCRIPTION | |
| C<ExtUtils::Mksymlists> produces files used by the linker under some OSs | |
| during the creation of shared libraries for dynamic extensions. It is | |
| normally called from a MakeMaker-generated Makefile when the extension | |
| is built. The linker option file is generated by calling the function | |
| C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>. | |
| It takes one argument, a list of key-value pairs, in which the following | |
| keys are recognized: | |
| =over 4 | |
| =item DLBASE | |
| This item specifies the name by which the linker knows the | |
| extension, which may be different from the name of the | |
| extension itself (for instance, some linkers add an '_' to the | |
| name of the extension). If it is not specified, it is derived | |
| from the NAME attribute. It is presently used only by OS2 and Win32. | |
| =item DL_FUNCS | |
| This is identical to the DL_FUNCS attribute available via MakeMaker, | |
| from which it is usually taken. Its value is a reference to an | |
| associative array, in which each key is the name of a package, and | |
| each value is an a reference to an array of function names which | |
| should be exported by the extension. For instance, one might say | |
| C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ], | |
| Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The | |
| function names should be identical to those in the XSUB code; | |
| C<Mksymlists> will alter the names written to the linker option | |
| file to match the changes made by F<xsubpp>. In addition, if | |
| none of the functions in a list begin with the string B<boot_>, | |
| C<Mksymlists> will add a bootstrap function for that package, | |
| just as xsubpp does. (If a B<boot_E<lt>pkgE<gt>> function is | |
| present in the list, it is passed through unchanged.) If | |
| DL_FUNCS is not specified, it defaults to the bootstrap | |
| function for the extension specified in NAME. | |
| =item DL_VARS | |
| This is identical to the DL_VARS attribute available via MakeMaker, | |
| and, like DL_FUNCS, it is usually specified via MakeMaker. Its | |
| value is a reference to an array of variable names which should | |
| be exported by the extension. | |
| =item FILE | |
| This key can be used to specify the name of the linker option file | |
| (minus the OS-specific extension), if for some reason you do not | |
| want to use the default value, which is the last word of the NAME | |
| attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>). | |
| =item FUNCLIST | |
| This provides an alternate means to specify function names to be | |
| exported from the extension. Its value is a reference to an | |
| array of function names to be exported by the extension. These | |
| names are passed through unaltered to the linker options file. | |
| Specifying a value for the FUNCLIST attribute suppresses automatic | |
| generation of the bootstrap function for the package. To still create | |
| the bootstrap name you have to specify the package name in the | |
| DL_FUNCS hash: | |
| Mksymlists({ NAME => $name , | |
| FUNCLIST => [ $func1, $func2 ], | |
| DL_FUNCS => { $pkg => [] } }); | |
| =item IMPORTS | |
| This attribute is used to specify names to be imported into the | |
| extension. It is currently only used by OS/2 and Win32. | |
| =item NAME | |
| This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which | |
| the linker option file will be produced. | |
| =back | |
| When calling C<Mksymlists>, one should always specify the NAME | |
| attribute. In most cases, this is all that's necessary. In | |
| the case of unusual extensions, however, the other attributes | |
| can be used to provide additional information to the linker. | |
| =head1 AUTHOR | |
| Charles Bailey I<E<lt>[email protected]<gt>> | |
| =head1 REVISION | |
| Last revised 14-Feb-1996, for Perl 5.002. | |
| EXTUTILS_MKSYMLISTS | |
| $fatpacked{"ExtUtils/testlib.pm"} = <<'EXTUTILS_TESTLIB'; | |
| package ExtUtils::testlib; | |
| use strict; | |
| use warnings; | |
| our $VERSION = '6.59'; | |
| use Cwd; | |
| use File::Spec; | |
| # So the tests can chdir around and not break @INC. | |
| # We use getcwd() because otherwise rel2abs will blow up under taint | |
| # mode pre-5.8. We detaint is so @INC won't be tainted. This is | |
| # no worse, and probably better, than just shoving an untainted, | |
| # relative "blib/lib" onto @INC. | |
| my $cwd; | |
| BEGIN { | |
| ($cwd) = getcwd() =~ /(.*)/; | |
| } | |
| use lib map { File::Spec->rel2abs($_, $cwd) } qw(blib/arch blib/lib); | |
| 1; | |
| __END__ | |
| =head1 NAME | |
| ExtUtils::testlib - add blib/* directories to @INC | |
| =head1 SYNOPSIS | |
| use ExtUtils::testlib; | |
| =head1 DESCRIPTION | |
| After an extension has been built and before it is installed it may be | |
| desirable to test it bypassing C<make test>. By adding | |
| use ExtUtils::testlib; | |
| to a test program the intermediate directories used by C<make> are | |
| added to @INC. | |
| EXTUTILS_TESTLIB | |
| $fatpacked{"File/pushd.pm"} = <<'FILE_PUSHD'; | |
| package File::pushd; | |
| $VERSION = '1.00'; | |
| @EXPORT = qw( pushd tempd ); | |
| @ISA = qw( Exporter ); | |
| use 5.004; | |
| use strict; | |
| #use warnings; | |
| use Exporter; | |
| use Carp; | |
| use Cwd qw( cwd abs_path ); | |
| use File::Path qw( rmtree ); | |
| use File::Temp qw(); | |
| use File::Spec; | |
| use overload | |
| q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) }, | |
| fallback => 1; | |
| #--------------------------------------------------------------------------# | |
| # pushd() | |
| #--------------------------------------------------------------------------# | |
| sub pushd { | |
| my ($target_dir) = @_; | |
| my $orig = cwd; | |
| my $dest; | |
| eval { $dest = $target_dir ? abs_path( $target_dir ) : $orig }; | |
| croak "Can't locate directory $target_dir: $@" if $@; | |
| if ($dest ne $orig) { | |
| chdir $dest or croak "Can't chdir to $dest\: $!"; | |
| } | |
| my $self = bless { | |
| _pushd => $dest, | |
| _original => $orig | |
| }, __PACKAGE__; | |
| return $self; | |
| } | |
| #--------------------------------------------------------------------------# | |
| # tempd() | |
| #--------------------------------------------------------------------------# | |
| sub tempd { | |
| my $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ) ); | |
| $dir->{_tempd} = 1; | |
| return $dir; | |
| } | |
| #--------------------------------------------------------------------------# | |
| # preserve() | |
| #--------------------------------------------------------------------------# | |
| sub preserve { | |
| my $self = shift; | |
| return 1 if ! $self->{"_tempd"}; | |
| if ( @_ == 0 ) { | |
| return $self->{_preserve} = 1; | |
| } | |
| else { | |
| return $self->{_preserve} = $_[0] ? 1 : 0; | |
| } | |
| } | |
| #--------------------------------------------------------------------------# | |
| # DESTROY() | |
| # Revert to original directory as object is destroyed and cleanup | |
| # if necessary | |
| #--------------------------------------------------------------------------# | |
| sub DESTROY { | |
| my ($self) = @_; | |
| my $orig = $self->{_original}; | |
| chdir $orig if $orig; # should always be so, but just in case... | |
| if ( $self->{_tempd} && | |
| !$self->{_preserve} ) { | |
| eval { rmtree( $self->{_pushd} ) }; | |
| carp $@ if $@; | |
| } | |
| } | |
| 1; #this line is important and will help the module return a true value | |
| __END__ | |
| =begin wikidoc | |
| = NAME | |
| File::pushd - change directory temporarily for a limited scope | |
| = VERSION | |
| This documentation describes version %%VERSION%%. | |
| = SYNOPSIS | |
| use File::pushd; | |
| chdir $ENV{HOME}; | |
| # change directory again for a limited scope | |
| { | |
| my $dir = pushd( '/tmp' ); | |
| # working directory changed to /tmp | |
| } | |
| # working directory has reverted to $ENV{HOME} | |
| # tempd() is equivalent to pushd( File::Temp::tempdir ) | |
| { | |
| my $dir = tempd(); | |
| } | |
| # object stringifies naturally as an absolute path | |
| { | |
| my $dir = pushd( '/tmp' ); | |
| my $filename = File::Spec->catfile( $dir, "somefile.txt" ); | |
| # gives /tmp/somefile.txt | |
| } | |
| = DESCRIPTION | |
| File::pushd does a temporary {chdir} that is easily and automatically | |
| reverted, similar to {pushd} in some Unix command shells. It works by | |
| creating an object that caches the original working directory. When the object | |
| is destroyed, the destructor calls {chdir} to revert to the original working | |
| directory. By storing the object in a lexical variable with a limited scope, | |
| this happens automatically at the end of the scope. | |
| This is very handy when working with temporary directories for tasks like | |
| testing; a function is provided to streamline getting a temporary | |
| directory from [File::Temp]. | |
| For convenience, the object stringifies as the canonical form of the absolute | |
| pathname of the directory entered. | |
| = USAGE | |
| use File::pushd; | |
| Using File::pushd automatically imports the {pushd} and {tempd} functions. | |
| == pushd | |
| { | |
| my $dir = pushd( $target_directory ); | |
| } | |
| Caches the current working directory, calls {chdir} to change to the target | |
| directory, and returns a File::pushd object. When the object is | |
| destroyed, the working directory reverts to the original directory. | |
| The provided target directory can be a relative or absolute path. If | |
| called with no arguments, it uses the current directory as its target and | |
| returns to the current directory when the object is destroyed. | |
| == tempd | |
| { | |
| my $dir = tempd(); | |
| } | |
| This function is like {pushd} but automatically creates and calls {chdir} to | |
| a temporary directory created by [File::Temp]. Unlike normal [File::Temp] | |
| cleanup which happens at the end of the program, this temporary directory is | |
| removed when the object is destroyed. (But also see {preserve}.) A warning | |
| will be issued if the directory cannot be removed. | |
| == preserve | |
| { | |
| my $dir = tempd(); | |
| $dir->preserve; # mark to preserve at end of scope | |
| $dir->preserve(0); # mark to delete at end of scope | |
| } | |
| Controls whether a temporary directory will be cleaned up when the object is | |
| destroyed. With no arguments, {preserve} sets the directory to be preserved. | |
| With an argument, the directory will be preserved if the argument is true, or | |
| marked for cleanup if the argument is false. Only {tempd} objects may be | |
| marked for cleanup. (Target directories to {pushd} are always preserved.) | |
| {preserve} returns true if the directory will be preserved, and false | |
| otherwise. | |
| = SEE ALSO | |
| * [File::chdir] | |
| = BUGS | |
| Please report any bugs or feature using the CPAN Request Tracker. | |
| Bugs can be submitted through the web interface at | |
| [http://rt.cpan.org/Dist/Display.html?Queue=File-pushd] | |
| When submitting a bug or request, please include a test-file or a patch to an | |
| existing test-file that illustrates the bug or desired feature. | |
| = AUTHOR | |
| David A. Golden (DAGOLDEN) | |
| = COPYRIGHT AND LICENSE | |
| Copyright (c) 2005, 2006, 2007 by David A. Golden | |
| Licensed under the Apache License, Version 2.0 (the "License"); | |
| you may not use this file except in compliance with the License. | |
| You may obtain a copy of the License at | |
| [http://www.apache.org/licenses/LICENSE-2.0] | |
| Files produced as output though the use of this software, including | |
| generated copies of boilerplate templates provided with this software, | |
| shall not be considered Derivative Works, but shall be considered the | |
| original work of the Licensor. | |
| Unless required by applicable law or agreed to in writing, software | |
| distributed under the License is distributed on an "AS IS" BASIS, | |
| WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | |
| See the License for the specific language governing permissions and | |
| limitations under the License. | |
| =end wikidoc | |
| FILE_PUSHD | |
| $fatpacked{"IPC/Cmd.pm"} = <<'IPC_CMD'; | |
| package IPC::Cmd; | |
| use strict; | |
| BEGIN { | |
| use constant IS_VMS => $^O eq 'VMS' ? 1 : 0; | |
| use constant IS_WIN32 => $^O eq 'MSWin32' ? 1 : 0; | |
| use constant IS_WIN98 => (IS_WIN32 and !Win32::IsWinNT()) ? 1 : 0; | |
| use constant ALARM_CLASS => __PACKAGE__ . '::TimeOut'; | |
| use constant SPECIAL_CHARS => qw[< > | &]; | |
| use constant QUOTE => do { IS_WIN32 ? q["] : q['] }; | |
| use Exporter (); | |
| use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG | |
| $USE_IPC_RUN $USE_IPC_OPEN3 $CAN_USE_RUN_FORKED $WARN | |
| $INSTANCES | |
| ]; | |
| $VERSION = '0.72'; | |
| $VERBOSE = 0; | |
| $DEBUG = 0; | |
| $WARN = 1; | |
| $USE_IPC_RUN = IS_WIN32 && !IS_WIN98; | |
| $USE_IPC_OPEN3 = not IS_VMS; | |
| $CAN_USE_RUN_FORKED = 0; | |
| eval { | |
| require POSIX; POSIX->import(); | |
| require IPC::Open3; IPC::Open3->import(); | |
| require IO::Select; IO::Select->import(); | |
| require IO::Handle; IO::Handle->import(); | |
| require FileHandle; FileHandle->import(); | |
| require Socket; Socket->import(); | |
| require Time::HiRes; Time::HiRes->import(); | |
| require Win32 if IS_WIN32; | |
| }; | |
| $CAN_USE_RUN_FORKED = $@ || !IS_VMS && !IS_WIN32; | |
| @ISA = qw[Exporter]; | |
| @EXPORT_OK = qw[can_run run run_forked QUOTE]; | |
| } | |
| require Carp; | |
| use File::Spec; | |
| use Params::Check qw[check]; | |
| use Text::ParseWords (); # import ONLY if needed! | |
| use Module::Load::Conditional qw[can_load]; | |
| use Locale::Maketext::Simple Style => 'gettext'; | |
| =pod | |
| =head1 NAME | |
| IPC::Cmd - finding and running system commands made easy | |
| =head1 SYNOPSIS | |
| use IPC::Cmd qw[can_run run run_forked]; | |
| my $full_path = can_run('wget') or warn 'wget is not installed!'; | |
| ### commands can be arrayrefs or strings ### | |
| my $cmd = "$full_path -b theregister.co.uk"; | |
| my $cmd = [$full_path, '-b', 'theregister.co.uk']; | |
| ### in scalar context ### | |
| my $buffer; | |
| if( scalar run( command => $cmd, | |
| verbose => 0, | |
| buffer => \$buffer, | |
| timeout => 20 ) | |
| ) { | |
| print "fetched webpage successfully: $buffer\n"; | |
| } | |
| ### in list context ### | |
| my( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) = | |
| run( command => $cmd, verbose => 0 ); | |
| if( $success ) { | |
| print "this is what the command printed:\n"; | |
| print join "", @$full_buf; | |
| } | |
| ### check for features | |
| print "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3; | |
| print "IPC::Run available: " . IPC::Cmd->can_use_ipc_run; | |
| print "Can capture buffer: " . IPC::Cmd->can_capture_buffer; | |
| ### don't have IPC::Cmd be verbose, ie don't print to stdout or | |
| ### stderr when running commands -- default is '0' | |
| $IPC::Cmd::VERBOSE = 0; | |
| =head1 DESCRIPTION | |
| IPC::Cmd allows you to run commands platform independently, | |
| interactively if desired, but have them still work. | |
| The C<can_run> function can tell you if a certain binary is installed | |
| and if so where, whereas the C<run> function can actually execute any | |
| of the commands you give it and give you a clear return value, as well | |
| as adhere to your verbosity settings. | |
| =head1 CLASS METHODS | |
| =head2 $ipc_run_version = IPC::Cmd->can_use_ipc_run( [VERBOSE] ) | |
| Utility function that tells you if C<IPC::Run> is available. | |
| If the C<verbose> flag is passed, it will print diagnostic messages | |
| if L<IPC::Run> can not be found or loaded. | |
| =cut | |
| sub can_use_ipc_run { | |
| my $self = shift; | |
| my $verbose = shift || 0; | |
| ### IPC::Run doesn't run on win98 | |
| return if IS_WIN98; | |
| ### if we dont have ipc::run, we obviously can't use it. | |
| return unless can_load( | |
| modules => { 'IPC::Run' => '0.55' }, | |
| verbose => ($WARN && $verbose), | |
| ); | |
| ### otherwise, we're good to go | |
| return $IPC::Run::VERSION; | |
| } | |
| =head2 $ipc_open3_version = IPC::Cmd->can_use_ipc_open3( [VERBOSE] ) | |
| Utility function that tells you if C<IPC::Open3> is available. | |
| If the verbose flag is passed, it will print diagnostic messages | |
| if C<IPC::Open3> can not be found or loaded. | |
| =cut | |
| sub can_use_ipc_open3 { | |
| my $self = shift; | |
| my $verbose = shift || 0; | |
| ### IPC::Open3 is not working on VMS because of a lack of fork. | |
| return if IS_VMS; | |
| ### IPC::Open3 works on every non-VMS platform platform, but it can't | |
| ### capture buffers on win32 :( | |
| return unless can_load( | |
| modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| }, | |
| verbose => ($WARN && $verbose), | |
| ); | |
| return $IPC::Open3::VERSION; | |
| } | |
| =head2 $bool = IPC::Cmd->can_capture_buffer | |
| Utility function that tells you if C<IPC::Cmd> is capable of | |
| capturing buffers in it's current configuration. | |
| =cut | |
| sub can_capture_buffer { | |
| my $self = shift; | |
| return 1 if $USE_IPC_RUN && $self->can_use_ipc_run; | |
| return 1 if $USE_IPC_OPEN3 && $self->can_use_ipc_open3; | |
| return; | |
| } | |
| =head2 $bool = IPC::Cmd->can_use_run_forked | |
| Utility function that tells you if C<IPC::Cmd> is capable of | |
| providing C<run_forked> on the current platform. | |
| =head1 FUNCTIONS | |
| =head2 $path = can_run( PROGRAM ); | |
| C<can_run> takes only one argument: the name of a binary you wish | |
| to locate. C<can_run> works much like the unix binary C<which> or the bash | |
| command C<type>, which scans through your path, looking for the requested | |
| binary. | |
| Unlike C<which> and C<type>, this function is platform independent and | |
| will also work on, for example, Win32. | |
| If called in a scalar context it will return the full path to the binary | |
| you asked for if it was found, or C<undef> if it was not. | |
| If called in a list context and the global variable C<$INSTANCES> is a true | |
| value, it will return a list of the full paths to instances | |
| of the binary where found in C<PATH>, or an empty list if it was not found. | |
| =cut | |
| sub can_run { | |
| my $command = shift; | |
| # a lot of VMS executables have a symbol defined | |
| # check those first | |
| if ( $^O eq 'VMS' ) { | |
| require VMS::DCLsym; | |
| my $syms = VMS::DCLsym->new; | |
| return $command if scalar $syms->getsym( uc $command ); | |
| } | |
| require Config; | |
| require File::Spec; | |
| require ExtUtils::MakeMaker; | |
| my @possibles; | |
| if( File::Spec->file_name_is_absolute($command) ) { | |
| return MM->maybe_command($command); | |
| } else { | |
| for my $dir ( | |
| (split /\Q$Config::Config{path_sep}\E/, $ENV{PATH}), | |
| File::Spec->curdir | |
| ) { | |
| next if ! $dir || ! -d $dir; | |
| my $abs = File::Spec->catfile( IS_WIN32 ? Win32::GetShortPathName( $dir ) : $dir, $command); | |
| push @possibles, $abs if $abs = MM->maybe_command($abs); | |
| } | |
| } | |
| return @possibles if wantarray and $INSTANCES; | |
| return shift @possibles; | |
| } | |
| =head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR, timeout => DIGIT] ); | |
| C<run> takes 4 arguments: | |
| =over 4 | |
| =item command | |
| This is the command to execute. It may be either a string or an array | |
| reference. | |
| This is a required argument. | |
| See L<"Caveats"> for remarks on how commands are parsed and their | |
| limitations. | |
| =item verbose | |
| This controls whether all output of a command should also be printed | |
| to STDOUT/STDERR or should only be trapped in buffers (NOTE: buffers | |
| require L<IPC::Run> to be installed, or your system able to work with | |
| L<IPC::Open3>). | |
| It will default to the global setting of C<$IPC::Cmd::VERBOSE>, | |
| which by default is 0. | |
| =item buffer | |
| This will hold all the output of a command. It needs to be a reference | |
| to a scalar. | |
| Note that this will hold both the STDOUT and STDERR messages, and you | |
| have no way of telling which is which. | |
| If you require this distinction, run the C<run> command in list context | |
| and inspect the individual buffers. | |
| Of course, this requires that the underlying call supports buffers. See | |
| the note on buffers above. | |
| =item timeout | |
| Sets the maximum time the command is allowed to run before aborting, | |
| using the built-in C<alarm()> call. If the timeout is triggered, the | |
| C<errorcode> in the return value will be set to an object of the | |
| C<IPC::Cmd::TimeOut> class. See the L<"error message"> section below for | |
| details. | |
| Defaults to C<0>, meaning no timeout is set. | |
| =back | |
| C<run> will return a simple C<true> or C<false> when called in scalar | |
| context. | |
| In list context, you will be returned a list of the following items: | |
| =over 4 | |
| =item success | |
| A simple boolean indicating if the command executed without errors or | |
| not. | |
| =item error message | |
| If the first element of the return value (C<success>) was 0, then some | |
| error occurred. This second element is the error message the command | |
| you requested exited with, if available. This is generally a pretty | |
| printed value of C<$?> or C<$@>. See C<perldoc perlvar> for details on | |
| what they can contain. | |
| If the error was a timeout, the C<error message> will be prefixed with | |
| the string C<IPC::Cmd::TimeOut>, the timeout class. | |
| =item full_buffer | |
| This is an array reference containing all the output the command | |
| generated. | |
| Note that buffers are only available if you have L<IPC::Run> installed, | |
| or if your system is able to work with L<IPC::Open3> -- see below). | |
| Otherwise, this element will be C<undef>. | |
| =item out_buffer | |
| This is an array reference containing all the output sent to STDOUT the | |
| command generated. The notes from L<"full_buffer"> apply. | |
| =item error_buffer | |
| This is an arrayreference containing all the output sent to STDERR the | |
| command generated. The notes from L<"full_buffer"> apply. | |
| =back | |
| See the L<"HOW IT WORKS"> section below to see how C<IPC::Cmd> decides | |
| what modules or function calls to use when issuing a command. | |
| =cut | |
| { my @acc = qw[ok error _fds]; | |
| ### autogenerate accessors ### | |
| for my $key ( @acc ) { | |
| no strict 'refs'; | |
| *{__PACKAGE__."::$key"} = sub { | |
| $_[0]->{$key} = $_[1] if @_ > 1; | |
| return $_[0]->{$key}; | |
| } | |
| } | |
| } | |
| sub can_use_run_forked { | |
| return $CAN_USE_RUN_FORKED eq "1"; | |
| } | |
| # incompatible with POSIX::SigAction | |
| # | |
| sub install_layered_signal { | |
| my ($s, $handler_code) = @_; | |
| my %available_signals = map {$_ => 1} keys %SIG; | |
| die("install_layered_signal got nonexistent signal name [$s]") | |
| unless defined($available_signals{$s}); | |
| die("install_layered_signal expects coderef") | |
| if !ref($handler_code) || ref($handler_code) ne 'CODE'; | |
| my $previous_handler = $SIG{$s}; | |
| my $sig_handler = sub { | |
| my ($called_sig_name, @sig_param) = @_; | |
| # $s is a closure referring to real signal name | |
| # for which this handler is being installed. | |
| # it is used to distinguish between | |
| # real signal handlers and aliased signal handlers | |
| my $signal_name = $s; | |
| # $called_sig_name is a signal name which | |
| # was passed to this signal handler; | |
| # it doesn't equal $signal_name in case | |
| # some signal handlers in %SIG point | |
| # to other signal handler (CHLD and CLD, | |
| # ABRT and IOT) | |
| # | |
| # initial signal handler for aliased signal | |
| # calls some other signal handler which | |
| # should not execute the same handler_code again | |
| if ($called_sig_name eq $signal_name) { | |
| $handler_code->($signal_name); | |
| } | |
| # run original signal handler if any (including aliased) | |
| # | |
| if (ref($previous_handler)) { | |
| $previous_handler->($called_sig_name, @sig_param); | |
| } | |
| }; | |
| $SIG{$s} = $sig_handler; | |
| } | |
| # give process a chance sending TERM, | |
| # waiting for a while (2 seconds) | |
| # and killing it with KILL | |
| sub kill_gently { | |
| my ($pid, $opts) = @_; | |
| $opts = {} unless $opts; | |
| $opts->{'wait_time'} = 2 unless defined($opts->{'wait_time'}); | |
| $opts->{'first_kill_type'} = 'just_process' unless $opts->{'first_kill_type'}; | |
| $opts->{'final_kill_type'} = 'just_process' unless $opts->{'final_kill_type'}; | |
| if ($opts->{'first_kill_type'} eq 'just_process') { | |
| kill(15, $pid); | |
| } | |
| elsif ($opts->{'first_kill_type'} eq 'process_group') { | |
| kill(-15, $pid); | |
| } | |
| my $child_finished = 0; | |
| my $wait_start_time = time(); | |
| while (!$child_finished && $wait_start_time + $opts->{'wait_time'} > time()) { | |
| my $waitpid = waitpid($pid, WNOHANG); | |
| if ($waitpid eq -1) { | |
| $child_finished = 1; | |
| } | |
| Time::HiRes::usleep(250000); # quarter of a second | |
| } | |
| if (!$child_finished) { | |
| if ($opts->{'final_kill_type'} eq 'just_process') { | |
| kill(9, $pid); | |
| } | |
| elsif ($opts->{'final_kill_type'} eq 'process_group') { | |
| kill(-9, $pid); | |
| } | |
| } | |
| } | |
| sub open3_run { | |
| my ($cmd, $opts) = @_; | |
| $opts = {} unless $opts; | |
| my $child_in = FileHandle->new; | |
| my $child_out = FileHandle->new; | |
| my $child_err = FileHandle->new; | |
| $child_out->autoflush(1); | |
| $child_err->autoflush(1); | |
| my $pid = open3($child_in, $child_out, $child_err, $cmd); | |
| # push my child's pid to our parent | |
| # so in case i am killed parent | |
| # could stop my child (search for | |
| # child_child_pid in parent code) | |
| if ($opts->{'parent_info'}) { | |
| my $ps = $opts->{'parent_info'}; | |
| print $ps "spawned $pid\n"; | |
| } | |
| if ($child_in && $child_out->opened && $opts->{'child_stdin'}) { | |
| # If the child process dies for any reason, | |
| # the next write to CHLD_IN is likely to generate | |
| # a SIGPIPE in the parent, which is fatal by default. | |
| # So you may wish to handle this signal. | |
| # | |
| # from http://perldoc.perl.org/IPC/Open3.html, | |
| # absolutely needed to catch piped commands errors. | |
| # | |
| local $SIG{'PIPE'} = sub { 1; }; | |
| print $child_in $opts->{'child_stdin'}; | |
| } | |
| close($child_in); | |
| my $child_output = { | |
| 'out' => $child_out->fileno, | |
| 'err' => $child_err->fileno, | |
| $child_out->fileno => { | |
| 'parent_socket' => $opts->{'parent_stdout'}, | |
| 'scalar_buffer' => "", | |
| 'child_handle' => $child_out, | |
| 'block_size' => ($child_out->stat)[11] || 1024, | |
| }, | |
| $child_err->fileno => { | |
| 'parent_socket' => $opts->{'parent_stderr'}, | |
| 'scalar_buffer' => "", | |
| 'child_handle' => $child_err, | |
| 'block_size' => ($child_err->stat)[11] || 1024, | |
| }, | |
| }; | |
| my $select = IO::Select->new(); | |
| $select->add($child_out, $child_err); | |
| # pass any signal to the child | |
| # effectively creating process | |
| # strongly attached to the child: | |
| # it will terminate only after child | |
| # has terminated (except for SIGKILL, | |
| # which is specially handled) | |
| foreach my $s (keys %SIG) { | |
| my $sig_handler; | |
| $sig_handler = sub { | |
| kill("$s", $pid); | |
| $SIG{$s} = $sig_handler; | |
| }; | |
| $SIG{$s} = $sig_handler; | |
| } | |
| my $child_finished = 0; | |
| my $got_sig_child = 0; | |
| $SIG{'CHLD'} = sub { $got_sig_child = time(); }; | |
| while(!$child_finished && ($child_out->opened || $child_err->opened)) { | |
| # parent was killed otherwise we would have got | |
| # the same signal as parent and process it same way | |
| if (getppid() eq "1") { | |
| # end my process group with all the children | |
| # (i am the process group leader, so my pid | |
| # equals to the process group id) | |
| # | |
| # same thing which is done | |
| # with $opts->{'clean_up_children'} | |
| # in run_forked | |
| # | |
| kill(-9, $$); | |
| exit 1; | |
| } | |
| if ($got_sig_child) { | |
| if (time() - $got_sig_child > 1) { | |
| # select->can_read doesn't return 0 after SIG_CHLD | |
| # | |
| # "On POSIX-compliant platforms, SIGCHLD is the signal | |
| # sent to a process when a child process terminates." | |
| # http://en.wikipedia.org/wiki/SIGCHLD | |
| # | |
| # nevertheless kill KILL wouldn't break anything here | |
| # | |
| kill (9, $pid); | |
| $child_finished = 1; | |
| } | |
| } | |
| Time::HiRes::usleep(1); | |
| foreach my $fd ($select->can_read(1/100)) { | |
| my $str = $child_output->{$fd->fileno}; | |
| psSnake::die("child stream not found: $fd") unless $str; | |
| my $data; | |
| my $count = $fd->sysread($data, $str->{'block_size'}); | |
| if ($count) { | |
| if ($str->{'parent_socket'}) { | |
| my $ph = $str->{'parent_socket'}; | |
| print $ph $data; | |
| } | |
| else { | |
| $str->{'scalar_buffer'} .= $data; | |
| } | |
| } | |
| elsif ($count eq 0) { | |
| $select->remove($fd); | |
| $fd->close(); | |
| } | |
| else { | |
| psSnake::die("error during sysread: " . $!); | |
| } | |
| } | |
| } | |
| my $waitpid_ret = waitpid($pid, 0); | |
| my $real_exit = $?; | |
| my $exit_value = $real_exit >> 8; | |
| # since we've successfully reaped the child, | |
| # let our parent know about this. | |
| # | |
| if ($opts->{'parent_info'}) { | |
| my $ps = $opts->{'parent_info'}; | |
| # child was killed, inform parent | |
| if ($real_exit & 127) { | |
| print $ps "$pid killed with " . ($real_exit & 127) . "\n"; | |
| } | |
| print $ps "reaped $pid\n"; | |
| } | |
| if ($opts->{'parent_stdout'} || $opts->{'parent_stderr'}) { | |
| return $exit_value; | |
| } | |
| else { | |
| return { | |
| 'stdout' => $child_output->{$child_output->{'out'}}->{'scalar_buffer'}, | |
| 'stderr' => $child_output->{$child_output->{'err'}}->{'scalar_buffer'}, | |
| 'exit_code' => $exit_value, | |
| }; | |
| } | |
| } | |
| =head2 $hashref = run_forked( COMMAND, { child_stdin => SCALAR, timeout => DIGIT, stdout_handler => CODEREF, stderr_handler => CODEREF} ); | |
| C<run_forked> is used to execute some program or a coderef, | |
| optionally feed it with some input, get its return code | |
| and output (both stdout and stderr into separate buffers). | |
| In addition, it allows to terminate the program | |
| if it takes too long to finish. | |
| The important and distinguishing feature of run_forked | |
| is execution timeout which at first seems to be | |
| quite a simple task but if you think | |
| that the program which you're spawning | |
| might spawn some children itself (which | |
| in their turn could do the same and so on) | |
| it turns out to be not a simple issue. | |
| C<run_forked> is designed to survive and | |
| successfully terminate almost any long running task, | |
| even a fork bomb in case your system has the resources | |
| to survive during given timeout. | |
| This is achieved by creating separate watchdog process | |
| which spawns the specified program in a separate | |
| process session and supervises it: optionally | |
| feeds it with input, stores its exit code, | |
| stdout and stderr, terminates it in case | |
| it runs longer than specified. | |
| Invocation requires the command to be executed or a coderef and optionally a hashref of options: | |
| =over | |
| =item C<timeout> | |
| Specify in seconds how long to run the command before it is killed with with SIG_KILL (9), | |
| which effectively terminates it and all of its children (direct or indirect). | |
| =item C<child_stdin> | |
| Specify some text that will be passed into the C<STDIN> of the executed program. | |
| =item C<stdout_handler> | |
| Coderef of a subroutine to call when a portion of data is received on | |
| STDOUT from the executing program. | |
| =item C<stderr_handler> | |
| Coderef of a subroutine to call when a portion of data is received on | |
| STDERR from the executing program. | |
| =item C<discard_output> | |
| Discards the buffering of the standard output and standard errors for return by run_forked(). | |
| With this option you have to use the std*_handlers to read what the command outputs. | |
| Useful for commands that send a lot of output. | |
| =item C<terminate_on_parent_sudden_death> | |
| Enable this option if you wish all spawned processes to be killed if the initially spawned | |
| process (the parent) is killed or dies without waiting for child processes. | |
| =back | |
| C<run_forked> will return a HASHREF with the following keys: | |
| =over | |
| =item C<exit_code> | |
| The exit code of the executed program. | |
| =item C<timeout> | |
| The number of seconds the program ran for before being terminated, or 0 if no timeout occurred. | |
| =item C<stdout> | |
| Holds the standard output of the executed command (or empty string if | |
| there was no STDOUT output or if C<discard_output> was used; it's always defined!) | |
| =item C<stderr> | |
| Holds the standard error of the executed command (or empty string if | |
| there was no STDERR output or if C<discard_output> was used; it's always defined!) | |
| =item C<merged> | |
| Holds the standard output and error of the executed command merged into one stream | |
| (or empty string if there was no output at all or if C<discard_output> was used; it's always defined!) | |
| =item C<err_msg> | |
| Holds some explanation in the case of an error. | |
| =back | |
| =cut | |
| sub run_forked { | |
| ### container to store things in | |
| my $self = bless {}, __PACKAGE__; | |
| if (!can_use_run_forked()) { | |
| Carp::carp("run_forked is not available: $CAN_USE_RUN_FORKED"); | |
| return; | |
| } | |
| my ($cmd, $opts) = @_; | |
| if (!$cmd) { | |
| Carp::carp("run_forked expects command to run"); | |
| return; | |
| } | |
| $opts = {} unless $opts; | |
| $opts->{'timeout'} = 0 unless $opts->{'timeout'}; | |
| $opts->{'terminate_wait_time'} = 2 unless defined($opts->{'terminate_wait_time'}); | |
| # turned on by default | |
| $opts->{'clean_up_children'} = 1 unless defined($opts->{'clean_up_children'}); | |
| # sockets to pass child stdout to parent | |
| my $child_stdout_socket; | |
| my $parent_stdout_socket; | |
| # sockets to pass child stderr to parent | |
| my $child_stderr_socket; | |
| my $parent_stderr_socket; | |
| # sockets for child -> parent internal communication | |
| my $child_info_socket; | |
| my $parent_info_socket; | |
| socketpair($child_stdout_socket, $parent_stdout_socket, AF_UNIX, SOCK_STREAM, PF_UNSPEC) || | |
| die ("socketpair: $!"); | |
| socketpair($child_stderr_socket, $parent_stderr_socket, AF_UNIX, SOCK_STREAM, PF_UNSPEC) || | |
| die ("socketpair: $!"); | |
| socketpair($child_info_socket, $parent_info_socket, AF_UNIX, SOCK_STREAM, PF_UNSPEC) || | |
| die ("socketpair: $!"); | |
| $child_stdout_socket->autoflush(1); | |
| $parent_stdout_socket->autoflush(1); | |
| $child_stderr_socket->autoflush(1); | |
| $parent_stderr_socket->autoflush(1); | |
| $child_info_socket->autoflush(1); | |
| $parent_info_socket->autoflush(1); | |
| my $start_time = time(); | |
| my $pid; | |
| if ($pid = fork) { | |
| # we are a parent | |
| close($parent_stdout_socket); | |
| close($parent_stderr_socket); | |
| close($parent_info_socket); | |
| my $flags; | |
| # prepare sockets to read from child | |
| $flags = 0; | |
| fcntl($child_stdout_socket, F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; | |
| $flags |= O_NONBLOCK; | |
| fcntl($child_stdout_socket, F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; | |
| $flags = 0; | |
| fcntl($child_stderr_socket, F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; | |
| $flags |= O_NONBLOCK; | |
| fcntl($child_stderr_socket, F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; | |
| $flags = 0; | |
| fcntl($child_info_socket, F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; | |
| $flags |= O_NONBLOCK; | |
| fcntl($child_info_socket, F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; | |
| # print "child $pid started\n"; | |
| my $child_timedout = 0; | |
| my $child_finished = 0; | |
| my $child_stdout = ''; | |
| my $child_stderr = ''; | |
| my $child_merged = ''; | |
| my $child_exit_code = 0; | |
| my $child_killed_by_signal = 0; | |
| my $parent_died = 0; | |
| my $got_sig_child = 0; | |
| my $got_sig_quit = 0; | |
| my $orig_sig_child = $SIG{'CHLD'}; | |
| $SIG{'CHLD'} = sub { $got_sig_child = time(); }; | |
| if ($opts->{'terminate_on_signal'}) { | |
| install_layered_signal($opts->{'terminate_on_signal'}, sub { $got_sig_quit = time(); }); | |
| } | |
| my $child_child_pid; | |
| while (!$child_finished) { | |
| my $now = time(); | |
| if ($opts->{'terminate_on_parent_sudden_death'}) { | |
| $opts->{'runtime'}->{'last_parent_check'} = 0 | |
| unless defined($opts->{'runtime'}->{'last_parent_check'}); | |
| # check for parent once each five seconds | |
| if ($now - $opts->{'runtime'}->{'last_parent_check'} > 5) { | |
| if (getppid() eq "1") { | |
| kill_gently ($pid, { | |
| 'first_kill_type' => 'process_group', | |
| 'final_kill_type' => 'process_group', | |
| 'wait_time' => $opts->{'terminate_wait_time'} | |
| }); | |
| $parent_died = 1; | |
| } | |
| $opts->{'runtime'}->{'last_parent_check'} = $now; | |
| } | |
| } | |
| # user specified timeout | |
| if ($opts->{'timeout'}) { | |
| if ($now - $start_time > $opts->{'timeout'}) { | |
| kill_gently ($pid, { | |
| 'first_kill_type' => 'process_group', | |
| 'final_kill_type' => 'process_group', | |
| 'wait_time' => $opts->{'terminate_wait_time'} | |
| }); | |
| $child_timedout = 1; | |
| } | |
| } | |
| # give OS 10 seconds for correct return of waitpid, | |
| # kill process after that and finish wait loop; | |
| # shouldn't ever happen -- remove this code? | |
| if ($got_sig_child) { | |
| if ($now - $got_sig_child > 10) { | |
| print STDERR "waitpid did not return -1 for 10 seconds after SIG_CHLD, killing [$pid]\n"; | |
| kill (-9, $pid); | |
| $child_finished = 1; | |
| } | |
| } | |
| if ($got_sig_quit) { | |
| kill_gently ($pid, { | |
| 'first_kill_type' => 'process_group', | |
| 'final_kill_type' => 'process_group', | |
| 'wait_time' => $opts->{'terminate_wait_time'} | |
| }); | |
| $child_finished = 1; | |
| } | |
| my $waitpid = waitpid($pid, WNOHANG); | |
| # child finished, catch it's exit status | |
| if ($waitpid ne 0 && $waitpid ne -1) { | |
| $child_exit_code = $? >> 8; | |
| } | |
| if ($waitpid eq -1) { | |
| $child_finished = 1; | |
| next; | |
| } | |
| # child -> parent simple internal communication protocol | |
| while (my $l = <$child_info_socket>) { | |
| if ($l =~ /^spawned ([0-9]+?)\n(.*?)/so) { | |
| $child_child_pid = $1; | |
| $l = $2; | |
| } | |
| if ($l =~ /^reaped ([0-9]+?)\n(.*?)/so) { | |
| $child_child_pid = undef; | |
| $l = $2; | |
| } | |
| if ($l =~ /^[\d]+ killed with ([0-9]+?)\n(.*?)/so) { | |
| $child_killed_by_signal = $1; | |
| $l = $2; | |
| } | |
| } | |
| while (my $l = <$child_stdout_socket>) { | |
| if (!$opts->{'discard_output'}) { | |
| $child_stdout .= $l; | |
| $child_merged .= $l; | |
| } | |
| if ($opts->{'stdout_handler'} && ref($opts->{'stdout_handler'}) eq 'CODE') { | |
| $opts->{'stdout_handler'}->($l); | |
| } | |
| } | |
| while (my $l = <$child_stderr_socket>) { | |
| if (!$opts->{'discard_output'}) { | |
| $child_stderr .= $l; | |
| $child_merged .= $l; | |
| } | |
| if ($opts->{'stderr_handler'} && ref($opts->{'stderr_handler'}) eq 'CODE') { | |
| $opts->{'stderr_handler'}->($l); | |
| } | |
| } | |
| Time::HiRes::usleep(1); | |
| } | |
| # $child_pid_pid is not defined in two cases: | |
| # * when our child was killed before | |
| # it had chance to tell us the pid | |
| # of the child it spawned. we can do | |
| # nothing in this case :( | |
| # * our child successfully reaped its child, | |
| # we have nothing left to do in this case | |
| # | |
| # defined $child_pid_pid means child's child | |
| # has not died but nobody is waiting for it, | |
| # killing it brutally. | |
| # | |
| if ($child_child_pid) { | |
| kill_gently($child_child_pid); | |
| } | |
| # in case there are forks in child which | |
| # do not forward or process signals (TERM) correctly | |
| # kill whole child process group, effectively trying | |
| # not to return with some children or their parts still running | |
| # | |
| # to be more accurate -- we need to be sure | |
| # that this is process group created by our child | |
| # (and not some other process group with the same pgid, | |
| # created just after death of our child) -- fortunately | |
| # this might happen only when process group ids | |
| # are reused quickly (there are lots of processes | |
| # spawning new process groups for example) | |
| # | |
| if ($opts->{'clean_up_children'}) { | |
| kill(-9, $pid); | |
| } | |
| # print "child $pid finished\n"; | |
| close($child_stdout_socket); | |
| close($child_stderr_socket); | |
| close($child_info_socket); | |
| my $o = { | |
| 'stdout' => $child_stdout, | |
| 'stderr' => $child_stderr, | |
| 'merged' => $child_merged, | |
| 'timeout' => $child_timedout ? $opts->{'timeout'} : 0, | |
| 'exit_code' => $child_exit_code, | |
| 'parent_died' => $parent_died, | |
| 'killed_by_signal' => $child_killed_by_signal, | |
| 'child_pgid' => $pid, | |
| }; | |
| my $err_msg = ''; | |
| if ($o->{'exit_code'}) { | |
| $err_msg .= "exited with code [$o->{'exit_code'}]\n"; | |
| } | |
| if ($o->{'timeout'}) { | |
| $err_msg .= "ran more than [$o->{'timeout'}] seconds\n"; | |
| } | |
| if ($o->{'parent_died'}) { | |
| $err_msg .= "parent died\n"; | |
| } | |
| if ($o->{'stdout'}) { | |
| $err_msg .= "stdout:\n" . $o->{'stdout'} . "\n"; | |
| } | |
| if ($o->{'stderr'}) { | |
| $err_msg .= "stderr:\n" . $o->{'stderr'} . "\n"; | |
| } | |
| if ($o->{'killed_by_signal'}) { | |
| $err_msg .= "killed by signal [" . $o->{'killed_by_signal'} . "]\n"; | |
| } | |
| $o->{'err_msg'} = $err_msg; | |
| if ($orig_sig_child) { | |
| $SIG{'CHLD'} = $orig_sig_child; | |
| } | |
| else { | |
| delete($SIG{'CHLD'}); | |
| } | |
| return $o; | |
| } | |
| else { | |
| die("cannot fork: $!") unless defined($pid); | |
| # create new process session for open3 call, | |
| # so we hopefully can kill all the subprocesses | |
| # which might be spawned in it (except for those | |
| # which do setsid theirselves -- can't do anything | |
| # with those) | |
| POSIX::setsid() || die("Error running setsid: " . $!); | |
| if ($opts->{'child_BEGIN'} && ref($opts->{'child_BEGIN'}) eq 'CODE') { | |
| $opts->{'child_BEGIN'}->(); | |
| } | |
| close($child_stdout_socket); | |
| close($child_stderr_socket); | |
| close($child_info_socket); | |
| my $child_exit_code; | |
| # allow both external programs | |
| # and internal perl calls | |
| if (!ref($cmd)) { | |
| $child_exit_code = open3_run($cmd, { | |
| 'parent_info' => $parent_info_socket, | |
| 'parent_stdout' => $parent_stdout_socket, | |
| 'parent_stderr' => $parent_stderr_socket, | |
| 'child_stdin' => $opts->{'child_stdin'}, | |
| }); | |
| } | |
| elsif (ref($cmd) eq 'CODE') { | |
| $child_exit_code = $cmd->({ | |
| 'opts' => $opts, | |
| 'parent_info' => $parent_info_socket, | |
| 'parent_stdout' => $parent_stdout_socket, | |
| 'parent_stderr' => $parent_stderr_socket, | |
| 'child_stdin' => $opts->{'child_stdin'}, | |
| }); | |
| } | |
| else { | |
| print $parent_stderr_socket "Invalid command reference: " . ref($cmd) . "\n"; | |
| $child_exit_code = 1; | |
| } | |
| close($parent_stdout_socket); | |
| close($parent_stderr_socket); | |
| close($parent_info_socket); | |
| if ($opts->{'child_END'} && ref($opts->{'child_END'}) eq 'CODE') { | |
| $opts->{'child_END'}->(); | |
| } | |
| exit $child_exit_code; | |
| } | |
| } | |
| sub run { | |
| ### container to store things in | |
| my $self = bless {}, __PACKAGE__; | |
| my %hash = @_; | |
| ### if the user didn't provide a buffer, we'll store it here. | |
| my $def_buf = ''; | |
| my($verbose,$cmd,$buffer,$timeout); | |
| my $tmpl = { | |
| verbose => { default => $VERBOSE, store => \$verbose }, | |
| buffer => { default => \$def_buf, store => \$buffer }, | |
| command => { required => 1, store => \$cmd, | |
| allow => sub { !ref($_[0]) or ref($_[0]) eq 'ARRAY' }, | |
| }, | |
| timeout => { default => 0, store => \$timeout }, | |
| }; | |
| unless( check( $tmpl, \%hash, $VERBOSE ) ) { | |
| Carp::carp( loc( "Could not validate input: %1", | |
| Params::Check->last_error ) ); | |
| return; | |
| }; | |
| $cmd = _quote_args_vms( $cmd ) if IS_VMS; | |
| ### strip any empty elements from $cmd if present | |
| $cmd = [ grep { defined && length } @$cmd ] if ref $cmd; | |
| my $pp_cmd = (ref $cmd ? "@$cmd" : $cmd); | |
| print loc("Running [%1]...\n", $pp_cmd ) if $verbose; | |
| ### did the user pass us a buffer to fill or not? if so, set this | |
| ### flag so we know what is expected of us | |
| ### XXX this is now being ignored. in the future, we could add diagnostic | |
| ### messages based on this logic | |
| #my $user_provided_buffer = $buffer == \$def_buf ? 0 : 1; | |
| ### buffers that are to be captured | |
| my( @buffer, @buff_err, @buff_out ); | |
| ### capture STDOUT | |
| my $_out_handler = sub { | |
| my $buf = shift; | |
| return unless defined $buf; | |
| print STDOUT $buf if $verbose; | |
| push @buffer, $buf; | |
| push @buff_out, $buf; | |
| }; | |
| ### capture STDERR | |
| my $_err_handler = sub { | |
| my $buf = shift; | |
| return unless defined $buf; | |
| print STDERR $buf if $verbose; | |
| push @buffer, $buf; | |
| push @buff_err, $buf; | |
| }; | |
| ### flag to indicate we have a buffer captured | |
| my $have_buffer = $self->can_capture_buffer ? 1 : 0; | |
| ### flag indicating if the subcall went ok | |
| my $ok; | |
| ### dont look at previous errors: | |
| local $?; | |
| local $@; | |
| local $!; | |
| ### we might be having a timeout set | |
| eval { | |
| local $SIG{ALRM} = sub { die bless sub { | |
| ALARM_CLASS . | |
| qq[: Command '$pp_cmd' aborted by alarm after $timeout seconds] | |
| }, ALARM_CLASS } if $timeout; | |
| alarm $timeout || 0; | |
| ### IPC::Run is first choice if $USE_IPC_RUN is set. | |
| if( !IS_WIN32 and $USE_IPC_RUN and $self->can_use_ipc_run( 1 ) ) { | |
| ### ipc::run handlers needs the command as a string or an array ref | |
| $self->_debug( "# Using IPC::Run. Have buffer: $have_buffer" ) | |
| if $DEBUG; | |
| $ok = $self->_ipc_run( $cmd, $_out_handler, $_err_handler ); | |
| ### since IPC::Open3 works on all platforms, and just fails on | |
| ### win32 for capturing buffers, do that ideally | |
| } elsif ( $USE_IPC_OPEN3 and $self->can_use_ipc_open3( 1 ) ) { | |
| $self->_debug("# Using IPC::Open3. Have buffer: $have_buffer") | |
| if $DEBUG; | |
| ### in case there are pipes in there; | |
| ### IPC::Open3 will call exec and exec will do the right thing | |
| my $method = IS_WIN32 ? '_open3_run_win32' : '_open3_run'; | |
| $ok = $self->$method( | |
| $cmd, $_out_handler, $_err_handler, $verbose | |
| ); | |
| ### if we are allowed to run verbose, just dispatch the system command | |
| } else { | |
| $self->_debug( "# Using system(). Have buffer: $have_buffer" ) | |
| if $DEBUG; | |
| $ok = $self->_system_run( $cmd, $verbose ); | |
| } | |
| alarm 0; | |
| }; | |
| ### restore STDIN after duping, or STDIN will be closed for | |
| ### this current perl process! | |
| $self->__reopen_fds( @{ $self->_fds} ) if $self->_fds; | |
| my $err; | |
| unless( $ok ) { | |
| ### alarm happened | |
| if ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) { | |
| $err = $@->(); # the error code is an expired alarm | |
| ### another error happened, set by the dispatchub | |
| } else { | |
| $err = $self->error; | |
| } | |
| } | |
| ### fill the buffer; | |
| $$buffer = join '', @buffer if @buffer; | |
| ### return a list of flags and buffers (if available) in list | |
| ### context, or just a simple 'ok' in scalar | |
| return wantarray | |
| ? $have_buffer | |
| ? ($ok, $err, \@buffer, \@buff_out, \@buff_err) | |
| : ($ok, $err ) | |
| : $ok | |
| } | |
| sub _open3_run_win32 { | |
| my $self = shift; | |
| my $cmd = shift; | |
| my $outhand = shift; | |
| my $errhand = shift; | |
| my $pipe = sub { | |
| socketpair($_[0], $_[1], AF_UNIX, SOCK_STREAM, PF_UNSPEC) | |
| or return undef; | |
| shutdown($_[0], 1); # No more writing for reader | |
| shutdown($_[1], 0); # No more reading for writer | |
| return 1; | |
| }; | |
| my $open3 = sub { | |
| local (*TO_CHLD_R, *TO_CHLD_W); | |
| local (*FR_CHLD_R, *FR_CHLD_W); | |
| local (*FR_CHLD_ERR_R, *FR_CHLD_ERR_W); | |
| $pipe->(*TO_CHLD_R, *TO_CHLD_W ) or die $^E; | |
| $pipe->(*FR_CHLD_R, *FR_CHLD_W ) or die $^E; | |
| $pipe->(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $^E; | |
| my $pid = IPC::Open3::open3('>&TO_CHLD_R', '<&FR_CHLD_W', '<&FR_CHLD_ERR_W', @_); | |
| return ( $pid, *TO_CHLD_W, *FR_CHLD_R, *FR_CHLD_ERR_R ); | |
| }; | |
| $cmd = [ grep { defined && length } @$cmd ] if ref $cmd; | |
| $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd ); | |
| my ($pid, $to_chld, $fr_chld, $fr_chld_err) = | |
| $open3->( ( ref $cmd ? @$cmd : $cmd ) ); | |
| my $in_sel = IO::Select->new(); | |
| my $out_sel = IO::Select->new(); | |
| my %objs; | |
| $objs{ fileno( $fr_chld ) } = $outhand; | |
| $objs{ fileno( $fr_chld_err ) } = $errhand; | |
| $in_sel->add( $fr_chld ); | |
| $in_sel->add( $fr_chld_err ); | |
| close($to_chld); | |
| while ($in_sel->count() + $out_sel->count()) { | |
| my ($ins, $outs) = IO::Select::select($in_sel, $out_sel, undef); | |
| for my $fh (@$ins) { | |
| my $obj = $objs{ fileno($fh) }; | |
| my $buf; | |
| my $bytes_read = sysread($fh, $buf, 64*1024 ); #, length($buf)); | |
| if (!$bytes_read) { | |
| $in_sel->remove($fh); | |
| } | |
| else { | |
| $obj->( "$buf" ); | |
| } | |
| } | |
| for my $fh (@$outs) { | |
| } | |
| } | |
| waitpid($pid, 0); | |
| ### some error occurred | |
| if( $? ) { | |
| $self->error( $self->_pp_child_error( $cmd, $? ) ); | |
| $self->ok( 0 ); | |
| return; | |
| } else { | |
| return $self->ok( 1 ); | |
| } | |
| } | |
| sub _open3_run { | |
| my $self = shift; | |
| my $cmd = shift; | |
| my $_out_handler = shift; | |
| my $_err_handler = shift; | |
| my $verbose = shift || 0; | |
| ### Following code are adapted from Friar 'abstracts' in the | |
| ### Perl Monastery (http://www.perlmonks.org/index.pl?node_id=151886). | |
| ### XXX that code didn't work. | |
| ### we now use the following code, thanks to theorbtwo | |
| ### define them beforehand, so we always have defined FH's | |
| ### to read from. | |
| use Symbol; | |
| my $kidout = Symbol::gensym(); | |
| my $kiderror = Symbol::gensym(); | |
| ### Dup the filehandle so we can pass 'our' STDIN to the | |
| ### child process. This stops us from having to pump input | |
| ### from ourselves to the childprocess. However, we will need | |
| ### to revive the FH afterwards, as IPC::Open3 closes it. | |
| ### We'll do the same for STDOUT and STDERR. It works without | |
| ### duping them on non-unix derivatives, but not on win32. | |
| my @fds_to_dup = ( IS_WIN32 && !$verbose | |
| ? qw[STDIN STDOUT STDERR] | |
| : qw[STDIN] | |
| ); | |
| $self->_fds( \@fds_to_dup ); | |
| $self->__dup_fds( @fds_to_dup ); | |
| ### pipes have to come in a quoted string, and that clashes with | |
| ### whitespace. This sub fixes up such commands so they run properly | |
| $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd ); | |
| ### dont stringify @$cmd, so spaces in filenames/paths are | |
| ### treated properly | |
| my $pid = eval { | |
| IPC::Open3::open3( | |
| '<&STDIN', | |
| (IS_WIN32 ? '>&STDOUT' : $kidout), | |
| (IS_WIN32 ? '>&STDERR' : $kiderror), | |
| ( ref $cmd ? @$cmd : $cmd ), | |
| ); | |
| }; | |
| ### open3 error occurred | |
| if( $@ and $@ =~ /^open3:/ ) { | |
| $self->ok( 0 ); | |
| $self->error( $@ ); | |
| return; | |
| }; | |
| ### use OUR stdin, not $kidin. Somehow, | |
| ### we never get the input.. so jump through | |
| ### some hoops to do it :( | |
| my $selector = IO::Select->new( | |
| (IS_WIN32 ? \*STDERR : $kiderror), | |
| \*STDIN, | |
| (IS_WIN32 ? \*STDOUT : $kidout) | |
| ); | |
| STDOUT->autoflush(1); STDERR->autoflush(1); STDIN->autoflush(1); | |
| $kidout->autoflush(1) if UNIVERSAL::can($kidout, 'autoflush'); | |
| $kiderror->autoflush(1) if UNIVERSAL::can($kiderror, 'autoflush'); | |
| ### add an explicit break statement | |
| ### code courtesy of theorbtwo from #london.pm | |
| my $stdout_done = 0; | |
| my $stderr_done = 0; | |
| OUTER: while ( my @ready = $selector->can_read ) { | |
| for my $h ( @ready ) { | |
| my $buf; | |
| ### $len is the amount of bytes read | |
| my $len = sysread( $h, $buf, 4096 ); # try to read 4096 bytes | |
| ### see perldoc -f sysread: it returns undef on error, | |
| ### so bail out. | |
| if( not defined $len ) { | |
| warn(loc("Error reading from process: %1", $!)); | |
| last OUTER; | |
| } | |
| ### check for $len. it may be 0, at which point we're | |
| ### done reading, so don't try to process it. | |
| ### if we would print anyway, we'd provide bogus information | |
| $_out_handler->( "$buf" ) if $len && $h == $kidout; | |
| $_err_handler->( "$buf" ) if $len && $h == $kiderror; | |
| ### Wait till child process is done printing to both | |
| ### stdout and stderr. | |
| $stdout_done = 1 if $h == $kidout and $len == 0; | |
| $stderr_done = 1 if $h == $kiderror and $len == 0; | |
| last OUTER if ($stdout_done && $stderr_done); | |
| } | |
| } | |
| waitpid $pid, 0; # wait for it to die | |
| ### restore STDIN after duping, or STDIN will be closed for | |
| ### this current perl process! | |
| ### done in the parent call now | |
| # $self->__reopen_fds( @fds_to_dup ); | |
| ### some error occurred | |
| if( $? ) { | |
| $self->error( $self->_pp_child_error( $cmd, $? ) ); | |
| $self->ok( 0 ); | |
| return; | |
| } else { | |
| return $self->ok( 1 ); | |
| } | |
| } | |
| ### Text::ParseWords::shellwords() uses unix semantics. that will break | |
| ### on win32 | |
| { my $parse_sub = IS_WIN32 | |
| ? __PACKAGE__->can('_split_like_shell_win32') | |
| : Text::ParseWords->can('shellwords'); | |
| sub _ipc_run { | |
| my $self = shift; | |
| my $cmd = shift; | |
| my $_out_handler = shift; | |
| my $_err_handler = shift; | |
| STDOUT->autoflush(1); STDERR->autoflush(1); | |
| ### a command like: | |
| # [ | |
| # '/usr/bin/gzip', | |
| # '-cdf', | |
| # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz', | |
| # '|', | |
| # '/usr/bin/tar', | |
| # '-tf -' | |
| # ] | |
| ### needs to become: | |
| # [ | |
| # ['/usr/bin/gzip', '-cdf', | |
| # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz'] | |
| # '|', | |
| # ['/usr/bin/tar', '-tf -'] | |
| # ] | |
| my @command; | |
| my $special_chars; | |
| my $re = do { my $x = join '', SPECIAL_CHARS; qr/([$x])/ }; | |
| if( ref $cmd ) { | |
| my $aref = []; | |
| for my $item (@$cmd) { | |
| if( $item =~ $re ) { | |
| push @command, $aref, $item; | |
| $aref = []; | |
| $special_chars .= $1; | |
| } else { | |
| push @$aref, $item; | |
| } | |
| } | |
| push @command, $aref; | |
| } else { | |
| @command = map { if( $_ =~ $re ) { | |
| $special_chars .= $1; $_; | |
| } else { | |
| # [ split /\s+/ ] | |
| [ map { m/[ ]/ ? qq{'$_'} : $_ } $parse_sub->($_) ] | |
| } | |
| } split( /\s*$re\s*/, $cmd ); | |
| } | |
| ### if there's a pipe in the command, *STDIN needs to | |
| ### be inserted *BEFORE* the pipe, to work on win32 | |
| ### this also works on *nix, so we should do it when possible | |
| ### this should *also* work on multiple pipes in the command | |
| ### if there's no pipe in the command, append STDIN to the back | |
| ### of the command instead. | |
| ### XXX seems IPC::Run works it out for itself if you just | |
| ### dont pass STDIN at all. | |
| # if( $special_chars and $special_chars =~ /\|/ ) { | |
| # ### only add STDIN the first time.. | |
| # my $i; | |
| # @command = map { ($_ eq '|' && not $i++) | |
| # ? ( \*STDIN, $_ ) | |
| # : $_ | |
| # } @command; | |
| # } else { | |
| # push @command, \*STDIN; | |
| # } | |
| # \*STDIN is already included in the @command, see a few lines up | |
| my $ok = eval { IPC::Run::run( @command, | |
| fileno(STDOUT).'>', | |
| $_out_handler, | |
| fileno(STDERR).'>', | |
| $_err_handler | |
| ) | |
| }; | |
| ### all is well | |
| if( $ok ) { | |
| return $self->ok( $ok ); | |
| ### some error occurred | |
| } else { | |
| $self->ok( 0 ); | |
| ### if the eval fails due to an exception, deal with it | |
| ### unless it's an alarm | |
| if( $@ and not UNIVERSAL::isa( $@, ALARM_CLASS ) ) { | |
| $self->error( $@ ); | |
| ### if it *is* an alarm, propagate | |
| } elsif( $@ ) { | |
| die $@; | |
| ### some error in the sub command | |
| } else { | |
| $self->error( $self->_pp_child_error( $cmd, $? ) ); | |
| } | |
| return; | |
| } | |
| } | |
| } | |
| sub _system_run { | |
| my $self = shift; | |
| my $cmd = shift; | |
| my $verbose = shift || 0; | |
| ### pipes have to come in a quoted string, and that clashes with | |
| ### whitespace. This sub fixes up such commands so they run properly | |
| $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd ); | |
| my @fds_to_dup = $verbose ? () : qw[STDOUT STDERR]; | |
| $self->_fds( \@fds_to_dup ); | |
| $self->__dup_fds( @fds_to_dup ); | |
| ### system returns 'true' on failure -- the exit code of the cmd | |
| $self->ok( 1 ); | |
| system( ref $cmd ? @$cmd : $cmd ) == 0 or do { | |
| $self->error( $self->_pp_child_error( $cmd, $? ) ); | |
| $self->ok( 0 ); | |
| }; | |
| ### done in the parent call now | |
| #$self->__reopen_fds( @fds_to_dup ); | |
| return unless $self->ok; | |
| return $self->ok; | |
| } | |
| { my %sc_lookup = map { $_ => $_ } SPECIAL_CHARS; | |
| sub __fix_cmd_whitespace_and_special_chars { | |
| my $self = shift; | |
| my $cmd = shift; | |
| ### command has a special char in it | |
| if( ref $cmd and grep { $sc_lookup{$_} } @$cmd ) { | |
| ### since we have special chars, we have to quote white space | |
| ### this *may* conflict with the parsing :( | |
| my $fixed; | |
| my @cmd = map { / / ? do { $fixed++; QUOTE.$_.QUOTE } : $_ } @$cmd; | |
| $self->_debug( "# Quoted $fixed arguments containing whitespace" ) | |
| if $DEBUG && $fixed; | |
| ### stringify it, so the special char isn't escaped as argument | |
| ### to the program | |
| $cmd = join ' ', @cmd; | |
| } | |
| return $cmd; | |
| } | |
| } | |
| ### Command-line arguments (but not the command itself) must be quoted | |
| ### to ensure case preservation. Borrowed from Module::Build with adaptations. | |
| ### Patch for this supplied by Craig Berry, see RT #46288: [PATCH] Add argument | |
| ### quoting for run() on VMS | |
| sub _quote_args_vms { | |
| ### Returns a command string with proper quoting so that the subprocess | |
| ### sees this same list of args, or if we get a single arg that is an | |
| ### array reference, quote the elements of it (except for the first) | |
| ### and return the reference. | |
| my @args = @_; | |
| my $got_arrayref = (scalar(@args) == 1 | |
| && UNIVERSAL::isa($args[0], 'ARRAY')) | |
| ? 1 | |
| : 0; | |
| @args = split(/\s+/, $args[0]) unless $got_arrayref || scalar(@args) > 1; | |
| my $cmd = $got_arrayref ? shift @{$args[0]} : shift @args; | |
| ### Do not quote qualifiers that begin with '/' or previously quoted args. | |
| map { if (/^[^\/\"]/) { | |
| $_ =~ s/\"/""/g; # escape C<"> by doubling | |
| $_ = q(").$_.q("); | |
| } | |
| } | |
| ($got_arrayref ? @{$args[0]} | |
| : @args | |
| ); | |
| $got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd); | |
| return $got_arrayref ? $args[0] | |
| : join(' ', @args); | |
| } | |
| ### XXX this is cribbed STRAIGHT from M::B 0.30 here: | |
| ### http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell | |
| ### XXX this *should* be integrated into text::parsewords | |
| sub _split_like_shell_win32 { | |
| # As it turns out, Windows command-parsing is very different from | |
| # Unix command-parsing. Double-quotes mean different things, | |
| # backslashes don't necessarily mean escapes, and so on. So we | |
| # can't use Text::ParseWords::shellwords() to break a command string | |
| # into words. The algorithm below was bashed out by Randy and Ken | |
| # (mostly Randy), and there are a lot of regression tests, so we | |
| # should feel free to adjust if desired. | |
| local $_ = shift; | |
| my @argv; | |
| return @argv unless defined() && length(); | |
| my $arg = ''; | |
| my( $i, $quote_mode ) = ( 0, 0 ); | |
| while ( $i < length() ) { | |
| my $ch = substr( $_, $i , 1 ); | |
| my $next_ch = substr( $_, $i+1, 1 ); | |
| if ( $ch eq '\\' && $next_ch eq '"' ) { | |
| $arg .= '"'; | |
| $i++; | |
| } elsif ( $ch eq '\\' && $next_ch eq '\\' ) { | |
| $arg .= '\\'; | |
| $i++; | |
| } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) { | |
| $quote_mode = !$quote_mode; | |
| $arg .= '"'; | |
| $i++; | |
| } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode && | |
| ( $i + 2 == length() || | |
| substr( $_, $i + 2, 1 ) eq ' ' ) | |
| ) { # for cases like: a"" => [ 'a' ] | |
| push( @argv, $arg ); | |
| $arg = ''; | |
| $i += 2; | |
| } elsif ( $ch eq '"' ) { | |
| $quote_mode = !$quote_mode; | |
| } elsif ( $ch eq ' ' && !$quote_mode ) { | |
| push( @argv, $arg ) if defined( $arg ) && length( $arg ); | |
| $arg = ''; | |
| ++$i while substr( $_, $i + 1, 1 ) eq ' '; | |
| } else { | |
| $arg .= $ch; | |
| } | |
| $i++; | |
| } | |
| push( @argv, $arg ) if defined( $arg ) && length( $arg ); | |
| return @argv; | |
| } | |
| { use File::Spec; | |
| use Symbol; | |
| my %Map = ( | |
| STDOUT => [qw|>&|, \*STDOUT, Symbol::gensym() ], | |
| STDERR => [qw|>&|, \*STDERR, Symbol::gensym() ], | |
| STDIN => [qw|<&|, \*STDIN, Symbol::gensym() ], | |
| ); | |
| ### dups FDs and stores them in a cache | |
| sub __dup_fds { | |
| my $self = shift; | |
| my @fds = @_; | |
| __PACKAGE__->_debug( "# Closing the following fds: @fds" ) if $DEBUG; | |
| for my $name ( @fds ) { | |
| my($redir, $fh, $glob) = @{$Map{$name}} or ( | |
| Carp::carp(loc("No such FD: '%1'", $name)), next ); | |
| ### MUST use the 2-arg version of open for dup'ing for | |
| ### 5.6.x compatibility. 5.8.x can use 3-arg open | |
| ### see perldoc5.6.2 -f open for details | |
| open $glob, $redir . fileno($fh) or ( | |
| Carp::carp(loc("Could not dup '$name': %1", $!)), | |
| return | |
| ); | |
| ### we should re-open this filehandle right now, not | |
| ### just dup it | |
| ### Use 2-arg version of open, as 5.5.x doesn't support | |
| ### 3-arg version =/ | |
| if( $redir eq '>&' ) { | |
| open( $fh, '>' . File::Spec->devnull ) or ( | |
| Carp::carp(loc("Could not reopen '$name': %1", $!)), | |
| return | |
| ); | |
| } | |
| } | |
| return 1; | |
| } | |
| ### reopens FDs from the cache | |
| sub __reopen_fds { | |
| my $self = shift; | |
| my @fds = @_; | |
| __PACKAGE__->_debug( "# Reopening the following fds: @fds" ) if $DEBUG; | |
| for my $name ( @fds ) { | |
| my($redir, $fh, $glob) = @{$Map{$name}} or ( | |
| Carp::carp(loc("No such FD: '%1'", $name)), next ); | |
| ### MUST use the 2-arg version of open for dup'ing for | |
| ### 5.6.x compatibility. 5.8.x can use 3-arg open | |
| ### see perldoc5.6.2 -f open for details | |
| open( $fh, $redir . fileno($glob) ) or ( | |
| Carp::carp(loc("Could not restore '$name': %1", $!)), | |
| return | |
| ); | |
| ### close this FD, we're not using it anymore | |
| close $glob; | |
| } | |
| return 1; | |
| } | |
| } | |
| sub _debug { | |
| my $self = shift; | |
| my $msg = shift or return; | |
| my $level = shift || 0; | |
| local $Carp::CarpLevel += $level; | |
| Carp::carp($msg); | |
| return 1; | |
| } | |
| sub _pp_child_error { | |
| my $self = shift; | |
| my $cmd = shift or return; | |
| my $ce = shift or return; | |
| my $pp_cmd = ref $cmd ? "@$cmd" : $cmd; | |
| my $str; | |
| if( $ce == -1 ) { | |
| ### Include $! in the error message, so that the user can | |
| ### see 'No such file or directory' versus 'Permission denied' | |
| ### versus 'Cannot fork' or whatever the cause was. | |
| $str = "Failed to execute '$pp_cmd': $!"; | |
| } elsif ( $ce & 127 ) { | |
| ### some signal | |
| $str = loc( "'%1' died with signal %d, %s coredump\n", | |
| $pp_cmd, ($ce & 127), ($ce & 128) ? 'with' : 'without'); | |
| } else { | |
| ### Otherwise, the command run but gave error status. | |
| $str = "'$pp_cmd' exited with value " . ($ce >> 8); | |
| } | |
| $self->_debug( "# Child error '$ce' translated to: $str" ) if $DEBUG; | |
| return $str; | |
| } | |
| 1; | |
| =head2 $q = QUOTE | |
| Returns the character used for quoting strings on this platform. This is | |
| usually a C<'> (single quote) on most systems, but some systems use different | |
| quotes. For example, C<Win32> uses C<"> (double quote). | |
| You can use it as follows: | |
| use IPC::Cmd qw[run QUOTE]; | |
| my $cmd = q[echo ] . QUOTE . q[foo bar] . QUOTE; | |
| This makes sure that C<foo bar> is treated as a string, rather than two | |
| separate arguments to the C<echo> function. | |
| __END__ | |
| =head1 HOW IT WORKS | |
| C<run> will try to execute your command using the following logic: | |
| =over 4 | |
| =item * | |
| If you have C<IPC::Run> installed, and the variable C<$IPC::Cmd::USE_IPC_RUN> | |
| is set to true (See the L<"Global Variables"> section) use that to execute | |
| the command. You will have the full output available in buffers, interactive commands | |
| are sure to work and you are guaranteed to have your verbosity | |
| settings honored cleanly. | |
| =item * | |
| Otherwise, if the variable C<$IPC::Cmd::USE_IPC_OPEN3> is set to true | |
| (See the L<"Global Variables"> section), try to execute the command using | |
| L<IPC::Open3>. Buffers will be available on all platforms, | |
| interactive commands will still execute cleanly, and also your verbosity | |
| settings will be adhered to nicely; | |
| =item * | |
| Otherwise, if you have the C<verbose> argument set to true, we fall back | |
| to a simple C<system()> call. We cannot capture any buffers, but | |
| interactive commands will still work. | |
| =item * | |
| Otherwise we will try and temporarily redirect STDERR and STDOUT, do a | |
| C<system()> call with your command and then re-open STDERR and STDOUT. | |
| This is the method of last resort and will still allow you to execute | |
| your commands cleanly. However, no buffers will be available. | |
| =back | |
| =head1 Global Variables | |
| The behaviour of IPC::Cmd can be altered by changing the following | |
| global variables: | |
| =head2 $IPC::Cmd::VERBOSE | |
| This controls whether IPC::Cmd will print any output from the | |
| commands to the screen or not. The default is 0. | |
| =head2 $IPC::Cmd::USE_IPC_RUN | |
| This variable controls whether IPC::Cmd will try to use L<IPC::Run> | |
| when available and suitable. | |
| =head2 $IPC::Cmd::USE_IPC_OPEN3 | |
| This variable controls whether IPC::Cmd will try to use L<IPC::Open3> | |
| when available and suitable. Defaults to true. | |
| =head2 $IPC::Cmd::WARN | |
| This variable controls whether run-time warnings should be issued, like | |
| the failure to load an C<IPC::*> module you explicitly requested. | |
| Defaults to true. Turn this off at your own risk. | |
| =head2 $IPC::Cmd::INSTANCES | |
| This variable controls whether C<can_run> will return all instances of | |
| the binary it finds in the C<PATH> when called in a list context. | |
| Defaults to false, set to true to enable the described behaviour. | |
| =head1 Caveats | |
| =over 4 | |
| =item Whitespace and IPC::Open3 / system() | |
| When using C<IPC::Open3> or C<system>, if you provide a string as the | |
| C<command> argument, it is assumed to be appropriately escaped. You can | |
| use the C<QUOTE> constant to use as a portable quote character (see above). | |
| However, if you provide an array reference, special rules apply: | |
| If your command contains B<special characters> (< > | &), it will | |
| be internally stringified before executing the command, to avoid that these | |
| special characters are escaped and passed as arguments instead of retaining | |
| their special meaning. | |
| However, if the command contained arguments that contained whitespace, | |
| stringifying the command would loose the significance of the whitespace. | |
| Therefore, C<IPC::Cmd> will quote any arguments containing whitespace in your | |
| command if the command is passed as an arrayref and contains special characters. | |
| =item Whitespace and IPC::Run | |
| When using C<IPC::Run>, if you provide a string as the C<command> argument, | |
| the string will be split on whitespace to determine the individual elements | |
| of your command. Although this will usually just Do What You Mean, it may | |
| break if you have files or commands with whitespace in them. | |
| If you do not wish this to happen, you should provide an array | |
| reference, where all parts of your command are already separated out. | |
| Note however, if there are extra or spurious whitespaces in these parts, | |
| the parser or underlying code may not interpret it correctly, and | |
| cause an error. | |
| Example: | |
| The following code | |
| gzip -cdf foo.tar.gz | tar -xf - | |
| should either be passed as | |
| "gzip -cdf foo.tar.gz | tar -xf -" | |
| or as | |
| ['gzip', '-cdf', 'foo.tar.gz', '|', 'tar', '-xf', '-'] | |
| But take care not to pass it as, for example | |
| ['gzip -cdf foo.tar.gz', '|', 'tar -xf -'] | |
| Since this will lead to issues as described above. | |
| =item IO Redirect | |
| Currently it is too complicated to parse your command for IO | |
| redirections. For capturing STDOUT or STDERR there is a work around | |
| however, since you can just inspect your buffers for the contents. | |
| =item Interleaving STDOUT/STDERR | |
| Neither IPC::Run nor IPC::Open3 can interleave STDOUT and STDERR. For short | |
| bursts of output from a program, e.g. this sample, | |
| for ( 1..4 ) { | |
| $_ % 2 ? print STDOUT $_ : print STDERR $_; | |
| } | |
| IPC::[Run|Open3] will first read all of STDOUT, then all of STDERR, meaning | |
| the output looks like '13' on STDOUT and '24' on STDERR, instead of | |
| 1 | |
| 2 | |
| 3 | |
| 4 | |
| This has been recorded in L<rt.cpan.org> as bug #37532: Unable to interleave | |
| STDOUT and STDERR. | |
| =back | |
| =head1 See Also | |
| L<IPC::Run>, L<IPC::Open3> | |
| =head1 ACKNOWLEDGEMENTS | |
| Thanks to James Mastros and Martijn van der Streek for their | |
| help in getting L<IPC::Open3> to behave nicely. | |
| Thanks to Petya Kohts for the C<run_forked> code. | |
| =head1 BUG REPORTS | |
| Please report bugs or other issues to E<lt>[email protected]<gt>. | |
| =head1 AUTHOR | |
| Original author: Jos Boumans E<lt>[email protected]<gt>. | |
| Current maintainer: Chris Williams E<lt>[email protected]<gt>. | |
| =head1 COPYRIGHT | |
| This library is free software; you may redistribute and/or modify it | |
| under the same terms as Perl itself. | |
| =cut | |
| IPC_CMD | |
| $fatpacked{"JSON/PP/Compat5006.pm"} = <<'JSON_PP_COMPAT5006'; | |
| package JSON::PP::Compat5006; | |
| use 5.006; | |
| use strict; | |
| BEGIN { | |
| if ( $] >= 5.008 ) { | |
| require Carp; | |
| die( "JSON::PP::Compat5006 is for Perl 5.6" ); | |
| } | |
| } | |
| my @properties; | |
| $JSON::PP::Compat5006::VERSION = '1.09'; | |
| BEGIN { | |
| sub utf8::is_utf8 { | |
| my $len = length $_[0]; # char length | |
| { | |
| use bytes; # byte length; | |
| return $len != length $_[0]; # if !=, UTF8-flagged on. | |
| } | |
| } | |
| sub utf8::upgrade { | |
| ; # noop; | |
| } | |
| sub utf8::downgrade ($;$) { | |
| return 1 unless ( utf8::is_utf8( $_[0] ) ); | |
| if ( _is_valid_utf8( $_[0] ) ) { | |
| my $downgrade; | |
| for my $c ( unpack( "U*", $_[0] ) ) { | |
| if ( $c < 256 ) { | |
| $downgrade .= pack("C", $c); | |
| } | |
| else { | |
| $downgrade .= pack("U", $c); | |
| } | |
| } | |
| $_[0] = $downgrade; | |
| return 1; | |
| } | |
| else { | |
| Carp::croak("Wide character in subroutine entry") unless ( $_[1] ); | |
| 0; | |
| } | |
| } | |
| sub utf8::encode ($) { # UTF8 flag off | |
| if ( utf8::is_utf8( $_[0] ) ) { | |
| $_[0] = pack( "C*", unpack( "C*", $_[0] ) ); | |
| } | |
| else { | |
| $_[0] = pack( "U*", unpack( "C*", $_[0] ) ); | |
| $_[0] = pack( "C*", unpack( "C*", $_[0] ) ); | |
| } | |
| } | |
| sub utf8::decode ($) { # UTF8 flag on | |
| if ( _is_valid_utf8( $_[0] ) ) { | |
| utf8::downgrade( $_[0] ); | |
| $_[0] = pack( "U*", unpack( "U*", $_[0] ) ); | |
| } | |
| } | |
| *JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii; | |
| *JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1; | |
| *JSON::PP::JSON_PP_decode_surrogates = \&JSON::PP::_decode_surrogates; | |
| *JSON::PP::JSON_PP_decode_unicode = \&JSON::PP::_decode_unicode; | |
| unless ( defined &B::SVp_NOK ) { # missing in B module. | |
| eval q{ sub B::SVp_NOK () { 0x02000000; } }; | |
| } | |
| } | |
| sub _encode_ascii { | |
| join('', | |
| map { | |
| $_ <= 127 ? | |
| chr($_) : | |
| $_ <= 65535 ? | |
| sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_)); | |
| } _unpack_emu($_[0]) | |
| ); | |
| } | |
| sub _encode_latin1 { | |
| join('', | |
| map { | |
| $_ <= 255 ? | |
| chr($_) : | |
| $_ <= 65535 ? | |
| sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_)); | |
| } _unpack_emu($_[0]) | |
| ); | |
| } | |
| sub _unpack_emu { # for Perl 5.6 unpack warnings | |
| return !utf8::is_utf8($_[0]) ? unpack('C*', $_[0]) | |
| : _is_valid_utf8($_[0]) ? unpack('U*', $_[0]) | |
| : unpack('C*', $_[0]); | |
| } | |
| sub _is_valid_utf8 { | |
| my $str = $_[0]; | |
| my $is_utf8; | |
| while ($str =~ /(?: | |
| ( | |
| [\x00-\x7F] | |
| |[\xC2-\xDF][\x80-\xBF] | |
| |[\xE0][\xA0-\xBF][\x80-\xBF] | |
| |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] | |
| |[\xED][\x80-\x9F][\x80-\xBF] | |
| |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] | |
| |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] | |
| |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] | |
| |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] | |
| ) | |
| | (.) | |
| )/xg) | |
| { | |
| if (defined $1) { | |
| $is_utf8 = 1 if (!defined $is_utf8); | |
| } | |
| else { | |
| $is_utf8 = 0 if (!defined $is_utf8); | |
| if ($is_utf8) { # eventually, not utf8 | |
| return; | |
| } | |
| } | |
| } | |
| return $is_utf8; | |
| } | |
| 1; | |
| __END__ | |
| =pod | |
| =head1 NAME | |
| JSON::PP::Compat5006 - Helper module in using JSON::PP in Perl 5.6 | |
| =head1 DESCRIPTION | |
| JSON::PP calls internally. | |
| =head1 AUTHOR | |
| Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> | |
| =head1 COPYRIGHT AND LICENSE | |
| Copyright 2007-2010 by Makamaka Hannyaharamitu | |
| This library is free software; you can redistribute it and/or modify | |
| it under the same terms as Perl itself. | |
| =cut | |
| JSON_PP_COMPAT5006 | |
| $fatpacked{"Locale/Maketext.pm"} = <<'LOCALE_MAKETEXT'; | |
| package Locale::Maketext; | |
| use strict; | |
| use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS | |
| $USE_LITERALS $MATCH_SUPERS_TIGHTLY); | |
| use Carp (); | |
| use I18N::LangTags (); | |
| use I18N::LangTags::Detect (); | |
| #-------------------------------------------------------------------------- | |
| BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } } | |
| # define the constant 'DEBUG' at compile-time | |
| # turn on utf8 if we have it (this is what GutsLoader.pm used to do essentially ) | |
| # use if (exists $INC{'utf8.pm'} || eval 'use utf8'), 'utf8'; | |
| BEGIN { | |
| # if we have it || we can load it | |
| if ( exists $INC{'utf8.pm'} || eval { local $SIG{'__DIE__'};require utf8; } ) { | |
| utf8->import(); | |
| DEBUG and warn " utf8 on for _compile()\n"; | |
| } | |
| else { | |
| DEBUG and warn " utf8 not available for _compile() ($INC{'utf8.pm'})\n$@\n"; | |
| } | |
| } | |
| $VERSION = '1.19'; | |
| @ISA = (); | |
| $MATCH_SUPERS = 1; | |
| $MATCH_SUPERS_TIGHTLY = 1; | |
| $USING_LANGUAGE_TAGS = 1; | |
| # Turning this off is somewhat of a security risk in that little or no | |
| # checking will be done on the legality of tokens passed to the | |
| # eval("use $module_name") in _try_use. If you turn this off, you have | |
| # to do your own taint checking. | |
| $USE_LITERALS = 1 unless defined $USE_LITERALS; | |
| # a hint for compiling bracket-notation things. | |
| my %isa_scan = (); | |
| ########################################################################### | |
| sub quant { | |
| my($handle, $num, @forms) = @_; | |
| return $num if @forms == 0; # what should this mean? | |
| return $forms[2] if @forms > 2 and $num == 0; # special zeroth case | |
| # Normal case: | |
| # Note that the formatting of $num is preserved. | |
| return( $handle->numf($num) . ' ' . $handle->numerate($num, @forms) ); | |
| # Most human languages put the number phrase before the qualified phrase. | |
| } | |
| sub numerate { | |
| # return this lexical item in a form appropriate to this number | |
| my($handle, $num, @forms) = @_; | |
| my $s = ($num == 1); | |
| return '' unless @forms; | |
| if(@forms == 1) { # only the headword form specified | |
| return $s ? $forms[0] : ($forms[0] . 's'); # very cheap hack. | |
| } | |
| else { # sing and plural were specified | |
| return $s ? $forms[0] : $forms[1]; | |
| } | |
| } | |
| #-------------------------------------------------------------------------- | |
| sub numf { | |
| my($handle, $num) = @_[0,1]; | |
| if($num < 10_000_000_000 and $num > -10_000_000_000 and $num == int($num)) { | |
| $num += 0; # Just use normal integer stringification. | |
| # Specifically, don't let %G turn ten million into 1E+007 | |
| } | |
| else { | |
| $num = CORE::sprintf('%G', $num); | |
| # "CORE::" is there to avoid confusion with the above sub sprintf. | |
| } | |
| while( $num =~ s/^([-+]?\d+)(\d{3})/$1,$2/s ) {1} # right from perlfaq5 | |
| # The initial \d+ gobbles as many digits as it can, and then we | |
| # backtrack so it un-eats the rightmost three, and then we | |
| # insert the comma there. | |
| $num =~ tr<.,><,.> if ref($handle) and $handle->{'numf_comma'}; | |
| # This is just a lame hack instead of using Number::Format | |
| return $num; | |
| } | |
| sub sprintf { | |
| no integer; | |
| my($handle, $format, @params) = @_; | |
| return CORE::sprintf($format, @params); | |
| # "CORE::" is there to avoid confusion with myself! | |
| } | |
| #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=# | |
| use integer; # vroom vroom... applies to the whole rest of the module | |
| sub language_tag { | |
| my $it = ref($_[0]) || $_[0]; | |
| return undef unless $it =~ m/([^':]+)(?:::)?$/s; | |
| $it = lc($1); | |
| $it =~ tr<_><->; | |
| return $it; | |
| } | |
| sub encoding { | |
| my $it = $_[0]; | |
| return( | |
| (ref($it) && $it->{'encoding'}) | |
| || 'iso-8859-1' # Latin-1 | |
| ); | |
| } | |
| #-------------------------------------------------------------------------- | |
| sub fallback_languages { return('i-default', 'en', 'en-US') } | |
| sub fallback_language_classes { return () } | |
| #-------------------------------------------------------------------------- | |
| sub fail_with { # an actual attribute method! | |
| my($handle, @params) = @_; | |
| return unless ref($handle); | |
| $handle->{'fail'} = $params[0] if @params; | |
| return $handle->{'fail'}; | |
| } | |
| #-------------------------------------------------------------------------- | |
| sub failure_handler_auto { | |
| # Meant to be used like: | |
| # $handle->fail_with('failure_handler_auto') | |
| my $handle = shift; | |
| my $phrase = shift; | |
| $handle->{'failure_lex'} ||= {}; | |
| my $lex = $handle->{'failure_lex'}; | |
| my $value ||= ($lex->{$phrase} ||= $handle->_compile($phrase)); | |
| # Dumbly copied from sub maketext: | |
| return ${$value} if ref($value) eq 'SCALAR'; | |
| return $value if ref($value) ne 'CODE'; | |
| { | |
| local $SIG{'__DIE__'}; | |
| eval { $value = &$value($handle, @_) }; | |
| } | |
| # If we make it here, there was an exception thrown in the | |
| # call to $value, and so scream: | |
| if($@) { | |
| # pretty up the error message | |
| $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?} | |
| {\n in bracket code [compiled line $1],}s; | |
| #$err =~ s/\n?$/\n/s; | |
| Carp::croak "Error in maketexting \"$phrase\":\n$@ as used"; | |
| # Rather unexpected, but suppose that the sub tried calling | |
| # a method that didn't exist. | |
| } | |
| else { | |
| return $value; | |
| } | |
| } | |
| #========================================================================== | |
| sub new { | |
| # Nothing fancy! | |
| my $class = ref($_[0]) || $_[0]; | |
| my $handle = bless {}, $class; | |
| $handle->init; | |
| return $handle; | |
| } | |
| sub init { return } # no-op | |
| ########################################################################### | |
| sub maketext { | |
| # Remember, this can fail. Failure is controllable many ways. | |
| Carp::croak 'maketext requires at least one parameter' unless @_ > 1; | |
| my($handle, $phrase) = splice(@_,0,2); | |
| Carp::confess('No handle/phrase') unless (defined($handle) && defined($phrase)); | |
| # backup $@ in case it it's still being used in the calling code. | |
| # If no failures, we'll re-set it back to what it was later. | |
| my $at = $@; | |
| # Copy @_ case one of its elements is $@. | |
| @_ = @_; | |
| # Look up the value: | |
| my $value; | |
| if (exists $handle->{'_external_lex_cache'}{$phrase}) { | |
| DEBUG and warn "* Using external lex cache version of \"$phrase\"\n"; | |
| $value = $handle->{'_external_lex_cache'}{$phrase}; | |
| } | |
| else { | |
| foreach my $h_r ( | |
| @{ $isa_scan{ref($handle) || $handle} || $handle->_lex_refs } | |
| ) { | |
| DEBUG and warn "* Looking up \"$phrase\" in $h_r\n"; | |
| if(exists $h_r->{$phrase}) { | |
| DEBUG and warn " Found \"$phrase\" in $h_r\n"; | |
| unless(ref($value = $h_r->{$phrase})) { | |
| # Nonref means it's not yet compiled. Compile and replace. | |
| if ($handle->{'use_external_lex_cache'}) { | |
| $value = $handle->{'_external_lex_cache'}{$phrase} = $handle->_compile($value); | |
| } | |
| else { | |
| $value = $h_r->{$phrase} = $handle->_compile($value); | |
| } | |
| } | |
| last; | |
| } | |
| # extending packages need to be able to localize _AUTO and if readonly can't "local $h_r->{'_AUTO'} = 1;" | |
| # but they can "local $handle->{'_external_lex_cache'}{'_AUTO'} = 1;" | |
| elsif($phrase !~ m/^_/s and ($handle->{'use_external_lex_cache'} ? ( exists $handle->{'_external_lex_cache'}{'_AUTO'} ? $handle->{'_external_lex_cache'}{'_AUTO'} : $h_r->{'_AUTO'} ) : $h_r->{'_AUTO'})) { | |
| # it's an auto lex, and this is an autoable key! | |
| DEBUG and warn " Automaking \"$phrase\" into $h_r\n"; | |
| if ($handle->{'use_external_lex_cache'}) { | |
| $value = $handle->{'_external_lex_cache'}{$phrase} = $handle->_compile($phrase); | |
| } | |
| else { | |
| $value = $h_r->{$phrase} = $handle->_compile($phrase); | |
| } | |
| last; | |
| } | |
| DEBUG>1 and print " Not found in $h_r, nor automakable\n"; | |
| # else keep looking | |
| } | |
| } | |
| unless(defined($value)) { | |
| DEBUG and warn "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle, " fails.\n"; | |
| if(ref($handle) and $handle->{'fail'}) { | |
| DEBUG and warn "WARNING0: maketext fails looking for <$phrase>\n"; | |
| my $fail; | |
| if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference | |
| $@ = $at; # Put $@ back in case we altered it along the way. | |
| return &{$fail}($handle, $phrase, @_); | |
| # If it ever returns, it should return a good value. | |
| } | |
| else { # It's a method name | |
| $@ = $at; # Put $@ back in case we altered it along the way. | |
| return $handle->$fail($phrase, @_); | |
| # If it ever returns, it should return a good value. | |
| } | |
| } | |
| else { | |
| # All we know how to do is this; | |
| Carp::croak("maketext doesn't know how to say:\n$phrase\nas needed"); | |
| } | |
| } | |
| if(ref($value) eq 'SCALAR'){ | |
| $@ = $at; # Put $@ back in case we altered it along the way. | |
| return $$value ; | |
| } | |
| if(ref($value) ne 'CODE'){ | |
| $@ = $at; # Put $@ back in case we altered it along the way. | |
| return $value ; | |
| } | |
| { | |
| local $SIG{'__DIE__'}; | |
| eval { $value = &$value($handle, @_) }; | |
| } | |
| # If we make it here, there was an exception thrown in the | |
| # call to $value, and so scream: | |
| if ($@) { | |
| # pretty up the error message | |
| $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?} | |
| {\n in bracket code [compiled line $1],}s; | |
| #$err =~ s/\n?$/\n/s; | |
| Carp::croak "Error in maketexting \"$phrase\":\n$@ as used"; | |
| # Rather unexpected, but suppose that the sub tried calling | |
| # a method that didn't exist. | |
| } | |
| else { | |
| $@ = $at; # Put $@ back in case we altered it along the way. | |
| return $value; | |
| } | |
| $@ = $at; # Put $@ back in case we altered it along the way. | |
| } | |
| ########################################################################### | |
| sub get_handle { # This is a constructor and, yes, it CAN FAIL. | |
| # Its class argument has to be the base class for the current | |
| # application's l10n files. | |
| my($base_class, @languages) = @_; | |
| $base_class = ref($base_class) || $base_class; | |
| # Complain if they use __PACKAGE__ as a project base class? | |
| if( @languages ) { | |
| DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| if($USING_LANGUAGE_TAGS) { # An explicit language-list was given! | |
| @languages = | |
| map {; $_, I18N::LangTags::alternate_language_tags($_) } | |
| # Catch alternation | |
| map I18N::LangTags::locale2language_tag($_), | |
| # If it's a lg tag, fine, pass thru (untainted) | |
| # If it's a locale ID, try converting to a lg tag (untainted), | |
| # otherwise nix it. | |
| @languages; | |
| DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| } | |
| } | |
| else { | |
| @languages = $base_class->_ambient_langprefs; | |
| } | |
| @languages = $base_class->_langtag_munging(@languages); | |
| my %seen; | |
| foreach my $module_name ( map { $base_class . '::' . $_ } @languages ) { | |
| next unless length $module_name; # sanity | |
| next if $seen{$module_name}++ # Already been here, and it was no-go | |
| || !&_try_use($module_name); # Try to use() it, but can't it. | |
| return($module_name->new); # Make it! | |
| } | |
| return undef; # Fail! | |
| } | |
| ########################################################################### | |
| sub _langtag_munging { | |
| my($base_class, @languages) = @_; | |
| # We have all these DEBUG statements because otherwise it's hard as hell | |
| # to diagnose ifwhen something goes wrong. | |
| DEBUG and warn 'Lgs1: ', map("<$_>", @languages), "\n"; | |
| if($USING_LANGUAGE_TAGS) { | |
| DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| @languages = $base_class->_add_supers( @languages ); | |
| push @languages, I18N::LangTags::panic_languages(@languages); | |
| DEBUG and warn "After adding panic languages:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| push @languages, $base_class->fallback_languages; | |
| # You are free to override fallback_languages to return empty-list! | |
| DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| @languages = # final bit of processing to turn them into classname things | |
| map { | |
| my $it = $_; # copy | |
| $it =~ tr<-A-Z><_a-z>; # lc, and turn - to _ | |
| $it =~ tr<_a-z0-9><>cd; # remove all but a-z0-9_ | |
| $it; | |
| } @languages | |
| ; | |
| DEBUG and warn "Nearing end of munging:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| } | |
| else { | |
| DEBUG and warn "Bypassing language-tags.\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| } | |
| DEBUG and warn "Before adding fallback classes:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| push @languages, $base_class->fallback_language_classes; | |
| # You are free to override that to return whatever. | |
| DEBUG and warn "Finally:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| return @languages; | |
| } | |
| ########################################################################### | |
| sub _ambient_langprefs { | |
| return I18N::LangTags::Detect::detect(); | |
| } | |
| ########################################################################### | |
| sub _add_supers { | |
| my($base_class, @languages) = @_; | |
| if (!$MATCH_SUPERS) { | |
| # Nothing | |
| DEBUG and warn "Bypassing any super-matching.\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| } | |
| elsif( $MATCH_SUPERS_TIGHTLY ) { | |
| DEBUG and warn "Before adding new supers tightly:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| @languages = I18N::LangTags::implicate_supers( @languages ); | |
| DEBUG and warn "After adding new supers tightly:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| } | |
| else { | |
| DEBUG and warn "Before adding supers to end:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| @languages = I18N::LangTags::implicate_supers_strictly( @languages ); | |
| DEBUG and warn "After adding supers to end:\n", | |
| ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; | |
| } | |
| return @languages; | |
| } | |
| ########################################################################### | |
| # | |
| # This is where most people should stop reading. | |
| # | |
| ########################################################################### | |
| my %tried = (); | |
| # memoization of whether we've used this module, or found it unusable. | |
| sub _try_use { # Basically a wrapper around "require Modulename" | |
| # "Many men have tried..." "They tried and failed?" "They tried and died." | |
| return $tried{$_[0]} if exists $tried{$_[0]}; # memoization | |
| my $module = $_[0]; # ASSUME sane module name! | |
| { no strict 'refs'; | |
| no warnings 'once'; | |
| return($tried{$module} = 1) | |
| if %{$module . '::Lexicon'} or @{$module . '::ISA'}; | |
| # weird case: we never use'd it, but there it is! | |
| } | |
| DEBUG and warn " About to use $module ...\n"; | |
| local $SIG{'__DIE__'}; | |
| local $@; | |
| eval "require $module"; # used to be "use $module", but no point in that. | |
| if($@) { | |
| DEBUG and warn "Error using $module \: $@\n"; | |
| return $tried{$module} = 0; | |
| } | |
| else { | |
| DEBUG and warn " OK, $module is used\n"; | |
| return $tried{$module} = 1; | |
| } | |
| } | |
| #-------------------------------------------------------------------------- | |
| sub _lex_refs { # report the lexicon references for this handle's class | |
| # returns an arrayREF! | |
| no strict 'refs'; | |
| no warnings 'once'; | |
| my $class = ref($_[0]) || $_[0]; | |
| DEBUG and warn "Lex refs lookup on $class\n"; | |
| return $isa_scan{$class} if exists $isa_scan{$class}; # memoization! | |
| my @lex_refs; | |
| my $seen_r = ref($_[1]) ? $_[1] : {}; | |
| if( defined( *{$class . '::Lexicon'}{'HASH'} )) { | |
| push @lex_refs, *{$class . '::Lexicon'}{'HASH'}; | |
| DEBUG and warn '%' . $class . '::Lexicon contains ', | |
| scalar(keys %{$class . '::Lexicon'}), " entries\n"; | |
| } | |
| # Implements depth(height?)-first recursive searching of superclasses. | |
| # In hindsight, I suppose I could have just used Class::ISA! | |
| foreach my $superclass (@{$class . '::ISA'}) { | |
| DEBUG and warn " Super-class search into $superclass\n"; | |
| next if $seen_r->{$superclass}++; | |
| push @lex_refs, @{&_lex_refs($superclass, $seen_r)}; # call myself | |
| } | |
| $isa_scan{$class} = \@lex_refs; # save for next time | |
| return \@lex_refs; | |
| } | |
| sub clear_isa_scan { %isa_scan = (); return; } # end on a note of simplicity! | |
| #-------------------------------------------------------------------------- | |
| sub _compile { | |
| # This big scary routine compiles an entry. | |
| # It returns either a coderef if there's brackety bits in this, or | |
| # otherwise a ref to a scalar. | |
| my $string_to_compile = $_[1]; # There are taint issues using regex on @_ - perlbug 60378,27344 | |
| # The while() regex is more expensive than this check on strings that don't need a compile. | |
| # this op causes a ~2% speed hit for strings that need compile and a 250% speed improvement | |
| # on strings that don't need compiling. | |
| return \"$string_to_compile" if($string_to_compile !~ m/[\[~\]]/ms); # return a string ref if chars [~] are not in the string | |
| my $target = ref($_[0]) || $_[0]; | |
| my(@code); | |
| my(@c) = (''); # "chunks" -- scratch. | |
| my $call_count = 0; | |
| my $big_pile = ''; | |
| { | |
| my $in_group = 0; # start out outside a group | |
| my($m, @params); # scratch | |
| while($string_to_compile =~ # Iterate over chunks. | |
| m/( | |
| [^\~\[\]]+ # non-~[] stuff (Capture everything else here) | |
| | | |
| ~. # ~[, ~], ~~, ~other | |
| | | |
| \[ # [ presumably opening a group | |
| | | |
| \] # ] presumably closing a group | |
| | | |
| ~ # terminal ~ ? | |
| | | |
| $ | |
| )/xgs | |
| ) { | |
| DEBUG>2 and warn qq{ "$1"\n}; | |
| if($1 eq '[' or $1 eq '') { # "[" or end | |
| # Whether this is "[" or end, force processing of any | |
| # preceding literal. | |
| if($in_group) { | |
| if($1 eq '') { | |
| $target->_die_pointing($string_to_compile, 'Unterminated bracket group'); | |
| } | |
| else { | |
| $target->_die_pointing($string_to_compile, 'You can\'t nest bracket groups'); | |
| } | |
| } | |
| else { | |
| if ($1 eq '') { | |
| DEBUG>2 and warn " [end-string]\n"; | |
| } | |
| else { | |
| $in_group = 1; | |
| } | |
| die "How come \@c is empty?? in <$string_to_compile>" unless @c; # sanity | |
| if(length $c[-1]) { | |
| # Now actually processing the preceding literal | |
| $big_pile .= $c[-1]; | |
| if($USE_LITERALS and ( | |
| (ord('A') == 65) | |
| ? $c[-1] !~ m/[^\x20-\x7E]/s | |
| # ASCII very safe chars | |
| : $c[-1] !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s | |
| # EBCDIC very safe chars | |
| )) { | |
| # normal case -- all very safe chars | |
| $c[-1] =~ s/'/\\'/g; | |
| push @code, q{ '} . $c[-1] . "',\n"; | |
| $c[-1] = ''; # reuse this slot | |
| } | |
| else { | |
| push @code, ' $c[' . $#c . "],\n"; | |
| push @c, ''; # new chunk | |
| } | |
| } | |
| # else just ignore the empty string. | |
| } | |
| } | |
| elsif($1 eq ']') { # "]" | |
| # close group -- go back in-band | |
| if($in_group) { | |
| $in_group = 0; | |
| DEBUG>2 and warn " --Closing group [$c[-1]]\n"; | |
| # And now process the group... | |
| if(!length($c[-1]) or $c[-1] =~ m/^\s+$/s) { | |
| DEBUG>2 and warn " -- (Ignoring)\n"; | |
| $c[-1] = ''; # reset out chink | |
| next; | |
| } | |
| #$c[-1] =~ s/^\s+//s; | |
| #$c[-1] =~ s/\s+$//s; | |
| ($m,@params) = split(/,/, $c[-1], -1); # was /\s*,\s*/ | |
| # A bit of a hack -- we've turned "~,"'s into DELs, so turn | |
| # 'em into real commas here. | |
| if (ord('A') == 65) { # ASCII, etc | |
| foreach($m, @params) { tr/\x7F/,/ } | |
| } | |
| else { # EBCDIC (1047, 0037, POSIX-BC) | |
| # Thanks to Peter Prymmer for the EBCDIC handling | |
| foreach($m, @params) { tr/\x07/,/ } | |
| } | |
| # Special-case handling of some method names: | |
| if($m eq '_*' or $m =~ m/^_(-?\d+)$/s) { | |
| # Treat [_1,...] as [,_1,...], etc. | |
| unshift @params, $m; | |
| $m = ''; | |
| } | |
| elsif($m eq '*') { | |
| $m = 'quant'; # "*" for "times": "4 cars" is 4 times "cars" | |
| } | |
| elsif($m eq '#') { | |
| $m = 'numf'; # "#" for "number": [#,_1] for "the number _1" | |
| } | |
| # Most common case: a simple, legal-looking method name | |
| if($m eq '') { | |
| # 0-length method name means to just interpolate: | |
| push @code, ' ('; | |
| } | |
| elsif($m =~ /^\w+(?:\:\:\w+)*$/s | |
| and $m !~ m/(?:^|\:)\d/s | |
| # exclude starting a (sub)package or symbol with a digit | |
| ) { | |
| # Yes, it even supports the demented (and undocumented?) | |
| # $obj->Foo::bar(...) syntax. | |
| $target->_die_pointing( | |
| $string_to_compile, q{Can't use "SUPER::" in a bracket-group method}, | |
| 2 + length($c[-1]) | |
| ) | |
| if $m =~ m/^SUPER::/s; | |
| # Because for SUPER:: to work, we'd have to compile this into | |
| # the right package, and that seems just not worth the bother, | |
| # unless someone convinces me otherwise. | |
| push @code, ' $_[0]->' . $m . '('; | |
| } | |
| else { | |
| # TODO: implement something? or just too icky to consider? | |
| $target->_die_pointing( | |
| $string_to_compile, | |
| "Can't use \"$m\" as a method name in bracket group", | |
| 2 + length($c[-1]) | |
| ); | |
| } | |
| pop @c; # we don't need that chunk anymore | |
| ++$call_count; | |
| foreach my $p (@params) { | |
| if($p eq '_*') { | |
| # Meaning: all parameters except $_[0] | |
| $code[-1] .= ' @_[1 .. $#_], '; | |
| # and yes, that does the right thing for all @_ < 3 | |
| } | |
| elsif($p =~ m/^_(-?\d+)$/s) { | |
| # _3 meaning $_[3] | |
| $code[-1] .= '$_[' . (0 + $1) . '], '; | |
| } | |
| elsif($USE_LITERALS and ( | |
| (ord('A') == 65) | |
| ? $p !~ m/[^\x20-\x7E]/s | |
| # ASCII very safe chars | |
| : $p !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s | |
| # EBCDIC very safe chars | |
| )) { | |
| # Normal case: a literal containing only safe characters | |
| $p =~ s/'/\\'/g; | |
| $code[-1] .= q{'} . $p . q{', }; | |
| } | |
| else { | |
| # Stow it on the chunk-stack, and just refer to that. | |
| push @c, $p; | |
| push @code, ' $c[' . $#c . '], '; | |
| } | |
| } | |
| $code[-1] .= "),\n"; | |
| push @c, ''; | |
| } | |
| else { | |
| $target->_die_pointing($string_to_compile, q{Unbalanced ']'}); | |
| } | |
| } | |
| elsif(substr($1,0,1) ne '~') { | |
| # it's stuff not containing "~" or "[" or "]" | |
| # i.e., a literal blob | |
| $c[-1] .= $1; | |
| } | |
| elsif($1 eq '~~') { # "~~" | |
| $c[-1] .= '~'; | |
| } | |
| elsif($1 eq '~[') { # "~[" | |
| $c[-1] .= '['; | |
| } | |
| elsif($1 eq '~]') { # "~]" | |
| $c[-1] .= ']'; | |
| } | |
| elsif($1 eq '~,') { # "~," | |
| if($in_group) { | |
| # This is a hack, based on the assumption that no-one will actually | |
| # want a DEL inside a bracket group. Let's hope that's it's true. | |
| if (ord('A') == 65) { # ASCII etc | |
| $c[-1] .= "\x7F"; | |
| } | |
| else { # EBCDIC (cp 1047, 0037, POSIX-BC) | |
| $c[-1] .= "\x07"; | |
| } | |
| } | |
| else { | |
| $c[-1] .= '~,'; | |
| } | |
| } | |
| elsif($1 eq '~') { # possible only at string-end, it seems. | |
| $c[-1] .= '~'; | |
| } | |
| else { | |
| # It's a "~X" where X is not a special character. | |
| # Consider it a literal ~ and X. | |
| $c[-1] .= $1; | |
| } | |
| } | |
| } | |
| if($call_count) { | |
| undef $big_pile; # Well, nevermind that. | |
| } | |
| else { | |
| # It's all literals! Ahwell, that can happen. | |
| # So don't bother with the eval. Return a SCALAR reference. | |
| return \$big_pile; | |
| } | |
| die q{Last chunk isn't null??} if @c and length $c[-1]; # sanity | |
| DEBUG and warn scalar(@c), " chunks under closure\n"; | |
| if(@code == 0) { # not possible? | |
| DEBUG and warn "Empty code\n"; | |
| return \''; | |
| } | |
| elsif(@code > 1) { # most cases, presumably! | |
| unshift @code, "join '',\n"; | |
| } | |
| unshift @code, "use strict; sub {\n"; | |
| push @code, "}\n"; | |
| DEBUG and warn @code; | |
| my $sub = eval(join '', @code); | |
| die "$@ while evalling" . join('', @code) if $@; # Should be impossible. | |
| return $sub; | |
| } | |
| #-------------------------------------------------------------------------- | |
| sub _die_pointing { | |
| # This is used by _compile to throw a fatal error | |
| my $target = shift; # class name | |
| # ...leaving $_[0] the error-causing text, and $_[1] the error message | |
| my $i = index($_[0], "\n"); | |
| my $pointy; | |
| my $pos = pos($_[0]) - (defined($_[2]) ? $_[2] : 0) - 1; | |
| if($pos < 1) { | |
| $pointy = "^=== near there\n"; | |
| } | |
| else { # we need to space over | |
| my $first_tab = index($_[0], "\t"); | |
| if($pos > 2 and ( -1 == $first_tab or $first_tab > pos($_[0]))) { | |
| # No tabs, or the first tab is harmlessly after where we will point to, | |
| # AND we're far enough from the margin that we can draw a proper arrow. | |
| $pointy = ('=' x $pos) . "^ near there\n"; | |
| } | |
| else { | |
| # tabs screw everything up! | |
| $pointy = substr($_[0],0,$pos); | |
| $pointy =~ tr/\t //cd; | |
| # make everything into whitespace, but preserving tabs | |
| $pointy .= "^=== near there\n"; | |
| } | |
| } | |
| my $errmsg = "$_[1], in\:\n$_[0]"; | |
| if($i == -1) { | |
| # No newline. | |
| $errmsg .= "\n" . $pointy; | |
| } | |
| elsif($i == (length($_[0]) - 1) ) { | |
| # Already has a newline at end. | |
| $errmsg .= $pointy; | |
| } | |
| else { | |
| # don't bother with the pointy bit, I guess. | |
| } | |
| Carp::croak( "$errmsg via $target, as used" ); | |
| } | |
| 1; | |
| LOCALE_MAKETEXT | |
| $fatpacked{"Locale/Maketext/Extract.pm"} = <<'LOCALE_MAKETEXT_EXTRACT'; | |
| package Locale::Maketext::Extract; | |
| $Locale::Maketext::Extract::VERSION = '0.38'; | |
| use strict; | |
| use Locale::Maketext::Lexicon(); | |
| =head1 NAME | |
| Locale::Maketext::Extract - Extract translatable strings from source | |
| =head1 SYNOPSIS | |
| my $Ext = Locale::Maketext::Extract->new; | |
| $Ext->read_po('messages.po'); | |
| $Ext->extract_file($_) for <*.pl>; | |
| # Set $entries_are_in_gettext_format if the .pl files above use | |
| # loc('%1') instead of loc('[_1]') | |
| $Ext->compile($entries_are_in_gettext_format); | |
| $Ext->write_po('messages.po'); | |
| ----------------------------------- | |
| ### Specifying parser plugins ### | |
| my $Ext = Locale::Maketext::Extract->new( | |
| # Specify which parser plugins to use | |
| plugins => { | |
| # Use Perl parser, process files with extension .pl .pm .cgi | |
| perl => [], | |
| # Use YAML parser, process all files | |
| yaml => ['*'], | |
| # Use TT2 parser, process files with extension .tt2 .tt .html | |
| # or which match the regex | |
| tt2 => [ | |
| 'tt2', | |
| 'tt', | |
| 'html', | |
| qr/\.tt2?\./ | |
| ], | |
| # Use My::Module as a parser for all files | |
| 'My::Module' => ['*'], | |
| }, | |
| # Warn if a parser can't process a file or problems loading a plugin | |
| warnings => 1, | |
| # List processed files | |
| verbose => 1, | |
| ); | |
| =head1 DESCRIPTION | |
| This module can extract translatable strings from files, and write | |
| them back to PO files. It can also parse existing PO files and merge | |
| their contents with newly extracted strings. | |
| A command-line utility, L<xgettext.pl>, is installed with this module | |
| as well. | |
| The format parsers are loaded as plugins, so it is possible to define | |
| your own parsers. | |
| Following formats of input files are supported: | |
| =over 4 | |
| =item Perl source files (plugin: perl) | |
| Valid localization function names are: C<translate>, C<maketext>, | |
| C<gettext>, C<loc>, C<x>, C<_> and C<__>. | |
| For a slightly more accurate, but much slower Perl parser, you can use the PPI | |
| plugin. This does not have a short name (like C<perl>), but must be specified | |
| in full. | |
| =item HTML::Mason (Mason 1) and Mason (Mason 2) (plugin: mason) | |
| HTML::Mason (aka Mason 1) | |
| Strings inside <&|/l>...</&> and <&|/loc>...</&> are extracted. | |
| Mason (aka Mason 2) | |
| Strings inside <% $.floc { %>...</%> or <% $.fl { %>...</%> or | |
| <% $self->floc { %>...</%> or <% $self->fl { %>...</%> are extracted. | |
| =item Template Toolkit (plugin: tt2) | |
| Valid forms are: | |
| [% | l(arg1,argn) %]string[% END %] | |
| [% 'string' | l(arg1,argn) %] | |
| [% l('string',arg1,argn) %] | |
| FILTER and | are interchangeable | |
| l and loc are interchangeable | |
| args are optional | |
| =item Text::Template (plugin: text) | |
| Sentences between C<STARTxxx> and C<ENDxxx> are extracted individually. | |
| =item YAML (plugin: yaml) | |
| Valid forms are _"string" or _'string', eg: | |
| title: _"My title" | |
| desc: _'My "quoted" string' | |
| Quotes do not have to be escaped, so you could also do: | |
| desc: _"My "quoted" string" | |
| =item HTML::FormFu (plugin: formfu) | |
| HTML::FormFu uses a config-file to generate forms, with built in | |
| support for localizing errors, labels etc. | |
| We extract the text after C<_loc: >: | |
| content_loc: this is the string | |
| message_loc: ['Max string length: [_1]', 10] | |
| =item Generic Template (plugin: generic) | |
| Strings inside {{...}} are extracted. | |
| =back | |
| =head1 METHODS | |
| =head2 Constructor | |
| new() | |
| new( | |
| plugins => {...}, | |
| warnings => 1 | 0, | |
| verbose => 0 | 1 | 2 | 3, | |
| ) | |
| See L</"Plugins">, L</"Warnings"> and L</"Verbose"> for details | |
| =head2 Plugins | |
| $ext->plugins({...}); | |
| Locale::Maketext::Extract uses plugins (see below for the list) | |
| to parse different formats. | |
| Each plugin can also specify which file types it can parse. | |
| # use only the YAML plugin | |
| # only parse files with the default extension list defined in the plugin | |
| # ie .yaml .yml .conf | |
| $ext->plugins({ | |
| yaml => [], | |
| }) | |
| # use only the Perl plugin | |
| # parse all file types | |
| $ext->plugins({ | |
| perl => '*' | |
| }) | |
| $ext->plugins({ | |
| tt2 => [ | |
| 'tt', # matches base filename against /\.tt$/ | |
| qr/\.tt2?\./, # matches base filename against regex | |
| \&my_filter, # codref called | |
| ] | |
| }) | |
| sub my_filter { | |
| my ($base_filename,$path_to_file) = @_; | |
| return 1 | 0; | |
| } | |
| # Specify your own parser | |
| # only parse files with the default extension list defined in the plugin | |
| $ext->plugins({ | |
| 'My::Extract::Parser' => [] | |
| }) | |
| By default, if no plugins are specified, then it uses all of the builtin | |
| plugins, and overrides the file types specified in each plugin | |
| - instead, each plugin is tried for every file. | |
| =head3 Available plugins | |
| =over 4 | |
| =item C<perl> : L<Locale::Maketext::Extract::Plugin::Perl> | |
| For a slightly more accurate but much slower Perl parser, you can use | |
| the PPI plugin. This does not have a short name, but must be specified in | |
| full, ie: L<Locale::Maketext::Extract::Plugin::PPI> | |
| =item C<tt2> : L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item C<yaml> : L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item C<formfu> : L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item C<mason> : L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item C<text> : L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item C<generic> : L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| Also, see L<Locale::Maketext::Extract::Plugin::Base> for details of how to | |
| write your own plugin. | |
| =head2 Warnings | |
| Because the YAML and TT2 plugins use proper parsers, rather than just regexes, | |
| if a source file is not valid and it is unable to parse the file, then the | |
| parser will throw an error and abort parsing. | |
| The next enabled plugin will be tried. | |
| By default, you will not see these errors. If you would like to see them, | |
| then enable warnings via new(). All parse errors will be printed to STDERR. | |
| Also, if developing your own plugin, turn on warnings to see any errors that | |
| result from loading your plugin. | |
| =head2 Verbose | |
| If you would like to see which files have been processed, which plugins were | |
| used, and which strings were extracted, then enable C<verbose>. If no | |
| acceptable plugin was found, or no strings were extracted, then the file | |
| is not listed: | |
| $ext = Locale::Extract->new( verbose => 1 | 2 | 3); | |
| OR | |
| xgettext.pl ... -v # files reported | |
| xgettext.pl ... -v -v # files and plugins reported | |
| xgettext.pl ... -v -v -v # files, plugins and strings reported | |
| =cut | |
| our %Known_Plugins = ( | |
| perl => 'Locale::Maketext::Extract::Plugin::Perl', | |
| yaml => 'Locale::Maketext::Extract::Plugin::YAML', | |
| tt2 => 'Locale::Maketext::Extract::Plugin::TT2', | |
| text => 'Locale::Maketext::Extract::Plugin::TextTemplate', | |
| mason => 'Locale::Maketext::Extract::Plugin::Mason', | |
| generic => 'Locale::Maketext::Extract::Plugin::Generic', | |
| formfu => 'Locale::Maketext::Extract::Plugin::FormFu', | |
| ); | |
| sub new { | |
| my $class = shift; | |
| my %params = @_; | |
| my $plugins = delete $params{plugins} | |
| || { map { $_ => '*' } keys %Known_Plugins }; | |
| Locale::Maketext::Lexicon::set_option( 'keep_fuzzy' => 1 ); | |
| my $self = bless( { header => '', | |
| entries => {}, | |
| compiled_entries => {}, | |
| lexicon => {}, | |
| warnings => 0, | |
| verbose => 0, | |
| wrap => 0, | |
| %params, | |
| }, | |
| $class | |
| ); | |
| $self->{verbose} ||= 0; | |
| die "No plugins defined in new()" | |
| unless $plugins; | |
| $self->plugins($plugins); | |
| return $self; | |
| } | |
| =head2 Accessors | |
| header, set_header | |
| lexicon, set_lexicon, msgstr, set_msgstr | |
| entries, set_entries, entry, add_entry, del_entry | |
| compiled_entries, set_compiled_entries, compiled_entry, | |
| add_compiled_entry, del_compiled_entry | |
| clear | |
| =cut | |
| sub header { $_[0]{header} || _default_header() } | |
| sub set_header { $_[0]{header} = $_[1] } | |
| sub lexicon { $_[0]{lexicon} } | |
| sub set_lexicon { $_[0]{lexicon} = $_[1] || {}; delete $_[0]{lexicon}{''}; } | |
| sub msgstr { $_[0]{lexicon}{ $_[1] } } | |
| sub set_msgstr { $_[0]{lexicon}{ $_[1] } = $_[2] } | |
| sub entries { $_[0]{entries} } | |
| sub set_entries { $_[0]{entries} = $_[1] || {} } | |
| sub compiled_entries { $_[0]{compiled_entries} } | |
| sub set_compiled_entries { $_[0]{compiled_entries} = $_[1] || {} } | |
| sub entry { @{ $_[0]->entries->{ $_[1] } || [] } } | |
| sub add_entry { push @{ $_[0]->entries->{ $_[1] } }, $_[2] } | |
| sub del_entry { delete $_[0]->entries->{ $_[1] } } | |
| sub compiled_entry { @{ $_[0]->compiled_entries->{ $_[1] } || [] } } | |
| sub add_compiled_entry { push @{ $_[0]->compiled_entries->{ $_[1] } }, $_[2] } | |
| sub del_compiled_entry { delete $_[0]->compiled_entries->{ $_[1] } } | |
| sub plugins { | |
| my $self = shift; | |
| if (@_) { | |
| my @plugins; | |
| my %params = %{ shift @_ }; | |
| foreach my $name ( keys %params ) { | |
| my $plugin_class = $Known_Plugins{$name} || $name; | |
| my $filename = $plugin_class . '.pm'; | |
| $filename =~ s/::/\//g; | |
| local $@; | |
| eval { | |
| require $filename && 1; | |
| 1; | |
| } or do { | |
| my $error = $@ || 'Unknown'; | |
| print STDERR "Error loading $plugin_class: $error\n" | |
| if $self->{warnings}; | |
| next; | |
| }; | |
| push @plugins, $plugin_class->new( $params{$name} ); | |
| } | |
| $self->{plugins} = \@plugins; | |
| } | |
| return $self->{plugins} || []; | |
| } | |
| sub clear { | |
| $_[0]->set_header; | |
| $_[0]->set_lexicon; | |
| $_[0]->set_comments; | |
| $_[0]->set_fuzzy; | |
| $_[0]->set_entries; | |
| $_[0]->set_compiled_entries; | |
| } | |
| =head2 PO File manipulation | |
| =head3 method read_po ($file) | |
| =cut | |
| sub read_po { | |
| my ( $self, $file ) = @_; | |
| print STDERR "READING PO FILE : $file\n" | |
| if $self->{verbose}; | |
| my $header = ''; | |
| local ( *LEXICON, $_ ); | |
| open LEXICON, $file or die $!; | |
| while (<LEXICON>) { | |
| ( 1 .. /^$/ ) or last; | |
| $header .= $_; | |
| } | |
| 1 while chomp $header; | |
| $self->set_header("$header\n"); | |
| require Locale::Maketext::Lexicon::Gettext; | |
| my $lexicon = {}; | |
| my $comments = {}; | |
| my $fuzzy = {}; | |
| $self->set_compiled_entries( {} ); | |
| if ( defined($_) ) { | |
| ( $lexicon, $comments, $fuzzy ) | |
| = Locale::Maketext::Lexicon::Gettext->parse( $_, <LEXICON> ); | |
| } | |
| # Internally the lexicon is in gettext format already. | |
| $self->set_lexicon( { map _maketext_to_gettext($_), %$lexicon } ); | |
| $self->set_comments($comments); | |
| $self->set_fuzzy($fuzzy); | |
| close LEXICON; | |
| } | |
| sub msg_comment { | |
| my $self = shift; | |
| my $msgid = shift; | |
| my $comment = $self->{comments}->{$msgid}; | |
| return $comment; | |
| } | |
| sub msg_fuzzy { | |
| return $_[0]->{fuzzy}{$_[1]} ? ', fuzzy' : ''; | |
| } | |
| sub set_comments { | |
| $_[0]->{comments} = $_[1]; | |
| } | |
| sub set_fuzzy { | |
| $_[0]->{fuzzy} = $_[1]; | |
| } | |
| =head3 method write_po ($file, $add_format_marker?) | |
| =cut | |
| sub write_po { | |
| my ( $self, $file, $add_format_marker ) = @_; | |
| print STDERR "WRITING PO FILE : $file\n" | |
| if $self->{verbose}; | |
| local *LEXICON; | |
| open LEXICON, ">$file" or die "Can't write to $file$!\n"; | |
| print LEXICON $self->header; | |
| foreach my $msgid ( $self->msgids ) { | |
| $self->normalize_space($msgid); | |
| print LEXICON "\n"; | |
| if ( my $comment = $self->msg_comment($msgid) ) { | |
| my @lines = split "\n", $comment; | |
| print LEXICON map {"# $_\n"} @lines; | |
| } | |
| print LEXICON $self->msg_variables($msgid); | |
| print LEXICON $self->msg_positions($msgid); | |
| my $flags = $self->msg_fuzzy($msgid); | |
| $flags.= $self->msg_format($msgid) if $add_format_marker; | |
| print LEXICON "#$flags\n" if $flags; | |
| print LEXICON $self->msg_out($msgid); | |
| } | |
| print STDERR "DONE\n\n" | |
| if $self->{verbose}; | |
| } | |
| =head2 Extraction | |
| extract | |
| extract_file | |
| =cut | |
| sub extract { | |
| my $self = shift; | |
| my $file = shift; | |
| my $content = shift; | |
| local $@; | |
| my ( @messages, $total, $error_found ); | |
| $total = 0; | |
| my $verbose = $self->{verbose}; | |
| foreach my $plugin ( @{ $self->plugins } ) { | |
| if ( $plugin->known_file_type($file) ) { | |
| pos($content) = 0; | |
| my $success = eval { $plugin->extract($content); 1; }; | |
| if ($success) { | |
| my $entries = $plugin->entries; | |
| if ( $verbose > 1 && @$entries ) { | |
| push @messages, | |
| " - " | |
| . ref($plugin) | |
| . ' - Strings extracted : ' | |
| . ( scalar @$entries ); | |
| } | |
| for my $entry (@$entries) { | |
| my ( $string, $line, $vars ) = @$entry; | |
| $self->add_entry( $string => [ $file, $line, $vars ] ); | |
| if ( $verbose > 2 ) { | |
| $vars = '' if !defined $vars; | |
| # pad string | |
| $string =~ s/\n/\n /g; | |
| push @messages, | |
| sprintf( qq[ - %-8s "%s" (%s)], | |
| $line . ':', | |
| $string, $vars | |
| ), | |
| ; | |
| } | |
| } | |
| $total += @$entries; | |
| } | |
| else { | |
| $error_found++; | |
| if ( $self->{warnings} ) { | |
| push @messages, | |
| "Error parsing '$file' with plugin " | |
| . ( ref $plugin ) | |
| . ": \n $@\n"; | |
| } | |
| } | |
| $plugin->clear; | |
| } | |
| } | |
| print STDERR " * $file\n - Total strings extracted : $total" | |
| . ( $error_found ? ' [ERROR ] ' : '' ) . "\n" | |
| if $verbose | |
| && ( $total || $error_found ); | |
| print STDERR join( "\n", @messages ) . "\n" | |
| if @messages; | |
| } | |
| sub extract_file { | |
| my ( $self, $file ) = @_; | |
| local ( $/, *FH ); | |
| open FH, $file or die "Error reading from file '$file' : $!"; | |
| my $content = scalar <FH>; | |
| $self->extract( $file => $content ); | |
| close FH; | |
| } | |
| =head2 Compilation | |
| =head3 compile($entries_are_in_gettext_style?) | |
| Merges the C<entries> into C<compiled_entries>. | |
| If C<$entries_are_in_gettext_style> is true, the previously extracted entries | |
| are assumed to be in the B<Gettext> style (e.g. C<%1>). | |
| Otherwise they are assumed to be in B<Maketext> style (e.g. C<[_1]>) and are | |
| converted into B<Gettext> style before merging into C<compiled_entries>. | |
| The C<entries> are I<not> cleared after each compilation; use | |
| C<->set_entries()> to clear them if you need to extract from sources with | |
| varying styles. | |
| =cut | |
| sub compile { | |
| my ( $self, $entries_are_in_gettext_style ) = @_; | |
| my $entries = $self->entries; | |
| my $lexicon = $self->lexicon; | |
| my $comp = $self->compiled_entries; | |
| while ( my ( $k, $v ) = each %$entries ) { | |
| my $compiled_key = ( ($entries_are_in_gettext_style) | |
| ? $k | |
| : _maketext_to_gettext($k) | |
| ); | |
| $comp->{$compiled_key} = $v; | |
| $lexicon->{$compiled_key} = '' | |
| unless exists $lexicon->{$compiled_key}; | |
| } | |
| return %$lexicon; | |
| } | |
| =head3 normalize_space | |
| =cut | |
| my %Escapes = map { ( "\\$_" => eval("qq(\\$_)") ) } qw(t r f b a e); | |
| sub normalize_space { | |
| my ( $self, $msgid ) = @_; | |
| my $nospace = $msgid; | |
| $nospace =~ s/ +$//; | |
| return | |
| unless ( !$self->has_msgid($msgid) and $self->has_msgid($nospace) ); | |
| $self->set_msgstr( $msgid => $self->msgstr($nospace) | |
| . ( ' ' x ( length($msgid) - length($nospace) ) ) ); | |
| } | |
| =head2 Lexicon accessors | |
| msgids, has_msgid, | |
| msgstr, set_msgstr | |
| msg_positions, msg_variables, msg_format, msg_out | |
| =cut | |
| sub msgids { sort keys %{ $_[0]{lexicon} } } | |
| sub has_msgid { | |
| my $msg_str = $_[0]->msgstr( $_[1] ); | |
| return defined $msg_str ? length $msg_str : 0; | |
| } | |
| sub msg_positions { | |
| my ( $self, $msgid ) = @_; | |
| my %files = ( map { ( " $_->[0]:$_->[1]" => 1 ) } | |
| $self->compiled_entry($msgid) ); | |
| return $self->{wrap} | |
| ? join( "\n", ( map { '#:' . $_ } sort( keys %files ) ), '' ) | |
| : join( '', '#:', sort( keys %files ), "\n" ); | |
| } | |
| sub msg_variables { | |
| my ( $self, $msgid ) = @_; | |
| my $out = ''; | |
| my %seen; | |
| foreach my $entry ( grep { $_->[2] } $self->compiled_entry($msgid) ) { | |
| my ( $file, $line, $var ) = @$entry; | |
| $var =~ s/^\s*,\s*//; | |
| $var =~ s/\s*$//; | |
| $out .= "#. ($var)\n" unless !length($var) or $seen{$var}++; | |
| } | |
| return $out; | |
| } | |
| sub msg_format { | |
| my ( $self, $msgid ) = @_; | |
| return ", perl-maketext-format" | |
| if $msgid =~ /%(?:[1-9]\d*|\w+\([^\)]*\))/; | |
| return ''; | |
| } | |
| sub msg_out { | |
| my ( $self, $msgid ) = @_; | |
| my $msgstr = $self->msgstr($msgid); | |
| return "msgid " . _format($msgid) . "msgstr " . _format($msgstr); | |
| } | |
| =head2 Internal utilities | |
| _default_header | |
| _maketext_to_gettext | |
| _escape | |
| _format | |
| =cut | |
| sub _default_header { | |
| return << '.'; | |
| # SOME DESCRIPTIVE TITLE. | |
| # Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER | |
| # This file is distributed under the same license as the PACKAGE package. | |
| # FIRST AUTHOR <EMAIL@ADDRESS>, YEAR. | |
| # | |
| #, fuzzy | |
| msgid "" | |
| msgstr "" | |
| "Project-Id-Version: PACKAGE VERSION\n" | |
| "POT-Creation-Date: YEAR-MO-DA HO:MI+ZONE\n" | |
| "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" | |
| "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" | |
| "Language-Team: LANGUAGE <[email protected]>\n" | |
| "MIME-Version: 1.0\n" | |
| "Content-Type: text/plain; charset=CHARSET\n" | |
| "Content-Transfer-Encoding: 8bit\n" | |
| . | |
| } | |
| sub _maketext_to_gettext { | |
| my $text = shift; | |
| return '' unless defined $text; | |
| $text =~ s{((?<!~)(?:~~)*)\[_([1-9]\d*|\*)\]} | |
| {$1%$2}g; | |
| $text =~ s{((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]} | |
| {"$1%$2(" . _escape($3) . ')'}eg; | |
| $text =~ s/~([\~\[\]])/$1/g; | |
| return $text; | |
| } | |
| sub _escape { | |
| my $text = shift; | |
| $text =~ s/\b_([1-9]\d*)/%$1/g; | |
| return $text; | |
| } | |
| sub _format { | |
| my $str = shift; | |
| $str =~ s/(?=[\\"])/\\/g; | |
| while ( my ( $char, $esc ) = each %Escapes ) { | |
| $str =~ s/$esc/$char/g; | |
| } | |
| return "\"$str\"\n" unless $str =~ /\n/; | |
| my $multi_line = ( $str =~ /\n(?!\z)/ ); | |
| $str =~ s/\n/\\n"\n"/g; | |
| if ( $str =~ /\n"$/ ) { | |
| chop $str; | |
| } | |
| else { | |
| $str .= "\"\n"; | |
| } | |
| return $multi_line ? qq(""\n"$str) : qq("$str); | |
| } | |
| 1; | |
| =head1 ACKNOWLEDGMENTS | |
| Thanks to Jesse Vincent for contributing to an early version of this | |
| module. | |
| Also to Alain Barbet, who effectively re-wrote the source parser with a | |
| flex-like algorithm. | |
| =head1 SEE ALSO | |
| L<xgettext.pl>, L<Locale::Maketext>, L<Locale::Maketext::Lexicon> | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2003-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| LOCALE_MAKETEXT_EXTRACT | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/Base.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_BASE'; | |
| package Locale::Maketext::Extract::Plugin::Base; | |
| use strict; | |
| use File::Basename qw(fileparse); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::Base - Base module for format parser plugins | |
| =head1 SYNOPSIS | |
| package My::Parser::Plugin; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| sub file_types { | |
| return [qw( ext ext2 )] | |
| } | |
| sub extract { | |
| my $self = shift; | |
| local $_ = shift; | |
| my $line = 1; | |
| while (my $found = $self->routine_to_extract_strings) { | |
| $self->add_entry($str,[$filename,$line,$vars]) | |
| } | |
| return; | |
| } | |
| =head1 DESCRIPTION | |
| All format parser plugins in Locale::Maketext::Extract inherit from | |
| Locale::Maketext::Extract::Plugin::Base. | |
| If you want to write your own custom parser plugin, you will need to inherit | |
| from this module, and provide C<file_types()> and C<extract()> methods, | |
| as shown above. | |
| =head1 METHODS | |
| =over 4 | |
| =item new() | |
| $plugin = My::Parser->new( | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| =cut | |
| sub new { | |
| my $class = shift; | |
| my $self = bless { | |
| entries => [], | |
| }, $class; | |
| $self->_compile_file_types(@_); | |
| return $self; | |
| } | |
| =item add_entry() | |
| $plugin->add_entry($str,$line,$vars) | |
| =cut | |
| sub add_entry { | |
| my $self = shift; | |
| push @{$self->{entries}},[@_]; | |
| } | |
| =item C<entries()> | |
| $entries = $plugin->entries; | |
| =cut | |
| #=================================== | |
| sub entries { | |
| #=================================== | |
| my $self = shift; | |
| return $self->{entries}; | |
| } | |
| =item C<clear()> | |
| $plugin->clear | |
| Clears all stored entries. | |
| =cut | |
| #=================================== | |
| sub clear { | |
| #=================================== | |
| my $self = shift; | |
| $self->{entries}=[]; | |
| } | |
| =item file_types() | |
| @default_file_types = $plugin->file_types | |
| Returns a list of recognised file types that your module knows how to parse. | |
| Each file type can be one of: | |
| =over 4 | |
| =item * A plain string | |
| 'pl' => base filename is matched against qr/\.pl$/ | |
| '*' => all files are accepted | |
| =item * A regex | |
| qr/\.tt2?\./ => base filename is matched against this regex | |
| =item * A codref | |
| sub {} => this codref is called as $coderef->($base_filename,$path_to_file) | |
| It should return true or false | |
| =back | |
| =cut | |
| sub file_types { | |
| die "Please override sub file_types() to return " | |
| . "a list of recognised file extensions, or regexes"; | |
| } | |
| =item extract() | |
| $plugin->extract($filecontents); | |
| extract() is the method that will be called to process the contents of the | |
| current file. | |
| When it finds a string that should be extracted, it should call | |
| $self->add_entry($string,$line,$vars]) | |
| where C<$vars> refers to any arguments that are being passed to the localise | |
| function. For instance: | |
| l("You found [quant,_1,file,files]",files_found) | |
| string: "You found [quant,_1,file,files]" | |
| vars : (files_found) | |
| IMPORTANT: a single plugin instance is used for all files, so if you plan | |
| on storing state information in the C<$plugin> object, this should be cleared | |
| out at the beginning of C<extract()> | |
| =cut | |
| sub extract { | |
| die "Please override sub extract()"; | |
| } | |
| sub _compile_file_types { | |
| my $self = shift; | |
| my @file_types | |
| = ref $_[0] eq 'ARRAY' | |
| ? @{ shift @_ } | |
| : @_; | |
| @file_types = $self->file_types | |
| unless @file_types; | |
| my @checks; | |
| if ( grep { $_ eq '*' } @file_types ) { | |
| $self->{file_checks} = [ sub {1} ]; | |
| return; | |
| } | |
| foreach my $type (@file_types) { | |
| if ( ref $type eq 'CODE' ) { | |
| push @checks, $type; | |
| next; | |
| } | |
| else { | |
| my $regex | |
| = ref $type | |
| ? $type | |
| : qr/^.*\.\Q$type\E$/; | |
| push @checks, sub { $_[0] =~ m/$regex/ }; | |
| } | |
| } | |
| $self->{file_checks} = \@checks; | |
| } | |
| =item known_file_type() | |
| if ($plugin->known_file_type($filename_with_path)) { | |
| .... | |
| } | |
| Determines whether the current file should be handled by this parser, based | |
| either on the list of file_types specified when this object was created, | |
| or the default file_types specified in the module. | |
| =cut | |
| sub known_file_type { | |
| my $self = shift; | |
| my ( $name, $path ) = fileparse( shift @_ ); | |
| foreach my $check ( @{ $self->{file_checks} } ) { | |
| return 1 if $check->( $name, $path ); | |
| } | |
| return 0; | |
| } | |
| =back | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::PPI> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| =head1 AUTHORS | |
| Clinton Gormley [DRTECH] E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_BASE | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/FormFu.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_FORMFU'; | |
| package Locale::Maketext::Extract::Plugin::FormFu; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::FormFu - FormFu format parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::FormFu->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| HTML::FormFu uses a config-file to generate forms, with built in support | |
| for localizing errors, labels etc. | |
| =head1 SHORT PLUGIN NAME | |
| formfu | |
| =head1 VALID FORMATS | |
| We extract the text after any key which ends in C<_loc>: | |
| content_loc: this is the string | |
| message_loc: ['Max length [_1]', 10] | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item .yaml | |
| =item .yml | |
| =item .conf | |
| =back | |
| =head1 REQUIRES | |
| L<YAML> | |
| =head1 NOTES | |
| The docs for the YAML module describes it as alpha code. It is not as tolerant | |
| of errors as L<YAML::Syck>. However, because it is pure Perl, it is easy | |
| to hook into. | |
| I have seen it enter endless loops, so if xgettext.pl hangs, try running it | |
| again with C<--verbose --verbose> (twice) enabled, so that you can see if | |
| the fault lies with YAML. If it does, either correct the YAML source file, | |
| or use the file_types to exclude that file. | |
| =cut | |
| sub file_types { | |
| return qw( yaml yml conf ); | |
| } | |
| sub extract { | |
| my $self = shift; | |
| my $data = shift; | |
| my $y = Locale::Maketext::Extract::Plugin::FormFu::Extractor->new(); | |
| $y->load($data); | |
| foreach my $entry ( @{ $y->found } ) { | |
| $self->add_entry(@$entry); | |
| } | |
| } | |
| package Locale::Maketext::Extract::Plugin::FormFu::Extractor; | |
| use base qw(YAML::Loader); | |
| #=================================== | |
| sub new { | |
| #=================================== | |
| my $class = shift; | |
| my $self = $class->SUPER::new(@_); | |
| $self->{found} = []; | |
| return $self; | |
| } | |
| #=================================== | |
| sub _check_key { | |
| #=================================== | |
| my $self = shift; | |
| my ( $key, $value, $line ) = @_; | |
| my ( $str, $vars ); | |
| if ( ref $value ) { | |
| return if ref $value ne 'ARRAY'; | |
| $str = shift @$value; | |
| $vars = join( ', ', @$value ); | |
| } | |
| else { | |
| $str = $value; | |
| } | |
| return | |
| unless $key | |
| && $key =~ /_loc$/ | |
| && defined $str; | |
| push @{ $self->{found} }, [ $str, $line, $vars ]; | |
| } | |
| #=================================== | |
| sub _parse_mapping { | |
| #=================================== | |
| my $self = shift; | |
| my ($anchor) = @_; | |
| my $mapping = {}; | |
| $self->anchor2node->{$anchor} = $mapping; | |
| my $key; | |
| while ( not $self->done | |
| and $self->indent == $self->offset->[ $self->level ] ) | |
| { | |
| # If structured key: | |
| if ( $self->{content} =~ s/^\?\s*// ) { | |
| $self->preface( $self->content ); | |
| $self->_parse_next_line(YAML::Loader::COLLECTION); | |
| $key = $self->_parse_node(); | |
| $key = "$key"; | |
| } | |
| # If "default" key (equals sign) | |
| elsif ( $self->{content} =~ s/^\=\s*// ) { | |
| $key = YAML::Loader::VALUE; | |
| } | |
| # If "comment" key (slash slash) | |
| elsif ( $self->{content} =~ s/^\=\s*// ) { | |
| $key = YAML::Loader::COMMENT; | |
| } | |
| # Regular scalar key: | |
| else { | |
| $self->inline( $self->content ); | |
| $key = $self->_parse_inline(); | |
| $key = "$key"; | |
| $self->content( $self->inline ); | |
| $self->inline(''); | |
| } | |
| unless ( $self->{content} =~ s/^:\s*// ) { | |
| $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT'); | |
| } | |
| $self->preface( $self->content ); | |
| my $line = $self->line; | |
| $self->_parse_next_line(YAML::Loader::COLLECTION); | |
| my $value = $self->_parse_node(); | |
| if ( exists $mapping->{$key} ) { | |
| $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY'); | |
| } | |
| else { | |
| $mapping->{$key} = $value; | |
| $self->_check_key( $key, $value, $line ); | |
| } | |
| } | |
| return $mapping; | |
| } | |
| #=================================== | |
| sub _parse_inline_mapping { | |
| #=================================== | |
| my $self = shift; | |
| my ($anchor) = @_; | |
| my $node = {}; | |
| my $start_line = $self->{_start_line}; | |
| $self->anchor2node->{$anchor} = $node; | |
| $self->die('YAML_PARSE_ERR_INLINE_MAP') | |
| unless $self->{inline} =~ s/^\{\s*//; | |
| while ( not $self->{inline} =~ s/^\s*\}// ) { | |
| my $key = $self->_parse_inline(); | |
| $self->die('YAML_PARSE_ERR_INLINE_MAP') | |
| unless $self->{inline} =~ s/^\: \s*//; | |
| my $value = $self->_parse_inline(); | |
| if ( exists $node->{$key} ) { | |
| $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY'); | |
| } | |
| else { | |
| $node->{$key} = $value; | |
| $self->_check_key( $key, $value, $start_line ); | |
| } | |
| next if $self->inline =~ /^\s*\}/; | |
| $self->die('YAML_PARSE_ERR_INLINE_MAP') | |
| unless $self->{inline} =~ s/^\,\s*//; | |
| } | |
| return $node; | |
| } | |
| #=================================== | |
| sub _parse_next_line { | |
| #=================================== | |
| my $self = shift; | |
| $self->{_start_line} = $self->line; | |
| $self->SUPER::_parse_next_line(@_); | |
| } | |
| #=================================== | |
| sub found { | |
| #=================================== | |
| my $self = shift; | |
| return $self->{found}; | |
| } | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<YAML> | |
| =item L<HTML::FormFu> | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| =head1 AUTHORS | |
| Clinton Gormley E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_FORMFU | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/Generic.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_GENERIC'; | |
| package Locale::Maketext::Extract::Plugin::Generic; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::Generic - Generic template parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::Generic->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| Extracts strings to localise from generic templates. | |
| =head1 SHORT PLUGIN NAME | |
| generic | |
| =head1 VALID FORMATS | |
| Strings inside {{...}} are extracted. | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item All file types | |
| =back | |
| =cut | |
| sub file_types { | |
| return qw( * ); | |
| } | |
| sub extract { | |
| my $self = shift; | |
| local $_ = shift; | |
| my $line = 1; | |
| # Generic Template: | |
| $line = 1; pos($_) = 0; | |
| while (m/\G(.*?(?<!\{)\{\{(?!\{)(.*?)\}\})/sg) { | |
| my ($vars, $str) = ('', $2); | |
| $line += ( () = ($1 =~ /\n/g) ); # cryptocontext! | |
| $self->add_entry($str, $line, $vars ); | |
| } | |
| my $quoted = '(\')([^\\\']*(?:\\.[^\\\']*)*)(\')|(\")([^\\\"]*(?:\\.[^\\\"]*)*)(\")'; | |
| # Comment-based mark: "..." # loc | |
| $line = 1; pos($_) = 0; | |
| while (m/\G(.*?($quoted)[\}\)\],;]*\s*\#\s*loc\s*$)/smog) { | |
| my $str = substr($2, 1, -1); | |
| $line += ( () = ( $1 =~ /\n/g ) ); # cryptocontext! | |
| $str =~ s/\\(["'])/$1/g; | |
| $self->add_entry($str, $line, '' ); | |
| } | |
| # Comment-based pair mark: "..." => "..." # loc_pair | |
| $line = 1; pos($_) = 0; | |
| while (m/\G(.*?(\w+)\s*=>\s*($quoted)[\}\)\],;]*\s*\#\s*loc_pair\s*$)/smg) { | |
| my $key = $2; | |
| my $val = substr($3, 1, -1); | |
| $line += ( () = ( $1 =~ /\n/g ) ); # cryptocontext! | |
| $key =~ s/\\(["'])/$1/g; | |
| $val =~ s/\\(["'])/$1/g; | |
| $self->add_entry($val, $line, '' ); | |
| } | |
| } | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =back | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_GENERIC | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/Mason.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_MASON'; | |
| package Locale::Maketext::Extract::Plugin::Mason; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::Mason - HTML::Mason (aka Mason 1) and Mason | |
| (aka Mason 2) format parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::Mason->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| Extracts strings to localise from Mason files. | |
| =head1 SHORT PLUGIN NAME | |
| mason | |
| =head1 VALID FORMATS | |
| HTML::Mason (aka Mason 1) | |
| Strings inside <&|/l>...</&> and <&|/loc>...</&> are extracted. | |
| Mason (aka Mason 2) | |
| Strings inside <% $.floc { %>...</%> or <% $.fl { %>...</%> or | |
| <% $self->floc { %>...</%> or <% $self->fl { %>...</%> are extracted. | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item All file types | |
| =back | |
| =cut | |
| sub file_types { | |
| return qw( * ); | |
| } | |
| sub extract { | |
| my $self = shift; | |
| local $_ = shift; | |
| my $line = 1; | |
| # HTML::Mason (aka Mason 1) | |
| while (m!\G(.*?<&\|[ ]*/l(?:oc)?(?:[ ]*,[ ]*(.*?))?[ ]*&>(.*?)</&>)!sg) { | |
| my ( $vars, $str ) = ( $2, $3 ); | |
| $line += ( () = ( $1 =~ /\n/g ) ); # cryptocontext! | |
| $self->add_entry( $str, $line, $vars ); | |
| } | |
| # Mason (aka Mason 2) | |
| while ( | |
| m!\G(.*?<%[ ]*(?:\$(?:\.|self->))fl(?:oc)?(?:[ ]*\((.*?)\))?[ ]*{[ ]*%>(.*?)</%>)!sg | |
| ) | |
| { | |
| my ( $vars, $str ) = ( $2, $3 ); | |
| $line += ( () = ( $1 =~ /\n/g ) ); # cryptocontext! | |
| $self->add_entry( $str, $line, $vars ); | |
| } | |
| } | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_MASON | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/PPI.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_PPI'; | |
| package Locale::Maketext::Extract::Plugin::PPI; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| use PPI(); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::PPI - Perl format parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::PPI->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| Does exactly the same thing as the L<Locale::Maketext::Extract::Plugin::Perl> | |
| parser, but more accurately, and more slowly. Considerably more slowly! For this | |
| reason it isn't a built-in plugin. | |
| =head1 SHORT PLUGIN NAME | |
| none - the module must be specified in full | |
| =head1 VALID FORMATS | |
| Valid localization function names are: | |
| =over 4 | |
| =item translate | |
| =item maketext | |
| =item gettext | |
| =item loc | |
| =item x | |
| =item _ | |
| =item __ | |
| =back | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item .pm | |
| =item .pl | |
| =item .cgi | |
| =back | |
| =cut | |
| sub file_types { | |
| return qw( pm pl cgi ); | |
| } | |
| my %subnames = map { $_ => 1 } qw (translate maketext gettext loc x __); | |
| #=================================== | |
| sub extract { | |
| #=================================== | |
| my $self = shift; | |
| my $text = shift; | |
| my $doc = PPI::Document->new( \$text, index_locations => 1 ); | |
| foreach my $statement ( @{ $doc->find('PPI::Statement') } ) { | |
| my @children = $statement->schildren; | |
| while ( my $child = shift @children ) { | |
| next | |
| unless @children | |
| && ( $child->isa('PPI::Token::Word') | |
| && $subnames{ $child->content } | |
| || $child->isa('PPI::Token::Magic') | |
| && $child->content eq '_' ); | |
| my $list = shift @children; | |
| next | |
| unless $list->isa('PPI::Structure::List') | |
| && $list->schildren; | |
| $self->_check_arg_list($list); | |
| } | |
| } | |
| } | |
| #=================================== | |
| sub _check_arg_list { | |
| #=================================== | |
| my $self = shift; | |
| my $list = shift; | |
| my @args = ( $list->schildren )[0]->schildren; | |
| my $final_string = ''; | |
| my ( $line, $mode ); | |
| while ( my $string_el = shift @args ) { | |
| return | |
| unless $string_el->isa('PPI::Token::Quote') | |
| || $string_el->isa('PPI::Token::HereDoc'); | |
| $line ||= $string_el->location->[0]; | |
| my $string; | |
| if ( $string_el->isa('PPI::Token::HereDoc') ) { | |
| $string = join( '', $string_el->heredoc ); | |
| $mode | |
| = $string_el->{_mode} eq 'interpolate' | |
| ? 'double' | |
| : 'literal'; | |
| } | |
| else { | |
| $string = $string_el->string; | |
| $mode | |
| = $string_el->isa('PPI::Token::Quote::Literal') ? 'literal' | |
| : ( $string_el->isa('PPI::Token::Quote::Double') | |
| || $string_el->isa('PPI::Token::Quote::Interpolate') ) | |
| ? 'double' | |
| : 'single'; | |
| } | |
| if ( $mode eq 'double' ) { | |
| return | |
| if !!( $string =~ /(?<!\\)(?:\\\\)*[\$\@]/ ); | |
| $string = eval qq("$string"); | |
| } | |
| elsif ( $mode eq 'single' ) { | |
| $string =~ s/\\'/'/g; | |
| } | |
| # $string =~ s/(?<!\\)\\//g; | |
| $string =~ s/\\\\/\\/g; | |
| # unless $mode eq 'literal'; | |
| $final_string .= $string; | |
| my $next_op = shift @args; | |
| last | |
| unless $next_op | |
| && $next_op->isa('PPI::Token::Operator') | |
| && $next_op->content eq '.'; | |
| } | |
| return unless $final_string; | |
| my $vars = join( '', map { $_->content } @args ); | |
| $self->add_entry( $final_string, $line, $vars ); | |
| } | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_PPI | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/Perl.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_PERL'; | |
| package Locale::Maketext::Extract::Plugin::Perl; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::Perl - Perl format parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::Perl->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| Extracts strings to localise (including HEREDOCS and | |
| concatenated strings) from Perl code. | |
| This Perl parser is very fast and very good, but not perfect - it does make | |
| mistakes. The PPI parser (L<Locale::Maketext::Extract::Plugin::PPI>) is more | |
| accurate, but a lot slower, and so is not enabled by default. | |
| =head1 SHORT PLUGIN NAME | |
| perl | |
| =head1 VALID FORMATS | |
| Valid localization function names are: | |
| =over 4 | |
| =item translate | |
| =item maketext | |
| =item gettext | |
| =item loc | |
| =item x | |
| =item _ | |
| =item __ | |
| =back | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item .pm | |
| =item .pl | |
| =item .cgi | |
| =back | |
| =cut | |
| use constant NUL => 0; | |
| use constant BEG => 1; | |
| use constant PAR => 2; | |
| use constant HERE => 10; | |
| use constant QUO1 => 3; | |
| use constant QUO2 => 4; | |
| use constant QUO3 => 5; | |
| use constant QUO4 => 6; | |
| use constant QUO5 => 7; | |
| use constant QUO6 => 8; | |
| use constant QUO7 => 9; | |
| sub file_types { | |
| return qw( pm pl cgi ); | |
| } | |
| sub extract { | |
| my $self = shift; | |
| local $_ = shift; | |
| local $SIG{__WARN__} = sub { die @_ }; | |
| # Perl code: | |
| my ( $state, $line_offset, $str, $str_part, $vars, $quo, $heredoc ) | |
| = ( 0, 0 ); | |
| my $orig = 1 + ( () = ( ( my $__ = $_ ) =~ /\n/g ) ); | |
| PARSER: { | |
| $_ = substr( $_, pos($_) ) if ( pos($_) ); | |
| my $line = $orig - ( () = ( ( my $__ = $_ ) =~ /\n/g ) ); | |
| # various ways to spell the localization function | |
| $state == NUL | |
| && m/\b(translate|maketext|gettext|__?|loc(?:ali[sz]e)?|x)/gc | |
| && do { $state = BEG; redo }; | |
| $state == BEG && m/^([\s\t\n]*)/gc && redo; | |
| # begin () | |
| $state == BEG | |
| && m/^([\S\(])\s*/gc | |
| && do { $state = ( ( $1 eq '(' ) ? PAR : NUL ); redo }; | |
| # concat | |
| $state == PAR | |
| && defined($str) | |
| && m/^(\s*\.\s*)/gc | |
| && do { $line_offset += ( () = ( ( my $__ = $1 ) =~ /\n/g ) ); redo }; | |
| # str_part | |
| $state == PAR && defined($str_part) && do { | |
| if ( ( $quo == QUO1 ) || ( $quo == QUO5 ) ) { | |
| $str_part =~ s/\\([\\'])/$1/g | |
| if ($str_part); # normalize q strings | |
| } | |
| elsif ( $quo != QUO6 ) { | |
| $str_part =~ s/(\\(?:[0x]..|c?.))/"qq($1)"/eeg | |
| if ($str_part); # normalize qq / qx strings | |
| } | |
| $str .= $str_part; | |
| undef $str_part; | |
| undef $quo; | |
| redo; | |
| }; | |
| # begin or end of string | |
| $state == PAR && m/^(\')/gc && do { $state = $quo = QUO1; redo }; | |
| $state == QUO1 && m/^([^'\\]+)/gc && do { $str_part .= $1; redo }; | |
| $state == QUO1 && m/^((?:\\.)+)/gcs && do { $str_part .= $1; redo }; | |
| $state == QUO1 && m/^\'/gc && do { $state = PAR; redo }; | |
| $state == PAR && m/^\"/gc && do { $state = $quo = QUO2; redo }; | |
| $state == QUO2 && m/^([^"\\]+)/gc && do { $str_part .= $1; redo }; | |
| $state == QUO2 && m/^((?:\\.)+)/gcs && do { $str_part .= $1; redo }; | |
| $state == QUO2 && m/^\"/gc && do { $state = PAR; redo }; | |
| $state == PAR && m/^\`/gc && do { $state = $quo = QUO3; redo }; | |
| $state == QUO3 && m/^([^\`]*)/gc && do { $str_part .= $1; redo }; | |
| $state == QUO3 && m/^\`/gc && do { $state = PAR; redo }; | |
| $state == PAR && m/^qq\{/gc && do { $state = $quo = QUO4; redo }; | |
| $state == QUO4 && m/^([^\}]*)/gc && do { $str_part .= $1; redo }; | |
| $state == QUO4 && m/^\}/gc && do { $state = PAR; redo }; | |
| $state == PAR && m/^q\{/gc && do { $state = $quo = QUO5; redo }; | |
| $state == QUO5 && m/^([^\}]*)/gc && do { $str_part .= $1; redo }; | |
| $state == QUO5 && m/^\}/gc && do { $state = PAR; redo }; | |
| # find heredoc terminator, then get the | |
| #heredoc and go back to current position | |
| $state == PAR | |
| && m/^<<\s*\'/gc | |
| && do { $state = $quo = QUO6; $heredoc = ''; redo }; | |
| $state == QUO6 && m/^([^'\\\n]+)/gc && do { $heredoc .= $1; redo }; | |
| $state == QUO6 && m/^((?:\\.)+)/gc && do { $heredoc .= $1; redo }; | |
| $state == QUO6 | |
| && m/^\'/gc | |
| && do { $state = HERE; $heredoc =~ s/\\\'/\'/g; redo }; | |
| $state == PAR | |
| && m/^<<\s*\"/gc | |
| && do { $state = $quo = QUO7; $heredoc = ''; redo }; | |
| $state == QUO7 && m/^([^"\\\n]+)/gc && do { $heredoc .= $1; redo }; | |
| $state == QUO7 && m/^((?:\\.)+)/gc && do { $heredoc .= $1; redo }; | |
| $state == QUO7 | |
| && m/^\"/gc | |
| && do { $state = HERE; $heredoc =~ s/\\\"/\"/g; redo }; | |
| $state == PAR | |
| && m/^<<(\w*)/gc | |
| && do { $state = HERE; $quo = QUO7; $heredoc = $1; redo }; | |
| # jump ahaid and get the heredoc, then s/// also | |
| # resets the pos and we are back at the current pos | |
| $state == HERE | |
| && m/^.*\r?\n/gc | |
| && s/\G(.*?\r?\n)$heredoc(\r?\n)//s | |
| && do { $state = PAR; $str_part .= $1; $line_offset++; redo }; | |
| # end () | |
| # | |
| $state == PAR && m/^\s*[\)]/gc && do { | |
| $state = NUL; | |
| $vars =~ s/[\n\r]//g if ($vars); | |
| $self->add_entry( $str, | |
| $line - ( () = $str =~ /\n/g ) - $line_offset, | |
| $vars ) | |
| if $str; | |
| undef $str; | |
| undef $vars; | |
| undef $heredoc; | |
| $line_offset = 0; | |
| redo; | |
| }; | |
| # a line of vars | |
| $state == PAR && m/^([^\)]*)/gc && do { $vars .= "$1\n"; redo }; | |
| } | |
| } | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::PPI> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_PERL | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/TT2.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_TT2'; | |
| package Locale::Maketext::Extract::Plugin::TT2; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| use Template::Constants qw( :debug ); | |
| use Template::Parser; | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::TT2 - Template Toolkit format parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::TT2->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| Extracts strings to localise from Template Toolkit templates. | |
| =head1 SHORT PLUGIN NAME | |
| tt2 | |
| =head1 VALID FORMATS | |
| Valid formats are: | |
| =over 4 | |
| =item [% |l(args) %]string[% END %] | |
| =item [% 'string' | l(args) %] | |
| =item [% l('string',args) %] | |
| =item [% c.l('string') %] | |
| Also all the above combinations with C<c.> prepended should work | |
| correctly. This is the default syntax when using TT templates | |
| with L<Mojolicious>. | |
| =back | |
| l and loc are interchangeable. | |
| | and FILTER are interchangeable. | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item .tt | |
| =item .tt2 | |
| =item .html | |
| =item .tt.* | |
| =item .tt2.* | |
| =back | |
| =head1 REQUIRES | |
| L<Template> | |
| =head1 NOTES | |
| =over 4 | |
| =item * | |
| B<BEWARE> Using the C<loc> form can give false positives if you use the Perl parser | |
| plugin on TT files. If you want to use the C<loc> form, then you should | |
| specify the file types that you want to the Perl plugin to parse, or enable | |
| the default file types, eg: | |
| xgetext.pl -P perl .... # default file types | |
| xgettext.pl -P perl=pl,pm ... # specified file types | |
| =item * | |
| The string-to-be-localised must be a string, not a variable. We try not | |
| to extract calls to your localise function which contain variables eg: | |
| l('string',arg) # extracted | |
| l(var,arg) # not extracted | |
| This doesn't work for block filters, so don't do that. Eg: | |
| [% FILTER l %] | |
| string [% var %] # BAD! | |
| [% END %] | |
| =item * | |
| Getting the right line number is difficult in TT. Often it'll be a range | |
| of lines, or it may be thrown out by the use of PRE_CHOMP or POST_CHOMP. It will | |
| always be within a few lines of the correct location. | |
| =item * | |
| If you have PRE/POST_CHOMP enabled by default in your templates, then you should | |
| extract the strings using the same values. In order to set them, you can | |
| use the following wrapper script: | |
| #!/usr/bin/perl | |
| use Locale::Maketext::Extract::Run qw(xgettext); | |
| use Locale::Maketext::Extract::Plugin::TT2(); | |
| %Locale::Maketext::Extract::Plugin::TT2::PARSER_OPTIONS = ( | |
| PRE_CHOMP => 1, # or 2 | |
| POST_CHOMP => 1, # or 2 | |
| # Also START/END_TAG, ANYCASE, INTERPOLATE, V1DOLLAR, EVAL_PERL | |
| ); | |
| xgettext(@ARGV); | |
| =back | |
| =cut | |
| # import strip_quotes | |
| *strip_quotes | |
| = \&Locale::Maketext::Extract::Plugin::TT2::Directive::strip_quotes; | |
| our %PARSER_OPTIONS; | |
| #=================================== | |
| sub file_types { | |
| #=================================== | |
| return ( qw( tt tt2 html ), qr/\.tt2?\./ ); | |
| } | |
| my %Escapes = map { ( "\\$_" => eval("qq(\\$_)") ) } qw(t n r f b a e); | |
| #=================================== | |
| sub extract { | |
| #=================================== | |
| my $self = shift; | |
| my $data = shift; | |
| $Template::Directive::PRETTY = 1; | |
| my $parser = | |
| Locale::Maketext::Extract::Plugin::TT2::Parser->new( | |
| %PARSER_OPTIONS, | |
| FACTORY => 'Locale::Maketext::Extract::Plugin::TT2::Directive', | |
| FILE_INFO => 0, | |
| ); | |
| _init_overrides($parser); | |
| $parser->{extracted} = []; | |
| $Locale::Maketext::Extract::Plugin::TT2::Directive::PARSER | |
| = $parser; # hack | |
| $parser->parse($data) | |
| || die $parser->error; | |
| foreach my $entry ( @{ $parser->{extracted} } ) { | |
| $entry->[2] =~ s/^\((.*)\)$/$1/s; # Remove () from vars | |
| $_ =~ s/\\'/'/gs # Unescape \' | |
| for @{$entry}[ 0, 2 ]; | |
| $entry->[2] =~ s/\\(?!")/\\\\/gs; # Escape all \ not followed by " | |
| # Escape argument lists correctly | |
| while ( my ( $char, $esc ) = each %Escapes ) { | |
| $entry->[2] =~ s/$esc/$char/g; | |
| } | |
| $entry->[1] =~ s/\D+.*$//; | |
| $self->add_entry(@$entry); | |
| } | |
| } | |
| #=================================== | |
| sub _init_overrides { | |
| #=================================== | |
| my $parser = shift; | |
| # Override the concatenation sub to return _ instead of . | |
| my $states = $parser->{STATES}; | |
| foreach my $state ( @{$states} ) { | |
| if ( my $CAT_no = $state->{ACTIONS}{CAT} ) { | |
| my $CAT_rule_no | |
| = $states->[ $states->[$CAT_no]{GOTOS}{expr} ]->{DEFAULT}; | |
| # override the TT::Grammar sub which cats two args | |
| $parser->{RULES}[ -$CAT_rule_no ][2] = sub { | |
| my $first = ( $_[1] ); | |
| my $second = ( $_[3] ); | |
| if ( strip_quotes($first) && strip_quotes($second) ) { | |
| # both are literal | |
| return "'${first}${second}'"; | |
| } | |
| else { | |
| # at least one is an ident | |
| return "$_[1] _ $_[3]"; | |
| } | |
| }; | |
| last; | |
| } | |
| } | |
| } | |
| #=================================== | |
| #=================================== | |
| package Locale::Maketext::Extract::Plugin::TT2::Parser; | |
| #=================================== | |
| #=================================== | |
| use base 'Template::Parser'; | |
| # disabled location() because it was adding unneccessary text | |
| # to filter blocks | |
| #=================================== | |
| sub location {''} | |
| #=================================== | |
| # Custom TT parser for Locale::Maketext::Lexicon | |
| # | |
| # Written by Andy Wardley http://wardley.org/ | |
| # | |
| # 18 September 2008 | |
| # | |
| #----------------------------------------------------------------------- | |
| # custom directive generator to capture filters, variables and | |
| # massage a few other elements to make life easy. | |
| #----------------------------------------------------------------------- | |
| #=================================== | |
| #=================================== | |
| package Locale::Maketext::Extract::Plugin::TT2::Directive; | |
| #=================================== | |
| #=================================== | |
| use base 'Template::Directive'; | |
| our $PARSER; | |
| #=================================== | |
| sub textblock { | |
| #=================================== | |
| my ( $class, $text ) = @_; | |
| $text =~ s/([\\'])/\\$1/g; | |
| return "'$text'"; | |
| } | |
| #=================================== | |
| sub ident { | |
| #=================================== | |
| my ( $class, $ident ) = @_; | |
| return "NULL" unless @$ident; | |
| if ( scalar @$ident <= 2 && !$ident->[1] ) { | |
| my $var = $ident->[0]; | |
| $var =~ s/^'(.+)'$/$1/; | |
| return $var; | |
| } | |
| else { | |
| my @source = @$ident; | |
| my @dotted; | |
| my $first = 1; | |
| my $first_literal; | |
| while (@source) { | |
| my ( $name, $args ) = splice( @source, 0, 2 ); | |
| if ($first) { | |
| strip_quotes($name); | |
| my $first_arg = $args && @$args ? $args->[0] : ''; | |
| $first_literal = strip_quotes($first_arg); | |
| $first--; | |
| } | |
| elsif ( !strip_quotes($name) && $name =~ /\D/ ) { | |
| $name = '$' . $name; | |
| } | |
| $name .= join_args($args); | |
| push( @dotted, $name ); | |
| } | |
| my $got_i18n = 0; | |
| # Classic TT syntax [% l('...') %] or [% loc('....') %] | |
| if ( $first_literal | |
| && ( $ident->[0] eq "'l'" or $ident->[0] eq "'loc'" ) ) | |
| { | |
| $got_i18n = 1; | |
| } | |
| # Mojolicious TT syntax [% c.l('...') %] | |
| elsif ($ident->[0] eq "'c'" && $ident->[2] eq "'l'") | |
| { | |
| $got_i18n = 1; | |
| splice(@$ident, 0, 2); | |
| } | |
| if ($got_i18n) { | |
| my $string = shift @{ $ident->[1] }; | |
| strip_quotes($string); | |
| $string =~ s/\\\\/\\/g; | |
| my $args = join_args( $ident->[1] ); | |
| push @{ $PARSER->{extracted} }, | |
| [ $string, ${ $PARSER->{LINE} }, $args ]; | |
| } | |
| return join( '.', @dotted ); | |
| } | |
| } | |
| #=================================== | |
| sub text { | |
| #=================================== | |
| my ( $class, $text ) = @_; | |
| $text =~ s/\\/\\\\/g; | |
| return "'$text'"; | |
| } | |
| #=================================== | |
| sub quoted { | |
| #=================================== | |
| my ( $class, $items ) = @_; | |
| return '' unless @$items; | |
| return ( $items->[0] ) if scalar @$items == 1; | |
| return '(' . join( ' _ ', @$items ) . ')'; | |
| } | |
| #=================================== | |
| sub args { | |
| #=================================== | |
| my ( $class, $args ) = @_; | |
| my $hash = shift @$args; | |
| push( @$args, '{ ' . join( ', ', @$hash ) . ' }' ) # named params | |
| if @$hash; | |
| return $args; | |
| } | |
| #=================================== | |
| sub get { | |
| #=================================== | |
| my ( $class, $expr ) = @_; | |
| return $expr; | |
| } | |
| #=================================== | |
| sub filter { | |
| #=================================== | |
| my ( $class, $lnameargs, $block ) = @_; | |
| my ( $name, $args, $alias ) = @$lnameargs; | |
| $name = $name->[0]; | |
| return '' | |
| unless $name eq "'l'" | |
| or $name eq "'loc'" | |
| or $name eq "'c.l'"; | |
| if ( strip_quotes($block) ) { | |
| $block =~ s/\\\\/\\/g; | |
| $args = join_args( $class->args($args) ); | |
| # NOTE: line number is at end of block, and can be a range | |
| my ($end) = ( ${ $PARSER->{LINE} } =~ /^(\d+)/ ); | |
| my $start = $end; | |
| # rewind line count for newlines | |
| $start -= $block =~ tr/\n//; | |
| my $line = $start == $end ? $start : "$start-$end"; | |
| push @{ $PARSER->{extracted} }, [ $block, $line, $args ]; | |
| } | |
| return ''; | |
| } | |
| # strips outer single quotes from a string (modifies original string) | |
| # returns true if stripped, or false | |
| #=================================== | |
| sub strip_quotes { | |
| #=================================== | |
| return scalar $_[0] =~ s/^'(.*)'$/$1/s; | |
| } | |
| #=================================== | |
| sub join_args { | |
| #=================================== | |
| my $args = shift; | |
| return '' unless $args && @$args; | |
| my @new_args = (@$args); | |
| for (@new_args) { | |
| s/\\\\/\\/g; | |
| if ( strip_quotes($_) ) { | |
| s/"/\\"/g; | |
| $_ = qq{"$_"}; | |
| } | |
| } | |
| return '(' . join( ', ', @new_args ) . ')'; | |
| } | |
| =head1 ACKNOWLEDGEMENTS | |
| Thanks to Andy Wardley for writing the Template::Directive subclass which | |
| made this possible. | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =item L<Template::Toolkit> | |
| =back | |
| =head1 AUTHORS | |
| Clinton Gormley E<lt>[email protected]<gt> | |
| Andy Wardley http://wardley.org | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_TT2 | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/TextTemplate.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_TEXTTEMPLATE'; | |
| package Locale::Maketext::Extract::Plugin::TextTemplate; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| use vars qw($VERSION); | |
| $VERSION = '0.31'; | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::TextTemplate - Text::Template format parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::TextTemplate->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| Extracts strings to localise from Text::Template files | |
| =head1 SHORT PLUGIN NAME | |
| text | |
| =head1 VALID FORMATS | |
| Sentences between STARTxxx and ENDxxx are extracted individually. | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item All file types | |
| =back | |
| =cut | |
| sub file_types { | |
| return qw( * ); | |
| } | |
| sub extract { | |
| my $self = shift; | |
| local $_ = shift; | |
| my $line = 1; pos($_) = 0; | |
| # Text::Template | |
| if ($_=~/^STARTTEXT$/m and $_=~ /^ENDTEXT$/m) { | |
| require HTML::Parser; | |
| require Lingua::EN::Sentence; | |
| { | |
| package Locale::Maketext::Extract::Plugin::TextTemplate::Parser; | |
| our @ISA = 'HTML::Parser'; | |
| *{'text'} = sub { | |
| my ($self, $str, $is_cdata) = @_; | |
| my $sentences = Lingua::EN::Sentence::get_sentences($str) or return; | |
| $str =~ s/\n/ /g; $str =~ s/^\s+//; $str =~ s/\s+$//; | |
| $self->add_entry($str , $line); | |
| }; | |
| } | |
| my $p = Locale::Maketext::Extract::Plugin::TextTemplate::Parser->new; | |
| while (m/\G((.*?)^(?:START|END)[A-Z]+$)/smg) { | |
| my ($str) = ($2); | |
| $line += ( () = ($1 =~ /\n/g) ); # cryptocontext! | |
| $p->parse($str); $p->eof; | |
| } | |
| $_ = ''; | |
| } | |
| } | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::YAML> | |
| =item L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_TEXTTEMPLATE | |
| $fatpacked{"Locale/Maketext/Extract/Plugin/YAML.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_PLUGIN_YAML'; | |
| package Locale::Maketext::Extract::Plugin::YAML; | |
| use strict; | |
| use base qw(Locale::Maketext::Extract::Plugin::Base); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Plugin::YAML - YAML format parser | |
| =head1 SYNOPSIS | |
| $plugin = Locale::Maketext::Extract::Plugin::YAML->new( | |
| $lexicon # A Locale::Maketext::Extract object | |
| @file_types # Optionally specify a list of recognised file types | |
| ) | |
| $plugin->extract($filename,$filecontents); | |
| =head1 DESCRIPTION | |
| Extracts strings to localise from YAML files. | |
| =head1 SHORT PLUGIN NAME | |
| yaml | |
| =head1 VALID FORMATS | |
| Valid formats are: | |
| =over 4 | |
| =item * | |
| key: _"string" | |
| =item * | |
| key: _'string' | |
| =item * | |
| key: _'string with embedded 'quotes'' | |
| =item * | |
| key: |- | |
| _'my folded | |
| string | |
| to translate' | |
| Note, the left hand side of the folded string must line up with the C<_>, | |
| otherwise YAML adds spaces at the beginning of each line. | |
| =item * | |
| key: |- | |
| _'my block | |
| string | |
| to translate | |
| ' | |
| Note, you must use the trailing C<-> so that YAMl doesn't add a carriage | |
| return after your final quote. | |
| =back | |
| =head1 KNOWN FILE TYPES | |
| =over 4 | |
| =item .yaml | |
| =item .yml | |
| =item .conf | |
| =back | |
| =head1 REQUIRES | |
| L<YAML> | |
| =head1 NOTES | |
| The docs for the YAML module describes it as alpha code. It is not as tolerant | |
| of errors as L<YAML::Syck>. However, because it is pure Perl, it is easy | |
| to hook into. | |
| I have seen it enter endless loops, so if xgettext.pl hangs, try running it | |
| again with C<--verbose --verbose> (twice) enabled, so that you can see if | |
| the fault lies with YAML. If it does, either correct the YAML source file, | |
| or use the file_types to exclude that file. | |
| =cut | |
| sub file_types { | |
| return qw( yaml yml conf ); | |
| } | |
| sub extract { | |
| my $self = shift; | |
| my $data = shift; | |
| my $y = Locale::Maketext::Extract::Plugin::YAML::Extractor->new(); | |
| $y->load($data); | |
| foreach my $entry (@{$y->found}) { | |
| $self->add_entry(@$entry) | |
| } | |
| } | |
| package Locale::Maketext::Extract::Plugin::YAML::Extractor; | |
| use base qw(YAML::Loader); | |
| #=================================== | |
| sub new { | |
| #=================================== | |
| my $class = shift; | |
| my $self = $class->SUPER::new(@_); | |
| $self->{found} = []; | |
| return $self; | |
| } | |
| #=================================== | |
| sub check_scalar { | |
| #=================================== | |
| my $self = shift; | |
| my $node = $_[0]; | |
| if ( defined $node && !ref $node && $node =~ /^__?(["'])(.+)\1$/s ) { | |
| my $string = $2; | |
| my $line = $_[1]; | |
| push @{ $self->{found} }, [ $string, $line ]; | |
| } | |
| return $node; | |
| } | |
| sub _parse_node { | |
| my $self = shift; | |
| my $line = $self->{_start_line}||=length($self->preface) ? $self->line - 1 : $self->line; | |
| my $node = $self->SUPER::_parse_node(@_); | |
| $self->{start_line} = 0; | |
| return $self->check_scalar($node,$line); | |
| } | |
| sub _parse_inline_seq { | |
| my $self = shift; | |
| my $line = $self->{_start_line}||=$self->line; | |
| my $node = $self->SUPER::_parse_inline_seq(@_); | |
| foreach (@$node) { | |
| $self->check_scalar( $_, $line ); | |
| } | |
| $self->{start_line} = 0; | |
| return $node; | |
| } | |
| sub _parse_inline_mapping { | |
| my $self = shift; | |
| my $line = $self->{_start_line}||=$self->line; | |
| my $node = $self->SUPER::_parse_inline_mapping(@_); | |
| foreach ( values %$node ) { | |
| $self->check_scalar( $_, $line ); | |
| } | |
| $self->{start_line} = 0; | |
| return $node; | |
| } | |
| #=================================== | |
| sub _parse_next_line { | |
| #=================================== | |
| my $self = shift; | |
| $self->{_start_line} = $self->line | |
| if $_[0] == YAML::Loader::COLLECTION; | |
| $self->SUPER::_parse_next_line(@_); | |
| } | |
| sub found { | |
| my $self = shift; | |
| return $self->{found}; | |
| } | |
| =head1 SEE ALSO | |
| =over 4 | |
| =item L<xgettext.pl> | |
| for extracting translatable strings from common template | |
| systems and perl source files. | |
| =item L<YAML> | |
| =item L<Locale::Maketext::Lexicon> | |
| =item L<Locale::Maketext::Extract::Plugin::Base> | |
| =item L<Locale::Maketext::Extract::Plugin::FormFu> | |
| =item L<Locale::Maketext::Extract::Plugin::Perl> | |
| =item L<Locale::Maketext::Extract::Plugin::TT2> | |
| =item L<Locale::Maketext::Extract::Plugin::Mason> | |
| =item L<Locale::Maketext::Extract::Plugin::TextTemplate> | |
| =item L<Locale::Maketext::Extract::Plugin::Generic> | |
| =back | |
| =head1 AUTHORS | |
| Clinton Gormley E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_EXTRACT_PLUGIN_YAML | |
| $fatpacked{"Locale/Maketext/Extract/Run.pm"} = <<'LOCALE_MAKETEXT_EXTRACT_RUN'; | |
| package Locale::Maketext::Extract::Run; | |
| $Locale::Maketext::Lexicon::Extract::Run::VERSION = '0.35'; | |
| use strict; | |
| use vars qw( @ISA @EXPORT_OK ); | |
| use File::Spec::Functions qw(catfile); | |
| =head1 NAME | |
| Locale::Maketext::Extract::Run - Module interface to xgettext.pl | |
| =head1 SYNOPSIS | |
| use Locale::Maketext::Extract::Run 'xgettext'; | |
| xgettext(@ARGV); | |
| =cut | |
| use Cwd; | |
| use Config (); | |
| use File::Find; | |
| use Getopt::Long; | |
| use Locale::Maketext::Extract; | |
| use Exporter; | |
| use constant HAS_SYMLINK => ( $Config::Config{d_symlink} ? 1 : 0 ); | |
| @ISA = 'Exporter'; | |
| @EXPORT_OK = 'xgettext'; | |
| sub xgettext { __PACKAGE__->run(@_) } | |
| sub run { | |
| my $self = shift; | |
| local @ARGV = @_; | |
| my %opts; | |
| Getopt::Long::Configure("no_ignore_case"); | |
| Getopt::Long::GetOptions( \%opts, | |
| 'f|files-from:s@', | |
| 'D|directory:s@', | |
| 'u|use-gettext-style|unescaped', | |
| 'g|gnu-gettext', | |
| 'o|output:s@', | |
| 'd|default-domain:s', | |
| 'p|output-dir:s@', | |
| 'P|plugin:s@', | |
| 'W|wrap!', | |
| 'w|warnings!', | |
| 'v|verbose+', | |
| 'h|help', | |
| ) or help(); | |
| help() if $opts{h}; | |
| my %extract_options = %{ $self->_parse_extract_options( \%opts ) }; | |
| my @po = @{ $opts{o} || [ ( $opts{d} || 'messages' ) . '.po' ] }; | |
| foreach my $file ( @{ $opts{f} || [] } ) { | |
| open FILE, $file or die "Cannot open $file: $!"; | |
| while (<FILE>) { | |
| chomp; | |
| push @ARGV, $_ if -r and !-d; | |
| } | |
| } | |
| foreach my $dir ( @{ $opts{D} || [] } ) { | |
| File::Find::find( { | |
| wanted => sub { | |
| if (-d) { | |
| $File::Find::prune | |
| = /^(\.svn|blib|autogen|var|m4|local|CVS|\.git)$/; | |
| return; | |
| } | |
| # Only extract from non-binary, normal files | |
| return unless (-f or -s) and -T; | |
| return | |
| if (/\.po$|\.bak$|~|,D|,B$/i) | |
| || (/^[\.#]/); | |
| push @ARGV, $File::Find::name; | |
| }, | |
| follow => HAS_SYMLINK, | |
| }, | |
| $dir | |
| ); | |
| } | |
| @ARGV = ('-') unless @ARGV; | |
| s!^\.[/\\]!! for @ARGV; | |
| my $cwd = getcwd(); | |
| my $Ext = Locale::Maketext::Extract->new(%extract_options); | |
| foreach my $dir ( @{ $opts{p} || ['.'] } ) { | |
| $Ext->extract_file($_) for grep !/\.po$/i, @ARGV; | |
| foreach my $po (@po) { | |
| $Ext->read_po($po) if -r $po and -s _; | |
| $Ext->compile( $opts{u} ) or next; | |
| $Ext->write_po( catfile( $dir, $po ), $opts{g} ); | |
| } | |
| } | |
| } | |
| sub _parse_extract_options { | |
| my $self = shift; | |
| my $opts = shift; | |
| # If a list of plugins is specified, then we use those modules | |
| # plus their default list of file extensionse | |
| # and warnings enabled by default | |
| my %extract_options | |
| = ( verbose => $opts->{v}, wrap => $opts->{W} || 0 ); | |
| if ( my $plugin_args = $opts->{P} ) { | |
| # file extension with potentially multiple dots eg .tt.html | |
| my %plugins; | |
| foreach my $param (@$plugin_args) { | |
| my ( $plugin, $args ) | |
| = ( $param =~ /^([a-z_]\w+(?:::\w+)*)(?:=(.+))?$/i ); | |
| die "Couldn't understand plugin option '$param'" | |
| unless $plugin; | |
| my @extensions; | |
| if ($args) { | |
| foreach my $arg ( split /,/, $args ) { | |
| if ( $arg eq '*' ) { | |
| @extensions = ('*'); | |
| last; | |
| } | |
| my ($extension) = ( $arg =~ /^\.?(\w+(?:\.\w+)*)$/ ); | |
| die "Couldn't understand '$arg' in plugin '$param'" | |
| unless defined $extension; | |
| push @extensions, $extension; | |
| } | |
| } | |
| $plugins{$plugin} = \@extensions; | |
| } | |
| $extract_options{plugins} = \%plugins; | |
| $extract_options{warnings} = exists $opts->{w} ? $opts->{w} : 1; | |
| } | |
| # otherwise we default to the original xgettext.pl modules | |
| # with warnings disabled by default | |
| else { | |
| $extract_options{warnings} = $opts->{w}; | |
| } | |
| return \%extract_options; | |
| } | |
| sub help { | |
| local $SIG{__WARN__} = sub { }; | |
| { exec "perldoc $0"; } | |
| { exec "pod2text $0"; } | |
| } | |
| 1; | |
| =head1 COPYRIGHT | |
| Copyright 2003-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| LOCALE_MAKETEXT_EXTRACT_RUN | |
| $fatpacked{"Locale/Maketext/Guts.pm"} = <<'LOCALE_MAKETEXT_GUTS'; | |
| package Locale::Maketext::Guts; | |
| use Locale::Maketext; | |
| our $VERSION = '1.19'; | |
| =head1 NAME | |
| Locale::Maketext::Guts - Deprecated module to load Locale::Maketext utf8 code | |
| =head1 SYNOPSIS | |
| # Do this instead please | |
| use Locale::Maketext | |
| =head1 DESCRIPTION | |
| Previously Local::Maketext::GutsLoader performed some magic to load | |
| Locale::Maketext when utf8 was unavailable. The subs this module provided | |
| were merged back into Locale::Maketext | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_GUTS | |
| $fatpacked{"Locale/Maketext/GutsLoader.pm"} = <<'LOCALE_MAKETEXT_GUTSLOADER'; | |
| package Locale::Maketext::GutsLoader; | |
| use Locale::Maketext; | |
| our $VERSION = '1.19'; | |
| sub zorp { return scalar @_ } | |
| =head1 NAME | |
| Locale::Maketext::GutsLoader - Deprecated module to load Locale::Maketext utf8 code | |
| =head1 SYNOPSIS | |
| # Do this instead please | |
| use Locale::Maketext | |
| =head1 DESCRIPTION | |
| Previously Locale::Maketext::Guts performed some magic to load | |
| Locale::Maketext when utf8 was unavailable. The subs this module provided | |
| were merged back into Locale::Maketext. | |
| =cut | |
| 1; | |
| LOCALE_MAKETEXT_GUTSLOADER | |
| $fatpacked{"Locale/Maketext/Lexicon.pm"} = <<'LOCALE_MAKETEXT_LEXICON'; | |
| package Locale::Maketext::Lexicon; | |
| $Locale::Maketext::Lexicon::VERSION = '0.91'; | |
| use 5.004; | |
| use strict; | |
| =head1 NAME | |
| Locale::Maketext::Lexicon - Use other catalog formats in Maketext | |
| =head1 VERSION | |
| This document describes version 0.91 of Locale::Maketext::Lexicon. | |
| =head1 SYNOPSIS | |
| As part of a localization class, automatically glob for available | |
| lexicons: | |
| package Hello::I18N; | |
| use base 'Locale::Maketext'; | |
| use Locale::Maketext::Lexicon { | |
| '*' => [Gettext => '/usr/local/share/locale/*/LC_MESSAGES/hello.mo'], | |
| ### Uncomment to fallback when a key is missing from lexicons | |
| # _auto => 1, | |
| ### Uncomment to decode lexicon entries into Unicode strings | |
| # _decode => 1, | |
| ### Uncomment to load and parse everything right away | |
| # _preload => 1, | |
| ### Uncomment to use %1 / %quant(%1) instead of [_1] / [quant, _1] | |
| # _style => 'gettext', | |
| }; | |
| Explicitly specify languages, during compile- or run-time: | |
| package Hello::I18N; | |
| use base 'Locale::Maketext'; | |
| use Locale::Maketext::Lexicon { | |
| de => [Gettext => 'hello_de.po'], | |
| fr => [ | |
| Gettext => 'hello_fr.po', | |
| Gettext => 'local/hello/fr.po', | |
| ], | |
| }; | |
| # ... incrementally add new lexicons | |
| Locale::Maketext::Lexicon->import({ | |
| de => [Gettext => 'local/hello/de.po'], | |
| }) | |
| Alternatively, as part of a localization subclass: | |
| package Hello::I18N::de; | |
| use base 'Hello::I18N'; | |
| use Locale::Maketext::Lexicon (Gettext => \*DATA); | |
| __DATA__ | |
| # Some sample data | |
| msgid "" | |
| msgstr "" | |
| "Project-Id-Version: Hello 1.3.22.1\n" | |
| "MIME-Version: 1.0\n" | |
| "Content-Type: text/plain; charset=iso8859-1\n" | |
| "Content-Transfer-Encoding: 8bit\n" | |
| #: Hello.pm:10 | |
| msgid "Hello, World!" | |
| msgstr "Hallo, Welt!" | |
| #: Hello.pm:11 | |
| msgid "You have %quant(%1,piece) of mail." | |
| msgstr "Sie haben %quant(%1,Poststueck,Poststuecken)." | |
| =head1 DESCRIPTION | |
| This module provides lexicon-handling modules to read from other | |
| localization formats, such as I<Gettext>, I<Msgcat>, and so on. | |
| If you are unfamiliar with the concept of lexicon modules, please | |
| consult L<Locale::Maketext> and the C<webl10n> HTML files in the C<docs/> | |
| directory of this module. | |
| A command-line utility L<xgettext.pl> is also installed with this | |
| module, for extracting translatable strings from source files. | |
| =head2 The C<import> function | |
| The C<import()> function accepts two forms of arguments: | |
| =over 4 | |
| =item (I<format> => I<source> ... ) | |
| This form takes any number of argument pairs (usually one); | |
| I<source> may be a file name, a filehandle, or an array reference. | |
| For each such pair, it pass the contents specified by the second | |
| argument to B<Locale::Maketext::Lexicon::I<format>>->parse as a | |
| plain list, and export its return value as the C<%Lexicon> hash | |
| in the calling package. | |
| In the case that there are multiple such pairs, the lexicon | |
| defined by latter ones overrides earlier ones. | |
| =item { I<language> => [ I<format>, I<source> ... ] ... } | |
| This form accepts a hash reference. It will export a C<%Lexicon> | |
| into the subclasses specified by each I<language>, using the process | |
| described above. It is designed to alleviate the need to set up a | |
| separate subclass for each localized language, and just use the catalog | |
| files. | |
| This module will convert the I<language> arguments into lowercase, | |
| and replace all C<-> with C<_>, so C<zh_TW> and C<zh-tw> will both | |
| map to the C<zh_tw> subclass. | |
| If I<language> begins with C<_>, it is taken as an option that | |
| controls how lexicons are parsed. See L</Options> for a list | |
| of available options. | |
| The C<*> is a special I<language>; it must be used in conjunction | |
| with a filename that also contains C<*>; all matched files with | |
| a valid language code in the place of C<*> will be automatically | |
| prepared as a lexicon subclass. If there is multiple C<*> in | |
| the filename, the last one is used as the language name. | |
| =back | |
| =head2 Options | |
| =over 4 | |
| =item C<_auto> | |
| If set to a true value, missing lookups on lexicons are handled | |
| silently, as if an C<Auto> lexicon has been appended on all | |
| language lexicons. | |
| =item C<_decode> | |
| If set to a true value, source entries will be converted into | |
| utf8-strings (available in Perl 5.6.1 or later). This feature | |
| needs the B<Encode> or B<Encode::compat> module. | |
| Currently, only the C<Gettext> backend supports this option. | |
| =item C<_encoding> | |
| This option only has effect when C<_decode> is set to true. | |
| It specifies an encoding to store lexicon entries, instead of | |
| utf8-strings. | |
| If C<_encoding> is set to C<locale>, the encoding from the | |
| current locale setting is used. | |
| =item C<_preload> | |
| By default parsing is delayed until first use of the lexicon, | |
| set this option to true value to parse it asap. Increment | |
| adding lexicons forces parsing. | |
| =back | |
| =head2 Subclassing format handlers | |
| If you wish to override how sources specified in different data types | |
| are handled, please use a subclass that overrides C<lexicon_get_I<TYPE>>. | |
| XXX: not documented well enough yet. Patches welcome. | |
| =head1 NOTES | |
| When you attempt to localize an entry missing in the lexicon, Maketext | |
| will throw an exception by default. To inhibit this behaviour, override | |
| the C<_AUTO> key in your language subclasses, for example: | |
| $Hello::I18N::en::Lexicon{_AUTO} = 1; # autocreate missing keys | |
| If you want to implement a new C<Lexicon::*> backend module, please note | |
| that C<parse()> takes an array containing the B<source strings> from the | |
| specified filehandle or filename, which are I<not> C<chomp>ed. Although | |
| if the source is an array reference, its elements will probably not contain | |
| any newline characters anyway. | |
| The C<parse()> function should return a hash reference, which will be | |
| assigned to the I<typeglob> (C<*Lexicon>) of the language module. All | |
| it amounts to is that if the returned reference points to a tied hash, | |
| the C<%Lexicon> will be aliased to the same tied hash if it was not | |
| initialized previously. | |
| =cut | |
| our %Opts; | |
| sub option { shift if ref( $_[0] ); $Opts{ lc $_[0] } } | |
| sub set_option { shift if ref( $_[0] ); $Opts{ lc $_[0] } = $_[1] } | |
| sub encoding { | |
| my $encoding = option( @_, 'encoding' ) or return; | |
| return $encoding unless lc($encoding) eq 'locale'; | |
| local $^W; # no warnings 'uninitialized', really. | |
| my ( $country_language, $locale_encoding ); | |
| local $@; | |
| eval { | |
| require I18N::Langinfo; | |
| $locale_encoding | |
| = I18N::Langinfo::langinfo( I18N::Langinfo::CODESET() ); | |
| } | |
| or eval { | |
| require Win32::Console; | |
| $locale_encoding = 'cp' . Win32::Console::OutputCP(); | |
| }; | |
| if ( !$locale_encoding ) { | |
| foreach my $key (qw( LANGUAGE LC_ALL LC_MESSAGES LANG )) { | |
| $ENV{$key} =~ /^([^.]+)\.([^.:]+)/ or next; | |
| ( $country_language, $locale_encoding ) = ( $1, $2 ); | |
| last; | |
| } | |
| } | |
| if ( defined $locale_encoding | |
| && lc($locale_encoding) eq 'euc' | |
| && defined $country_language ) | |
| { | |
| if ( $country_language =~ /^ja_JP|japan(?:ese)?$/i ) { | |
| $locale_encoding = 'euc-jp'; | |
| } | |
| elsif ( $country_language =~ /^ko_KR|korean?$/i ) { | |
| $locale_encoding = 'euc-kr'; | |
| } | |
| elsif ( $country_language =~ /^zh_CN|chin(?:a|ese)?$/i ) { | |
| $locale_encoding = 'euc-cn'; | |
| } | |
| elsif ( $country_language =~ /^zh_TW|taiwan(?:ese)?$/i ) { | |
| $locale_encoding = 'euc-tw'; | |
| } | |
| } | |
| return $locale_encoding; | |
| } | |
| sub import { | |
| my $class = shift; | |
| return unless @_; | |
| my %entries; | |
| if ( UNIVERSAL::isa( $_[0], 'HASH' ) ) { | |
| # a hashref with $lang as keys, [$format, $src ...] as values | |
| %entries = %{ $_[0] }; | |
| } | |
| elsif ( @_ % 2 == 0 ) { | |
| %entries = ( '' => [ splice @_, 0, 2 ], @_ ); | |
| } | |
| # expand the wildcard entry | |
| if ( my $wild_entry = delete $entries{'*'} ) { | |
| while ( my ( $format, $src ) = splice( @$wild_entry, 0, 2 ) ) { | |
| next if ref($src); # XXX: implement globbing for the 'Tie' backend | |
| my $pattern = quotemeta($src); | |
| $pattern =~ s/\\\*(?=[^*]+$)/\([-\\w]+\)/g or next; | |
| $pattern =~ s/\\\*/.*?/g; | |
| $pattern =~ s/\\\?/./g; | |
| $pattern =~ s/\\\[/[/g; | |
| $pattern =~ s/\\\]/]/g; | |
| $pattern =~ s[\\\{(.*?)\\\\}][ | |
| '(?:'.join('|', split(/,/, $1)).')' | |
| ]eg; | |
| require File::Glob; | |
| foreach my $file ( File::Glob::bsd_glob($src) ) { | |
| $file =~ /$pattern/ or next; | |
| push @{ $entries{$1} }, ( $format => $file ) if $1; | |
| } | |
| delete $entries{$1} | |
| unless !defined($1) | |
| or exists $entries{$1} and @{ $entries{$1} }; | |
| } | |
| } | |
| %Opts = (); | |
| foreach my $key ( grep /^_/, keys %entries ) { | |
| set_option( lc( substr( $key, 1 ) ) => delete( $entries{$key} ) ); | |
| } | |
| my $OptsRef = {%Opts}; | |
| while ( my ( $lang, $entry ) = each %entries ) { | |
| my $export = caller; | |
| if ( length $lang ) { | |
| # normalize language tag to Maketext's subclass convention | |
| $lang = lc($lang); | |
| $lang =~ s/-/_/g; | |
| $export .= "::$lang"; | |
| } | |
| my @pairs = @{ $entry || [] } or die "no format specified"; | |
| while ( my ( $format, $src ) = splice( @pairs, 0, 2 ) ) { | |
| if ( defined($src) and !ref($src) and $src =~ /\*/ ) { | |
| unshift( @pairs, $format => $_ ) | |
| for File::Glob::bsd_glob($src); | |
| next; | |
| } | |
| my @content | |
| = eval { $class->lexicon_get( $src, scalar caller(1), $lang ); }; | |
| next if $@ and $@ =~ /^next\b/; | |
| die $@ if $@; | |
| no strict 'refs'; | |
| eval "use $class\::$format; 1" or die $@; | |
| if ( %{"$export\::Lexicon"} ) { | |
| my $lexicon = \%{"$export\::Lexicon"}; | |
| if ( my $obj = tied %$lexicon ) { | |
| # if it's our tied hash then force loading | |
| # otherwise late load will rewrite | |
| $obj->_force if $obj->isa(__PACKAGE__); | |
| } | |
| # clear the memoized cache for old entries: | |
| Locale::Maketext->clear_isa_scan; | |
| my $new = "$class\::$format"->parse(@content); | |
| # avoid hash rebuild, on big sets | |
| @{$lexicon}{ keys %$new } = values %$new; | |
| } | |
| else { | |
| local $^W if $] >= 5.009; # no warnings 'once', really. | |
| tie %{"$export\::Lexicon"}, __PACKAGE__, | |
| { | |
| Opts => $OptsRef, | |
| Export => "$export\::Lexicon", | |
| Class => "$class\::$format", | |
| Content => \@content, | |
| }; | |
| tied( %{"$export\::Lexicon"} )->_force | |
| if $OptsRef->{'preload'}; | |
| } | |
| length $lang or next; | |
| # Avoid re-entry | |
| my $caller = caller(); | |
| next if $export->isa($caller); | |
| push( @{"$export\::ISA"}, scalar caller ); | |
| if ( my $style = option('style') ) { | |
| my $cref | |
| = $class->can( lc("_style_$style") ) | |
| ->( $class, $export->can('maketext') ) | |
| or die "Unknown style: $style"; | |
| # Avoid redefinition warnings | |
| local $SIG{__WARN__} = sub {1}; | |
| *{"$export\::maketext"} = $cref; | |
| } | |
| } | |
| } | |
| } | |
| sub _style_gettext { | |
| my ( $self, $orig ) = @_; | |
| require Locale::Maketext::Lexicon::Gettext; | |
| sub { | |
| my $lh = shift; | |
| my $str = shift; | |
| return $orig->( | |
| $lh, | |
| Locale::Maketext::Lexicon::Gettext::_gettext_to_maketext($str), @_ | |
| ); | |
| } | |
| } | |
| sub TIEHASH { | |
| my ( $class, $args ) = @_; | |
| return bless( $args, $class ); | |
| } | |
| { | |
| no strict 'refs'; | |
| sub _force { | |
| my $args = shift; | |
| unless ( $args->{'Done'} ) { | |
| $args->{'Done'} = 1; | |
| local *Opts = $args->{Opts}; | |
| *{ $args->{Export} } | |
| = $args->{Class}->parse( @{ $args->{Content} } ); | |
| $args->{'Export'}{'_AUTO'} = 1 | |
| if option('auto'); | |
| } | |
| return $args->{'Export'}; | |
| } | |
| sub FETCH { _force( $_[0] )->{ $_[1] } } | |
| sub EXISTS { _force( $_[0] )->{ $_[1] } } | |
| sub DELETE { delete _force( $_[0] )->{ $_[1] } } | |
| sub SCALAR { scalar %{ _force( $_[0] ) } } | |
| sub STORE { _force( $_[0] )->{ $_[1] } = $_[2] } | |
| sub CLEAR { %{ _force( $_[0] )->{ $_[1] } } = () } | |
| sub NEXTKEY { each %{ _force( $_[0] ) } } | |
| sub FIRSTKEY { | |
| my $hash = _force( $_[0] ); | |
| my $a = scalar keys %$hash; | |
| each %$hash; | |
| } | |
| } | |
| sub lexicon_get { | |
| my ( $class, $src, $caller, $lang ) = @_; | |
| return unless defined $src; | |
| foreach my $type ( qw(ARRAY HASH SCALAR GLOB), ref($src) ) { | |
| next unless UNIVERSAL::isa( $src, $type ); | |
| my $method = 'lexicon_get_' . lc($type); | |
| die "cannot handle source $type for $src: no $method defined" | |
| unless $class->can($method); | |
| return $class->$method( $src, $caller, $lang ); | |
| } | |
| # default handler | |
| return $class->lexicon_get_( $src, $caller, $lang ); | |
| } | |
| # for scalarrefs and arrayrefs we just dereference the $src | |
| sub lexicon_get_scalar { ${ $_[1] } } | |
| sub lexicon_get_array { @{ $_[1] } } | |
| sub lexicon_get_hash { | |
| my ( $class, $src, $caller, $lang ) = @_; | |
| return map { $_ => $src->{$_} } sort keys %$src; | |
| } | |
| sub lexicon_get_glob { | |
| my ( $class, $src, $caller, $lang ) = @_; | |
| no strict 'refs'; | |
| local $^W if $] >= 5.009; # no warnings 'once', really. | |
| # be extra magical and check for DATA section | |
| if ( eof($src) and $src eq \*{"$caller\::DATA"} | |
| or $src eq \*{"main\::DATA"} ) | |
| { | |
| # okay, the *DATA isn't initiated yet. let's read. | |
| # | |
| require FileHandle; | |
| my $fh = FileHandle->new; | |
| my $package = ( ( $src eq \*{"main\::DATA"} ) ? 'main' : $caller ); | |
| if ( $package eq 'main' and -e $0 ) { | |
| $fh->open($0) or die "Can't open $0: $!"; | |
| } | |
| else { | |
| my $level = 1; | |
| while ( my ( $pkg, $filename ) = caller( $level++ ) ) { | |
| next unless $pkg eq $package; | |
| next unless -e $filename; | |
| next; | |
| $fh->open($filename) or die "Can't open $filename: $!"; | |
| last; | |
| } | |
| } | |
| while (<$fh>) { | |
| # okay, this isn't foolproof, but good enough | |
| last if /^__DATA__$/; | |
| } | |
| return <$fh>; | |
| } | |
| # fh containing the lines | |
| my $pos = tell($src); | |
| my @lines = <$src>; | |
| seek( $src, $pos, 0 ); | |
| return @lines; | |
| } | |
| # assume filename - search path, open and return its contents | |
| sub lexicon_get_ { | |
| my ( $class, $src, $caller, $lang ) = @_; | |
| $src = $class->lexicon_find( $src, $caller, $lang ); | |
| defined $src or die 'next'; | |
| require FileHandle; | |
| my $fh = FileHandle->new; | |
| $fh->open($src) or die "Cannot read $src (called by $caller): $!"; | |
| binmode($fh); | |
| return <$fh>; | |
| } | |
| sub lexicon_find { | |
| my ( $class, $src, $caller, $lang ) = @_; | |
| return $src if -e $src; | |
| require File::Spec; | |
| my @path = split '::', $caller; | |
| push @path, $lang if length $lang; | |
| while (@path) { | |
| foreach (@INC) { | |
| my $file = File::Spec->catfile( $_, @path, $src ); | |
| return $file if -e $file; | |
| } | |
| pop @path; | |
| } | |
| return undef; | |
| } | |
| 1; | |
| =head1 ACKNOWLEDGMENTS | |
| Thanks to Jesse Vincent for suggesting this module to be written. | |
| Thanks also to Sean M. Burke for coming up with B<Locale::Maketext> | |
| in the first place, and encouraging me to experiment with alternative | |
| Lexicon syntaxes. | |
| Thanks also to Yi Ma Mao for providing the MO file parsing subroutine, | |
| as well as inspiring me to implement file globbing and transcoding | |
| support. | |
| See the F<AUTHORS> file in the distribution for a list of people who | |
| have sent helpful patches, ideas or comments. | |
| =head1 SEE ALSO | |
| L<xgettext.pl> for extracting translatable strings from common template | |
| systems and perl source files. | |
| L<Locale::Maketext>, L<Locale::Maketext::Lexicon::Auto>, | |
| L<Locale::Maketext::Lexicon::Gettext>, L<Locale::Maketext::Lexicon::Msgcat>, | |
| L<Locale::Maketext::Lexicon::Tie> | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002-2008 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| LOCALE_MAKETEXT_LEXICON | |
| $fatpacked{"Locale/Maketext/Lexicon/Auto.pm"} = <<'LOCALE_MAKETEXT_LEXICON_AUTO'; | |
| package Locale::Maketext::Lexicon::Auto; | |
| $Locale::Maketext::Lexicon::Auto::VERSION = '0.10'; | |
| use strict; | |
| =head1 NAME | |
| Locale::Maketext::Lexicon::Auto - Auto fallback lexicon for Maketext | |
| =head1 SYNOPSIS | |
| package Hello::I18N; | |
| use base 'Locale::Maketext'; | |
| use Locale::Maketext::Lexicon { | |
| en => ['Auto'], | |
| # ... other languages | |
| }; | |
| =head1 DESCRIPTION | |
| This module builds a simple Lexicon hash that contains nothing but | |
| C<( '_AUTO' =E<gt> 1)>, which tells C<Locale::Maketext> that no | |
| localizing is needed -- just use the lookup key as the returned string. | |
| It is especially useful if you're starting to prototype a program, and | |
| do not want to deal with the localization files yet. | |
| =head1 CAVEATS | |
| If the key to C<-E<gt>maketext> begins with a C<_>, C<Locale::Maketext> | |
| will still throw an exception. See L<Locale::Maketext/CONTROLLING LOOKUP | |
| FAILURE> for how to prevent it. | |
| =cut | |
| sub parse { | |
| +{ _AUTO => 1 }; | |
| } | |
| 1; | |
| =head1 SEE ALSO | |
| L<Locale::Maketext>, L<Locale::Maketext::Lexicon> | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002, 2003, 2004, 2007 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| LOCALE_MAKETEXT_LEXICON_AUTO | |
| $fatpacked{"Locale/Maketext/Lexicon/Gettext.pm"} = <<'LOCALE_MAKETEXT_LEXICON_GETTEXT'; | |
| package Locale::Maketext::Lexicon::Gettext; | |
| $Locale::Maketext::Lexicon::Gettext::VERSION = '0.17'; | |
| use strict; | |
| =head1 NAME | |
| Locale::Maketext::Lexicon::Gettext - PO and MO file parser for Maketext | |
| =head1 SYNOPSIS | |
| Called via B<Locale::Maketext::Lexicon>: | |
| package Hello::I18N; | |
| use base 'Locale::Maketext'; | |
| use Locale::Maketext::Lexicon { | |
| de => [Gettext => 'hello/de.mo'], | |
| }; | |
| Directly calling C<parse()>: | |
| use Locale::Maketext::Lexicon::Gettext; | |
| my %Lexicon = %{ Locale::Maketext::Lexicon::Gettext->parse(<DATA>) }; | |
| __DATA__ | |
| #: Hello.pm:10 | |
| msgid "Hello, World!" | |
| msgstr "Hallo, Welt!" | |
| #: Hello.pm:11 | |
| msgid "You have %quant(%1,piece) of mail." | |
| msgstr "Sie haben %quant(%1,Poststueck,Poststuecken)." | |
| =head1 DESCRIPTION | |
| This module implements a perl-based C<Gettext> parser for | |
| B<Locale::Maketext>. It transforms all C<%1>, C<%2>, <%*>... sequences | |
| to C<[_1]>, C<[_2]>, C<[_*]>, and so on. It accepts either plain PO | |
| file, or a MO file which will be handled with a pure-perl parser | |
| adapted from Imacat's C<Locale::Maketext::Gettext>. | |
| Since version 0.03, this module also looks for C<%I<function>(I<args...>)> | |
| in the lexicon strings, and transform it to C<[I<function>,I<args...>]>. | |
| Any C<%1>, C<%2>... sequences inside the I<args> will have their percent | |
| signs (C<%>) replaced by underscores (C<_>). | |
| The name of I<function> above should begin with a letter or underscore, | |
| followed by any number of alphanumeric characters and/or underscores. | |
| As an exception, the function name may also consist of a single asterisk | |
| (C<*>) or pound sign (C<#>), which are C<Locale::Maketext>'s shorthands | |
| for C<quant> and C<numf>, respectively. | |
| As an additional feature, this module also parses MIME-header style | |
| metadata specified in the null msgstr (C<"">), and add them to the | |
| C<%Lexicon> with a C<__> prefix. For example, the example above will | |
| set C<__Content-Type> to C<text/plain; charset=iso8859-1>, without | |
| the newline or the colon. | |
| Any normal entry that duplicates a metadata entry takes precedence. | |
| Hence, a C<msgid "__Content-Type"> line occurs anywhere should override | |
| the above value. | |
| =head1 OPTIONS | |
| =head2 use_fuzzy | |
| When parsing PO files, fuzzy entries (entries marked with C<#, fuzzy>) | |
| are silently ignored. If you wish to use fuzzy entries, specify a true | |
| value to the C<_use_fuzzy> option: | |
| use Locale::Maketext::Lexicon { | |
| de => [Gettext => 'hello/de.mo'], | |
| _use_fuzzy => 1, | |
| }; | |
| =head2 allow_empty | |
| When parsing PO files, empty entries (entries with C<msgstr "">) are | |
| silently ignored. If you wish to allow empty entries, specify a true | |
| value to the C<_allow_empty> option: | |
| use Locale::Maketext::Lexicon { | |
| de => [Gettext => 'hello/de.mo'], | |
| _allow_empty => 1, | |
| }; | |
| =cut | |
| my ( $InputEncoding, $OutputEncoding, $DoEncoding ); | |
| sub input_encoding {$InputEncoding} | |
| sub output_encoding {$OutputEncoding} | |
| sub parse { | |
| my $self = shift; | |
| my ( %var, $key, @ret ); | |
| my @metadata; | |
| my @comments; | |
| my @fuzzy; | |
| $InputEncoding = $OutputEncoding = $DoEncoding = undef; | |
| use Carp; | |
| Carp::cluck "Undefined source called\n" unless defined $_[0]; | |
| # Check for magic string of MO files | |
| return parse_mo( join( '', @_ ) ) | |
| if ( $_[0] =~ /^\x95\x04\x12\xde/ or $_[0] =~ /^\xde\x12\x04\x95/ ); | |
| local $^W; # no 'uninitialized' warnings, please. | |
| require Locale::Maketext::Lexicon; | |
| my $KeepFuzzy = Locale::Maketext::Lexicon::option('keep_fuzzy'); | |
| my $UseFuzzy = $KeepFuzzy | |
| || Locale::Maketext::Lexicon::option('use_fuzzy'); | |
| my $AllowEmpty = Locale::Maketext::Lexicon::option('allow_empty'); | |
| my $process = sub { | |
| if ( length( $var{msgstr} ) and ( $UseFuzzy or !$var{fuzzy} ) ) { | |
| push @ret, ( map transform($_), @var{ 'msgid', 'msgstr' } ); | |
| } | |
| elsif ($AllowEmpty) { | |
| push @ret, ( transform( $var{msgid} ), '' ); | |
| } | |
| if ( $var{msgid} eq '' ) { | |
| push @metadata, parse_metadata( $var{msgstr} ); | |
| } | |
| else { | |
| push @comments, $var{msgid}, $var{msgcomment}; | |
| } | |
| if ( $KeepFuzzy && $var{fuzzy} ) { | |
| push @fuzzy, $var{msgid}, 1; | |
| } | |
| %var = (); | |
| }; | |
| # Parse PO files | |
| foreach (@_) { | |
| s/[\015\012]*\z//; # fix CRLF issues | |
| /^(msgid|msgstr) +"(.*)" *$/ | |
| ? do { # leading strings | |
| $var{$1} = $2; | |
| $key = $1; | |
| } | |
| : | |
| /^"(.*)" *$/ | |
| ? do { # continued strings | |
| $var{$key} .= $1; | |
| } | |
| : | |
| /^# (.*)$/ | |
| ? do { # user comments | |
| $var{msgcomment} .= $1 . "\n"; | |
| } | |
| : | |
| /^#, +(.*) *$/ | |
| ? do { # control variables | |
| $var{$_} = 1 for split( /,\s+/, $1 ); | |
| } | |
| : | |
| /^ *$/ && %var | |
| ? do { # interpolate string escapes | |
| $process->($_); | |
| } | |
| : (); | |
| } | |
| # do not silently skip last entry | |
| $process->() if keys %var != 0; | |
| push @ret, map { transform($_) } @var{ 'msgid', 'msgstr' } | |
| if length $var{msgstr}; | |
| push @metadata, parse_metadata( $var{msgstr} ) | |
| if $var{msgid} eq ''; | |
| return wantarray | |
| ? ( { @metadata, @ret }, {@comments}, {@fuzzy} ) | |
| : ( { @metadata, @ret } ); | |
| } | |
| sub parse_metadata { | |
| return map { | |
| (/^([^\x00-\x1f\x80-\xff :=]+):\s*(.*)$/) | |
| ? ( $1 eq 'Content-Type' ) | |
| ? do { | |
| my $enc = $2; | |
| if ( $enc =~ /\bcharset=\s*([-\w]+)/i ) { | |
| $InputEncoding = $1 || ''; | |
| $OutputEncoding | |
| = Locale::Maketext::Lexicon::encoding() | |
| || ''; | |
| $InputEncoding = 'utf8' | |
| if $InputEncoding =~ /^utf-?8$/i; | |
| $OutputEncoding = 'utf8' | |
| if $OutputEncoding =~ /^utf-?8$/i; | |
| if ( Locale::Maketext::Lexicon::option('decode') | |
| and ( !$OutputEncoding | |
| or $InputEncoding ne $OutputEncoding ) | |
| ) | |
| { | |
| require Encode::compat if $] < 5.007001; | |
| require Encode; | |
| $DoEncoding = 1; | |
| } | |
| } | |
| ( "__Content-Type", $enc ); | |
| } | |
| : ( "__$1", $2 ) | |
| : (); | |
| } split( /\r*\n+\r*/, transform(pop) ); | |
| } | |
| sub transform { | |
| my $str = shift; | |
| if ( $DoEncoding and $InputEncoding ) { | |
| $str | |
| = ( $InputEncoding eq 'utf8' ) | |
| ? Encode::decode_utf8($str) | |
| : Encode::decode( $InputEncoding, $str ); | |
| } | |
| $str =~ s/\\([0x]..|c?.)/qq{"\\$1"}/eeg; | |
| if ( $DoEncoding and $OutputEncoding ) { | |
| $str | |
| = ( $OutputEncoding eq 'utf8' ) | |
| ? Encode::encode_utf8($str) | |
| : Encode::encode( $OutputEncoding, $str ); | |
| } | |
| return _gettext_to_maketext($str); | |
| } | |
| sub _gettext_to_maketext { | |
| my $str = shift; | |
| $str =~ s{([\~\[\]])}{~$1}g; | |
| $str =~ s{ | |
| ([%\\]%) # 1 - escaped sequence | |
| | | |
| % (?: | |
| ([A-Za-z#*]\w*) # 2 - function call | |
| \(([^\)]*)\) # 3 - arguments | |
| | | |
| ([1-9]\d*|\*) # 4 - variable | |
| ) | |
| }{ | |
| $1 ? $1 | |
| : $2 ? "\[$2,"._unescape($3)."]" | |
| : "[_$4]" | |
| }egx; | |
| $str; | |
| } | |
| sub _unescape { | |
| join( ',', | |
| map { /\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_ } | |
| split( /,/, $_[0] ) ); | |
| } | |
| # This subroutine was derived from Locale::Maketext::Gettext::readmo() | |
| # under the Perl License; the original author is Yi Ma Mao (IMACAT). | |
| sub parse_mo { | |
| my $content = shift; | |
| my $tmpl = ( substr( $content, 0, 4 ) eq "\xde\x12\x04\x95" ) ? 'V' : 'N'; | |
| # Check the MO format revision number | |
| # There is only one revision now: revision 0. | |
| return if unpack( $tmpl, substr( $content, 4, 4 ) ) > 0; | |
| my ( $num, $offo, $offt ); | |
| # Number of strings | |
| $num = unpack $tmpl, substr( $content, 8, 4 ); | |
| # Offset to the beginning of the original strings | |
| $offo = unpack $tmpl, substr( $content, 12, 4 ); | |
| # Offset to the beginning of the translated strings | |
| $offt = unpack $tmpl, substr( $content, 16, 4 ); | |
| my ( @metadata, @ret ); | |
| for ( 0 .. $num - 1 ) { | |
| my ( $len, $off, $stro, $strt ); | |
| # The first word is the length of the string | |
| $len = unpack $tmpl, substr( $content, $offo + $_ * 8, 4 ); | |
| # The second word is the offset of the string | |
| $off = unpack $tmpl, substr( $content, $offo + $_ * 8 + 4, 4 ); | |
| # Original string | |
| $stro = substr( $content, $off, $len ); | |
| # The first word is the length of the string | |
| $len = unpack $tmpl, substr( $content, $offt + $_ * 8, 4 ); | |
| # The second word is the offset of the string | |
| $off = unpack $tmpl, substr( $content, $offt + $_ * 8 + 4, 4 ); | |
| # Translated string | |
| $strt = substr( $content, $off, $len ); | |
| # Hash it | |
| push @metadata, parse_metadata($strt) if $stro eq ''; | |
| push @ret, ( map transform($_), $stro, $strt ) if length $strt; | |
| } | |
| return { @metadata, @ret }; | |
| } | |
| 1; | |
| =head1 SEE ALSO | |
| L<Locale::Maketext>, L<Locale::Maketext::Lexicon> | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002, 2003, 2004, 2007 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| LOCALE_MAKETEXT_LEXICON_GETTEXT | |
| $fatpacked{"Locale/Maketext/Lexicon/Msgcat.pm"} = <<'LOCALE_MAKETEXT_LEXICON_MSGCAT'; | |
| package Locale::Maketext::Lexicon::Msgcat; | |
| $Locale::Maketext::Lexicon::Msgcat::VERSION = '0.03'; | |
| use strict; | |
| =head1 NAME | |
| Locale::Maketext::Lexicon::Msgcat - Msgcat catalog parser Maketext | |
| =head1 SYNOPSIS | |
| package Hello::I18N; | |
| use base 'Locale::Maketext'; | |
| use Locale::Maketext::Lexicon { | |
| en => ['Msgcat', 'en_US/hello.pl.m'], | |
| }; | |
| package main; | |
| my $lh = Hello::I18N->get_handle('en'); | |
| print $lh->maketext(1,2); # set 1, msg 2 | |
| print $lh->maketext("1,2"); # same thing | |
| =head1 DESCRIPTION | |
| This module parses one or more Msgcat catalogs in plain text format, | |
| and returns a Lexicon hash, which may be looked up either with a | |
| two-argument form (C<$set_id, $msg_id>) or as a single string | |
| (C<"$set_id,$msg_id">). | |
| =head1 NOTES | |
| All special characters (C<[>, C<]> and C<~>) in catalogs will be | |
| escaped so they lose their magic meanings. That means C<-E<gt>maketext> | |
| calls to this lexicon will I<not> take any additional arguments. | |
| =cut | |
| sub parse { | |
| my $set = 0; | |
| my $msg = undef; | |
| my ($qr, $qq, $qc) = (qr//, '', ''); | |
| my @out; | |
| # Set up the msgcat handler | |
| { | |
| no strict 'refs'; | |
| no warnings 'once'; | |
| *{Locale::Maketext::msgcat} = \&_msgcat; | |
| } | |
| # Parse *.m files; Locale::Msgcat objects and *.cat are not yet supported. | |
| foreach (@_) { | |
| s/[\015\012]*\z//; # fix CRLF issues | |
| /^\$set (\d+)/ | |
| ? do { # set_id | |
| $set = int($1); | |
| push @out, $1, "[msgcat,$1,_1]"; | |
| } | |
| : | |
| /^\$quote (.)/ | |
| ? do { # quote character | |
| $qc = $1; | |
| $qq = quotemeta($1); | |
| $qr = qr/$qq?/; | |
| } | |
| : | |
| /^(\d+) ($qr)(.*?)\2(\\?)$/ | |
| ? do { # msg_id and msg_str | |
| local $^W; | |
| push @out, "$set," . int($1); | |
| if ($4) { | |
| $msg = $3; | |
| } | |
| else { | |
| push @out, unescape($qq, $qc, $3); | |
| undef $msg; | |
| } | |
| } | |
| : | |
| (defined $msg and /^($qr)(.*?)\1(\\?)$/) | |
| ? do { # continued string | |
| local $^W; | |
| if ($3) { | |
| $msg .= $2; | |
| } | |
| else { | |
| push @out, unescape($qq, $qc, $msg . $2); | |
| undef $msg; | |
| } | |
| } | |
| : (); | |
| } | |
| push @out, '' if defined $msg; | |
| return {@out}; | |
| } | |
| sub _msgcat { | |
| my ($self, $set_id, $msg_id, @args) = @_; | |
| return $self->maketext(int($set_id) . ',' . int($msg_id), @args); | |
| } | |
| sub unescape { | |
| my ($qq, $qc, $str) = @_; | |
| $str =~ s/(\\([ntvbrf\\$qq]))/($2 eq $qc) ? $qc : eval qq("$1")/e; | |
| $str =~ s/([\~\[\]])/~$1/g; | |
| return $str; | |
| } | |
| 1; | |
| =head1 SEE ALSO | |
| L<Locale::Maketext>, L<Locale::Maketext::Lexicon> | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002, 2003, 2004, 2007 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| LOCALE_MAKETEXT_LEXICON_MSGCAT | |
| $fatpacked{"Locale/Maketext/Lexicon/Tie.pm"} = <<'LOCALE_MAKETEXT_LEXICON_TIE'; | |
| package Locale::Maketext::Lexicon::Tie; | |
| $Locale::Maketext::Lexicon::Tie::VERSION = '0.05'; | |
| use strict; | |
| use Symbol (); | |
| =head1 NAME | |
| Locale::Maketext::Lexicon::Tie - Use tied hashes as lexicons for Maketext | |
| =head1 SYNOPSIS | |
| package Hello::I18N; | |
| use base 'Locale::Maketext'; | |
| use Locale::Maketext::Lexicon { | |
| en => [ Tie => [ DB_File => 'en.db' ] ], | |
| }; | |
| =head1 DESCRIPTION | |
| This module lets you easily C<tie> the C<%Lexicon> hash to a database | |
| or other data sources. It takes an array reference of arguments, and | |
| passes them directly to C<tie()>. | |
| Entries will then be fetched whenever it is used; this module does not | |
| cache them. | |
| =cut | |
| sub parse { | |
| my $self = shift; | |
| my $mod = shift; | |
| my $sym = Symbol::gensym(); | |
| # Load the target module into memory | |
| { | |
| no strict 'refs'; | |
| eval "use $mod; 1" or die $@ unless %{"$mod\::"}; | |
| } | |
| # Perform the actual tie | |
| tie %{*$sym}, $mod, @_; | |
| # Returns the GLOB reference, so %Lexicon will be tied too | |
| return $sym; | |
| } | |
| 1; | |
| =head1 SEE ALSO | |
| L<Locale::Maketext>, L<Locale::Maketext::Lexicon> | |
| =head1 AUTHORS | |
| Audrey Tang E<lt>[email protected]<gt> | |
| =head1 COPYRIGHT | |
| Copyright 2002, 2003, 2004, 2007 by Audrey Tang E<lt>[email protected]<gt>. | |
| This software is released under the MIT license cited below. | |
| =head2 The "MIT" License | |
| Permission is hereby granted, free of charge, to any person obtaining a copy | |
| of this software and associated documentation files (the "Software"), to deal | |
| in the Software without restriction, including without limitation the rights | |
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
| copies of the Software, and to permit persons to whom the Software is | |
| furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS | |
| OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER | |
| DEALINGS IN THE SOFTWARE. | |
| =cut | |
| LOCALE_MAKETEXT_LEXICON_TIE | |
| $fatpacked{"Module/Load.pm"} = <<'MODULE_LOAD'; | |
| package Module::Load; | |
| $VERSION = '0.20'; | |
| use strict; | |
| use File::Spec (); | |
| sub import { | |
| my $who = _who(); | |
| { no strict 'refs'; | |
| *{"${who}::load"} = *load; | |
| } | |
| } | |
| sub load (*;@) { | |
| my $mod = shift or return; | |
| my $who = _who(); | |
| if( _is_file( $mod ) ) { | |
| require $mod; | |
| } else { | |
| LOAD: { | |
| my $err; | |
| for my $flag ( qw[1 0] ) { | |
| my $file = _to_file( $mod, $flag); | |
| eval { require $file }; | |
| $@ ? $err .= $@ : last LOAD; | |
| } | |
| die $err if $err; | |
| } | |
| } | |
| ### This addresses #41883: Module::Load cannot import | |
| ### non-Exporter module. ->import() routines weren't | |
| ### properly called when load() was used. | |
| { no strict 'refs'; | |
| my $import; | |
| if (@_ and $import = $mod->can('import')) { | |
| unshift @_, $mod; | |
| goto &$import; | |
| } | |
| } | |
| } | |
| sub _to_file{ | |
| local $_ = shift; | |
| my $pm = shift || ''; | |
| ## trailing blanks ignored by default. [rt #69886] | |
| my @parts = split /::/, $_, -1; | |
| ### because of [perl #19213], see caveats ### | |
| my $file = $^O eq 'MSWin32' | |
| ? join "/", @parts | |
| : File::Spec->catfile( @parts ); | |
| $file .= '.pm' if $pm; | |
| ### on perl's before 5.10 (5.9.5@31746) if you require | |
| ### a file in VMS format, it's stored in %INC in VMS | |
| ### format. Therefor, better unixify it first | |
| ### Patch in reply to John Malmbergs patch (as mentioned | |
| ### above) on p5p Tue 21 Aug 2007 04:55:07 | |
| $file = VMS::Filespec::unixify($file) if $^O eq 'VMS'; | |
| return $file; | |
| } | |
| sub _who { (caller(1))[0] } | |
| sub _is_file { | |
| local $_ = shift; | |
| return /^\./ ? 1 : | |
| /[^\w:']/ ? 1 : | |
| undef | |
| #' silly bbedit.. | |
| } | |
| 1; | |
| __END__ | |
| =pod | |
| =head1 NAME | |
| Module::Load - runtime require of both modules and files | |
| =head1 SYNOPSIS | |
| use Module::Load; | |
| my $module = 'Data:Dumper'; | |
| load Data::Dumper; # loads that module | |
| load 'Data::Dumper'; # ditto | |
| load $module # tritto | |
| my $script = 'some/script.pl' | |
| load $script; | |
| load 'some/script.pl'; # use quotes because of punctuations | |
| load thing; # try 'thing' first, then 'thing.pm' | |
| load CGI, ':standard' # like 'use CGI qw[:standard]' | |
| =head1 DESCRIPTION | |
| C<load> eliminates the need to know whether you are trying to require | |
| either a file or a module. | |
| If you consult C<perldoc -f require> you will see that C<require> will | |
| behave differently when given a bareword or a string. | |
| In the case of a string, C<require> assumes you are wanting to load a | |
| file. But in the case of a bareword, it assumes you mean a module. | |
| This gives nasty overhead when you are trying to dynamically require | |
| modules at runtime, since you will need to change the module notation | |
| (C<Acme::Comment>) to a file notation fitting the particular platform | |
| you are on. | |
| C<load> eliminates the need for this overhead and will just DWYM. | |
| =head1 Rules | |
| C<load> has the following rules to decide what it thinks you want: | |
| =over 4 | |
| =item * | |
| If the argument has any characters in it other than those matching | |
| C<\w>, C<:> or C<'>, it must be a file | |
| =item * | |
| If the argument matches only C<[\w:']>, it must be a module | |
| =item * | |
| If the argument matches only C<\w>, it could either be a module or a | |
| file. We will try to find C<file.pm> first in C<@INC> and if that | |
| fails, we will try to find C<file> in @INC. If both fail, we die with | |
| the respective error messages. | |
| =back | |
| =head1 Caveats | |
| Because of a bug in perl (#19213), at least in version 5.6.1, we have | |
| to hardcode the path separator for a require on Win32 to be C</>, like | |
| on Unix rather than the Win32 C<\>. Otherwise perl will not read its | |
| own %INC accurately double load files if they are required again, or | |
| in the worst case, core dump. | |
| C<Module::Load> cannot do implicit imports, only explicit imports. | |
| (in other words, you always have to specify explicitly what you wish | |
| to import from a module, even if the functions are in that modules' | |
| C<@EXPORT>) | |
| =head1 ACKNOWLEDGEMENTS | |
| Thanks to Jonas B. Nielsen for making explicit imports work. | |
| =head1 BUG REPORTS | |
| Please report bugs or other issues to E<lt>[email protected]<gt>. | |
| =head1 AUTHOR | |
| This module by Jos Boumans E<lt>[email protected]<gt>. | |
| =head1 COPYRIGHT | |
| This library is free software; you may redistribute and/or modify it | |
| under the same terms as Perl itself. | |
| =cut | |
| MODULE_LOAD | |
| $fatpacked{"Params/Check.pm"} = <<'PARAMS_CHECK'; | |
| package Params::Check; | |
| use strict; | |
| use Carp qw[carp croak]; | |
| use Locale::Maketext::Simple Style => 'gettext'; | |
| BEGIN { | |
| use Exporter (); | |
| use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $ALLOW_UNKNOWN | |
| $STRICT_TYPE $STRIP_LEADING_DASHES $NO_DUPLICATES | |
| $PRESERVE_CASE $ONLY_ALLOW_DEFINED $WARNINGS_FATAL | |
| $SANITY_CHECK_TEMPLATE $CALLER_DEPTH $_ERROR_STRING | |
| ]; | |
| @ISA = qw[ Exporter ]; | |
| @EXPORT_OK = qw[check allow last_error]; | |
| $VERSION = '0.32'; | |
| $VERBOSE = $^W ? 1 : 0; | |
| $NO_DUPLICATES = 0; | |
| $STRIP_LEADING_DASHES = 0; | |
| $STRICT_TYPE = 0; | |
| $ALLOW_UNKNOWN = 0; | |
| $PRESERVE_CASE = 0; | |
| $ONLY_ALLOW_DEFINED = 0; | |
| $SANITY_CHECK_TEMPLATE = 1; | |
| $WARNINGS_FATAL = 0; | |
| $CALLER_DEPTH = 0; | |
| } | |
| my %known_keys = map { $_ => 1 } | |
| qw| required allow default strict_type no_override | |
| store defined |; | |
| =pod | |
| =head1 NAME | |
| Params::Check - A generic input parsing/checking mechanism. | |
| =head1 SYNOPSIS | |
| use Params::Check qw[check allow last_error]; | |
| sub fill_personal_info { | |
| my %hash = @_; | |
| my $x; | |
| my $tmpl = { | |
| firstname => { required => 1, defined => 1 }, | |
| lastname => { required => 1, store => \$x }, | |
| gender => { required => 1, | |
| allow => [qr/M/i, qr/F/i], | |
| }, | |
| married => { allow => [0,1] }, | |
| age => { default => 21, | |
| allow => qr/^\d+$/, | |
| }, | |
| phone => { allow => [ sub { return 1 if /$valid_re/ }, | |
| '1-800-PERL' ] | |
| }, | |
| id_list => { default => [], | |
| strict_type => 1 | |
| }, | |
| employer => { default => 'NSA', no_override => 1 }, | |
| }; | |
| ### check() returns a hashref of parsed args on success ### | |
| my $parsed_args = check( $tmpl, \%hash, $VERBOSE ) | |
| or die qw[Could not parse arguments!]; | |
| ... other code here ... | |
| } | |
| my $ok = allow( $colour, [qw|blue green yellow|] ); | |
| my $error = Params::Check::last_error(); | |
| =head1 DESCRIPTION | |
| Params::Check is a generic input parsing/checking mechanism. | |
| It allows you to validate input via a template. The only requirement | |
| is that the arguments must be named. | |
| Params::Check can do the following things for you: | |
| =over 4 | |
| =item * | |
| Convert all keys to lowercase | |
| =item * | |
| Check if all required arguments have been provided | |
| =item * | |
| Set arguments that have not been provided to the default | |
| =item * | |
| Weed out arguments that are not supported and warn about them to the | |
| user | |
| =item * | |
| Validate the arguments given by the user based on strings, regexes, | |
| lists or even subroutines | |
| =item * | |
| Enforce type integrity if required | |
| =back | |
| Most of Params::Check's power comes from its template, which we'll | |
| discuss below: | |
| =head1 Template | |
| As you can see in the synopsis, based on your template, the arguments | |
| provided will be validated. | |
| The template can take a different set of rules per key that is used. | |
| The following rules are available: | |
| =over 4 | |
| =item default | |
| This is the default value if none was provided by the user. | |
| This is also the type C<strict_type> will look at when checking type | |
| integrity (see below). | |
| =item required | |
| A boolean flag that indicates if this argument was a required | |
| argument. If marked as required and not provided, check() will fail. | |
| =item strict_type | |
| This does a C<ref()> check on the argument provided. The C<ref> of the | |
| argument must be the same as the C<ref> of the default value for this | |
| check to pass. | |
| This is very useful if you insist on taking an array reference as | |
| argument for example. | |
| =item defined | |
| If this template key is true, enforces that if this key is provided by | |
| user input, its value is C<defined>. This just means that the user is | |
| not allowed to pass C<undef> as a value for this key and is equivalent | |
| to: | |
| allow => sub { defined $_[0] && OTHER TESTS } | |
| =item no_override | |
| This allows you to specify C<constants> in your template. ie, they | |
| keys that are not allowed to be altered by the user. It pretty much | |
| allows you to keep all your C<configurable> data in one place; the | |
| C<Params::Check> template. | |
| =item store | |
| This allows you to pass a reference to a scalar, in which the data | |
| will be stored: | |
| my $x; | |
| my $args = check(foo => { default => 1, store => \$x }, $input); | |
| This is basically shorthand for saying: | |
| my $args = check( { foo => { default => 1 }, $input ); | |
| my $x = $args->{foo}; | |
| You can alter the global variable $Params::Check::NO_DUPLICATES to | |
| control whether the C<store>'d key will still be present in your | |
| result set. See the L<Global Variables> section below. | |
| =item allow | |
| A set of criteria used to validate a particular piece of data if it | |
| has to adhere to particular rules. | |
| See the C<allow()> function for details. | |
| =back | |
| =head1 Functions | |
| =head2 check( \%tmpl, \%args, [$verbose] ); | |
| This function is not exported by default, so you'll have to ask for it | |
| via: | |
| use Params::Check qw[check]; | |
| or use its fully qualified name instead. | |
| C<check> takes a list of arguments, as follows: | |
| =over 4 | |
| =item Template | |
| This is a hashreference which contains a template as explained in the | |
| C<SYNOPSIS> and C<Template> section. | |
| =item Arguments | |
| This is a reference to a hash of named arguments which need checking. | |
| =item Verbose | |
| A boolean to indicate whether C<check> should be verbose and warn | |
| about what went wrong in a check or not. | |
| You can enable this program wide by setting the package variable | |
| C<$Params::Check::VERBOSE> to a true value. For details, see the | |
| section on C<Global Variables> below. | |
| =back | |
| C<check> will return when it fails, or a hashref with lowercase | |
| keys of parsed arguments when it succeeds. | |
| So a typical call to check would look like this: | |
| my $parsed = check( \%template, \%arguments, $VERBOSE ) | |
| or warn q[Arguments could not be parsed!]; | |
| A lot of the behaviour of C<check()> can be altered by setting | |
| package variables. See the section on C<Global Variables> for details | |
| on this. | |
| =cut | |
| sub check { | |
| my ($utmpl, $href, $verbose) = @_; | |
| ### clear the current error string ### | |
| _clear_error(); | |
| ### did we get the arguments we need? ### | |
| if ( !$utmpl or !$href ) { | |
| _store_error(loc('check() expects two arguments')); | |
| return unless $WARNINGS_FATAL; | |
| croak(__PACKAGE__->last_error); | |
| } | |
| ### sensible defaults ### | |
| $verbose ||= $VERBOSE || 0; | |
| ### XXX what type of template is it? ### | |
| ### { key => { } } ? | |
| #if (ref $args eq 'HASH') { | |
| # 1; | |
| #} | |
| ### clean up the template ### | |
| my $args = _clean_up_args( $href ) or return; | |
| ### sanity check + defaults + required keys set? ### | |
| my $defs = _sanity_check_and_defaults( $utmpl, $args, $verbose ) | |
| or return; | |
| ### deref only once ### | |
| my %utmpl = %$utmpl; | |
| my %args = %$args; | |
| my %defs = %$defs; | |
| ### flag to see if anything went wrong ### | |
| my $wrong; | |
| ### flag to see if we warned for anything, needed for warnings_fatal | |
| my $warned; | |
| for my $key (keys %args) { | |
| ### you gave us this key, but it's not in the template ### | |
| unless( $utmpl{$key} ) { | |
| ### but we'll allow it anyway ### | |
| if( $ALLOW_UNKNOWN ) { | |
| $defs{$key} = $args{$key}; | |
| ### warn about the error ### | |
| } else { | |
| _store_error( | |
| loc("Key '%1' is not a valid key for %2 provided by %3", | |
| $key, _who_was_it(), _who_was_it(1)), $verbose); | |
| $warned ||= 1; | |
| } | |
| next; | |
| } | |
| ### check if you're even allowed to override this key ### | |
| if( $utmpl{$key}->{'no_override'} ) { | |
| _store_error( | |
| loc(q[You are not allowed to override key '%1']. | |
| q[for %2 from %3], $key, _who_was_it(), _who_was_it(1)), | |
| $verbose | |
| ); | |
| $warned ||= 1; | |
| next; | |
| } | |
| ### copy of this keys template instructions, to save derefs ### | |
| my %tmpl = %{$utmpl{$key}}; | |
| ### check if you were supposed to provide defined() values ### | |
| if( ($tmpl{'defined'} || $ONLY_ALLOW_DEFINED) and | |
| not defined $args{$key} | |
| ) { | |
| _store_error(loc(q|Key '%1' must be defined when passed|, $key), | |
| $verbose ); | |
| $wrong ||= 1; | |
| next; | |
| } | |
| ### check if they should be of a strict type, and if it is ### | |
| if( ($tmpl{'strict_type'} || $STRICT_TYPE) and | |
| (ref $args{$key} ne ref $tmpl{'default'}) | |
| ) { | |
| _store_error(loc(q|Key '%1' needs to be of type '%2'|, | |
| $key, ref $tmpl{'default'} || 'SCALAR'), $verbose ); | |
| $wrong ||= 1; | |
| next; | |
| } | |
| ### check if we have an allow handler, to validate against ### | |
| ### allow() will report its own errors ### | |
| if( exists $tmpl{'allow'} and not do { | |
| local $_ERROR_STRING; | |
| allow( $args{$key}, $tmpl{'allow'} ) | |
| } | |
| ) { | |
| ### stringify the value in the error report -- we don't want dumps | |
| ### of objects, but we do want to see *roughly* what we passed | |
| _store_error(loc(q|Key '%1' (%2) is of invalid type for '%3' |. | |
| q|provided by %4|, | |
| $key, "$args{$key}", _who_was_it(), | |
| _who_was_it(1)), $verbose); | |
| $wrong ||= 1; | |
| next; | |
| } | |
| ### we got here, then all must be OK ### | |
| $defs{$key} = $args{$key}; | |
| } | |
| ### croak with the collected errors if there were errors and | |
| ### we have the fatal flag toggled. | |
| croak(__PACKAGE__->last_error) if ($wrong || $warned) && $WARNINGS_FATAL; | |
| ### done with our loop... if $wrong is set, something went wrong | |
| ### and the user is already informed, just return... | |
| return if $wrong; | |
| ### check if we need to store any of the keys ### | |
| ### can't do it before, because something may go wrong later, | |
| ### leaving the user with a few set variables | |
| for my $key (keys %defs) { | |
| if( my $ref = $utmpl{$key}->{'store'} ) { | |
| $$ref = $NO_DUPLICATES ? delete $defs{$key} : $defs{$key}; | |
| } | |
| } | |
| return \%defs; | |
| } | |
| =head2 allow( $test_me, \@criteria ); | |
| The function that handles the C<allow> key in the template is also | |
| available for independent use. | |
| The function takes as first argument a key to test against, and | |
| as second argument any form of criteria that are also allowed by | |
| the C<allow> key in the template. | |
| You can use the following types of values for allow: | |
| =over 4 | |
| =item string | |
| The provided argument MUST be equal to the string for the validation | |
| to pass. | |
| =item regexp | |
| The provided argument MUST match the regular expression for the | |
| validation to pass. | |
| =item subroutine | |
| The provided subroutine MUST return true in order for the validation | |
| to pass and the argument accepted. | |
| (This is particularly useful for more complicated data). | |
| =item array ref | |
| The provided argument MUST equal one of the elements of the array | |
| ref for the validation to pass. An array ref can hold all the above | |
| values. | |
| =back | |
| It returns true if the key matched the criteria, or false otherwise. | |
| =cut | |
| sub allow { | |
| ### use $_[0] and $_[1] since this is hot code... ### | |
| #my ($val, $ref) = @_; | |
| ### it's a regexp ### | |
| if( ref $_[1] eq 'Regexp' ) { | |
| local $^W; # silence warnings if $val is undef # | |
| return if $_[0] !~ /$_[1]/; | |
| ### it's a sub ### | |
| } elsif ( ref $_[1] eq 'CODE' ) { | |
| return unless $_[1]->( $_[0] ); | |
| ### it's an array ### | |
| } elsif ( ref $_[1] eq 'ARRAY' ) { | |
| ### loop over the elements, see if one of them says the | |
| ### value is OK | |
| ### also, short-circuit when possible | |
| for ( @{$_[1]} ) { | |
| return 1 if allow( $_[0], $_ ); | |
| } | |
| return; | |
| ### fall back to a simple, but safe 'eq' ### | |
| } else { | |
| return unless _safe_eq( $_[0], $_[1] ); | |
| } | |
| ### we got here, no failures ### | |
| return 1; | |
| } | |
| ### helper functions ### | |
| ### clean up the template ### | |
| sub _clean_up_args { | |
| ### don't even bother to loop, if there's nothing to clean up ### | |
| return $_[0] if $PRESERVE_CASE and !$STRIP_LEADING_DASHES; | |
| my %args = %{$_[0]}; | |
| ### keys are note aliased ### | |
| for my $key (keys %args) { | |
| my $org = $key; | |
| $key = lc $key unless $PRESERVE_CASE; | |
| $key =~ s/^-// if $STRIP_LEADING_DASHES; | |
| $args{$key} = delete $args{$org} if $key ne $org; | |
| } | |
| ### return references so we always return 'true', even on empty | |
| ### arguments | |
| return \%args; | |
| } | |
| sub _sanity_check_and_defaults { | |
| my %utmpl = %{$_[0]}; | |
| my %args = %{$_[1]}; | |
| my $verbose = $_[2]; | |
| my %defs; my $fail; | |
| for my $key (keys %utmpl) { | |
| ### check if required keys are provided | |
| ### keys are now lower cased, unless preserve case was enabled | |
| ### at which point, the utmpl keys must match, but that's the users | |
| ### problem. | |
| if( $utmpl{$key}->{'required'} and not exists $args{$key} ) { | |
| _store_error( | |
| loc(q|Required option '%1' is not provided for %2 by %3|, | |
| $key, _who_was_it(1), _who_was_it(2)), $verbose ); | |
| ### mark the error ### | |
| $fail++; | |
| next; | |
| } | |
| ### next, set the default, make sure the key exists in %defs ### | |
| $defs{$key} = $utmpl{$key}->{'default'} | |
| if exists $utmpl{$key}->{'default'}; | |
| if( $SANITY_CHECK_TEMPLATE ) { | |
| ### last, check if they provided any weird template keys | |
| ### -- do this last so we don't always execute this code. | |
| ### just a small optimization. | |
| map { _store_error( | |
| loc(q|Template type '%1' not supported [at key '%2']|, | |
| $_, $key), 1, 1 ); | |
| } grep { | |
| not $known_keys{$_} | |
| } keys %{$utmpl{$key}}; | |
| ### make sure you passed a ref, otherwise, complain about it! | |
| if ( exists $utmpl{$key}->{'store'} ) { | |
| _store_error( loc( | |
| q|Store variable for '%1' is not a reference!|, $key | |
| ), 1, 1 ) unless ref $utmpl{$key}->{'store'}; | |
| } | |
| } | |
| } | |
| ### errors found ### | |
| return if $fail; | |
| ### return references so we always return 'true', even on empty | |
| ### defaults | |
| return \%defs; | |
| } | |
| sub _safe_eq { | |
| ### only do a straight 'eq' if they're both defined ### | |
| return defined($_[0]) && defined($_[1]) | |
| ? $_[0] eq $_[1] | |
| : defined($_[0]) eq defined($_[1]); | |
| } | |
| sub _who_was_it { | |
| my $level = $_[0] || 0; | |
| return (caller(2 + $CALLER_DEPTH + $level))[3] || 'ANON' | |
| } | |
| =head2 last_error() | |
| Returns a string containing all warnings and errors reported during | |
| the last time C<check> was called. | |
| This is useful if you want to report then some other way than | |
| C<carp>'ing when the verbose flag is on. | |
| It is exported upon request. | |
| =cut | |
| { $_ERROR_STRING = ''; | |
| sub _store_error { | |
| my($err, $verbose, $offset) = @_[0..2]; | |
| $verbose ||= 0; | |
| $offset ||= 0; | |
| my $level = 1 + $offset; | |
| local $Carp::CarpLevel = $level; | |
| carp $err if $verbose; | |
| $_ERROR_STRING .= $err . "\n"; | |
| } | |
| sub _clear_error { | |
| $_ERROR_STRING = ''; | |
| } | |
| sub last_error { $_ERROR_STRING } | |
| } | |
| 1; | |
| =head1 Global Variables | |
| The behaviour of Params::Check can be altered by changing the | |
| following global variables: | |
| =head2 $Params::Check::VERBOSE | |
| This controls whether Params::Check will issue warnings and | |
| explanations as to why certain things may have failed. | |
| If you set it to 0, Params::Check will not output any warnings. | |
| The default is 1 when L<warnings> are enabled, 0 otherwise; | |
| =head2 $Params::Check::STRICT_TYPE | |
| This works like the C<strict_type> option you can pass to C<check>, | |
| which will turn on C<strict_type> globally for all calls to C<check>. | |
| The default is 0; | |
| =head2 $Params::Check::ALLOW_UNKNOWN | |
| If you set this flag, unknown options will still be present in the | |
| return value, rather than filtered out. This is useful if your | |
| subroutine is only interested in a few arguments, and wants to pass | |
| the rest on blindly to perhaps another subroutine. | |
| The default is 0; | |
| =head2 $Params::Check::STRIP_LEADING_DASHES | |
| If you set this flag, all keys passed in the following manner: | |
| function( -key => 'val' ); | |
| will have their leading dashes stripped. | |
| =head2 $Params::Check::NO_DUPLICATES | |
| If set to true, all keys in the template that are marked as to be | |
| stored in a scalar, will also be removed from the result set. | |
| Default is false, meaning that when you use C<store> as a template | |
| key, C<check> will put it both in the scalar you supplied, as well as | |
| in the hashref it returns. | |
| =head2 $Params::Check::PRESERVE_CASE | |
| If set to true, L<Params::Check> will no longer convert all keys from | |
| the user input to lowercase, but instead expect them to be in the | |
| case the template provided. This is useful when you want to use | |
| similar keys with different casing in your templates. | |
| Understand that this removes the case-insensitivity feature of this | |
| module. | |
| Default is 0; | |
| =head2 $Params::Check::ONLY_ALLOW_DEFINED | |
| If set to true, L<Params::Check> will require all values passed to be | |
| C<defined>. If you wish to enable this on a 'per key' basis, use the | |
| template option C<defined> instead. | |
| Default is 0; | |
| =head2 $Params::Check::SANITY_CHECK_TEMPLATE | |
| If set to true, L<Params::Check> will sanity check templates, validating | |
| for errors and unknown keys. Although very useful for debugging, this | |
| can be somewhat slow in hot-code and large loops. | |
| To disable this check, set this variable to C<false>. | |
| Default is 1; | |
| =head2 $Params::Check::WARNINGS_FATAL | |
| If set to true, L<Params::Check> will C<croak> when an error during | |
| template validation occurs, rather than return C<false>. | |
| Default is 0; | |
| =head2 $Params::Check::CALLER_DEPTH | |
| This global modifies the argument given to C<caller()> by | |
| C<Params::Check::check()> and is useful if you have a custom wrapper | |
| function around C<Params::Check::check()>. The value must be an | |
| integer, indicating the number of wrapper functions inserted between | |
| the real function call and C<Params::Check::check()>. | |
| Example wrapper function, using a custom stacktrace: | |
| sub check { | |
| my ($template, $args_in) = @_; | |
| local $Params::Check::WARNINGS_FATAL = 1; | |
| local $Params::Check::CALLER_DEPTH = $Params::Check::CALLER_DEPTH + 1; | |
| my $args_out = Params::Check::check($template, $args_in); | |
| my_stacktrace(Params::Check::last_error) unless $args_out; | |
| return $args_out; | |
| } | |
| Default is 0; | |
| =head1 Acknowledgements | |
| Thanks to Richard Soderberg for his performance improvements. | |
| =head1 BUG REPORTS | |
| Please report bugs or other issues to E<lt>[email protected]<gt>. | |
| =head1 AUTHOR | |
| This module by Jos Boumans E<lt>[email protected]<gt>. | |
| =head1 COPYRIGHT | |
| This library is free software; you may redistribute and/or modify it | |
| under the same terms as Perl itself. | |
| =cut | |
| # Local variables: | |
| # c-indentation-style: bsd | |
| # c-basic-offset: 4 | |
| # indent-tabs-mode: nil | |
| # End: | |
| # vim: expandtab shiftwidth=4: | |
| PARAMS_CHECK | |
| $fatpacked{"darwin-2level/Time/HiRes.pm"} = <<'DARWIN-2LEVEL_TIME_HIRES'; | |
| package Time::HiRes; | |
| { use 5.006; } | |
| use strict; | |
| require Exporter; | |
| require DynaLoader; | |
| our @ISA = qw(Exporter DynaLoader); | |
| our @EXPORT = qw( ); | |
| our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval | |
| getitimer setitimer nanosleep clock_gettime clock_getres | |
| clock clock_nanosleep | |
| CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID | |
| CLOCK_REALTIME CLOCK_SOFTTIME CLOCK_THREAD_CPUTIME_ID | |
| CLOCK_TIMEOFDAY CLOCKS_PER_SEC | |
| ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF | |
| TIMER_ABSTIME | |
| d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer | |
| d_nanosleep d_clock_gettime d_clock_getres | |
| d_clock d_clock_nanosleep | |
| stat | |
| ); | |
| our $VERSION = '1.9724'; | |
| our $XS_VERSION = $VERSION; | |
| $VERSION = eval $VERSION; | |
| our $AUTOLOAD; | |
| sub AUTOLOAD { | |
| my $constname; | |
| ($constname = $AUTOLOAD) =~ s/.*:://; | |
| # print "AUTOLOAD: constname = $constname ($AUTOLOAD)\n"; | |
| die "&Time::HiRes::constant not defined" if $constname eq 'constant'; | |
| my ($error, $val) = constant($constname); | |
| # print "AUTOLOAD: error = $error, val = $val\n"; | |
| if ($error) { | |
| my (undef,$file,$line) = caller; | |
| die "$error at $file line $line.\n"; | |
| } | |
| { | |
| no strict 'refs'; | |
| *$AUTOLOAD = sub { $val }; | |
| } | |
| goto &$AUTOLOAD; | |
| } | |
| sub import { | |
| my $this = shift; | |
| for my $i (@_) { | |
| if (($i eq 'clock_getres' && !&d_clock_getres) || | |
| ($i eq 'clock_gettime' && !&d_clock_gettime) || | |
| ($i eq 'clock_nanosleep' && !&d_clock_nanosleep) || | |
| ($i eq 'clock' && !&d_clock) || | |
| ($i eq 'nanosleep' && !&d_nanosleep) || | |
| ($i eq 'usleep' && !&d_usleep) || | |
| ($i eq 'ualarm' && !&d_ualarm)) { | |
| require Carp; | |
| Carp::croak("Time::HiRes::$i(): unimplemented in this platform"); | |
| } | |
| } | |
| Time::HiRes->export_to_level(1, $this, @_); | |
| } | |
| bootstrap Time::HiRes; | |
| # Preloaded methods go here. | |
| sub tv_interval { | |
| # probably could have been done in C | |
| my ($a, $b) = @_; | |
| $b = [gettimeofday()] unless defined($b); | |
| (${$b}[0] - ${$a}[0]) + ((${$b}[1] - ${$a}[1]) / 1_000_000); | |
| } | |
| # Autoload methods go after =cut, and are processed by the autosplit program. | |
| 1; | |
| __END__ | |
| =head1 NAME | |
| Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers | |
| =head1 SYNOPSIS | |
| use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep | |
| clock_gettime clock_getres clock_nanosleep clock | |
| stat ); | |
| usleep ($microseconds); | |
| nanosleep ($nanoseconds); | |
| ualarm ($microseconds); | |
| ualarm ($microseconds, $interval_microseconds); | |
| $t0 = [gettimeofday]; | |
| ($seconds, $microseconds) = gettimeofday; | |
| $elapsed = tv_interval ( $t0, [$seconds, $microseconds]); | |
| $elapsed = tv_interval ( $t0, [gettimeofday]); | |
| $elapsed = tv_interval ( $t0 ); | |
| use Time::HiRes qw ( time alarm sleep ); | |
| $now_fractions = time; | |
| sleep ($floating_seconds); | |
| alarm ($floating_seconds); | |
| alarm ($floating_seconds, $floating_interval); | |
| use Time::HiRes qw( setitimer getitimer ); | |
| setitimer ($which, $floating_seconds, $floating_interval ); | |
| getitimer ($which); | |
| use Time::HiRes qw( clock_gettime clock_getres clock_nanosleep | |
| ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF ); | |
| $realtime = clock_gettime(CLOCK_REALTIME); | |
| $resolution = clock_getres(CLOCK_REALTIME); | |
| clock_nanosleep(CLOCK_REALTIME, 1.5e9); | |
| clock_nanosleep(CLOCK_REALTIME, time()*1e9 + 10e9, TIMER_ABSTIME); | |
| my $ticktock = clock(); | |
| use Time::HiRes qw( stat ); | |
| my @stat = stat("file"); | |
| my @stat = stat(FH); | |
| =head1 DESCRIPTION | |
| The C<Time::HiRes> module implements a Perl interface to the | |
| C<usleep>, C<nanosleep>, C<ualarm>, C<gettimeofday>, and | |
| C<setitimer>/C<getitimer> system calls, in other words, high | |
| resolution time and timers. See the L</EXAMPLES> section below and the | |
| test scripts for usage; see your system documentation for the | |
| description of the underlying C<nanosleep> or C<usleep>, C<ualarm>, | |
| C<gettimeofday>, and C<setitimer>/C<getitimer> calls. | |
| If your system lacks C<gettimeofday()> or an emulation of it you don't | |
| get C<gettimeofday()> or the one-argument form of C<tv_interval()>. | |
| If your system lacks all of C<nanosleep()>, C<usleep()>, | |
| C<select()>, and C<poll>, you don't get C<Time::HiRes::usleep()>, | |
| C<Time::HiRes::nanosleep()>, or C<Time::HiRes::sleep()>. | |
| If your system lacks both C<ualarm()> and C<setitimer()> you don't get | |
| C<Time::HiRes::ualarm()> or C<Time::HiRes::alarm()>. | |
| If you try to import an unimplemented function in the C<use> statement | |
| it will fail at compile time. | |
| If your subsecond sleeping is implemented with C<nanosleep()> instead | |
| of C<usleep()>, you can mix subsecond sleeping with signals since | |
| C<nanosleep()> does not use signals. This, however, is not portable, | |
| and you should first check for the truth value of | |
| C<&Time::HiRes::d_nanosleep> to see whether you have nanosleep, and | |
| then carefully read your C<nanosleep()> C API documentation for any | |
| peculiarities. | |
| If you are using C<nanosleep> for something else than mixing sleeping | |
| with signals, give some thought to whether Perl is the tool you should | |
| be using for work requiring nanosecond accuracies. | |
| Remember that unless you are working on a I<hard realtime> system, | |
| any clocks and timers will be imprecise, especially so if you are working | |
| in a pre-emptive multiuser system. Understand the difference between | |
| I<wallclock time> and process time (in UNIX-like systems the sum of | |
| I<user> and I<system> times). Any attempt to sleep for X seconds will | |
| most probably end up sleeping B<more> than that, but don't be surpised | |
| if you end up sleeping slightly B<less>. | |
| The following functions can be imported from this module. | |
| No functions are exported by default. | |
| =over 4 | |
| =item gettimeofday () | |
| In array context returns a two-element array with the seconds and | |
| microseconds since the epoch. In scalar context returns floating | |
| seconds like C<Time::HiRes::time()> (see below). | |
| =item usleep ( $useconds ) | |
| Sleeps for the number of microseconds (millionths of a second) | |
| specified. Returns the number of microseconds actually slept. | |
| Can sleep for more than one second, unlike the C<usleep> system call. | |
| Can also sleep for zero seconds, which often works like a I<thread yield>. | |
| See also C<Time::HiRes::usleep()>, C<Time::HiRes::sleep()>, and | |
| C<Time::HiRes::clock_nanosleep()>. | |
| Do not expect usleep() to be exact down to one microsecond. | |
| =item nanosleep ( $nanoseconds ) | |
| Sleeps for the number of nanoseconds (1e9ths of a second) specified. | |
| Returns the number of nanoseconds actually slept (accurate only to | |
| microseconds, the nearest thousand of them). Can sleep for more than | |
| one second. Can also sleep for zero seconds, which often works like | |
| a I<thread yield>. See also C<Time::HiRes::sleep()>, | |
| C<Time::HiRes::usleep()>, and C<Time::HiRes::clock_nanosleep()>. | |
| Do not expect nanosleep() to be exact down to one nanosecond. | |
| Getting even accuracy of one thousand nanoseconds is good. | |
| =item ualarm ( $useconds [, $interval_useconds ] ) | |
| Issues a C<ualarm> call; the C<$interval_useconds> is optional and | |
| will be zero if unspecified, resulting in C<alarm>-like behaviour. | |
| Returns the remaining time in the alarm in microseconds, or C<undef> | |
| if an error occurred. | |
| ualarm(0) will cancel an outstanding ualarm(). | |
| Note that the interaction between alarms and sleeps is unspecified. | |
| =item tv_interval | |
| tv_interval ( $ref_to_gettimeofday [, $ref_to_later_gettimeofday] ) | |
| Returns the floating seconds between the two times, which should have | |
| been returned by C<gettimeofday()>. If the second argument is omitted, | |
| then the current time is used. | |
| =item time () | |
| Returns a floating seconds since the epoch. This function can be | |
| imported, resulting in a nice drop-in replacement for the C<time> | |
| provided with core Perl; see the L</EXAMPLES> below. | |
| B<NOTE 1>: This higher resolution timer can return values either less | |
| or more than the core C<time()>, depending on whether your platform | |
| rounds the higher resolution timer values up, down, or to the nearest second | |
| to get the core C<time()>, but naturally the difference should be never | |
| more than half a second. See also L</clock_getres>, if available | |
| in your system. | |
| B<NOTE 2>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT, when | |
| the C<time()> seconds since epoch rolled over to 1_000_000_000, the | |
| default floating point format of Perl and the seconds since epoch have | |
| conspired to produce an apparent bug: if you print the value of | |
| C<Time::HiRes::time()> you seem to be getting only five decimals, not | |
| six as promised (microseconds). Not to worry, the microseconds are | |
| there (assuming your platform supports such granularity in the first | |
| place). What is going on is that the default floating point format of | |
| Perl only outputs 15 digits. In this case that means ten digits | |
| before the decimal separator and five after. To see the microseconds | |
| you can use either C<printf>/C<sprintf> with C<"%.6f">, or the | |
| C<gettimeofday()> function in list context, which will give you the | |
| seconds and microseconds as two separate values. | |
| =item sleep ( $floating_seconds ) | |
| Sleeps for the specified amount of seconds. Returns the number of | |
| seconds actually slept (a floating point value). This function can | |
| be imported, resulting in a nice drop-in replacement for the C<sleep> | |
| provided with perl, see the L</EXAMPLES> below. | |
| Note that the interaction between alarms and sleeps is unspecified. | |
| =item alarm ( $floating_seconds [, $interval_floating_seconds ] ) | |
| The C<SIGALRM> signal is sent after the specified number of seconds. | |
| Implemented using C<setitimer()> if available, C<ualarm()> if not. | |
| The C<$interval_floating_seconds> argument is optional and will be | |
| zero if unspecified, resulting in C<alarm()>-like behaviour. This | |
| function can be imported, resulting in a nice drop-in replacement for | |
| the C<alarm> provided with perl, see the L</EXAMPLES> below. | |
| Returns the remaining time in the alarm in seconds, or C<undef> | |
| if an error occurred. | |
| B<NOTE 1>: With some combinations of operating systems and Perl | |
| releases C<SIGALRM> restarts C<select()>, instead of interrupting it. | |
| This means that an C<alarm()> followed by a C<select()> may together | |
| take the sum of the times specified for the the C<alarm()> and the | |
| C<select()>, not just the time of the C<alarm()>. | |
| Note that the interaction between alarms and sleeps is unspecified. | |
| =item setitimer ( $which, $floating_seconds [, $interval_floating_seconds ] ) | |
| Start up an interval timer: after a certain time, a signal ($which) arrives, | |
| and more signals may keep arriving at certain intervals. To disable | |
| an "itimer", use C<$floating_seconds> of zero. If the | |
| C<$interval_floating_seconds> is set to zero (or unspecified), the | |
| timer is disabled B<after> the next delivered signal. | |
| Use of interval timers may interfere with C<alarm()>, C<sleep()>, | |
| and C<usleep()>. In standard-speak the "interaction is unspecified", | |
| which means that I<anything> may happen: it may work, it may not. | |
| In scalar context, the remaining time in the timer is returned. | |
| In list context, both the remaining time and the interval are returned. | |
| There are usually three or four interval timers (signals) available: the | |
| C<$which> can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or | |
| C<ITIMER_REALPROF>. Note that which ones are available depends: true | |
| UNIX platforms usually have the first three, but only Solaris seems to | |
| have C<ITIMER_REALPROF> (which is used to profile multithreaded programs). | |
| Win32 unfortunately does not haveinterval timers. | |
| C<ITIMER_REAL> results in C<alarm()>-like behaviour. Time is counted in | |
| I<real time>; that is, wallclock time. C<SIGALRM> is delivered when | |
| the timer expires. | |
| C<ITIMER_VIRTUAL> counts time in (process) I<virtual time>; that is, | |
| only when the process is running. In multiprocessor/user/CPU systems | |
| this may be more or less than real or wallclock time. (This time is | |
| also known as the I<user time>.) C<SIGVTALRM> is delivered when the | |
| timer expires. | |
| C<ITIMER_PROF> counts time when either the process virtual time or when | |
| the operating system is running on behalf of the process (such as I/O). | |
| (This time is also known as the I<system time>.) (The sum of user | |
| time and system time is known as the I<CPU time>.) C<SIGPROF> is | |
| delivered when the timer expires. C<SIGPROF> can interrupt system calls. | |
| The semantics of interval timers for multithreaded programs are | |
| system-specific, and some systems may support additional interval | |
| timers. For example, it is unspecified which thread gets the signals. | |
| See your C<setitimer()> documentation. | |
| =item getitimer ( $which ) | |
| Return the remaining time in the interval timer specified by C<$which>. | |
| In scalar context, the remaining time is returned. | |
| In list context, both the remaining time and the interval are returned. | |
| The interval is always what you put in using C<setitimer()>. | |
| =item clock_gettime ( $which ) | |
| Return as seconds the current value of the POSIX high resolution timer | |
| specified by C<$which>. All implementations that support POSIX high | |
| resolution timers are supposed to support at least the C<$which> value | |
| of C<CLOCK_REALTIME>, which is supposed to return results close to the | |
| results of C<gettimeofday>, or the number of seconds since 00:00:00:00 | |
| January 1, 1970 Greenwich Mean Time (GMT). Do not assume that | |
| CLOCK_REALTIME is zero, it might be one, or something else. | |
| Another potentially useful (but not available everywhere) value is | |
| C<CLOCK_MONOTONIC>, which guarantees a monotonically increasing time | |
| value (unlike time() or gettimeofday(), which can be adjusted). | |
| See your system documentation for other possibly supported values. | |
| =item clock_getres ( $which ) | |
| Return as seconds the resolution of the POSIX high resolution timer | |
| specified by C<$which>. All implementations that support POSIX high | |
| resolution timers are supposed to support at least the C<$which> value | |
| of C<CLOCK_REALTIME>, see L</clock_gettime>. | |
| =item clock_nanosleep ( $which, $nanoseconds, $flags = 0) | |
| Sleeps for the number of nanoseconds (1e9ths of a second) specified. | |
| Returns the number of nanoseconds actually slept. The $which is the | |
| "clock id", as with clock_gettime() and clock_getres(). The flags | |
| default to zero but C<TIMER_ABSTIME> can specified (must be exported | |
| explicitly) which means that C<$nanoseconds> is not a time interval | |
| (as is the default) but instead an absolute time. Can sleep for more | |
| than one second. Can also sleep for zero seconds, which often works | |
| like a I<thread yield>. See also C<Time::HiRes::sleep()>, | |
| C<Time::HiRes::usleep()>, and C<Time::HiRes::nanosleep()>. | |
| Do not expect clock_nanosleep() to be exact down to one nanosecond. | |
| Getting even accuracy of one thousand nanoseconds is good. | |
| =item clock() | |
| Return as seconds the I<process time> (user + system time) spent by | |
| the process since the first call to clock() (the definition is B<not> | |
| "since the start of the process", though if you are lucky these times | |
| may be quite close to each other, depending on the system). What this | |
| means is that you probably need to store the result of your first call | |
| to clock(), and subtract that value from the following results of clock(). | |
| The time returned also includes the process times of the terminated | |
| child processes for which wait() has been executed. This value is | |
| somewhat like the second value returned by the times() of core Perl, | |
| but not necessarily identical. Note that due to backward | |
| compatibility limitations the returned value may wrap around at about | |
| 2147 seconds or at about 36 minutes. | |
| =item stat | |
| =item stat FH | |
| =item stat EXPR | |
| As L<perlfunc/stat> but with the access/modify/change file timestamps | |
| in subsecond resolution, if the operating system and the filesystem | |
| both support such timestamps. To override the standard stat(): | |
| use Time::HiRes qw(stat); | |
| Test for the value of &Time::HiRes::d_hires_stat to find out whether | |
| the operating system supports subsecond file timestamps: a value | |
| larger than zero means yes. There are unfortunately no easy | |
| ways to find out whether the filesystem supports such timestamps. | |
| UNIX filesystems often do; NTFS does; FAT doesn't (FAT timestamp | |
| granularity is B<two> seconds). | |
| A zero return value of &Time::HiRes::d_hires_stat means that | |
| Time::HiRes::stat is a no-op passthrough for CORE::stat(), | |
| and therefore the timestamps will stay integers. The same | |
| thing will happen if the filesystem does not do subsecond timestamps, | |
| even if the &Time::HiRes::d_hires_stat is non-zero. | |
| In any case do not expect nanosecond resolution, or even a microsecond | |
| resolution. Also note that the modify/access timestamps might have | |
| different resolutions, and that they need not be synchronized, e.g. | |
| if the operations are | |
| write | |
| stat # t1 | |
| read | |
| stat # t2 | |
| the access time stamp from t2 need not be greater-than the modify | |
| time stamp from t1: it may be equal or I<less>. | |
| =back | |
| =head1 EXAMPLES | |
| use Time::HiRes qw(usleep ualarm gettimeofday tv_interval); | |
| $microseconds = 750_000; | |
| usleep($microseconds); | |
| # signal alarm in 2.5s & every .1s thereafter | |
| ualarm(2_500_000, 100_000); | |
| # cancel that ualarm | |
| ualarm(0); | |
| # get seconds and microseconds since the epoch | |
| ($s, $usec) = gettimeofday(); | |
| # measure elapsed time | |
| # (could also do by subtracting 2 gettimeofday return values) | |
| $t0 = [gettimeofday]; | |
| # do bunch of stuff here | |
| $t1 = [gettimeofday]; | |
| # do more stuff here | |
| $t0_t1 = tv_interval $t0, $t1; | |
| $elapsed = tv_interval ($t0, [gettimeofday]); | |
| $elapsed = tv_interval ($t0); # equivalent code | |
| # | |
| # replacements for time, alarm and sleep that know about | |
| # floating seconds | |
| # | |
| use Time::HiRes; | |
| $now_fractions = Time::HiRes::time; | |
| Time::HiRes::sleep (2.5); | |
| Time::HiRes::alarm (10.6666666); | |
| use Time::HiRes qw ( time alarm sleep ); | |
| $now_fractions = time; | |
| sleep (2.5); | |
| alarm (10.6666666); | |
| # Arm an interval timer to go off first at 10 seconds and | |
| # after that every 2.5 seconds, in process virtual time | |
| use Time::HiRes qw ( setitimer ITIMER_VIRTUAL time ); | |
| $SIG{VTALRM} = sub { print time, "\n" }; | |
| setitimer(ITIMER_VIRTUAL, 10, 2.5); | |
| use Time::HiRes qw( clock_gettime clock_getres CLOCK_REALTIME ); | |
| # Read the POSIX high resolution timer. | |
| my $high = clock_getres(CLOCK_REALTIME); | |
| # But how accurate we can be, really? | |
| my $reso = clock_getres(CLOCK_REALTIME); | |
| use Time::HiRes qw( clock_nanosleep TIMER_ABSTIME ); | |
| clock_nanosleep(CLOCK_REALTIME, 1e6); | |
| clock_nanosleep(CLOCK_REALTIME, 2e9, TIMER_ABSTIME); | |
| use Time::HiRes qw( clock ); | |
| my $clock0 = clock(); | |
| ... # Do something. | |
| my $clock1 = clock(); | |
| my $clockd = $clock1 - $clock0; | |
| use Time::HiRes qw( stat ); | |
| my ($atime, $mtime, $ctime) = (stat("istics"))[8, 9, 10]; | |
| =head1 C API | |
| In addition to the perl API described above, a C API is available for | |
| extension writers. The following C functions are available in the | |
| modglobal hash: | |
| name C prototype | |
| --------------- ---------------------- | |
| Time::NVtime double (*)() | |
| Time::U2time void (*)(pTHX_ UV ret[2]) | |
| Both functions return equivalent information (like C<gettimeofday>) | |
| but with different representations. The names C<NVtime> and C<U2time> | |
| were selected mainly because they are operating system independent. | |
| (C<gettimeofday> is Unix-centric, though some platforms like Win32 and | |
| VMS have emulations for it.) | |
| Here is an example of using C<NVtime> from C: | |
| double (*myNVtime)(); /* Returns -1 on failure. */ | |
| SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0); | |
| if (!svp) croak("Time::HiRes is required"); | |
| if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer"); | |
| myNVtime = INT2PTR(double(*)(), SvIV(*svp)); | |
| printf("The current time is: %f\n", (*myNVtime)()); | |
| =head1 DIAGNOSTICS | |
| =head2 useconds or interval more than ... | |
| In ualarm() you tried to use number of microseconds or interval (also | |
| in microseconds) more than 1_000_000 and setitimer() is not available | |
| in your system to emulate that case. | |
| =head2 negative time not invented yet | |
| You tried to use a negative time argument. | |
| =head2 internal error: useconds < 0 (unsigned ... signed ...) | |
| Something went horribly wrong-- the number of microseconds that cannot | |
| become negative just became negative. Maybe your compiler is broken? | |
| =head2 useconds or uinterval equal to or more than 1000000 | |
| In some platforms it is not possible to get an alarm with subsecond | |
| resolution and later than one second. | |
| =head2 unimplemented in this platform | |
| Some calls simply aren't available, real or emulated, on every platform. | |
| =head1 CAVEATS | |
| Notice that the core C<time()> maybe rounding rather than truncating. | |
| What this means is that the core C<time()> may be reporting the time | |
| as one second later than C<gettimeofday()> and C<Time::HiRes::time()>. | |
| Adjusting the system clock (either manually or by services like ntp) | |
| may cause problems, especially for long running programs that assume | |
| a monotonously increasing time (note that all platforms do not adjust | |
| time as gracefully as UNIX ntp does). For example in Win32 (and derived | |
| platforms like Cygwin and MinGW) the Time::HiRes::time() may temporarily | |
| drift off from the system clock (and the original time()) by up to 0.5 | |
| seconds. Time::HiRes will notice this eventually and recalibrate. | |
| Note that since Time::HiRes 1.77 the clock_gettime(CLOCK_MONOTONIC) | |
| might help in this (in case your system supports CLOCK_MONOTONIC). | |
| Some systems have APIs but not implementations: for example QNX and Haiku | |
| have the interval timer APIs but not the functionality. | |
| =head1 SEE ALSO | |
| Perl modules L<BSD::Resource>, L<Time::TAI64>. | |
| Your system documentation for C<clock>, C<clock_gettime>, | |
| C<clock_getres>, C<clock_nanosleep>, C<clock_settime>, C<getitimer>, | |
| C<gettimeofday>, C<setitimer>, C<sleep>, C<stat>, C<ualarm>. | |
| =head1 AUTHORS | |
| D. Wegscheid <[email protected]> | |
| R. Schertler <[email protected]> | |
| J. Hietaniemi <[email protected]> | |
| G. Aas <[email protected]> | |
| =head1 COPYRIGHT AND LICENSE | |
| Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved. | |
| Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Jarkko Hietaniemi. | |
| All rights reserved. | |
| Copyright (C) 2011 Andrew Main (Zefram) <[email protected]> | |
| This program is free software; you can redistribute it and/or modify | |
| it under the same terms as Perl itself. | |
| =cut | |
| DARWIN-2LEVEL_TIME_HIRES | |
| $fatpacked{"darwin-2level/version.pm"} = <<'DARWIN-2LEVEL_VERSION'; | |
| #!perl -w | |
| package version; | |
| use 5.005_04; | |
| use strict; | |
| use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); | |
| $VERSION = 0.94; | |
| $CLASS = 'version'; | |
| #--------------------------------------------------------------------------# | |
| # Version regexp components | |
| #--------------------------------------------------------------------------# | |
| # Fraction part of a decimal version number. This is a common part of | |
| # both strict and lax decimal versions | |
| my $FRACTION_PART = qr/\.[0-9]+/; | |
| # First part of either decimal or dotted-decimal strict version number. | |
| # Unsigned integer with no leading zeroes (except for zero itself) to | |
| # avoid confusion with octal. | |
| my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/; | |
| # First part of either decimal or dotted-decimal lax version number. | |
| # Unsigned integer, but allowing leading zeros. Always interpreted | |
| # as decimal. However, some forms of the resulting syntax give odd | |
| # results if used as ordinary Perl expressions, due to how perl treats | |
| # octals. E.g. | |
| # version->new("010" ) == 10 | |
| # version->new( 010 ) == 8 | |
| # version->new( 010.2) == 82 # "8" . "2" | |
| my $LAX_INTEGER_PART = qr/[0-9]+/; | |
| # Second and subsequent part of a strict dotted-decimal version number. | |
| # Leading zeroes are permitted, and the number is always decimal. | |
| # Limited to three digits to avoid overflow when converting to decimal | |
| # form and also avoid problematic style with excessive leading zeroes. | |
| my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/; | |
| # Second and subsequent part of a lax dotted-decimal version number. | |
| # Leading zeroes are permitted, and the number is always decimal. No | |
| # limit on the numerical value or number of digits, so there is the | |
| # possibility of overflow when converting to decimal form. | |
| my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/; | |
| # Alpha suffix part of lax version number syntax. Acts like a | |
| # dotted-decimal part. | |
| my $LAX_ALPHA_PART = qr/_[0-9]+/; | |
| #--------------------------------------------------------------------------# | |
| # Strict version regexp definitions | |
| #--------------------------------------------------------------------------# | |
| # Strict decimal version number. | |
| my $STRICT_DECIMAL_VERSION = | |
| qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x; | |
| # Strict dotted-decimal version number. Must have both leading "v" and | |
| # at least three parts, to avoid confusion with decimal syntax. | |
| my $STRICT_DOTTED_DECIMAL_VERSION = | |
| qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x; | |
| # Complete strict version number syntax -- should generally be used | |
| # anchored: qr/ \A $STRICT \z /x | |
| $STRICT = | |
| qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x; | |
| #--------------------------------------------------------------------------# | |
| # Lax version regexp definitions | |
| #--------------------------------------------------------------------------# | |
| # Lax decimal version number. Just like the strict one except for | |
| # allowing an alpha suffix or allowing a leading or trailing | |
| # decimal-point | |
| my $LAX_DECIMAL_VERSION = | |
| qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )? | |
| | | |
| $FRACTION_PART $LAX_ALPHA_PART? | |
| /x; | |
| # Lax dotted-decimal version number. Distinguished by having either | |
| # leading "v" or at least three non-alpha parts. Alpha part is only | |
| # permitted if there are at least two non-alpha parts. Strangely | |
| # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2, | |
| # so when there is no "v", the leading part is optional | |
| my $LAX_DOTTED_DECIMAL_VERSION = | |
| qr/ | |
| v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )? | |
| | | |
| $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART? | |
| /x; | |
| # Complete lax version number syntax -- should generally be used | |
| # anchored: qr/ \A $LAX \z /x | |
| # | |
| # The string 'undef' is a special case to make for easier handling | |
| # of return values from ExtUtils::MM->parse_version | |
| $LAX = | |
| qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x; | |
| #--------------------------------------------------------------------------# | |
| { | |
| local $SIG{'__DIE__'}; | |
| eval "use version::vxs $VERSION"; | |
| if ( $@ ) { # don't have the XS version installed | |
| eval "use version::vpp $VERSION"; # don't tempt fate | |
| die "$@" if ( $@ ); | |
| push @ISA, "version::vpp"; | |
| local $^W; | |
| *version::qv = \&version::vpp::qv; | |
| *version::declare = \&version::vpp::declare; | |
| *version::_VERSION = \&version::vpp::_VERSION; | |
| if ($] >= 5.009000) { | |
| no strict 'refs'; | |
| *version::stringify = \&version::vpp::stringify; | |
| *{'version::(""'} = \&version::vpp::stringify; | |
| *version::new = \&version::vpp::new; | |
| *version::parse = \&version::vpp::parse; | |
| } | |
| } | |
| else { # use XS module | |
| push @ISA, "version::vxs"; | |
| local $^W; | |
| *version::declare = \&version::vxs::declare; | |
| *version::qv = \&version::vxs::qv; | |
| *version::_VERSION = \&version::vxs::_VERSION; | |
| *version::vcmp = \&version::vxs::VCMP; | |
| if ($] >= 5.009000) { | |
| no strict 'refs'; | |
| *version::stringify = \&version::vxs::stringify; | |
| *{'version::(""'} = \&version::vxs::stringify; | |
| *version::new = \&version::vxs::new; | |
| *version::parse = \&version::vxs::parse; | |
| } | |
| } | |
| } | |
| # Preloaded methods go here. | |
| sub import { | |
| no strict 'refs'; | |
| my ($class) = shift; | |
| # Set up any derived class | |
| unless ($class eq 'version') { | |
| local $^W; | |
| *{$class.'::declare'} = \&version::declare; | |
| *{$class.'::qv'} = \&version::qv; | |
| } | |
| my %args; | |
| if (@_) { # any remaining terms are arguments | |
| map { $args{$_} = 1 } @_ | |
| } | |
| else { # no parameters at all on use line | |
| %args = | |
| ( | |
| qv => 1, | |
| 'UNIVERSAL::VERSION' => 1, | |
| ); | |
| } | |
| my $callpkg = caller(); | |
| if (exists($args{declare})) { | |
| *{$callpkg.'::declare'} = | |
| sub {return $class->declare(shift) } | |
| unless defined(&{$callpkg.'::declare'}); | |
| } | |
| if (exists($args{qv})) { | |
| *{$callpkg.'::qv'} = | |
| sub {return $class->qv(shift) } | |
| unless defined(&{$callpkg.'::qv'}); | |
| } | |
| if (exists($args{'UNIVERSAL::VERSION'})) { | |
| local $^W; | |
| *UNIVERSAL::VERSION | |
| = \&version::_VERSION; | |
| } | |
| if (exists($args{'VERSION'})) { | |
| *{$callpkg.'::VERSION'} = \&version::_VERSION; | |
| } | |
| if (exists($args{'is_strict'})) { | |
| *{$callpkg.'::is_strict'} = \&version::is_strict | |
| unless defined(&{$callpkg.'::is_strict'}); | |
| } | |
| if (exists($args{'is_lax'})) { | |
| *{$callpkg.'::is_lax'} = \&version::is_lax | |
| unless defined(&{$callpkg.'::is_lax'}); | |
| } | |
| } | |
| sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x } | |
| sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x } | |
| 1; | |
| DARWIN-2LEVEL_VERSION | |
| $fatpacked{"darwin-2level/version/vxs.pm"} = <<'DARWIN-2LEVEL_VERSION_VXS'; | |
| #!perl -w | |
| package version::vxs; | |
| use 5.005_03; | |
| use strict; | |
| use vars qw(@ISA $VERSION $CLASS ); | |
| $VERSION = 0.94; | |
| $CLASS = 'version::vxs'; | |
| eval { | |
| require XSLoader; | |
| local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION | |
| XSLoader::load('version::vxs', $VERSION); | |
| 1; | |
| } or do { | |
| require DynaLoader; | |
| push @ISA, 'DynaLoader'; | |
| local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION | |
| bootstrap version::vxs $VERSION; | |
| }; | |
| # Preloaded methods go here. | |
| 1; | |
| DARWIN-2LEVEL_VERSION_VXS | |
| s/^ //mg for values %fatpacked; | |
| unshift @INC, sub { | |
| if (my $fat = $fatpacked{$_[1]}) { | |
| open my $fh, '<', \$fat | |
| or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; | |
| return $fh; | |
| } | |
| return | |
| }; | |
| } # END OF FATPACK CODE | |
| #!/Users/gugod/perl5/perlbrew/perls/perl-5.14.1/bin/perl | |
| eval 'exec /Users/gugod/perl5/perlbrew/perls/perl-5.14.1/bin/perl -S $0 ${1+"$@"}' | |
| if 0; # not running under some shell | |
| package | |
| patchperl; | |
| # ABSTRACT: patch a perl source tree | |
| use strict; | |
| use warnings; | |
| use Devel::PatchPerl; | |
| Devel::PatchPerl->patch_source($ARGV[1], $ARGV[0]); | |
| __END__ | |
| =pod | |
| =head1 NAME | |
| patchperl - patch a perl source tree | |
| =head1 VERSION | |
| version 0.52 | |
| =head1 AUTHOR | |
| Chris Williams <[email protected]> | |
| =head1 COPYRIGHT AND LICENSE | |
| This software is copyright (c) 2011 by Chris Williams and Marcus Holland-Moritz. | |
| This is free software; you can redistribute it and/or modify it under | |
| the same terms as the Perl 5 programming language system itself. | |
| =cut | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment