summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/ExtUtils
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils')
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm331
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm307
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm40
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm294
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm288
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm130
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm151
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm131
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm31
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm33
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm22
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm18
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm80
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Command.pm369
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm275
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm565
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm1006
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm549
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm131
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Constant/XS.pm259
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm511
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Install.pm1365
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm462
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm286
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm546
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP51
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM.pm90
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm79
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm2334
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm61
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm123
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm65
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm47
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm40
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm269
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm152
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm57
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm64
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm3634
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm1994
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm50
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm585
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm124
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MY.pm40
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm2807
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm39
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod431
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod180
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm881
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm280
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm109
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm312
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm352
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm2111
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm41
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/typemap336
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/xsubpp156
57 files changed, 26074 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm
new file mode 100644
index 00000000000..7854e88dc94
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm
@@ -0,0 +1,331 @@
+package ExtUtils::CBuilder;
+
+use File::Spec ();
+use File::Path ();
+use File::Basename ();
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+$VERSION = eval $VERSION;
+
+# Okay, this is the brute-force method of finding out what kind of
+# platform we're on. I don't know of a systematic way. These values
+# came from the latest (bleadperl) perlport.pod.
+
+my %OSTYPES = qw(
+ aix Unix
+ bsdos Unix
+ dgux Unix
+ dynixptx Unix
+ freebsd Unix
+ linux Unix
+ hpux Unix
+ irix Unix
+ darwin Unix
+ machten Unix
+ next Unix
+ openbsd Unix
+ netbsd Unix
+ dec_osf Unix
+ svr4 Unix
+ svr5 Unix
+ sco_sv Unix
+ unicos Unix
+ unicosmk Unix
+ solaris Unix
+ sunos Unix
+ cygwin Unix
+ os2 Unix
+ gnu Unix
+ gnukfreebsd Unix
+ haiku Unix
+
+ dos Windows
+ MSWin32 Windows
+
+ os390 EBCDIC
+ os400 EBCDIC
+ posix-bc EBCDIC
+ vmesa EBCDIC
+
+ MacOS MacOS
+ VMS VMS
+ VOS VOS
+ riscos RiscOS
+ amigaos Amiga
+ mpeix MPEiX
+ );
+
+# We only use this once - don't waste a symbol table entry on it.
+# More importantly, don't make it an inheritable method.
+my $load = sub {
+ my $mod = shift;
+ eval "use $mod";
+ die $@ if $@;
+ @ISA = ($mod);
+};
+
+{
+ my @package = split /::/, __PACKAGE__;
+
+ if (grep {-e File::Spec->catfile($_, @package, 'Platform', $^O) . '.pm'} @INC) {
+ $load->(__PACKAGE__ . "::Platform::$^O");
+
+ } elsif (exists $OSTYPES{$^O} and
+ grep {-e File::Spec->catfile($_, @package, 'Platform', $OSTYPES{$^O}) . '.pm'} @INC) {
+ $load->(__PACKAGE__ . "::Platform::$OSTYPES{$^O}");
+
+ } else {
+ $load->(__PACKAGE__ . "::Base");
+ }
+}
+
+sub os_type { $OSTYPES{$^O} }
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::CBuilder - Compile and link C code for Perl modules
+
+=head1 SYNOPSIS
+
+ use ExtUtils::CBuilder;
+
+ my $b = ExtUtils::CBuilder->new(%options);
+ $obj_file = $b->compile(source => 'MyModule.c');
+ $lib_file = $b->link(objects => $obj_file);
+
+=head1 DESCRIPTION
+
+This module can build the C portions of Perl modules by invoking the
+appropriate compilers and linkers in a cross-platform manner. It was
+motivated by the C<Module::Build> project, but may be useful for other
+purposes as well. However, it is I<not> intended as a general
+cross-platform interface to all your C building needs. That would
+have been a much more ambitious goal!
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Returns a new C<ExtUtils::CBuilder> object. A C<config> parameter
+lets you override C<Config.pm> settings for all operations performed
+by the object, as in the following example:
+
+ # Use a different compiler than Config.pm says
+ my $b = ExtUtils::CBuilder->new( config =>
+ { ld => 'gcc' } );
+
+A C<quiet> parameter tells C<CBuilder> to not print its C<system()>
+commands before executing them:
+
+ # Be quieter than normal
+ my $b = ExtUtils::CBuilder->new( quiet => 1 );
+
+=item have_compiler
+
+Returns true if the current system has a working C compiler and
+linker, false otherwise. To determine this, we actually compile and
+link a sample C library. The sample will be compiled in the system
+tempdir or, if that fails for some reason, in the current directory.
+
+=item have_cplusplus
+
+Just like have_compiler but for C++ instead of C.
+
+=item compile
+
+Compiles a C source file and produces an object file. The name of the
+object file is returned. The source file is specified in a C<source>
+parameter, which is required; the other parameters listed below are
+optional.
+
+=over 4
+
+=item C<object_file>
+
+Specifies the name of the output file to create. Otherwise the
+C<object_file()> method will be consulted, passing it the name of the
+C<source> file.
+
+=item C<include_dirs>
+
+Specifies any additional directories in which to search for header
+files. May be given as a string indicating a single directory, or as
+a list reference indicating multiple directories.
+
+=item C<extra_compiler_flags>
+
+Specifies any additional arguments to pass to the compiler. Should be
+given as a list reference containing the arguments individually, or if
+this is not possible, as a string containing all the arguments
+together.
+
+=item C<C++>
+
+Specifies that the source file is a C++ source file and sets appropriate
+compiler flags
+
+=back
+
+The operation of this method is also affected by the
+C<archlibexp>, C<cccdlflags>, C<ccflags>, C<optimize>, and C<cc>
+entries in C<Config.pm>.
+
+=item link
+
+Invokes the linker to produce a library file from object files. In
+scalar context, the name of the library file is returned. In list
+context, the library file and any temporary files created are
+returned. A required C<objects> parameter contains the name of the
+object files to process, either in a string (for one object file) or
+list reference (for one or more files). The following parameters are
+optional:
+
+
+=over 4
+
+=item lib_file
+
+Specifies the name of the output library file to create. Otherwise
+the C<lib_file()> method will be consulted, passing it the name of
+the first entry in C<objects>.
+
+=item module_name
+
+Specifies the name of the Perl module that will be created by linking.
+On platforms that need to do prelinking (Win32, OS/2, etc.) this is a
+required parameter.
+
+=item extra_linker_flags
+
+Any additional flags you wish to pass to the linker.
+
+=back
+
+On platforms where C<need_prelink()> returns true, C<prelink()>
+will be called automatically.
+
+The operation of this method is also affected by the C<lddlflags>,
+C<shrpenv>, and C<ld> entries in C<Config.pm>.
+
+=item link_executable
+
+Invokes the linker to produce an executable file from object files. In
+scalar context, the name of the executable file is returned. In list
+context, the executable file and any temporary files created are
+returned. A required C<objects> parameter contains the name of the
+object files to process, either in a string (for one object file) or
+list reference (for one or more files). The optional parameters are
+the same as C<link> with exception for
+
+
+=over 4
+
+=item exe_file
+
+Specifies the name of the output executable file to create. Otherwise
+the C<exe_file()> method will be consulted, passing it the name of the
+first entry in C<objects>.
+
+=back
+
+=item object_file
+
+ my $object_file = $b->object_file($source_file);
+
+Converts the name of a C source file to the most natural name of an
+output object file to create from it. For instance, on Unix the
+source file F<foo.c> would result in the object file F<foo.o>.
+
+=item lib_file
+
+ my $lib_file = $b->lib_file($object_file);
+
+Converts the name of an object file to the most natural name of a
+output library file to create from it. For instance, on Mac OS X the
+object file F<foo.o> would result in the library file F<foo.bundle>.
+
+=item exe_file
+
+ my $exe_file = $b->exe_file($object_file);
+
+Converts the name of an object file to the most natural name of an
+executable file to create from it. For instance, on Mac OS X the
+object file F<foo.o> would result in the executable file F<foo>, and
+on Windows it would result in F<foo.exe>.
+
+
+=item prelink
+
+On certain platforms like Win32, OS/2, VMS, and AIX, it is necessary
+to perform some actions before invoking the linker. The
+C<ExtUtils::Mksymlists> module does this, writing files used by the
+linker during the creation of shared libraries for dynamic extensions.
+The names of any files written will be returned as a list.
+
+Several parameters correspond to C<ExtUtils::Mksymlists::Mksymlists()>
+options, as follows:
+
+ Mksymlists() prelink() type
+ -------------|-------------------|-------------------
+ NAME | dl_name | string (required)
+ DLBASE | dl_base | string
+ FILE | dl_file | string
+ DL_VARS | dl_vars | array reference
+ DL_FUNCS | dl_funcs | hash reference
+ FUNCLIST | dl_func_list | array reference
+ IMPORTS | dl_imports | hash reference
+ VERSION | dl_version | string
+
+Please see the documentation for C<ExtUtils::Mksymlists> for the
+details of what these parameters do.
+
+=item need_prelink
+
+Returns true on platforms where C<prelink()> should be called
+during linking, and false otherwise.
+
+=item extra_link_args_after_prelink
+
+Returns list of extra arguments to give to the link command; the arguments
+are the same as for prelink(), with addition of array reference to the
+results of prelink(); this reference is indexed by key C<prelink_res>.
+
+=back
+
+=head1 TO DO
+
+Currently this has only been tested on Unix and doesn't contain any of
+the Windows-specific code from the C<Module::Build> project. I'll do
+that next.
+
+=head1 HISTORY
+
+This module is an outgrowth of the C<Module::Build> project, to which
+there have been many contributors. Notably, Randy W. Sims submitted
+lots of code to support 3 compilers on Windows and helped with various
+other platform-specific issues. Ilya Zakharevich has contributed
+fixes for OS/2; John E. Malmberg and Peter Prymmer have done likewise
+for VMS.
+
+=head1 AUTHOR
+
+Ken Williams, kwilliams@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003-2005 Ken Williams. All rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+perl(1), Module::Build(3)
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm
new file mode 100644
index 00000000000..28036c61bdc
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm
@@ -0,0 +1,307 @@
+package ExtUtils::CBuilder::Base;
+
+use strict;
+use File::Spec;
+use File::Basename;
+use Cwd ();
+use Config;
+use Text::ParseWords;
+use IO::File;
+
+use vars qw($VERSION);
+$VERSION = '0.27';
+
+sub new {
+ my $class = shift;
+ my $self = bless {@_}, $class;
+
+ $self->{properties}{perl} = $class->find_perl_interpreter
+ or warn "Warning: Can't locate your perl binary";
+
+ while (my ($k,$v) = each %Config) {
+ $self->{config}{$k} = $v unless exists $self->{config}{$k};
+ }
+ $self->{config}{cc} = $ENV{CC} if exists $ENV{CC};
+ return $self;
+}
+
+sub find_perl_interpreter {
+ my $perl;
+ File::Spec->file_name_is_absolute($perl = $^X)
+ or -f ($perl = $Config::Config{perlpath})
+ or ($perl = $^X);
+ return $perl;
+}
+
+sub add_to_cleanup {
+ my $self = shift;
+ foreach (@_) {
+ $self->{files_to_clean}{$_} = 1;
+ }
+}
+
+sub cleanup {
+ my $self = shift;
+ foreach my $file (keys %{$self->{files_to_clean}}) {
+ unlink $file;
+ }
+}
+
+sub object_file {
+ my ($self, $filename) = @_;
+
+ # File name, minus the suffix
+ (my $file_base = $filename) =~ s/\.[^.]+$//;
+ return "$file_base$self->{config}{obj_ext}";
+}
+
+sub arg_include_dirs {
+ my $self = shift;
+ return map {"-I$_"} @_;
+}
+
+sub arg_nolink { '-c' }
+
+sub arg_object_file {
+ my ($self, $file) = @_;
+ return ('-o', $file);
+}
+
+sub arg_share_object_file {
+ my ($self, $file) = @_;
+ return ($self->split_like_shell($self->{config}{lddlflags}), '-o', $file);
+}
+
+sub arg_exec_file {
+ my ($self, $file) = @_;
+ return ('-o', $file);
+}
+
+sub arg_defines {
+ my ($self, %args) = @_;
+ return map "-D$_=$args{$_}", keys %args;
+}
+
+sub compile {
+ my ($self, %args) = @_;
+ die "Missing 'source' argument to compile()" unless defined $args{source};
+
+ my $cf = $self->{config}; # For convenience
+
+ $args{object_file} ||= $self->object_file($args{source});
+
+ my @include_dirs = $self->arg_include_dirs
+ (@{$args{include_dirs} || []},
+ $self->perl_inc());
+
+ my @defines = $self->arg_defines( %{$args{defines} || {}} );
+
+ my @extra_compiler_flags = $self->split_like_shell($args{extra_compiler_flags});
+ my @cccdlflags = $self->split_like_shell($cf->{cccdlflags});
+ my @ccflags = $self->split_like_shell($cf->{ccflags});
+ push @ccflags, qw/-x c++/ if $args{'C++'};
+ my @optimize = $self->split_like_shell($cf->{optimize});
+ my @flags = (@include_dirs, @defines, @cccdlflags, @extra_compiler_flags,
+ $self->arg_nolink,
+ @ccflags, @optimize,
+ $self->arg_object_file($args{object_file}),
+ );
+
+ my @cc = $self->split_like_shell($cf->{cc});
+
+ $self->do_system(@cc, @flags, $args{source})
+ or die "error building $args{object_file} from '$args{source}'";
+
+ return $args{object_file};
+}
+
+sub have_compiler {
+ my ($self, $is_cplusplus) = @_;
+ return $self->{have_compiler} if defined $self->{have_compiler};
+
+ my $result;
+ my $attempts = 3;
+ # tmpdir has issues for some people so fall back to current dir
+ DIR: for my $dir ( File::Spec->tmpdir, '.' ) {
+
+ # don't clobber existing files (rare, but possible)
+ my $rand = int(rand(2**31));
+ my $tmpfile = File::Spec->catfile($dir, "compilet-$rand.c");
+ $tmpfile .= "c" if $is_cplusplus;
+ if ( -e $tmpfile ) {
+ redo DIR if $attempts--;
+ next DIR;
+ }
+
+ {
+ my $FH = IO::File->new("> $tmpfile") or die "Can't create $tmpfile: $!";
+ if ( $is_cplusplus ) {
+ print $FH "class Bogus { public: int boot_compilet() { return 1; } };\n";
+ }
+ else {
+ print $FH "int boot_compilet() { return 1; }\n";
+ }
+ }
+
+ my ($obj_file, @lib_files);
+ eval {
+ local $^W = 0;
+ local $self->{quiet} = 1;
+ $obj_file = $self->compile('C++' => $is_cplusplus, source => $tmpfile);
+ @lib_files = $self->link(objects => $obj_file, module_name => 'compilet');
+ };
+ $result = $@ ? 0 : 1;
+
+ foreach (grep defined, $tmpfile, $obj_file, @lib_files) {
+ 1 while unlink;
+ }
+ last DIR if $result;
+ }
+
+ return $self->{have_compiler} = $result;
+}
+
+sub have_cplusplus {
+ push @_, 1;
+ goto &have_compiler;
+}
+
+sub lib_file {
+ my ($self, $dl_file) = @_;
+ $dl_file =~ s/\.[^.]+$//;
+ $dl_file =~ tr/"//d;
+ return "$dl_file.$self->{config}{dlext}";
+}
+
+
+sub exe_file {
+ my ($self, $dl_file) = @_;
+ $dl_file =~ s/\.[^.]+$//;
+ $dl_file =~ tr/"//d;
+ return "$dl_file$self->{config}{_exe}";
+}
+
+sub need_prelink { 0 }
+
+sub extra_link_args_after_prelink { return }
+
+sub prelink {
+ my ($self, %args) = @_;
+
+ ($args{dl_file} = $args{dl_name}) =~ s/.*::// unless $args{dl_file};
+
+ require ExtUtils::Mksymlists;
+ ExtUtils::Mksymlists::Mksymlists( # dl. abbrev for dynamic library
+ DL_VARS => $args{dl_vars} || [],
+ DL_FUNCS => $args{dl_funcs} || {},
+ FUNCLIST => $args{dl_func_list} || [],
+ IMPORTS => $args{dl_imports} || {},
+ NAME => $args{dl_name}, # Name of the Perl module
+ DLBASE => $args{dl_base}, # Basename of DLL file
+ FILE => $args{dl_file}, # Dir + Basename of symlist file
+ VERSION => (defined $args{dl_version} ? $args{dl_version} : '0.0'),
+ );
+
+ # Mksymlists will create one of these files
+ return grep -e, map "$args{dl_file}.$_", qw(ext def opt);
+}
+
+sub link {
+ my ($self, %args) = @_;
+ return $self->_do_link('lib_file', lddl => 1, %args);
+}
+
+sub link_executable {
+ my ($self, %args) = @_;
+ return $self->_do_link('exe_file', lddl => 0, %args);
+}
+
+sub _do_link {
+ my ($self, $type, %args) = @_;
+
+ my $cf = $self->{config}; # For convenience
+
+ my $objects = delete $args{objects};
+ $objects = [$objects] unless ref $objects;
+ my $out = $args{$type} || $self->$type($objects->[0]);
+
+ my @temp_files;
+ @temp_files =
+ $self->prelink(%args,
+ dl_name => $args{module_name}) if $args{lddl} && $self->need_prelink;
+
+ my @linker_flags = ($self->split_like_shell($args{extra_linker_flags}),
+ $self->extra_link_args_after_prelink(%args, dl_name => $args{module_name},
+ prelink_res => \@temp_files));
+
+ my @output = $args{lddl} ? $self->arg_share_object_file($out) : $self->arg_exec_file($out);
+ my @shrp = $self->split_like_shell($cf->{shrpenv});
+ my @ld = $self->split_like_shell($cf->{ld});
+
+ $self->do_system(@shrp, @ld, @output, @$objects, @linker_flags)
+ or die "error building $out from @$objects";
+
+ return wantarray ? ($out, @temp_files) : $out;
+}
+
+
+sub do_system {
+ my ($self, @cmd) = @_;
+ print "@cmd\n" if !$self->{quiet};
+ return !system(@cmd);
+}
+
+sub split_like_shell {
+ my ($self, $string) = @_;
+
+ return () unless defined($string);
+ return @$string if UNIVERSAL::isa($string, 'ARRAY');
+ $string =~ s/^\s+|\s+$//g;
+ return () unless length($string);
+
+ return Text::ParseWords::shellwords($string);
+}
+
+# if building perl, perl's main source directory
+sub perl_src {
+ # N.B. makemaker actually searches regardless of PERL_CORE, but
+ # only squawks at not finding it if PERL_CORE is set
+
+ return unless $ENV{PERL_CORE};
+
+ my $Updir = File::Spec->updir;
+ my $dir = File::Spec->curdir;
+
+ # Try up to 5 levels upwards
+ for (0..10) {
+ if (
+ -f File::Spec->catfile($dir,"config_h.SH")
+ &&
+ -f File::Spec->catfile($dir,"perl.h")
+ &&
+ -f File::Spec->catfile($dir,"lib","Exporter.pm")
+ ) {
+ return Cwd::realpath( $dir );
+ }
+
+ $dir = File::Spec->catdir($dir, $Updir);
+ }
+
+ warn "PERL_CORE is set but I can't find your perl source!\n";
+ return ''; # return empty string if $ENV{PERL_CORE} but can't find dir ???
+}
+
+# directory of perl's include files
+sub perl_inc {
+ my $self = shift;
+
+ $self->perl_src() || File::Spec->catdir($self->{config}{archlibexp},"CORE");
+}
+
+sub DESTROY {
+ my $self = shift;
+ local($., $@, $!, $^E, $?);
+ $self->cleanup();
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm
new file mode 100644
index 00000000000..78ff244b5ba
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm
@@ -0,0 +1,40 @@
+package ExtUtils::CBuilder::Platform::Unix;
+
+use strict;
+use ExtUtils::CBuilder::Base;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+@ISA = qw(ExtUtils::CBuilder::Base);
+
+sub link_executable {
+ my $self = shift;
+
+ # On some platforms (which ones??) $Config{cc} seems to be a better
+ # bet for linking executables than $Config{ld}. Cygwin is a notable
+ # exception.
+ local $self->{config}{ld} =
+ $self->{config}{cc} . " " . $self->{config}{ldflags};
+ return $self->SUPER::link_executable(@_);
+}
+
+sub link {
+ my $self = shift;
+ my $cf = $self->{config};
+
+ # Some platforms (notably Mac OS X 10.3, but some others too) expect
+ # the syntax "FOO=BAR /bin/command arg arg" to work in %Config
+ # (notably $Config{ld}). It usually works in system(SCALAR), but we
+ # use system(LIST). We fix it up here with 'env'.
+
+ local $cf->{ld} = $cf->{ld};
+ if (ref $cf->{ld}) {
+ unshift @{$cf->{ld}}, 'env' if $cf->{ld}[0] =~ /^\s*\w+=/;
+ } else {
+ $cf->{ld} =~ s/^(\s*\w+=)/env $1/;
+ }
+
+ return $self->SUPER::link(@_);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm
new file mode 100644
index 00000000000..35a2eba550b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm
@@ -0,0 +1,294 @@
+package ExtUtils::CBuilder::Platform::VMS;
+
+use strict;
+use ExtUtils::CBuilder::Base;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+@ISA = qw(ExtUtils::CBuilder::Base);
+
+use File::Spec::Functions qw(catfile catdir);
+
+# We do prelink, but don't want the parent to redo it.
+
+sub need_prelink { 0 }
+
+sub arg_defines {
+ my ($self, %args) = @_;
+
+ s/"/""/g foreach values %args;
+
+ my @config_defines;
+
+ # VMS can only have one define qualifier; add the one from config, if any.
+ if ($self->{config}{ccflags} =~ s{/ def[^=]+ =+ \(? ([^\/\)]*) } {}ix) {
+ push @config_defines, $1;
+ }
+
+ return '' unless keys(%args) || @config_defines;
+
+ return ('/define=('
+ . join(',',
+ @config_defines,
+ map "\"$_" . ( length($args{$_}) ? "=$args{$_}" : '') . "\"",
+ keys %args)
+ . ')');
+}
+
+sub arg_include_dirs {
+ my ($self, @dirs) = @_;
+
+ # VMS can only have one include list, add the one from config.
+ if ($self->{config}{ccflags} =~ s{/inc[^=]+(?:=)+(?:\()?([^\/\)]*)} {}i) {
+ unshift @dirs, $1;
+ }
+ return unless @dirs;
+
+ return ('/include=(' . join(',', @dirs) . ')');
+}
+
+sub _do_link {
+ my ($self, $type, %args) = @_;
+
+ my $objects = delete $args{objects};
+ $objects = [$objects] unless ref $objects;
+
+ if ($args{lddl}) {
+
+ # prelink will call Mksymlists, which creates the extension-specific
+ # linker options file and populates it with the boot symbol.
+
+ my @temp_files = $self->prelink(%args, dl_name => $args{module_name});
+
+ # We now add the rest of what we need to the linker options file. We
+ # should replicate the functionality of C<ExtUtils::MM_VMS::dlsyms>,
+ # but there is as yet no infrastructure for handling object libraries,
+ # so for now we depend on object files being listed individually on the
+ # command line, which should work for simple cases. We do bring in our
+ # own version of C<ExtUtils::Liblist::Kid::ext> so that any additional
+ # libraries (including PERLSHR) can be added to the options file.
+
+ my @optlibs = $self->_liblist_ext( $args{'libs'} );
+
+ my $optfile = 'sys$disk:[]' . $temp_files[0];
+ open my $opt_fh, '>>', $optfile
+ or die "_do_link: Unable to open $optfile: $!";
+ for my $lib (@optlibs) {print $opt_fh "$lib\n" if length $lib }
+ close $opt_fh;
+
+ $objects->[-1] .= ',';
+ push @$objects, $optfile . '/OPTIONS,';
+
+ # This one not needed for DEC C, but leave for completeness.
+ push @$objects, $self->perl_inc() . 'perlshr_attr.opt/OPTIONS';
+ }
+
+ return $self->SUPER::_do_link($type, %args, objects => $objects);
+}
+
+sub arg_nolink { return; }
+
+sub arg_object_file {
+ my ($self, $file) = @_;
+ return "/obj=$file";
+}
+
+sub arg_exec_file {
+ my ($self, $file) = @_;
+ return ("/exe=$file");
+}
+
+sub arg_share_object_file {
+ my ($self, $file) = @_;
+ return ("$self->{config}{lddlflags}=$file");
+}
+
+
+sub lib_file {
+ my ($self, $dl_file) = @_;
+ $dl_file =~ s/\.[^.]+$//;
+ $dl_file =~ tr/"//d;
+ $dl_file = $dl_file .= '.' . $self->{config}{dlext};
+
+ # Need to create with the same name as DynaLoader will load with.
+ if (defined &DynaLoader::mod2fname) {
+ my ($dev,$dir,$file) = File::Spec->splitpath($dl_file);
+ $file = DynaLoader::mod2fname([$file]);
+ $dl_file = File::Spec->catpath($dev,$dir,$file);
+ }
+ return $dl_file;
+}
+
+# The following is reproduced almost verbatim from ExtUtils::Liblist::Kid::_vms_ext.
+# We can't just call that because it's tied up with the MakeMaker object hierarchy.
+
+sub _liblist_ext {
+ my($self, $potential_libs,$verbose,$give_libs) = @_;
+ $verbose ||= 0;
+
+ my(@crtls,$crtlstr);
+ @crtls = ( ($self->{'config'}{'ldflags'} =~ m-/Debug-i ? $self->{'config'}{'dbgprefix'} : '')
+ . 'PerlShr/Share' );
+ push(@crtls, grep { not /\(/ } split /\s+/, $self->{'config'}{'perllibs'});
+ push(@crtls, grep { not /\(/ } split /\s+/, $self->{'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 ensure 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($lib,$locspec,$type);
+ foreach $lib (@crtls) {
+ if (($locspec,$type) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i) {
+ if (lc $type eq '/share') { $locspec .= $self->{'config'}{'exe_ext'}; }
+ elsif (lc $type eq '/library') { $locspec .= $self->{'config'}{'lib_ext'}; }
+ else { $locspec .= $self->{'config'}{'obj_ext'}; }
+ $locspec = 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(@dirs,@libs,$dir,$lib,%found,@fndlibs,$ldlib);
+ my $cwd = cwd();
+ my($so,$lib_ext,$obj_ext) = @{$self->{'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 ($self->{'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
+ foreach $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(' ',$self->{'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 $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 = catdir($cwd,$dir);
+ }
+ }
+ @dirs = grep { length($_) } @dirs;
+ unshift(@dirs,''); # Check each $lib without additions first
+
+ LIB: foreach $lib (@libs) {
+ if (exists $libmap{$lib}) {
+ next unless length $libmap{$lib};
+ $lib = $libmap{$lib};
+ }
+
+ my(@variants,$variant,$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 $variant (@variants) {
+ my($fullname, $name);
+
+ foreach $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};
+ $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;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm
new file mode 100644
index 00000000000..f0b98dbaa30
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm
@@ -0,0 +1,288 @@
+package ExtUtils::CBuilder::Platform::Windows;
+
+use strict;
+use warnings;
+
+use File::Basename;
+use File::Spec;
+
+use ExtUtils::CBuilder::Base;
+use IO::File;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+@ISA = qw(ExtUtils::CBuilder::Base);
+
+=begin comment
+
+The compiler-specific packages implement functions for generating properly
+formatted commandlines for the compiler being used. Each package
+defines two primary functions 'format_linker_cmd()' &
+'format_compiler_cmd()' that accepts a list of named arguments (a
+hash) and returns a list of formatted options suitable for invoking the
+compiler. By default, if the compiler supports scripting of its
+operation then a script file is built containing the options while
+those options are removed from the commandline, and a reference to the
+script is pushed onto the commandline in their place. Scripting the
+compiler in this way helps to avoid the problems associated with long
+commandlines under some shells.
+
+=end comment
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ my $cf = $self->{config};
+
+ # Inherit from an appropriate compiler driver class
+ my $driver = "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
+ eval "require $driver" or die "Could not load compiler driver: $@";
+ unshift @ISA, $driver;
+
+ return $self;
+}
+
+sub _compiler_type {
+ my $self = shift;
+ my $cc = $self->{config}{cc};
+
+ return ( $cc =~ /cl(\.exe)?$/ ? 'MSVC'
+ : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
+ : 'GCC');
+}
+
+sub split_like_shell {
+ # Since Windows will pass the whole command string (not an argument
+ # array) to the target program and make the program parse it itself,
+ # we don't actually need to do any processing here.
+ (my $self, local $_) = @_;
+
+ return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
+ return unless defined() && length();
+ return ($_);
+}
+
+sub do_system {
+ # See above
+ my $self = shift;
+ my $cmd = join(" ",
+ grep length,
+ map {$a=$_;$a=~s/\t/ /g;$a=~s/^\s+|\s+$//;$a}
+ grep defined, @_);
+ return $self->SUPER::do_system($cmd);
+}
+
+sub arg_defines {
+ my ($self, %args) = @_;
+ s/"/\\"/g foreach values %args;
+ return map qq{"-D$_=$args{$_}"}, keys %args;
+}
+
+sub compile {
+ my ($self, %args) = @_;
+ my $cf = $self->{config};
+
+ die "Missing 'source' argument to compile()" unless defined $args{source};
+
+ my ($basename, $srcdir) =
+ ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
+
+ $srcdir ||= File::Spec->curdir();
+
+ my @defines = $self->arg_defines( %{ $args{defines} || {} } );
+
+ my %spec = (
+ srcdir => $srcdir,
+ builddir => $srcdir,
+ basename => $basename,
+ source => $args{source},
+ output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
+ cc => $cf->{cc},
+ cflags => [
+ $self->split_like_shell($cf->{ccflags}),
+ $self->split_like_shell($cf->{cccdlflags}),
+ $self->split_like_shell($args{extra_compiler_flags}),
+ ],
+ optimize => [ $self->split_like_shell($cf->{optimize}) ],
+ defines => \@defines,
+ includes => [ @{$args{include_dirs} || []} ],
+ perlinc => [
+ $self->perl_inc(),
+ $self->split_like_shell($cf->{incpath}),
+ ],
+ use_scripts => 1, # XXX provide user option to change this???
+ );
+
+ $self->normalize_filespecs(
+ \$spec{source},
+ \$spec{output},
+ $spec{includes},
+ $spec{perlinc},
+ );
+
+ my @cmds = $self->format_compiler_cmd(%spec);
+ while ( my $cmd = shift @cmds ) {
+ $self->do_system( @$cmd )
+ or die "error building $cf->{dlext} file from '$args{source}'";
+ }
+
+ (my $out = $spec{output}) =~ tr/'"//d;
+ return $out;
+}
+
+sub need_prelink { 1 }
+
+sub link {
+ my ($self, %args) = @_;
+ my $cf = $self->{config};
+
+ my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
+ my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
+ $to ||= File::Spec->curdir();
+
+ (my $file_base = $args{module_name}) =~ s/.*:://;
+ my $output = $args{lib_file} ||
+ File::Spec->catfile($to, "$file_base.$cf->{dlext}");
+
+ # if running in perl source tree, look for libs there, not installed
+ my $lddlflags = $cf->{lddlflags};
+ my $perl_src = $self->perl_src();
+ $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
+
+ my %spec = (
+ srcdir => $to,
+ builddir => $to,
+ startup => [ ],
+ objects => \@objects,
+ libs => [ ],
+ output => $output,
+ ld => $cf->{ld},
+ libperl => $cf->{libperl},
+ perllibs => [ $self->split_like_shell($cf->{perllibs}) ],
+ libpath => [ $self->split_like_shell($cf->{libpth}) ],
+ lddlflags => [ $self->split_like_shell($lddlflags) ],
+ other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
+ use_scripts => 1, # XXX provide user option to change this???
+ );
+
+ unless ( $spec{basename} ) {
+ ($spec{basename} = $args{module_name}) =~ s/.*:://;
+ }
+
+ $spec{srcdir} = File::Spec->canonpath( $spec{srcdir} );
+ $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
+
+ $spec{output} ||= File::Spec->catfile( $spec{builddir},
+ $spec{basename} . '.'.$cf->{dlext} );
+ $spec{manifest} ||= File::Spec->catfile( $spec{builddir},
+ $spec{basename} . '.'.$cf->{dlext}.'.manifest');
+ $spec{implib} ||= File::Spec->catfile( $spec{builddir},
+ $spec{basename} . $cf->{lib_ext} );
+ $spec{explib} ||= File::Spec->catfile( $spec{builddir},
+ $spec{basename} . '.exp' );
+ if ($cf->{cc} eq 'cl') {
+ $spec{dbg_file} ||= File::Spec->catfile( $spec{builddir},
+ $spec{basename} . '.pdb' );
+ }
+ elsif ($cf->{cc} eq 'bcc32') {
+ $spec{dbg_file} ||= File::Spec->catfile( $spec{builddir},
+ $spec{basename} . '.tds' );
+ }
+ $spec{def_file} ||= File::Spec->catfile( $spec{srcdir} ,
+ $spec{basename} . '.def' );
+ $spec{base_file} ||= File::Spec->catfile( $spec{srcdir} ,
+ $spec{basename} . '.base' );
+
+ $self->add_to_cleanup(
+ grep defined,
+ @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
+ );
+
+ foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
+ $self->normalize_filespecs( \$spec{$opt} );
+ }
+
+ foreach my $opt ( qw(libpath startup objects) ) {
+ $self->normalize_filespecs( $spec{$opt} );
+ }
+
+ (my $def_base = $spec{def_file}) =~ tr/'"//d;
+ $def_base =~ s/\.def$//;
+ $self->prelink( dl_name => $args{module_name},
+ dl_file => $def_base,
+ dl_base => $spec{basename} );
+
+ my @cmds = $self->format_linker_cmd(%spec);
+ while ( my $cmd = shift @cmds ) {
+ $self->do_system( @$cmd );
+ }
+
+ $spec{output} =~ tr/'"//d;
+ return wantarray
+ ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
+ : $spec{output};
+}
+
+# canonize & quote paths
+sub normalize_filespecs {
+ my ($self, @specs) = @_;
+ foreach my $spec ( grep defined, @specs ) {
+ if ( ref $spec eq 'ARRAY') {
+ $self->normalize_filespecs( map {\$_} grep defined, @$spec )
+ } elsif ( ref $spec eq 'SCALAR' ) {
+ $$spec =~ tr/"//d if $$spec;
+ next unless $$spec;
+ $$spec = '"' . File::Spec->canonpath($$spec) . '"';
+ } elsif ( ref $spec eq '' ) {
+ $spec = '"' . File::Spec->canonpath($spec) . '"';
+ } else {
+ die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
+ }
+ }
+}
+
+# directory of perl's include files
+sub perl_inc {
+ my $self = shift;
+
+ my $perl_src = $self->perl_src();
+
+ if ($perl_src) {
+ File::Spec->catdir($perl_src, "lib", "CORE");
+ } else {
+ File::Spec->catdir($self->{config}{archlibexp},"CORE");
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
+
+=head1 DESCRIPTION
+
+This module implements the Windows-specific parts of ExtUtils::CBuilder.
+Most of the Windows-specific stuff has to do with compiling and
+linking C code. Currently we support the 3 compilers perl itself
+supports: MSVC, BCC, and GCC.
+
+This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
+not implemented here will be implemented there. The interfaces are
+defined by the L<ExtUtils::CBuilder> documentation.
+
+=head1 AUTHOR
+
+Ken Williams <ken@mathforum.org>
+
+Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
+
+=head1 SEE ALSO
+
+perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm
new file mode 100644
index 00000000000..ee65c91a159
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm
@@ -0,0 +1,130 @@
+package ExtUtils::CBuilder::Platform::Windows::BCC;
+
+use vars qw($VERSION);
+$VERSION = '0.27';
+
+sub format_compiler_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{ $spec{includes} || [] },
+ @{ $spec{perlinc} || [] } ) {
+ $path = '-I' . $path;
+ }
+
+ %spec = $self->write_compiler_script(%spec)
+ if $spec{use_scripts};
+
+ return [ grep {defined && length} (
+ $spec{cc}, '-c' ,
+ @{$spec{includes}} ,
+ @{$spec{cflags}} ,
+ @{$spec{optimize}} ,
+ @{$spec{defines}} ,
+ @{$spec{perlinc}} ,
+ "-o$spec{output}" ,
+ $spec{source} ,
+ ) ];
+}
+
+sub write_compiler_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.ccs' );
+
+ $self->add_to_cleanup($script);
+
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ # XXX Borland "response files" seem to be unable to accept macro
+ # definitions containing quoted strings. Escaping strings with
+ # backslash doesn't work, and any level of quotes are stripped. The
+ # result is is a floating point number in the source file where a
+ # string is expected. So we leave the macros on the command line.
+ print $SCRIPT join( "\n",
+ map { ref $_ ? @{$_} : $_ }
+ grep defined,
+ delete(
+ @spec{ qw(includes cflags optimize perlinc) } )
+ );
+
+ push @{$spec{includes}}, '@"' . $script . '"';
+
+ return %spec;
+}
+
+sub format_linker_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{$spec{libpath}} ) {
+ $path = "-L$path";
+ }
+
+ push( @{$spec{startup}}, 'c0d32.obj' )
+ unless ( $spec{starup} && @{$spec{startup}} );
+
+ %spec = $self->write_linker_script(%spec)
+ if $spec{use_scripts};
+
+ return [ grep {defined && length} (
+ $spec{ld} ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{other_ldflags}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} , ',',
+ $spec{output} , ',',
+ $spec{map_file} , ',',
+ $spec{libperl} ,
+ @{$spec{perllibs}} , ',',
+ $spec{def_file}
+ ) ];
+}
+
+sub write_linker_script {
+ my ($self, %spec) = @_;
+
+ # To work around Borlands "unique" commandline syntax,
+ # two scripts are used:
+
+ my $ld_script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lds' );
+ my $ld_libs = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lbs' );
+
+ $self->add_to_cleanup($ld_script, $ld_libs);
+
+ print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
+
+ # Script 1: contains options & names of object files.
+ my $LD_SCRIPT = IO::File->new( ">$ld_script" )
+ or die( "Could not create linker script '$ld_script': $!" );
+
+ print $LD_SCRIPT join( " +\n",
+ map { @{$_} }
+ grep defined,
+ delete(
+ @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
+ );
+
+ # Script 2: contains name of libs to link against.
+ my $LD_LIBS = IO::File->new( ">$ld_libs" )
+ or die( "Could not create linker script '$ld_libs': $!" );
+
+ print $LD_LIBS join( " +\n",
+ (delete $spec{libperl} || ''),
+ @{delete $spec{perllibs} || []},
+ );
+
+ push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
+ push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
+
+ return %spec;
+}
+
+1;
+
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm
new file mode 100644
index 00000000000..132bf842bdb
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm
@@ -0,0 +1,151 @@
+package ExtUtils::CBuilder::Platform::Windows::GCC;
+
+use vars qw($VERSION);
+$VERSION = '0.27';
+
+sub format_compiler_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{ $spec{includes} || [] },
+ @{ $spec{perlinc} || [] } ) {
+ $path = '-I' . $path;
+ }
+
+ # split off any -arguments included in cc
+ my @cc = split / (?=-)/, $spec{cc};
+
+ return [ grep {defined && length} (
+ @cc, '-c' ,
+ @{$spec{includes}} ,
+ @{$spec{cflags}} ,
+ @{$spec{optimize}} ,
+ @{$spec{defines}} ,
+ @{$spec{perlinc}} ,
+ '-o', $spec{output} ,
+ $spec{source} ,
+ ) ];
+}
+
+sub format_linker_cmd {
+ my ($self, %spec) = @_;
+ my $cf = $self->{config};
+
+ # The Config.pm variable 'libperl' is hardcoded to the full name
+ # of the perl import library (i.e. 'libperl56.a'). GCC will not
+ # find it unless the 'lib' prefix & the extension are stripped.
+ $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
+
+ unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
+ if ( $spec{startup} && @{$spec{startup}} );
+
+ # From ExtUtils::MM_Win32:
+ #
+ ## one thing for GCC/Mingw32:
+ ## we try to overcome non-relocateable-DLL problems by generating
+ ## a (hopefully unique) image-base from the dll's name
+ ## -- BKS, 10-19-1999
+ File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
+ $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
+
+ %spec = $self->write_linker_script(%spec)
+ if $spec{use_scripts};
+
+ foreach my $path ( @{$spec{libpath}} ) {
+ $path = "-L$path";
+ }
+
+ my @cmds; # Stores the series of commands needed to build the module.
+
+ my $DLLTOOL = $cf->{dlltool} || 'dlltool';
+
+ push @cmds, [
+ $DLLTOOL, '--def' , $spec{def_file},
+ '--output-exp' , $spec{explib}
+ ];
+
+ # split off any -arguments included in ld
+ my @ld = split / (?=-)/, $spec{ld};
+
+ push @cmds, [ grep {defined && length} (
+ @ld ,
+ '-o', $spec{output} ,
+ "-Wl,--base-file,$spec{base_file}" ,
+ "-Wl,--image-base,$spec{image_base}" ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} ,
+ @{$spec{other_ldflags}} ,
+ $spec{libperl} ,
+ @{$spec{perllibs}} ,
+ $spec{explib} ,
+ $spec{map_file} ? ('-Map', $spec{map_file}) : ''
+ ) ];
+
+ push @cmds, [
+ $DLLTOOL, '--def' , $spec{def_file},
+ '--output-exp' , $spec{explib},
+ '--base-file' , $spec{base_file}
+ ];
+
+ push @cmds, [ grep {defined && length} (
+ @ld ,
+ '-o', $spec{output} ,
+ "-Wl,--image-base,$spec{image_base}" ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} ,
+ @{$spec{other_ldflags}} ,
+ $spec{libperl} ,
+ @{$spec{perllibs}} ,
+ $spec{explib} ,
+ $spec{map_file} ? ('-Map', $spec{map_file}) : ''
+ ) ];
+
+ return @cmds;
+}
+
+sub write_linker_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lds' );
+
+ $self->add_to_cleanup($script);
+
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ print $SCRIPT ( 'SEARCH_DIR(' . $_ . ")\n" )
+ for @{delete $spec{libpath} || []};
+
+ # gcc takes only one startup file, so the first object in startup is
+ # specified as the startup file and any others are shifted into the
+ # beginning of the list of objects.
+ if ( $spec{startup} && @{$spec{startup}} ) {
+ print $SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
+ unshift @{$spec{objects}},
+ @{delete $spec{startup} || []};
+ }
+
+ print $SCRIPT 'INPUT(' . join( ',',
+ @{delete $spec{objects} || []}
+ ) . ")\n";
+
+ print $SCRIPT 'INPUT(' . join( ' ',
+ (delete $spec{libperl} || ''),
+ @{delete $spec{perllibs} || []},
+ ) . ")\n";
+
+ #it is important to keep the order 1.linker_script - 2.other_ldflags
+ unshift @{$spec{other_ldflags}}, '"' . $script . '"';
+
+ return %spec;
+}
+
+1;
+
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm
new file mode 100644
index 00000000000..7da1c9b4c12
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm
@@ -0,0 +1,131 @@
+package ExtUtils::CBuilder::Platform::Windows::MSVC;
+
+use vars qw($VERSION);
+$VERSION = '0.27';
+
+sub arg_exec_file {
+ my ($self, $file) = @_;
+ return "/OUT:$file";
+}
+
+sub format_compiler_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{ $spec{includes} || [] },
+ @{ $spec{perlinc} || [] } ) {
+ $path = '-I' . $path;
+ }
+
+ %spec = $self->write_compiler_script(%spec)
+ if $spec{use_scripts};
+
+ return [ grep {defined && length} (
+ $spec{cc},'-nologo','-c',
+ @{$spec{includes}} ,
+ @{$spec{cflags}} ,
+ @{$spec{optimize}} ,
+ @{$spec{defines}} ,
+ @{$spec{perlinc}} ,
+ "-Fo$spec{output}" ,
+ $spec{source} ,
+ ) ];
+}
+
+sub write_compiler_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.ccs' );
+
+ $self->add_to_cleanup($script);
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ print $SCRIPT join( "\n",
+ map { ref $_ ? @{$_} : $_ }
+ grep defined,
+ delete(
+ @spec{ qw(includes cflags optimize defines perlinc) } )
+ );
+
+ push @{$spec{includes}}, '@"' . $script . '"';
+
+ return %spec;
+}
+
+sub format_linker_cmd {
+ my ($self, %spec) = @_;
+ my $cf = $self->{config};
+
+ foreach my $path ( @{$spec{libpath}} ) {
+ $path = "-libpath:$path";
+ }
+
+ my $output = $spec{output};
+
+ $spec{def_file} &&= '-def:' . $spec{def_file};
+ $spec{output} &&= '-out:' . $spec{output};
+ $spec{manifest} &&= '-manifest ' . $spec{manifest};
+ $spec{implib} &&= '-implib:' . $spec{implib};
+ $spec{map_file} &&= '-map:' . $spec{map_file};
+
+ %spec = $self->write_linker_script(%spec)
+ if $spec{use_scripts};
+
+ my @cmds; # Stores the series of commands needed to build the module.
+
+ push @cmds, [ grep {defined && length} (
+ $spec{ld} ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{other_ldflags}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} ,
+ $spec{map_file} ,
+ $spec{libperl} ,
+ @{$spec{perllibs}} ,
+ $spec{def_file} ,
+ $spec{implib} ,
+ $spec{output} ,
+ ) ];
+
+ # Embed the manifest file if it exists
+ push @cmds, [
+ 'if', 'exist', $spec{manifest}, 'mt', '-nologo', $spec{manifest}, '-outputresource:' . "$output;2"
+ ];
+
+ return @cmds;
+}
+
+sub write_linker_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lds' );
+
+ $self->add_to_cleanup($script);
+
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ print $SCRIPT join( "\n",
+ map { ref $_ ? @{$_} : $_ }
+ grep defined,
+ delete(
+ @spec{ qw(lddlflags libpath other_ldflags
+ startup objects libperl perllibs
+ def_file implib map_file) } )
+ );
+
+ push @{$spec{lddlflags}}, '@"' . $script . '"';
+
+ return %spec;
+}
+
+1;
+
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm
new file mode 100644
index 00000000000..656e0dc67ff
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm
@@ -0,0 +1,31 @@
+package ExtUtils::CBuilder::Platform::aix;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+use File::Spec;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub need_prelink { 1 }
+
+sub link {
+ my ($self, %args) = @_;
+ my $cf = $self->{config};
+
+ (my $baseext = $args{module_name}) =~ s/.*:://;
+ my $perl_inc = $self->perl_inc();
+
+ # Massage some very naughty bits in %Config
+ local $cf->{lddlflags} = $cf->{lddlflags};
+ for ($cf->{lddlflags}) {
+ s/\Q$(BASEEXT)\E/$baseext/;
+ s/\Q$(PERL_INC)\E/$perl_inc/;
+ }
+
+ return $self->SUPER::link(%args);
+}
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm
new file mode 100644
index 00000000000..f8650978ec4
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm
@@ -0,0 +1,33 @@
+package ExtUtils::CBuilder::Platform::cygwin;
+
+use strict;
+use File::Spec;
+use ExtUtils::CBuilder::Platform::Unix;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+# TODO: If a specific exe_file name is requested, if the exe created
+# doesn't have that name, we might want to rename it. Apparently asking
+# for an exe of "foo" might result in "foo.exe". Alternatively, we should
+# make sure the return value is correctly "foo.exe".
+# C.f http://rt.cpan.org/Public/Bug/Display.html?id=41003
+sub link_executable {
+ my $self = shift;
+ return $self->SUPER::link_executable(@_);
+}
+
+sub link {
+ my ($self, %args) = @_;
+
+ my $lib = $self->{config}{useshrplib} ? 'libperl.dll.a' : 'libperl.a';
+ $args{extra_linker_flags} = [
+ File::Spec->catfile($self->perl_inc(), $lib),
+ $self->split_like_shell($args{extra_linker_flags})
+ ];
+
+ return $self->SUPER::link(%args);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm
new file mode 100644
index 00000000000..efc79347708
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm
@@ -0,0 +1,22 @@
+package ExtUtils::CBuilder::Platform::darwin;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub compile {
+ my $self = shift;
+ my $cf = $self->{config};
+
+ # -flat_namespace isn't a compile flag, it's a linker flag. But
+ # it's mistakenly in Config.pm as both. Make the correction here.
+ local $cf->{ccflags} = $cf->{ccflags};
+ $cf->{ccflags} =~ s/-flat_namespace//;
+ $self->SUPER::compile(@_);
+}
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm
new file mode 100644
index 00000000000..d07b71f6d65
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm
@@ -0,0 +1,18 @@
+package ExtUtils::CBuilder::Platform::dec_osf;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+use File::Spec;
+
+use vars qw($VERSION @ISA);
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+$VERSION = '0.27';
+
+sub link_executable {
+ my $self = shift;
+ # $Config{ld} is 'ld' but that won't work: use the cc instead.
+ local $self->{config}{ld} = $self->{config}{cc};
+ return $self->SUPER::link_executable(@_);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm
new file mode 100644
index 00000000000..2815d587d7f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm
@@ -0,0 +1,80 @@
+package ExtUtils::CBuilder::Platform::os2;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.27';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub need_prelink { 1 }
+
+sub prelink {
+ # Generate import libraries (XXXX currently near .DEF; should be near DLL!)
+ my $self = shift;
+ my %args = @_;
+
+ my @res = $self->SUPER::prelink(%args);
+ die "Unexpected number of DEF files" unless @res == 1;
+ die "Can't find DEF file in the output"
+ unless $res[0] =~ m,^(.*)\.def$,si;
+ my $libname = "$1$self->{config}{lib_ext}"; # Put .LIB file near .DEF file
+ $self->do_system('emximp', '-o', $libname, $res[0]) or die "emxexp: res=$?";
+ return (@res, $libname);
+}
+
+sub _do_link {
+ my $self = shift;
+ my ($how, %args) = @_;
+ if ($how eq 'lib_file'
+ and (defined $args{module_name} and length $args{module_name})) {
+
+ # DynaLoader::mod2fname() is a builtin func
+ my $lib = DynaLoader::mod2fname([split /::/, $args{module_name}]);
+
+ # Now know the basename, find directory parts via lib_file, or objects
+ my $objs = ( (ref $args{objects}) ? $args{objects} : [$args{objects}] );
+ my $near_obj = $self->lib_file(@$objs);
+ my $ref_file = ( defined $args{lib_file} ? $args{lib_file} : $near_obj );
+ my $lib_dir = ($ref_file =~ m,(.*)[/\\],s ? "$1/" : '' );
+ my $exp_dir = ($near_obj =~ m,(.*)[/\\],s ? "$1/" : '' );
+
+ $args{dl_file} = $1 if $near_obj =~ m,(.*)\.,s; # put ExportList near OBJ
+ $args{lib_file} = "$lib_dir$lib.$self->{config}{dlext}"; # DLL file
+
+ # XXX _do_link does not have place to put libraries?
+ push @$objs, $self->perl_inc() . "/libperl$self->{config}{lib_ext}";
+ $args{objects} = $objs;
+ }
+ # Some 'env' do exec(), thus return too early when run from ksh;
+ # To avoid 'env', remove (useless) shrpenv
+ local $self->{config}{shrpenv} = '';
+ return $self->SUPER::_do_link($how, %args);
+}
+
+sub extra_link_args_after_prelink {
+ # Add .DEF file to the link line
+ my ($self, %args) = @_;
+
+ my @DEF = grep /\.def$/i, @{$args{prelink_res}};
+ die "More than one .def files created by `prelink' stage" if @DEF > 1;
+ # XXXX No "$how" argument here, so how to test for dynamic link?
+ die "No .def file created by `prelink' stage"
+ unless @DEF or not @{$args{prelink_res}};
+
+ my @after_libs = ($OS2::is_aout ? ()
+ : $self->perl_inc() . "/libperl_override$self->{config}{lib_ext}");
+ # , "-L", "-lperl"
+ (@after_libs, @DEF);
+}
+
+sub link_executable {
+ # ldflags is not expecting .exe extension given on command line; remove -Zexe
+ my $self = shift;
+ local $self->{config}{ldflags} = $self->{config}{ldflags};
+ $self->{config}{ldflags} =~ s/(?<!\S)-Zexe(?!\S)//;
+ return $self->SUPER::link_executable(@_);
+}
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm
new file mode 100644
index 00000000000..b5632ff06d6
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm
@@ -0,0 +1,369 @@
+package ExtUtils::Command;
+
+use 5.00503;
+use strict;
+use Carp;
+use File::Copy;
+use File::Compare;
+use File::Basename;
+use File::Path qw(rmtree);
+require Exporter;
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
+@ISA = qw(Exporter);
+@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod
+ dos2unix);
+$VERSION = '1.16';
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_VMS_mode = $Is_VMS;
+my $Is_VMS_noefs = $Is_VMS;
+my $Is_Win32 = $^O eq 'MSWin32';
+
+if( $Is_VMS ) {
+ my $vms_unix_rpt;
+ my $vms_efs;
+ my $vms_case;
+
+ if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+ $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+ $vms_efs = VMS::Feature::current("efs_charset");
+ $vms_case = VMS::Feature::current("efs_case_preserve");
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ $vms_case = $efs_case =~ /^[ET1]/i;
+ }
+ $Is_VMS_mode = 0 if $vms_unix_rpt;
+ $Is_VMS_noefs = 0 if ($vms_efs);
+}
+
+
+=head1 NAME
+
+ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
+
+=head1 SYNOPSIS
+
+ perl -MExtUtils::Command -e cat files... > destination
+ perl -MExtUtils::Command -e mv source... destination
+ perl -MExtUtils::Command -e cp source... destination
+ perl -MExtUtils::Command -e touch files...
+ perl -MExtUtils::Command -e rm_f files...
+ perl -MExtUtils::Command -e rm_rf directories...
+ perl -MExtUtils::Command -e mkpath directories...
+ perl -MExtUtils::Command -e eqtime source destination
+ perl -MExtUtils::Command -e test_f file
+ perl -MExtUtils::Command -e test_d directory
+ perl -MExtUtils::Command -e chmod mode files...
+ ...
+
+=head1 DESCRIPTION
+
+The module is used to replace common UNIX commands. In all cases the
+functions work from @ARGV rather than taking arguments. This makes
+them easier to deal with in Makefiles. Call them like this:
+
+ perl -MExtUtils::Command -e some_command some files to work on
+
+and I<NOT> like this:
+
+ perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
+
+For that use L<Shell::Command>.
+
+Filenames with * and ? will be glob expanded.
+
+
+=head2 FUNCTIONS
+
+=over 4
+
+=cut
+
+# VMS uses % instead of ? to mean "one character"
+my $wild_regex = $Is_VMS ? '*%' : '*?';
+sub expand_wildcards
+{
+ @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
+}
+
+
+=item cat
+
+ cat file ...
+
+Concatenates all files mentioned on command line to STDOUT.
+
+=cut
+
+sub cat ()
+{
+ expand_wildcards();
+ print while (<>);
+}
+
+=item eqtime
+
+ eqtime source destination
+
+Sets modified time of destination to that of source.
+
+=cut
+
+sub eqtime
+{
+ my ($src,$dst) = @ARGV;
+ local @ARGV = ($dst); touch(); # in case $dst doesn't exist
+ utime((stat($src))[8,9],$dst);
+}
+
+=item rm_rf
+
+ rm_rf files or directories ...
+
+Removes files and directories - recursively (even if readonly)
+
+=cut
+
+sub rm_rf
+{
+ expand_wildcards();
+ rmtree([grep -e $_,@ARGV],0,0);
+}
+
+=item rm_f
+
+ rm_f file ...
+
+Removes files (even if readonly)
+
+=cut
+
+sub rm_f {
+ expand_wildcards();
+
+ foreach my $file (@ARGV) {
+ next unless -f $file;
+
+ next if _unlink($file);
+
+ chmod(0777, $file);
+
+ next if _unlink($file);
+
+ carp "Cannot delete $file: $!";
+ }
+}
+
+sub _unlink {
+ my $files_unlinked = 0;
+ foreach my $file (@_) {
+ my $delete_count = 0;
+ $delete_count++ while unlink $file;
+ $files_unlinked++ if $delete_count;
+ }
+ return $files_unlinked;
+}
+
+
+=item touch
+
+ touch file ...
+
+Makes files exist, with current timestamp
+
+=cut
+
+sub touch {
+ my $t = time;
+ expand_wildcards();
+ foreach my $file (@ARGV) {
+ open(FILE,">>$file") || die "Cannot write $file:$!";
+ close(FILE);
+ utime($t,$t,$file);
+ }
+}
+
+=item mv
+
+ mv source_file destination_file
+ mv source_file source_file destination_dir
+
+Moves source to destination. Multiple sources are allowed if
+destination is an existing directory.
+
+Returns true if all moves succeeded, false otherwise.
+
+=cut
+
+sub mv {
+ expand_wildcards();
+ my @src = @ARGV;
+ my $dst = pop @src;
+
+ croak("Too many arguments") if (@src > 1 && ! -d $dst);
+
+ my $nok = 0;
+ foreach my $src (@src) {
+ $nok ||= !move($src,$dst);
+ }
+ return !$nok;
+}
+
+=item cp
+
+ cp source_file destination_file
+ cp source_file source_file destination_dir
+
+Copies sources to the destination. Multiple sources are allowed if
+destination is an existing directory.
+
+Returns true if all copies succeeded, false otherwise.
+
+=cut
+
+sub cp {
+ expand_wildcards();
+ my @src = @ARGV;
+ my $dst = pop @src;
+
+ croak("Too many arguments") if (@src > 1 && ! -d $dst);
+
+ my $nok = 0;
+ foreach my $src (@src) {
+ $nok ||= !copy($src,$dst);
+
+ # Win32 does not update the mod time of a copied file, just the
+ # created time which make does not look at.
+ utime(time, time, $dst) if $Is_Win32;
+ }
+ return $nok;
+}
+
+=item chmod
+
+ chmod mode files ...
+
+Sets UNIX like permissions 'mode' on all the files. e.g. 0666
+
+=cut
+
+sub chmod {
+ local @ARGV = @ARGV;
+ my $mode = shift(@ARGV);
+ expand_wildcards();
+
+ if( $Is_VMS_mode && $Is_VMS_noefs) {
+ foreach my $idx (0..$#ARGV) {
+ my $path = $ARGV[$idx];
+ next unless -d $path;
+
+ # chmod 0777, [.foo.bar] doesn't work on VMS, you have to do
+ # chmod 0777, [.foo]bar.dir
+ my @dirs = File::Spec->splitdir( $path );
+ $dirs[-1] .= '.dir';
+ $path = File::Spec->catfile(@dirs);
+
+ $ARGV[$idx] = $path;
+ }
+ }
+
+ chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
+}
+
+=item mkpath
+
+ mkpath directory ...
+
+Creates directories, including any parent directories.
+
+=cut
+
+sub mkpath
+{
+ expand_wildcards();
+ File::Path::mkpath([@ARGV],0,0777);
+}
+
+=item test_f
+
+ test_f file
+
+Tests if a file exists. I<Exits> with 0 if it does, 1 if it does not (ie.
+shell's idea of true and false).
+
+=cut
+
+sub test_f
+{
+ exit(-f $ARGV[0] ? 0 : 1);
+}
+
+=item test_d
+
+ test_d directory
+
+Tests if a directory exists. I<Exits> with 0 if it does, 1 if it does
+not (ie. shell's idea of true and false).
+
+=cut
+
+sub test_d
+{
+ exit(-d $ARGV[0] ? 0 : 1);
+}
+
+=item dos2unix
+
+ dos2unix files or dirs ...
+
+Converts DOS and OS/2 linefeeds to Unix style recursively.
+
+=cut
+
+sub dos2unix {
+ require File::Find;
+ File::Find::find(sub {
+ return if -d;
+ return unless -w _;
+ return unless -r _;
+ return if -B _;
+
+ local $\;
+
+ my $orig = $_;
+ my $temp = '.dos2unix_tmp';
+ open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
+ open TEMP, ">$temp" or
+ do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
+ while (my $line = <ORIG>) {
+ $line =~ s/\015\012/\012/g;
+ print TEMP $line;
+ }
+ close ORIG;
+ close TEMP;
+ rename $temp, $orig;
+
+ }, @ARGV);
+}
+
+=back
+
+=head1 SEE ALSO
+
+Shell::Command which is these same functions but take arguments normally.
+
+
+=head1 AUTHOR
+
+Nick Ing-Simmons C<ni-s@cpan.org>
+
+Maintained by Michael G Schwern C<schwern@pobox.com> within the
+ExtUtils-MakeMaker package and, as a separate CPAN package, by
+Randy Kobes C<r.kobes@uwinnipeg.ca>.
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm
new file mode 100644
index 00000000000..f9b474de16f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm
@@ -0,0 +1,275 @@
+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.56';
+
+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;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm
new file mode 100644
index 00000000000..0a20b89b792
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm
@@ -0,0 +1,565 @@
+package ExtUtils::Constant;
+use vars qw (@ISA $VERSION @EXPORT_OK %EXPORT_TAGS);
+$VERSION = 0.22;
+
+=head1 NAME
+
+ExtUtils::Constant - generate XS code to import C header constants
+
+=head1 SYNOPSIS
+
+ use ExtUtils::Constant qw (WriteConstants);
+ WriteConstants(
+ NAME => 'Foo',
+ NAMES => [qw(FOO BAR BAZ)],
+ );
+ # Generates wrapper code to make the values of the constants FOO BAR BAZ
+ # available to perl
+
+=head1 DESCRIPTION
+
+ExtUtils::Constant facilitates generating C and XS wrapper code to allow
+perl modules to AUTOLOAD constants defined in C library header files.
+It is principally used by the C<h2xs> utility, on which this code is based.
+It doesn't contain the routines to scan header files to extract these
+constants.
+
+=head1 USAGE
+
+Generally one only needs to call the C<WriteConstants> function, and then
+
+ #include "const-c.inc"
+
+in the C section of C<Foo.xs>
+
+ INCLUDE: const-xs.inc
+
+in the XS section of C<Foo.xs>.
+
+For greater flexibility use C<constant_types()>, C<C_constant> and
+C<XS_constant>, with which C<WriteConstants> is implemented.
+
+Currently this module understands the following types. h2xs may only know
+a subset. The sizes of the numeric types are chosen by the C<Configure>
+script at compile time.
+
+=over 4
+
+=item IV
+
+signed integer, at least 32 bits.
+
+=item UV
+
+unsigned integer, the same size as I<IV>
+
+=item NV
+
+floating point type, probably C<double>, possibly C<long double>
+
+=item PV
+
+NUL terminated string, length will be determined with C<strlen>
+
+=item PVN
+
+A fixed length thing, given as a [pointer, length] pair. If you know the
+length of a string at compile time you may use this instead of I<PV>
+
+=item SV
+
+A B<mortal> SV.
+
+=item YES
+
+Truth. (C<PL_sv_yes>) The value is not needed (and ignored).
+
+=item NO
+
+Defined Falsehood. (C<PL_sv_no>) The value is not needed (and ignored).
+
+=item UNDEF
+
+C<undef>. The value of the macro is not needed.
+
+=back
+
+=head1 FUNCTIONS
+
+=over 4
+
+=cut
+
+if ($] >= 5.006) {
+ eval "use warnings; 1" or die $@;
+}
+use strict;
+use Carp qw(croak cluck);
+
+use Exporter;
+use ExtUtils::Constant::Utils qw(C_stringify);
+use ExtUtils::Constant::XS qw(%XS_Constant %XS_TypeSet);
+
+@ISA = 'Exporter';
+
+%EXPORT_TAGS = ( 'all' => [ qw(
+ XS_constant constant_types return_clause memEQ_clause C_stringify
+ C_constant autoload WriteConstants WriteMakefileSnippet
+) ] );
+
+@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+=item constant_types
+
+A function returning a single scalar with C<#define> definitions for the
+constants used internally between the generated C and XS functions.
+
+=cut
+
+sub constant_types {
+ ExtUtils::Constant::XS->header();
+}
+
+sub memEQ_clause {
+ cluck "ExtUtils::Constant::memEQ_clause is deprecated";
+ ExtUtils::Constant::XS->memEQ_clause({name=>$_[0], checked_at=>$_[1],
+ indent=>$_[2]});
+}
+
+sub return_clause ($$) {
+ cluck "ExtUtils::Constant::return_clause is deprecated";
+ my $indent = shift;
+ ExtUtils::Constant::XS->return_clause({indent=>$indent}, @_);
+}
+
+sub switch_clause {
+ cluck "ExtUtils::Constant::switch_clause is deprecated";
+ my $indent = shift;
+ my $comment = shift;
+ ExtUtils::Constant::XS->switch_clause({indent=>$indent, comment=>$comment},
+ @_);
+}
+
+sub C_constant {
+ my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
+ = @_;
+ ExtUtils::Constant::XS->C_constant({package => $package, subname => $subname,
+ default_type => $default_type,
+ types => $what, indent => $indent,
+ breakout => $breakout}, @items);
+}
+
+=item XS_constant PACKAGE, TYPES, XS_SUBNAME, C_SUBNAME
+
+A function to generate the XS code to implement the perl subroutine
+I<PACKAGE>::constant used by I<PACKAGE>::AUTOLOAD to load constants.
+This XS code is a wrapper around a C subroutine usually generated by
+C<C_constant>, and usually named C<constant>.
+
+I<TYPES> should be given either as a comma separated list of types that the
+C subroutine C<constant> will generate or as a reference to a hash. It should
+be the same list of types as C<C_constant> was given.
+[Otherwise C<XS_constant> and C<C_constant> may have different ideas about
+the number of parameters passed to the C function C<constant>]
+
+You can call the perl visible subroutine something other than C<constant> if
+you give the parameter I<XS_SUBNAME>. The C subroutine it calls defaults to
+the name of the perl visible subroutine, unless you give the parameter
+I<C_SUBNAME>.
+
+=cut
+
+sub XS_constant {
+ my $package = shift;
+ my $what = shift;
+ my $XS_subname = shift;
+ my $C_subname = shift;
+ $XS_subname ||= 'constant';
+ $C_subname ||= $XS_subname;
+
+ if (!ref $what) {
+ # Convert line of the form IV,UV,NV to hash
+ $what = {map {$_ => 1} split /,\s*/, ($what)};
+ }
+ my $params = ExtUtils::Constant::XS->params ($what);
+ my $type;
+
+ my $xs = <<"EOT";
+void
+$XS_subname(sv)
+ PREINIT:
+#ifdef dXSTARG
+ dXSTARG; /* Faster if we have it. */
+#else
+ dTARGET;
+#endif
+ STRLEN len;
+ int type;
+EOT
+
+ if ($params->{IV}) {
+ $xs .= " IV iv;\n";
+ } else {
+ $xs .= " /* IV\t\tiv;\tUncomment this if you need to return IVs */\n";
+ }
+ if ($params->{NV}) {
+ $xs .= " NV nv;\n";
+ } else {
+ $xs .= " /* NV\t\tnv;\tUncomment this if you need to return NVs */\n";
+ }
+ if ($params->{PV}) {
+ $xs .= " const char *pv;\n";
+ } else {
+ $xs .=
+ " /* const char\t*pv;\tUncomment this if you need to return PVs */\n";
+ }
+
+ $xs .= << 'EOT';
+ INPUT:
+ SV * sv;
+ const char * s = SvPV(sv, len);
+EOT
+ if ($params->{''}) {
+ $xs .= << 'EOT';
+ INPUT:
+ int utf8 = SvUTF8(sv);
+EOT
+ }
+ $xs .= << 'EOT';
+ PPCODE:
+EOT
+
+ if ($params->{IV} xor $params->{NV}) {
+ $xs .= << "EOT";
+ /* Change this to $C_subname(aTHX_ s, len, &iv, &nv);
+ if you need to return both NVs and IVs */
+EOT
+ }
+ $xs .= " type = $C_subname(aTHX_ s, len";
+ $xs .= ', utf8' if $params->{''};
+ $xs .= ', &iv' if $params->{IV};
+ $xs .= ', &nv' if $params->{NV};
+ $xs .= ', &pv' if $params->{PV};
+ $xs .= ', &sv' if $params->{SV};
+ $xs .= ");\n";
+
+ # If anyone is insane enough to suggest a package name containing %
+ my $package_sprintf_safe = $package;
+ $package_sprintf_safe =~ s/%/%%/g;
+
+ $xs .= << "EOT";
+ /* Return 1 or 2 items. First is error message, or undef if no error.
+ Second, if present, is found value */
+ switch (type) {
+ case PERL_constant_NOTFOUND:
+ sv =
+ sv_2mortal(newSVpvf("%s is not a valid $package_sprintf_safe macro", s));
+ PUSHs(sv);
+ break;
+ case PERL_constant_NOTDEF:
+ sv = sv_2mortal(newSVpvf(
+ "Your vendor has not defined $package_sprintf_safe macro %s, used",
+ s));
+ PUSHs(sv);
+ break;
+EOT
+
+ foreach $type (sort keys %XS_Constant) {
+ # '' marks utf8 flag needed.
+ next if $type eq '';
+ $xs .= "\t/* Uncomment this if you need to return ${type}s\n"
+ unless $what->{$type};
+ $xs .= " case PERL_constant_IS$type:\n";
+ if (length $XS_Constant{$type}) {
+ $xs .= << "EOT";
+ EXTEND(SP, 1);
+ PUSHs(&PL_sv_undef);
+ $XS_Constant{$type};
+EOT
+ } else {
+ # Do nothing. return (), which will be correctly interpreted as
+ # (undef, undef)
+ }
+ $xs .= " break;\n";
+ unless ($what->{$type}) {
+ chop $xs; # Yes, another need for chop not chomp.
+ $xs .= " */\n";
+ }
+ }
+ $xs .= << "EOT";
+ default:
+ sv = sv_2mortal(newSVpvf(
+ "Unexpected return type %d while processing $package_sprintf_safe macro %s, used",
+ type, s));
+ PUSHs(sv);
+ }
+EOT
+
+ return $xs;
+}
+
+
+=item autoload PACKAGE, VERSION, AUTOLOADER
+
+A function to generate the AUTOLOAD subroutine for the module I<PACKAGE>
+I<VERSION> is the perl version the code should be backwards compatible with.
+It defaults to the version of perl running the subroutine. If I<AUTOLOADER>
+is true, the AUTOLOAD subroutine falls back on AutoLoader::AUTOLOAD for all
+names that the constant() routine doesn't recognise.
+
+=cut
+
+# ' # Grr. syntax highlighters that don't grok pod.
+
+sub autoload {
+ my ($module, $compat_version, $autoloader) = @_;
+ $compat_version ||= $];
+ croak "Can't maintain compatibility back as far as version $compat_version"
+ if $compat_version < 5;
+ my $func = "sub AUTOLOAD {\n"
+ . " # This AUTOLOAD is used to 'autoload' constants from the constant()\n"
+ . " # XS function.";
+ $func .= " If a constant is not found then control is passed\n"
+ . " # to the AUTOLOAD in AutoLoader." if $autoloader;
+
+
+ $func .= "\n\n"
+ . " my \$constname;\n";
+ $func .=
+ " our \$AUTOLOAD;\n" if ($compat_version >= 5.006);
+
+ $func .= <<"EOT";
+ (\$constname = \$AUTOLOAD) =~ s/.*:://;
+ croak "&${module}::constant not defined" if \$constname eq 'constant';
+ my (\$error, \$val) = constant(\$constname);
+EOT
+
+ if ($autoloader) {
+ $func .= <<'EOT';
+ if ($error) {
+ if ($error =~ /is not a valid/) {
+ $AutoLoader::AUTOLOAD = $AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ } else {
+ croak $error;
+ }
+ }
+EOT
+ } else {
+ $func .=
+ " if (\$error) { croak \$error; }\n";
+ }
+
+ $func .= <<'END';
+ {
+ no strict 'refs';
+ # Fixed between 5.005_53 and 5.005_61
+#XXX if ($] >= 5.00561) {
+#XXX *$AUTOLOAD = sub () { $val };
+#XXX }
+#XXX else {
+ *$AUTOLOAD = sub { $val };
+#XXX }
+ }
+ goto &$AUTOLOAD;
+}
+
+END
+
+ return $func;
+}
+
+
+=item WriteMakefileSnippet
+
+WriteMakefileSnippet ATTRIBUTE =E<gt> VALUE [, ...]
+
+A function to generate perl code for Makefile.PL that will regenerate
+the constant subroutines. Parameters are named as passed to C<WriteConstants>,
+with the addition of C<INDENT> to specify the number of leading spaces
+(default 2).
+
+Currently only C<INDENT>, C<NAME>, C<DEFAULT_TYPE>, C<NAMES>, C<C_FILE> and
+C<XS_FILE> are recognised.
+
+=cut
+
+sub WriteMakefileSnippet {
+ my %args = @_;
+ my $indent = $args{INDENT} || 2;
+
+ my $result = <<"EOT";
+ExtUtils::Constant::WriteConstants(
+ NAME => '$args{NAME}',
+ NAMES => \\\@names,
+ DEFAULT_TYPE => '$args{DEFAULT_TYPE}',
+EOT
+ foreach (qw (C_FILE XS_FILE)) {
+ next unless exists $args{$_};
+ $result .= sprintf " %-12s => '%s',\n",
+ $_, $args{$_};
+ }
+ $result .= <<'EOT';
+ );
+EOT
+
+ $result =~ s/^/' 'x$indent/gem;
+ return ExtUtils::Constant::XS->dump_names({default_type=>$args{DEFAULT_TYPE},
+ indent=>$indent,},
+ @{$args{NAMES}})
+ . $result;
+}
+
+=item WriteConstants ATTRIBUTE =E<gt> VALUE [, ...]
+
+Writes a file of C code and a file of XS code which you should C<#include>
+and C<INCLUDE> in the C and XS sections respectively of your module's XS
+code. You probably want to do this in your C<Makefile.PL>, so that you can
+easily edit the list of constants without touching the rest of your module.
+The attributes supported are
+
+=over 4
+
+=item NAME
+
+Name of the module. This must be specified
+
+=item DEFAULT_TYPE
+
+The default type for the constants. If not specified C<IV> is assumed.
+
+=item BREAKOUT_AT
+
+The names of the constants are grouped by length. Generate child subroutines
+for each group with this number or more names in.
+
+=item NAMES
+
+An array of constants' names, either scalars containing names, or hashrefs
+as detailed in L<"C_constant">.
+
+=item PROXYSUBS
+
+If true, uses proxy subs. See L<ExtUtils::Constant::ProxySubs>.
+
+=item C_FH
+
+A filehandle to write the C code to. If not given, then I<C_FILE> is opened
+for writing.
+
+=item C_FILE
+
+The name of the file to write containing the C code. The default is
+C<const-c.inc>. The C<-> in the name ensures that the file can't be
+mistaken for anything related to a legitimate perl package name, and
+not naming the file C<.c> avoids having to override Makefile.PL's
+C<.xs> to C<.c> rules.
+
+=item XS_FH
+
+A filehandle to write the XS code to. If not given, then I<XS_FILE> is opened
+for writing.
+
+=item XS_FILE
+
+The name of the file to write containing the XS code. The default is
+C<const-xs.inc>.
+
+=item XS_SUBNAME
+
+The perl visible name of the XS subroutine generated which will return the
+constants. The default is C<constant>.
+
+=item C_SUBNAME
+
+The name of the C subroutine generated which will return the constants.
+The default is I<XS_SUBNAME>. Child subroutines have C<_> and the name
+length appended, so constants with 10 character names would be in
+C<constant_10> with the default I<XS_SUBNAME>.
+
+=back
+
+=cut
+
+sub WriteConstants {
+ my %ARGS =
+ ( # defaults
+ C_FILE => 'const-c.inc',
+ XS_FILE => 'const-xs.inc',
+ XS_SUBNAME => 'constant',
+ DEFAULT_TYPE => 'IV',
+ @_);
+
+ $ARGS{C_SUBNAME} ||= $ARGS{XS_SUBNAME}; # No-one sane will have C_SUBNAME eq '0'
+
+ croak "Module name not specified" unless length $ARGS{NAME};
+
+ my $c_fh = $ARGS{C_FH};
+ if (!$c_fh) {
+ if ($] <= 5.008) {
+ # We need these little games, rather than doing things
+ # unconditionally, because we're used in core Makefile.PLs before
+ # IO is available (needed by filehandle), but also we want to work on
+ # older perls where undefined scalars do not automatically turn into
+ # anonymous file handles.
+ require FileHandle;
+ $c_fh = FileHandle->new();
+ }
+ open $c_fh, ">$ARGS{C_FILE}" or die "Can't open $ARGS{C_FILE}: $!";
+ }
+
+ my $xs_fh = $ARGS{XS_FH};
+ if (!$xs_fh) {
+ if ($] <= 5.008) {
+ require FileHandle;
+ $xs_fh = FileHandle->new();
+ }
+ open $xs_fh, ">$ARGS{XS_FILE}" or die "Can't open $ARGS{XS_FILE}: $!";
+ }
+
+ # As this subroutine is intended to make code that isn't edited, there's no
+ # need for the user to specify any types that aren't found in the list of
+ # names.
+
+ if ($ARGS{PROXYSUBS}) {
+ require ExtUtils::Constant::ProxySubs;
+ $ARGS{C_FH} = $c_fh;
+ $ARGS{XS_FH} = $xs_fh;
+ ExtUtils::Constant::ProxySubs->WriteConstants(%ARGS);
+ } else {
+ my $types = {};
+
+ print $c_fh constant_types(); # macro defs
+ print $c_fh "\n";
+
+ # indent is still undef. Until anyone implements indent style rules with
+ # it.
+ foreach (ExtUtils::Constant::XS->C_constant({package => $ARGS{NAME},
+ subname => $ARGS{C_SUBNAME},
+ default_type =>
+ $ARGS{DEFAULT_TYPE},
+ types => $types,
+ breakout =>
+ $ARGS{BREAKOUT_AT}},
+ @{$ARGS{NAMES}})) {
+ print $c_fh $_, "\n"; # C constant subs
+ }
+ print $xs_fh XS_constant ($ARGS{NAME}, $types, $ARGS{XS_SUBNAME},
+ $ARGS{C_SUBNAME});
+ }
+
+ close $c_fh or warn "Error closing $ARGS{C_FILE}: $!" unless $ARGS{C_FH};
+ close $xs_fh or warn "Error closing $ARGS{XS_FILE}: $!" unless $ARGS{XS_FH};
+}
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and
+others
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm
new file mode 100644
index 00000000000..b5b79af1ea7
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm
@@ -0,0 +1,1006 @@
+package ExtUtils::Constant::Base;
+
+use strict;
+use vars qw($VERSION);
+use Carp;
+use Text::Wrap;
+use ExtUtils::Constant::Utils qw(C_stringify perl_stringify);
+$VERSION = '0.04';
+
+use constant is_perl56 => ($] < 5.007 && $] > 5.005_50);
+
+
+=head1 NAME
+
+ExtUtils::Constant::Base - base class for ExtUtils::Constant objects
+
+=head1 SYNOPSIS
+
+ require ExtUtils::Constant::Base;
+ @ISA = 'ExtUtils::Constant::Base';
+
+=head1 DESCRIPTION
+
+ExtUtils::Constant::Base provides a base implementation of methods to
+generate C code to give fast constant value lookup by named string. Currently
+it's mostly used ExtUtils::Constant::XS, which generates the lookup code
+for the constant() subroutine found in many XS modules.
+
+=head1 USAGE
+
+ExtUtils::Constant::Base exports no subroutines. The following methods are
+available
+
+=over 4
+
+=cut
+
+sub valid_type {
+ # Default to assuming that you don't need different types of return data.
+ 1;
+}
+sub default_type {
+ '';
+}
+
+=item header
+
+A method returning a scalar containing definitions needed, typically for a
+C header file.
+
+=cut
+
+sub header {
+ ''
+}
+
+# This might actually be a return statement. Note that you are responsible
+# for any space you might need before your value, as it lets to perform
+# "tricks" such as "return KEY_" and have strings appended.
+sub assignment_clause_for_type;
+# In which case this might be an empty string
+sub return_statement_for_type {undef};
+sub return_statement_for_notdef;
+sub return_statement_for_notfound;
+
+# "#if 1" is true to a C pre-processor
+sub macro_from_name {
+ 1;
+}
+
+sub macro_from_item {
+ 1;
+}
+
+sub macro_to_ifdef {
+ my ($self, $macro) = @_;
+ if (ref $macro) {
+ return $macro->[0];
+ }
+ if (defined $macro && $macro ne "" && $macro ne "1") {
+ return $macro ? "#ifdef $macro\n" : "#if 0\n";
+ }
+ return "";
+}
+
+sub macro_to_endif {
+ my ($self, $macro) = @_;
+
+ if (ref $macro) {
+ return $macro->[1];
+ }
+ if (defined $macro && $macro ne "" && $macro ne "1") {
+ return "#endif\n";
+ }
+ return "";
+}
+
+sub name_param {
+ 'name';
+}
+
+# This is possibly buggy, in that it's not mandatory (below, in the main
+# C_constant parameters, but is expected to exist here, if it's needed)
+# Buggy because if you're definitely pure 8 bit only, and will never be
+# presented with your constants in utf8, the default form of C_constant can't
+# be told not to do the utf8 version.
+
+sub is_utf8_param {
+ 'utf8';
+}
+
+sub memEQ {
+ "!memcmp";
+}
+
+=item memEQ_clause args_hashref
+
+A method to return a suitable C C<if> statement to check whether I<name>
+is equal to the C variable C<name>. If I<checked_at> is defined, then it
+is used to avoid C<memEQ> for short names, or to generate a comment to
+highlight the position of the character in the C<switch> statement.
+
+If i<checked_at> is a reference to a scalar, then instead it gives
+the characters pre-checked at the beginning, (and the number of chars by
+which the C variable name has been advanced. These need to be chopped from
+the front of I<name>).
+
+=cut
+
+sub memEQ_clause {
+# if (memEQ(name, "thingy", 6)) {
+ # Which could actually be a character comparison or even ""
+ my ($self, $args) = @_;
+ my ($name, $checked_at, $indent) = @{$args}{qw(name checked_at indent)};
+ $indent = ' ' x ($indent || 4);
+ my $front_chop;
+ if (ref $checked_at) {
+ # regexp won't work on 5.6.1 without use utf8; in turn that won't work
+ # on 5.005_03.
+ substr ($name, 0, length $$checked_at,) = '';
+ $front_chop = C_stringify ($$checked_at);
+ undef $checked_at;
+ }
+ my $len = length $name;
+
+ if ($len < 2) {
+ return $indent . "{\n"
+ if (defined $checked_at and $checked_at == 0) or $len == 0;
+ # We didn't switch, drop through to the code for the 2 character string
+ $checked_at = 1;
+ }
+
+ my $name_param = $self->name_param;
+
+ if ($len < 3 and defined $checked_at) {
+ my $check;
+ if ($checked_at == 1) {
+ $check = 0;
+ } elsif ($checked_at == 0) {
+ $check = 1;
+ }
+ if (defined $check) {
+ my $char = C_stringify (substr $name, $check, 1);
+ # Placate 5.005 with a break in the string. I can't see a good way of
+ # getting it to not take [ as introducing an array lookup, even with
+ # ${name_param}[$check]
+ return $indent . "if ($name_param" . "[$check] == '$char') {\n";
+ }
+ }
+ if (($len == 2 and !defined $checked_at)
+ or ($len == 3 and defined ($checked_at) and $checked_at == 2)) {
+ my $char1 = C_stringify (substr $name, 0, 1);
+ my $char2 = C_stringify (substr $name, 1, 1);
+ return $indent .
+ "if ($name_param" . "[0] == '$char1' && $name_param" . "[1] == '$char2') {\n";
+ }
+ if (($len == 3 and defined ($checked_at) and $checked_at == 1)) {
+ my $char1 = C_stringify (substr $name, 0, 1);
+ my $char2 = C_stringify (substr $name, 2, 1);
+ return $indent .
+ "if ($name_param" . "[0] == '$char1' && $name_param" . "[2] == '$char2') {\n";
+ }
+
+ my $pointer = '^';
+ my $have_checked_last = defined ($checked_at) && $len == $checked_at + 1;
+ if ($have_checked_last) {
+ # Checked at the last character, so no need to memEQ it.
+ $pointer = C_stringify (chop $name);
+ $len--;
+ }
+
+ $name = C_stringify ($name);
+ my $memEQ = $self->memEQ();
+ my $body = $indent . "if ($memEQ($name_param, \"$name\", $len)) {\n";
+ # Put a little ^ under the letter we checked at
+ # Screws up for non printable and non-7 bit stuff, but that's too hard to
+ # get right.
+ if (defined $checked_at) {
+ $body .= $indent . "/* " . (' ' x length $memEQ)
+ . (' ' x length $name_param)
+ . (' ' x $checked_at) . $pointer
+ . (' ' x ($len - $checked_at + length $len)) . " */\n";
+ } elsif (defined $front_chop) {
+ $body .= $indent . "/* $front_chop"
+ . (' ' x ($len + 1 + length $len)) . " */\n";
+ }
+ return $body;
+}
+
+=item dump_names arg_hashref, ITEM...
+
+An internal function to generate the embedded perl code that will regenerate
+the constant subroutines. I<default_type>, I<types> and I<ITEM>s are the
+same as for C_constant. I<indent> is treated as number of spaces to indent
+by. If C<declare_types> is true a C<$types> is always declared in the perl
+code generated, if defined and false never declared, and if undefined C<$types>
+is only declared if the values in I<types> as passed in cannot be inferred from
+I<default_types> and the I<ITEM>s.
+
+=cut
+
+sub dump_names {
+ my ($self, $args, @items) = @_;
+ my ($default_type, $what, $indent, $declare_types)
+ = @{$args}{qw(default_type what indent declare_types)};
+ $indent = ' ' x ($indent || 0);
+
+ my $result;
+ my (@simple, @complex, %used_types);
+ foreach (@items) {
+ my $type;
+ if (ref $_) {
+ $type = $_->{type} || $default_type;
+ if ($_->{utf8}) {
+ # For simplicity always skip the bytes case, and reconstitute this entry
+ # from its utf8 twin.
+ next if $_->{utf8} eq 'no';
+ # Copy the hashref, as we don't want to mess with the caller's hashref.
+ $_ = {%$_};
+ unless (is_perl56) {
+ utf8::decode ($_->{name});
+ } else {
+ $_->{name} = pack 'U*', unpack 'U0U*', $_->{name};
+ }
+ delete $_->{utf8};
+ }
+ } else {
+ $_ = {name=>$_};
+ $type = $default_type;
+ }
+ $used_types{$type}++;
+ if ($type eq $default_type
+ # grr 5.6.1
+ and length $_->{name}
+ and length $_->{name} == ($_->{name} =~ tr/A-Za-z0-9_//)
+ and !defined ($_->{macro}) and !defined ($_->{value})
+ and !defined ($_->{default}) and !defined ($_->{pre})
+ and !defined ($_->{post}) and !defined ($_->{def_pre})
+ and !defined ($_->{def_post}) and !defined ($_->{weight})) {
+ # It's the default type, and the name consists only of A-Za-z0-9_
+ push @simple, $_->{name};
+ } else {
+ push @complex, $_;
+ }
+ }
+
+ if (!defined $declare_types) {
+ # Do they pass in any types we weren't already using?
+ foreach (keys %$what) {
+ next if $used_types{$_};
+ $declare_types++; # Found one in $what that wasn't used.
+ last; # And one is enough to terminate this loop
+ }
+ }
+ if ($declare_types) {
+ $result = $indent . 'my $types = {map {($_, 1)} qw('
+ . join (" ", sort keys %$what) . ")};\n";
+ }
+ local $Text::Wrap::huge = 'overflow';
+ local $Text::Wrap::columns = 80;
+ $result .= wrap ($indent . "my \@names = (qw(",
+ $indent . " ", join (" ", sort @simple) . ")");
+ if (@complex) {
+ foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) {
+ my $name = perl_stringify $item->{name};
+ my $line = ",\n$indent {name=>\"$name\"";
+ $line .= ", type=>\"$item->{type}\"" if defined $item->{type};
+ foreach my $thing (qw (macro value default pre post def_pre def_post)) {
+ my $value = $item->{$thing};
+ if (defined $value) {
+ if (ref $value) {
+ $line .= ", $thing=>[\""
+ . join ('", "', map {perl_stringify $_} @$value) . '"]';
+ } else {
+ $line .= ", $thing=>\"" . perl_stringify($value) . "\"";
+ }
+ }
+ }
+ $line .= "}";
+ # Ensure that the enclosing C comment doesn't end
+ # by turning */ into *" . "/
+ $line =~ s!\*\/!\*" . "/!gs;
+ # gcc -Wall doesn't like finding /* inside a comment
+ $line =~ s!\/\*!/" . "\*!gs;
+ $result .= $line;
+ }
+ }
+ $result .= ");\n";
+
+ $result;
+}
+
+=item assign arg_hashref, VALUE...
+
+A method to return a suitable assignment clause. If I<type> is aggregate
+(eg I<PVN> expects both pointer and length) then there should be multiple
+I<VALUE>s for the components. I<pre> and I<post> if defined give snippets
+of C code to proceed and follow the assignment. I<pre> will be at the start
+of a block, so variables may be defined in it.
+
+=cut
+# Hmm. value undef to to NOTDEF? value () to do NOTFOUND?
+
+sub assign {
+ my $self = shift;
+ my $args = shift;
+ my ($indent, $type, $pre, $post, $item)
+ = @{$args}{qw(indent type pre post item)};
+ $post ||= '';
+ my $clause;
+ my $close;
+ if ($pre) {
+ chomp $pre;
+ $close = "$indent}\n";
+ $clause = $indent . "{\n";
+ $indent .= " ";
+ $clause .= "$indent$pre";
+ $clause .= ";" unless $pre =~ /;$/;
+ $clause .= "\n";
+ }
+ confess "undef \$type" unless defined $type;
+ confess "Can't generate code for type $type"
+ unless $self->valid_type($type);
+
+ $clause .= join '', map {"$indent$_\n"}
+ $self->assignment_clause_for_type({type=>$type,item=>$item}, @_);
+ chomp $post;
+ if (length $post) {
+ $clause .= "$post";
+ $clause .= ";" unless $post =~ /;$/;
+ $clause .= "\n";
+ }
+ my $return = $self->return_statement_for_type($type);
+ $clause .= "$indent$return\n" if defined $return;
+ $clause .= $close if $close;
+ return $clause;
+}
+
+=item return_clause arg_hashref, ITEM
+
+A method to return a suitable C<#ifdef> clause. I<ITEM> is a hashref
+(as passed to C<C_constant> and C<match_clause>. I<indent> is the number
+of spaces to indent, defaulting to 6.
+
+=cut
+
+sub return_clause {
+
+##ifdef thingy
+# *iv_return = thingy;
+# return PERL_constant_ISIV;
+##else
+# return PERL_constant_NOTDEF;
+##endif
+ my ($self, $args, $item) = @_;
+ my $indent = $args->{indent};
+
+ my ($name, $value, $default, $pre, $post, $def_pre, $def_post, $type)
+ = @$item{qw (name value default pre post def_pre def_post type)};
+ $value = $name unless defined $value;
+ my $macro = $self->macro_from_item($item);
+ $indent = ' ' x ($indent || 6);
+ unless (defined $type) {
+ # use Data::Dumper; print STDERR Dumper ($item);
+ confess "undef \$type";
+ }
+
+ ##ifdef thingy
+ my $clause = $self->macro_to_ifdef($macro);
+
+ # *iv_return = thingy;
+ # return PERL_constant_ISIV;
+ $clause
+ .= $self->assign ({indent=>$indent, type=>$type, pre=>$pre, post=>$post,
+ item=>$item}, ref $value ? @$value : $value);
+
+ if (defined $macro && $macro ne "" && $macro ne "1") {
+ ##else
+ $clause .= "#else\n";
+
+ # return PERL_constant_NOTDEF;
+ if (!defined $default) {
+ my $notdef = $self->return_statement_for_notdef();
+ $clause .= "$indent$notdef\n" if defined $notdef;
+ } else {
+ my @default = ref $default ? @$default : $default;
+ $type = shift @default;
+ $clause .= $self->assign ({indent=>$indent, type=>$type, pre=>$pre,
+ post=>$post, item=>$item}, @default);
+ }
+ }
+ ##endif
+ $clause .= $self->macro_to_endif($macro);
+
+ return $clause;
+}
+
+sub match_clause {
+ # $offset defined if we have checked an offset.
+ my ($self, $args, $item) = @_;
+ my ($offset, $indent) = @{$args}{qw(checked_at indent)};
+ $indent = ' ' x ($indent || 4);
+ my $body = '';
+ my ($no, $yes, $either, $name, $inner_indent);
+ if (ref $item eq 'ARRAY') {
+ ($yes, $no) = @$item;
+ $either = $yes || $no;
+ confess "$item is $either expecting hashref in [0] || [1]"
+ unless ref $either eq 'HASH';
+ $name = $either->{name};
+ } else {
+ confess "$item->{name} has utf8 flag '$item->{utf8}', should be false"
+ if $item->{utf8};
+ $name = $item->{name};
+ $inner_indent = $indent;
+ }
+
+ $body .= $self->memEQ_clause ({name => $name, checked_at => $offset,
+ indent => length $indent});
+ # If we've been presented with an arrayref for $item, then the user string
+ # contains in the range 128-255, and we need to check whether it was utf8
+ # (or not).
+ # In the worst case we have two named constants, where one's name happens
+ # encoded in UTF8 happens to be the same byte sequence as the second's
+ # encoded in (say) ISO-8859-1.
+ # In this case, $yes and $no both have item hashrefs.
+ if ($yes) {
+ $body .= $indent . " if (" . $self->is_utf8_param . ") {\n";
+ } elsif ($no) {
+ $body .= $indent . " if (!" . $self->is_utf8_param . ") {\n";
+ }
+ if ($either) {
+ $body .= $self->return_clause ({indent=>4 + length $indent}, $either);
+ if ($yes and $no) {
+ $body .= $indent . " } else {\n";
+ $body .= $self->return_clause ({indent=>4 + length $indent}, $no);
+ }
+ $body .= $indent . " }\n";
+ } else {
+ $body .= $self->return_clause ({indent=>2 + length $indent}, $item);
+ }
+ $body .= $indent . "}\n";
+}
+
+
+=item switch_clause arg_hashref, NAMELEN, ITEMHASH, ITEM...
+
+An internal method to generate a suitable C<switch> clause, called by
+C<C_constant> I<ITEM>s are in the hash ref format as given in the description
+of C<C_constant>, and must all have the names of the same length, given by
+I<NAMELEN>. I<ITEMHASH> is a reference to a hash, keyed by name, values being
+the hashrefs in the I<ITEM> list. (No parameters are modified, and there can
+be keys in the I<ITEMHASH> that are not in the list of I<ITEM>s without
+causing problems - the hash is passed in to save generating it afresh for
+each call).
+
+=cut
+
+sub switch_clause {
+ my ($self, $args, $namelen, $items, @items) = @_;
+ my ($indent, $comment) = @{$args}{qw(indent comment)};
+ $indent = ' ' x ($indent || 2);
+
+ local $Text::Wrap::huge = 'overflow';
+ local $Text::Wrap::columns = 80;
+
+ my @names = sort map {$_->{name}} @items;
+ my $leader = $indent . '/* ';
+ my $follower = ' ' x length $leader;
+ my $body = $indent . "/* Names all of length $namelen. */\n";
+ if (defined $comment) {
+ $body = wrap ($leader, $follower, $comment) . "\n";
+ $leader = $follower;
+ }
+ my @safe_names = @names;
+ foreach (@safe_names) {
+ confess sprintf "Name '$_' is length %d, not $namelen", length
+ unless length == $namelen;
+ # Argh. 5.6.1
+ # next unless tr/A-Za-z0-9_//c;
+ next if tr/A-Za-z0-9_// == length;
+ $_ = '"' . perl_stringify ($_) . '"';
+ # Ensure that the enclosing C comment doesn't end
+ # by turning */ into *" . "/
+ s!\*\/!\*"."/!gs;
+ # gcc -Wall doesn't like finding /* inside a comment
+ s!\/\*!/"."\*!gs;
+ }
+ $body .= wrap ($leader, $follower, join (" ", @safe_names) . " */") . "\n";
+ # Figure out what to switch on.
+ # (RMS, Spread of jump table, Position, Hashref)
+ my @best = (1e38, ~0);
+ # Prefer the last character over the others. (As it lets us shorten the
+ # memEQ clause at no cost).
+ foreach my $i ($namelen - 1, 0 .. ($namelen - 2)) {
+ my ($min, $max) = (~0, 0);
+ my %spread;
+ if (is_perl56) {
+ # Need proper Unicode preserving hash keys for bytes in range 128-255
+ # here too, for some reason. grr 5.6.1 yet again.
+ tie %spread, 'ExtUtils::Constant::Aaargh56Hash';
+ }
+ foreach (@names) {
+ my $char = substr $_, $i, 1;
+ my $ord = ord $char;
+ confess "char $ord is out of range" if $ord > 255;
+ $max = $ord if $ord > $max;
+ $min = $ord if $ord < $min;
+ push @{$spread{$char}}, $_;
+ # warn "$_ $char";
+ }
+ # I'm going to pick the character to split on that minimises the root
+ # mean square of the number of names in each case. Normally this should
+ # be the one with the most keys, but it may pick a 7 where the 8 has
+ # one long linear search. I'm not sure if RMS or just sum of squares is
+ # actually better.
+ # $max and $min are for the tie-breaker if the root mean squares match.
+ # Assuming that the compiler may be building a jump table for the
+ # switch() then try to minimise the size of that jump table.
+ # Finally use < not <= so that if it still ties the earliest part of
+ # the string wins. Because if that passes but the memEQ fails, it may
+ # only need the start of the string to bin the choice.
+ # I think. But I'm micro-optimising. :-)
+ # OK. Trump that. Now favour the last character of the string, before the
+ # rest.
+ my $ss;
+ $ss += @$_ * @$_ foreach values %spread;
+ my $rms = sqrt ($ss / keys %spread);
+ if ($rms < $best[0] || ($rms == $best[0] && ($max - $min) < $best[1])) {
+ @best = ($rms, $max - $min, $i, \%spread);
+ }
+ }
+ confess "Internal error. Failed to pick a switch point for @names"
+ unless defined $best[2];
+ # use Data::Dumper; print Dumper (@best);
+ my ($offset, $best) = @best[2,3];
+ $body .= $indent . "/* Offset $offset gives the best switch position. */\n";
+
+ my $do_front_chop = $offset == 0 && $namelen > 2;
+ if ($do_front_chop) {
+ $body .= $indent . "switch (*" . $self->name_param() . "++) {\n";
+ } else {
+ $body .= $indent . "switch (" . $self->name_param() . "[$offset]) {\n";
+ }
+ foreach my $char (sort keys %$best) {
+ confess sprintf "'$char' is %d bytes long, not 1", length $char
+ if length ($char) != 1;
+ confess sprintf "char %#X is out of range", ord $char if ord ($char) > 255;
+ $body .= $indent . "case '" . C_stringify ($char) . "':\n";
+ foreach my $thisone (sort {
+ # Deal with the case of an item actually being an array ref to 1 or 2
+ # hashrefs. Don't assign to $a or $b, as they're aliases to the orignal
+ my $l = ref $a eq 'ARRAY' ? ($a->[0] || $->[1]) : $a;
+ my $r = ref $b eq 'ARRAY' ? ($b->[0] || $->[1]) : $b;
+ # Sort by weight first
+ ($r->{weight} || 0) <=> ($l->{weight} || 0)
+ # Sort equal weights by name
+ or $l->{name} cmp $r->{name}}
+ # If this looks evil, maybe it is. $items is a
+ # hashref, and we're doing a hash slice on it
+ @{$items}{@{$best->{$char}}}) {
+ # warn "You are here";
+ if ($do_front_chop) {
+ $body .= $self->match_clause ({indent => 2 + length $indent,
+ checked_at => \$char}, $thisone);
+ } else {
+ $body .= $self->match_clause ({indent => 2 + length $indent,
+ checked_at => $offset}, $thisone);
+ }
+ }
+ $body .= $indent . " break;\n";
+ }
+ $body .= $indent . "}\n";
+ return $body;
+}
+
+sub C_constant_return_type {
+ "static int";
+}
+
+sub C_constant_prefix_param {
+ '';
+}
+
+sub C_constant_prefix_param_defintion {
+ '';
+}
+
+sub name_param_definition {
+ "const char *" . $_[0]->name_param;
+}
+
+sub namelen_param {
+ 'len';
+}
+
+sub namelen_param_definition {
+ 'size_t ' . $_[0]->namelen_param;
+}
+
+sub C_constant_other_params {
+ '';
+}
+
+sub C_constant_other_params_defintion {
+ '';
+}
+
+=item params WHAT
+
+An "internal" method, subject to change, currently called to allow an
+overriding class to cache information that will then be passed into all
+the C<*param*> calls. (Yes, having to read the source to make sense of this is
+considered a known bug). I<WHAT> is be a hashref of types the constant
+function will return. In ExtUtils::Constant::XS this method is used to
+returns a hashref keyed IV NV PV SV to show which combination of pointers will
+be needed in the C argument list generated by
+C_constant_other_params_definition and C_constant_other_params
+
+=cut
+
+sub params {
+ '';
+}
+
+
+=item dogfood arg_hashref, ITEM...
+
+An internal function to generate the embedded perl code that will regenerate
+the constant subroutines. Parameters are the same as for C_constant.
+
+Currently the base class does nothing and returns an empty string.
+
+=cut
+
+sub dogfood {
+ ''
+}
+
+=item normalise_items args, default_type, seen_types, seen_items, ITEM...
+
+Convert the items to a normalised form. For 8 bit and Unicode values converts
+the item to an array of 1 or 2 items, both 8 bit and UTF-8 encoded.
+
+=cut
+
+sub normalise_items
+{
+ my $self = shift;
+ my $args = shift;
+ my $default_type = shift;
+ my $what = shift;
+ my $items = shift;
+ my @new_items;
+ foreach my $orig (@_) {
+ my ($name, $item);
+ if (ref $orig) {
+ # Make a copy which is a normalised version of the ref passed in.
+ $name = $orig->{name};
+ my ($type, $macro, $value) = @$orig{qw (type macro value)};
+ $type ||= $default_type;
+ $what->{$type} = 1;
+ $item = {name=>$name, type=>$type};
+
+ undef $macro if defined $macro and $macro eq $name;
+ $item->{macro} = $macro if defined $macro;
+ undef $value if defined $value and $value eq $name;
+ $item->{value} = $value if defined $value;
+ foreach my $key (qw(default pre post def_pre def_post weight
+ not_constant)) {
+ my $value = $orig->{$key};
+ $item->{$key} = $value if defined $value;
+ # warn "$key $value";
+ }
+ } else {
+ $name = $orig;
+ $item = {name=>$name, type=>$default_type};
+ $what->{$default_type} = 1;
+ }
+ warn +(ref ($self) || $self)
+ . "doesn't know how to handle values of type $_ used in macro $name"
+ unless $self->valid_type ($item->{type});
+ # tr///c is broken on 5.6.1 for utf8, so my original tr/\0-\177//c
+ # doesn't work. Upgrade to 5.8
+ # if ($name !~ tr/\0-\177//c || $] < 5.005_50) {
+ if ($name =~ tr/\0-\177// == length $name || $] < 5.005_50
+ || $args->{disable_utf8_duplication}) {
+ # No characters outside 7 bit ASCII.
+ if (exists $items->{$name}) {
+ die "Multiple definitions for macro $name";
+ }
+ $items->{$name} = $item;
+ } else {
+ # No characters outside 8 bit. This is hardest.
+ if (exists $items->{$name} and ref $items->{$name} ne 'ARRAY') {
+ confess "Unexpected ASCII definition for macro $name";
+ }
+ # Again, 5.6.1 tr broken, so s/5\.6.*/5\.8\.0/;
+ # if ($name !~ tr/\0-\377//c) {
+ if ($name =~ tr/\0-\377// == length $name) {
+# if ($] < 5.007) {
+# $name = pack "C*", unpack "U*", $name;
+# }
+ $item->{utf8} = 'no';
+ $items->{$name}[1] = $item;
+ push @new_items, $item;
+ # Copy item, to create the utf8 variant.
+ $item = {%$item};
+ }
+ # Encode the name as utf8 bytes.
+ unless (is_perl56) {
+ utf8::encode($name);
+ } else {
+# warn "Was >$name< " . length ${name};
+ $name = pack 'C*', unpack 'C*', $name . pack 'U*';
+# warn "Now '${name}' " . length ${name};
+ }
+ if ($items->{$name}[0]) {
+ die "Multiple definitions for macro $name";
+ }
+ $item->{utf8} = 'yes';
+ $item->{name} = $name;
+ $items->{$name}[0] = $item;
+ # We have need for the utf8 flag.
+ $what->{''} = 1;
+ }
+ push @new_items, $item;
+ }
+ @new_items;
+}
+
+=item C_constant arg_hashref, ITEM...
+
+A function that returns a B<list> of C subroutine definitions that return
+the value and type of constants when passed the name by the XS wrapper.
+I<ITEM...> gives a list of constant names. Each can either be a string,
+which is taken as a C macro name, or a reference to a hash with the following
+keys
+
+=over 8
+
+=item name
+
+The name of the constant, as seen by the perl code.
+
+=item type
+
+The type of the constant (I<IV>, I<NV> etc)
+
+=item value
+
+A C expression for the value of the constant, or a list of C expressions if
+the type is aggregate. This defaults to the I<name> if not given.
+
+=item macro
+
+The C pre-processor macro to use in the C<#ifdef>. This defaults to the
+I<name>, and is mainly used if I<value> is an C<enum>. If a reference an
+array is passed then the first element is used in place of the C<#ifdef>
+line, and the second element in place of the C<#endif>. This allows
+pre-processor constructions such as
+
+ #if defined (foo)
+ #if !defined (bar)
+ ...
+ #endif
+ #endif
+
+to be used to determine if a constant is to be defined.
+
+A "macro" 1 signals that the constant is always defined, so the C<#if>/C<#endif>
+test is omitted.
+
+=item default
+
+Default value to use (instead of C<croak>ing with "your vendor has not
+defined...") to return if the macro isn't defined. Specify a reference to
+an array with type followed by value(s).
+
+=item pre
+
+C code to use before the assignment of the value of the constant. This allows
+you to use temporary variables to extract a value from part of a C<struct>
+and return this as I<value>. This C code is places at the start of a block,
+so you can declare variables in it.
+
+=item post
+
+C code to place between the assignment of value (to a temporary) and the
+return from the function. This allows you to clear up anything in I<pre>.
+Rarely needed.
+
+=item def_pre
+
+=item def_post
+
+Equivalents of I<pre> and I<post> for the default value.
+
+=item utf8
+
+Generated internally. Is zero or undefined if name is 7 bit ASCII,
+"no" if the name is 8 bit (and so should only match if SvUTF8() is false),
+"yes" if the name is utf8 encoded.
+
+The internals automatically clone any name with characters 128-255 but none
+256+ (ie one that could be either in bytes or utf8) into a second entry
+which is utf8 encoded.
+
+=item weight
+
+Optional sorting weight for names, to determine the order of
+linear testing when multiple names fall in the same case of a switch clause.
+Higher comes earlier, undefined defaults to zero.
+
+=back
+
+In the argument hashref, I<package> is the name of the package, and is only
+used in comments inside the generated C code. I<subname> defaults to
+C<constant> if undefined.
+
+I<default_type> is the type returned by C<ITEM>s that don't specify their
+type. It defaults to the value of C<default_type()>. I<types> should be given
+either as a comma separated list of types that the C subroutine I<subname>
+will generate or as a reference to a hash. I<default_type> will be added to
+the list if not present, as will any types given in the list of I<ITEM>s. The
+resultant list should be the same list of types that C<XS_constant> is
+given. [Otherwise C<XS_constant> and C<C_constant> may differ in the number of
+parameters to the constant function. I<indent> is currently unused and
+ignored. In future it may be used to pass in information used to change the C
+indentation style used.] The best way to maintain consistency is to pass in a
+hash reference and let this function update it.
+
+I<breakout> governs when child functions of I<subname> are generated. If there
+are I<breakout> or more I<ITEM>s with the same length of name, then the code
+to switch between them is placed into a function named I<subname>_I<len>, for
+example C<constant_5> for names 5 characters long. The default I<breakout> is
+3. A single C<ITEM> is always inlined.
+
+=cut
+
+# The parameter now BREAKOUT was previously documented as:
+#
+# I<NAMELEN> if defined signals that all the I<name>s of the I<ITEM>s are of
+# this length, and that the constant name passed in by perl is checked and
+# also of this length. It is used during recursion, and should be C<undef>
+# unless the caller has checked all the lengths during code generation, and
+# the generated subroutine is only to be called with a name of this length.
+#
+# As you can see it now performs this function during recursion by being a
+# scalar reference.
+
+sub C_constant {
+ my ($self, $args, @items) = @_;
+ my ($package, $subname, $default_type, $what, $indent, $breakout) =
+ @{$args}{qw(package subname default_type types indent breakout)};
+ $package ||= 'Foo';
+ $subname ||= 'constant';
+ # I'm not using this. But a hashref could be used for full formatting without
+ # breaking this API
+ # $indent ||= 0;
+
+ my ($namelen, $items);
+ if (ref $breakout) {
+ # We are called recursively. We trust @items to be normalised, $what to
+ # be a hashref, and pinch %$items from our parent to save recalculation.
+ ($namelen, $items) = @$breakout;
+ } else {
+ $items = {};
+ if (is_perl56) {
+ # Need proper Unicode preserving hash keys.
+ require ExtUtils::Constant::Aaargh56Hash;
+ tie %$items, 'ExtUtils::Constant::Aaargh56Hash';
+ }
+ $breakout ||= 3;
+ $default_type ||= $self->default_type();
+ if (!ref $what) {
+ # Convert line of the form IV,UV,NV to hash
+ $what = {map {$_ => 1} split /,\s*/, ($what || '')};
+ # Figure out what types we're dealing with, and assign all unknowns to the
+ # default type
+ }
+ @items = $self->normalise_items ({}, $default_type, $what, $items, @items);
+ # use Data::Dumper; print Dumper @items;
+ }
+ my $params = $self->params ($what);
+
+ # Probably "static int"
+ my ($body, @subs);
+ $body = $self->C_constant_return_type($params) . "\n$subname ("
+ # Eg "pTHX_ "
+ . $self->C_constant_prefix_param_defintion($params)
+ # Probably "const char *name"
+ . $self->name_param_definition($params);
+ # Something like ", STRLEN len"
+ $body .= ", " . $self->namelen_param_definition($params)
+ unless defined $namelen;
+ $body .= $self->C_constant_other_params_defintion($params);
+ $body .= ") {\n";
+
+ if (defined $namelen) {
+ # We are a child subroutine. Print the simple description
+ my $comment = 'When generated this function returned values for the list'
+ . ' of names given here. However, subsequent manual editing may have'
+ . ' added or removed some.';
+ $body .= $self->switch_clause ({indent=>2, comment=>$comment},
+ $namelen, $items, @items);
+ } else {
+ # We are the top level.
+ $body .= " /* Initially switch on the length of the name. */\n";
+ $body .= $self->dogfood ({package => $package, subname => $subname,
+ default_type => $default_type, what => $what,
+ indent => $indent, breakout => $breakout},
+ @items);
+ $body .= ' switch ('.$self->namelen_param().") {\n";
+ # Need to group names of the same length
+ my @by_length;
+ foreach (@items) {
+ push @{$by_length[length $_->{name}]}, $_;
+ }
+ foreach my $i (0 .. $#by_length) {
+ next unless $by_length[$i]; # None of this length
+ $body .= " case $i:\n";
+ if (@{$by_length[$i]} == 1) {
+ my $only_thing = $by_length[$i]->[0];
+ if ($only_thing->{utf8}) {
+ if ($only_thing->{utf8} eq 'yes') {
+ # With utf8 on flag item is passed in element 0
+ $body .= $self->match_clause (undef, [$only_thing]);
+ } else {
+ # With utf8 off flag item is passed in element 1
+ $body .= $self->match_clause (undef, [undef, $only_thing]);
+ }
+ } else {
+ $body .= $self->match_clause (undef, $only_thing);
+ }
+ } elsif (@{$by_length[$i]} < $breakout) {
+ $body .= $self->switch_clause ({indent=>4},
+ $i, $items, @{$by_length[$i]});
+ } else {
+ # Only use the minimal set of parameters actually needed by the types
+ # of the names of this length.
+ my $what = {};
+ foreach (@{$by_length[$i]}) {
+ $what->{$_->{type}} = 1;
+ $what->{''} = 1 if $_->{utf8};
+ }
+ $params = $self->params ($what);
+ push @subs, $self->C_constant ({package=>$package,
+ subname=>"${subname}_$i",
+ default_type => $default_type,
+ types => $what, indent => $indent,
+ breakout => [$i, $items]},
+ @{$by_length[$i]});
+ $body .= " return ${subname}_$i ("
+ # Eg "aTHX_ "
+ . $self->C_constant_prefix_param($params)
+ # Probably "name"
+ . $self->name_param($params);
+ $body .= $self->C_constant_other_params($params);
+ $body .= ");\n";
+ }
+ $body .= " break;\n";
+ }
+ $body .= " }\n";
+ }
+ my $notfound = $self->return_statement_for_notfound();
+ $body .= " $notfound\n" if $notfound;
+ $body .= "}\n";
+ return (@subs, $body);
+}
+
+1;
+__END__
+
+=back
+
+=head1 BUGS
+
+Not everything is documented yet.
+
+Probably others.
+
+=head1 AUTHOR
+
+Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and
+others
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm
new file mode 100644
index 00000000000..c3fe8ed3c56
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm
@@ -0,0 +1,549 @@
+package ExtUtils::Constant::ProxySubs;
+
+use strict;
+use vars qw($VERSION @ISA %type_to_struct %type_from_struct %type_to_sv
+ %type_to_C_value %type_is_a_problem %type_num_args
+ %type_temporary);
+use Carp;
+require ExtUtils::Constant::XS;
+use ExtUtils::Constant::Utils qw(C_stringify);
+use ExtUtils::Constant::XS qw(%XS_TypeSet);
+
+$VERSION = '0.06';
+@ISA = 'ExtUtils::Constant::XS';
+
+%type_to_struct =
+ (
+ IV => '{const char *name; I32 namelen; IV value;}',
+ NV => '{const char *name; I32 namelen; NV value;}',
+ UV => '{const char *name; I32 namelen; UV value;}',
+ PV => '{const char *name; I32 namelen; const char *value;}',
+ PVN => '{const char *name; I32 namelen; const char *value; STRLEN len;}',
+ YES => '{const char *name; I32 namelen;}',
+ NO => '{const char *name; I32 namelen;}',
+ UNDEF => '{const char *name; I32 namelen;}',
+ '' => '{const char *name; I32 namelen;} ',
+ );
+
+%type_from_struct =
+ (
+ IV => sub { $_[0] . '->value' },
+ NV => sub { $_[0] . '->value' },
+ UV => sub { $_[0] . '->value' },
+ PV => sub { $_[0] . '->value' },
+ PVN => sub { $_[0] . '->value', $_[0] . '->len' },
+ YES => sub {},
+ NO => sub {},
+ UNDEF => sub {},
+ '' => sub {},
+ );
+
+%type_to_sv =
+ (
+ IV => sub { "newSViv($_[0])" },
+ NV => sub { "newSVnv($_[0])" },
+ UV => sub { "newSVuv($_[0])" },
+ PV => sub { "newSVpv($_[0], 0)" },
+ PVN => sub { "newSVpvn($_[0], $_[1])" },
+ YES => sub { '&PL_sv_yes' },
+ NO => sub { '&PL_sv_no' },
+ UNDEF => sub { '&PL_sv_undef' },
+ '' => sub { '&PL_sv_yes' },
+ SV => sub {"SvREFCNT_inc($_[0])"},
+ );
+
+%type_to_C_value =
+ (
+ YES => sub {},
+ NO => sub {},
+ UNDEF => sub {},
+ '' => sub {},
+ );
+
+sub type_to_C_value {
+ my ($self, $type) = @_;
+ return $type_to_C_value{$type} || sub {return map {ref $_ ? @$_ : $_} @_};
+}
+
+# TODO - figure out if there is a clean way for the type_to_sv code to
+# attempt s/sv_2mortal// and if it succeeds tell type_to_sv not to add
+# SvREFCNT_inc
+%type_is_a_problem =
+ (
+ # The documentation says *mortal SV*, but we now need a non-mortal copy.
+ SV => 1,
+ );
+
+%type_temporary =
+ (
+ SV => ['SV *'],
+ PV => ['const char *'],
+ PVN => ['const char *', 'STRLEN'],
+ );
+$type_temporary{$_} = [$_] foreach qw(IV UV NV);
+
+while (my ($type, $value) = each %XS_TypeSet) {
+ $type_num_args{$type}
+ = defined $value ? ref $value ? scalar @$value : 1 : 0;
+}
+$type_num_args{''} = 0;
+
+sub partition_names {
+ my ($self, $default_type, @items) = @_;
+ my (%found, @notfound, @trouble);
+
+ while (my $item = shift @items) {
+ my $default = delete $item->{default};
+ if ($default) {
+ # If we find a default value, convert it into a regular item and
+ # append it to the queue of items to process
+ my $default_item = {%$item};
+ $default_item->{invert_macro} = 1;
+ $default_item->{pre} = delete $item->{def_pre};
+ $default_item->{post} = delete $item->{def_post};
+ $default_item->{type} = shift @$default;
+ $default_item->{value} = $default;
+ push @items, $default_item;
+ } else {
+ # It can be "not found" unless it's the default (invert the macro)
+ # or the "macro" is an empty string (ie no macro)
+ push @notfound, $item unless $item->{invert_macro}
+ or !$self->macro_to_ifdef($self->macro_from_item($item));
+ }
+
+ if ($item->{pre} or $item->{post} or $item->{not_constant}
+ or $type_is_a_problem{$item->{type}}) {
+ push @trouble, $item;
+ } else {
+ push @{$found{$item->{type}}}, $item;
+ }
+ }
+ # use Data::Dumper; print Dumper \%found;
+ (\%found, \@notfound, \@trouble);
+}
+
+sub boottime_iterator {
+ my ($self, $type, $iterator, $hash, $subname) = @_;
+ my $extractor = $type_from_struct{$type};
+ die "Can't find extractor code for type $type"
+ unless defined $extractor;
+ my $generator = $type_to_sv{$type};
+ die "Can't find generator code for type $type"
+ unless defined $generator;
+
+ my $athx = $self->C_constant_prefix_param();
+
+ return sprintf <<"EOBOOT", &$generator(&$extractor($iterator));
+ while ($iterator->name) {
+ $subname($athx $hash, $iterator->name,
+ $iterator->namelen, %s);
+ ++$iterator;
+ }
+EOBOOT
+}
+
+sub name_len_value_macro {
+ my ($self, $item) = @_;
+ my $name = $item->{name};
+ my $value = $item->{value};
+ $value = $item->{name} unless defined $value;
+
+ my $namelen = length $name;
+ if ($name =~ tr/\0-\377// != $namelen) {
+ # the hash API signals UTF-8 by passing the length negated.
+ utf8::encode($name);
+ $namelen = -length $name;
+ }
+ $name = C_stringify($name);
+
+ my $macro = $self->macro_from_item($item);
+ ($name, $namelen, $value, $macro);
+}
+
+sub WriteConstants {
+ my $self = shift;
+ my $ARGS = {@_};
+
+ my ($c_fh, $xs_fh, $c_subname, $xs_subname, $default_type, $package)
+ = @{$ARGS}{qw(C_FH XS_FH C_SUBNAME XS_SUBNAME DEFAULT_TYPE NAME)};
+
+ my $options = $ARGS->{PROXYSUBS};
+ $options = {} unless ref $options;
+ my $explosives = $options->{croak_on_read};
+
+ $xs_subname ||= 'constant';
+
+ # If anyone is insane enough to suggest a package name containing %
+ my $package_sprintf_safe = $package;
+ $package_sprintf_safe =~ s/%/%%/g;
+
+ # All the types we see
+ my $what = {};
+ # A hash to lookup items with.
+ my $items = {};
+
+ my @items = $self->normalise_items ({disable_utf8_duplication => 1},
+ $default_type, $what, $items,
+ @{$ARGS->{NAMES}});
+
+ # Partition the values by type. Also include any defaults in here
+ # Everything that doesn't have a default needs alternative code for
+ # "I'm missing"
+ # And everything that has pre or post code ends up in a private block
+ my ($found, $notfound, $trouble)
+ = $self->partition_names($default_type, @items);
+
+ my $pthx = $self->C_constant_prefix_param_defintion();
+ my $athx = $self->C_constant_prefix_param();
+ my $symbol_table = C_stringify($package) . '::';
+
+ my $can_do_pcs = $] >= 5.009;
+ my $cast_CONSTSUB = $] < 5.010 ? '(char *)' : '';
+
+ print $c_fh $self->header(), <<"EOADD";
+static void
+${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value) {
+EOADD
+ if (!$can_do_pcs) {
+ print $c_fh <<'EO_NOPCS';
+ if (namelen == namelen) {
+EO_NOPCS
+ } else {
+ print $c_fh <<"EO_PCS";
+ SV **sv = hv_fetch(hash, name, namelen, TRUE);
+ if (!sv) {
+ Perl_croak($athx "Couldn't add key '%s' to %%$package_sprintf_safe\::",
+ name);
+ }
+ if (SvOK(*sv) || SvTYPE(*sv) == SVt_PVGV) {
+ /* Someone has been here before us - have to make a real sub. */
+EO_PCS
+ }
+ # This piece of code is common to both
+ print $c_fh <<"EOADD";
+ newCONSTSUB(hash, ${cast_CONSTSUB}name, value);
+EOADD
+ if ($can_do_pcs) {
+ print $c_fh <<'EO_PCS';
+ } else {
+ SvUPGRADE(*sv, SVt_RV);
+ SvRV_set(*sv, value);
+ SvROK_on(*sv);
+ SvREADONLY_on(value);
+ }
+EO_PCS
+ } else {
+ print $c_fh <<'EO_NOPCS';
+ }
+EO_NOPCS
+ }
+ print $c_fh <<'EOADD';
+}
+
+EOADD
+
+ print $c_fh $explosives ? <<"EXPLODE" : "\n";
+
+static int
+Im_sorry_Dave(pTHX_ SV *sv, MAGIC *mg)
+{
+ PERL_UNUSED_ARG(mg);
+ Perl_croak(aTHX_
+ "Your vendor has not defined $package_sprintf_safe macro %"SVf
+ " used", sv);
+ NORETURN_FUNCTION_END;
+}
+
+static MGVTBL not_defined_vtbl = {
+ Im_sorry_Dave, /* get - I'm afraid I can't do that */
+ Im_sorry_Dave, /* set */
+ 0, /* len */
+ 0, /* clear */
+ 0, /* free */
+ 0, /* copy */
+ 0, /* dup */
+};
+
+EXPLODE
+
+{
+ my $key = $symbol_table;
+ # Just seems tidier (and slightly more space efficient) not to have keys
+ # such as Fcntl::
+ $key =~ s/::$//;
+ my $key_len = length $key;
+
+ print $c_fh <<"MISSING";
+
+#ifndef SYMBIAN
+
+/* Store a hash of all symbols missing from the package. To avoid trampling on
+ the package namespace (uninvited) put each package's hash in our namespace.
+ To avoid creating lots of typeblogs and symbol tables for sub-packages, put
+ each package's hash into one hash in our namespace. */
+
+static HV *
+get_missing_hash(pTHX) {
+ HV *const parent
+ = get_hv("ExtUtils::Constant::ProxySubs::Missing", GVf_MULTI);
+ /* We could make a hash of hashes directly, but this would confuse anything
+ at Perl space that looks at us, and as we're visible in Perl space,
+ best to play nice. */
+ SV *const *const ref
+ = hv_fetch(parent, "$key", $key_len, TRUE);
+ HV *new_hv;
+
+ if (!ref)
+ return NULL;
+
+ if (SvROK(*ref))
+ return (HV*) SvRV(*ref);
+
+ new_hv = newHV();
+ SvUPGRADE(*ref, SVt_RV);
+ SvRV_set(*ref, (SV *)new_hv);
+ SvROK_on(*ref);
+ return new_hv;
+}
+
+#endif
+
+MISSING
+
+}
+
+ print $xs_fh <<"EOBOOT";
+BOOT:
+ {
+#ifdef dTHX
+ dTHX;
+#endif
+ HV *symbol_table = get_hv("$symbol_table", GV_ADD);
+#ifndef SYMBIAN
+ HV *${c_subname}_missing;
+#endif
+EOBOOT
+
+ my %iterator;
+
+ $found->{''}
+ = [map {{%$_, type=>'', invert_macro => 1}} @$notfound];
+
+ foreach my $type (sort keys %$found) {
+ my $struct = $type_to_struct{$type};
+ my $type_to_value = $self->type_to_C_value($type);
+ my $number_of_args = $type_num_args{$type};
+ die "Can't find structure definition for type $type"
+ unless defined $struct;
+
+ my $struct_type = $type ? lc($type) . '_s' : 'notfound_s';
+ print $c_fh "struct $struct_type $struct;\n";
+
+ my $array_name = 'values_for_' . ($type ? lc $type : 'notfound');
+ print $xs_fh <<"EOBOOT";
+
+ static const struct $struct_type $array_name\[] =
+ {
+EOBOOT
+
+
+ foreach my $item (@{$found->{$type}}) {
+ my ($name, $namelen, $value, $macro)
+ = $self->name_len_value_macro($item);
+
+ my $ifdef = $self->macro_to_ifdef($macro);
+ if (!$ifdef && $item->{invert_macro}) {
+ carp("Attempting to supply a default for '$name' which has no conditional macro");
+ next;
+ }
+ print $xs_fh $ifdef;
+ if ($item->{invert_macro}) {
+ print $xs_fh
+ " /* This is the default value: */\n" if $type;
+ print $xs_fh "#else\n";
+ }
+ print $xs_fh " { ", join (', ', "\"$name\"", $namelen,
+ &$type_to_value($value)), " },\n",
+ $self->macro_to_endif($macro);
+ }
+
+
+ # Terminate the list with a NULL
+ print $xs_fh " { NULL, 0", (", 0" x $number_of_args), " } };\n";
+
+ $iterator{$type} = "value_for_" . ($type ? lc $type : 'notfound');
+
+ print $xs_fh <<"EOBOOT";
+ const struct $struct_type *$iterator{$type} = $array_name;
+EOBOOT
+ }
+
+ delete $found->{''};
+
+ print $xs_fh <<"EOBOOT";
+#ifndef SYMBIAN
+ ${c_subname}_missing = get_missing_hash(aTHX);
+#endif
+EOBOOT
+
+ my $add_symbol_subname = $c_subname . '_add_symbol';
+ foreach my $type (sort keys %$found) {
+ print $xs_fh $self->boottime_iterator($type, $iterator{$type},
+ 'symbol_table',
+ $add_symbol_subname);
+ }
+
+ print $xs_fh <<"EOBOOT";
+ while (value_for_notfound->name) {
+EOBOOT
+
+ print $xs_fh $explosives ? <<"EXPLODE" : << "DONT";
+ SV *tripwire = newSV(0);
+
+ sv_magicext(tripwire, 0, PERL_MAGIC_ext, &not_defined_vtbl, 0, 0);
+ SvPV_set(tripwire, (char *)value_for_notfound->name);
+ if(value_for_notfound->namelen >= 0) {
+ SvCUR_set(tripwire, value_for_notfound->namelen);
+ } else {
+ SvCUR_set(tripwire, -value_for_notfound->namelen);
+ SvUTF8_on(tripwire);
+ }
+ SvPOKp_on(tripwire);
+ SvREADONLY_on(tripwire);
+ assert(SvLEN(tripwire) == 0);
+
+ $add_symbol_subname($athx symbol_table, value_for_notfound->name,
+ value_for_notfound->namelen, tripwire);
+EXPLODE
+
+ /* Need to add prototypes, else parsing will vary by platform. */
+ SV **sv = hv_fetch(symbol_table, value_for_notfound->name,
+ value_for_notfound->namelen, TRUE);
+ if (!sv) {
+ Perl_croak($athx
+ "Couldn't add key '%s' to %%$package_sprintf_safe\::",
+ value_for_notfound->name);
+ }
+ if (!SvOK(*sv) && SvTYPE(*sv) != SVt_PVGV) {
+ /* Nothing was here before, so mark a prototype of "" */
+ sv_setpvn(*sv, "", 0);
+ } else if (SvPOK(*sv) && SvCUR(*sv) == 0) {
+ /* There is already a prototype of "" - do nothing */
+ } else {
+ /* Someone has been here before us - have to make a real
+ typeglob. */
+ /* It turns out to be incredibly hard to deal with all the
+ corner cases of sub foo (); and reporting errors correctly,
+ so lets cheat a bit. Start with a constant subroutine */
+ CV *cv = newCONSTSUB(symbol_table,
+ ${cast_CONSTSUB}value_for_notfound->name,
+ &PL_sv_yes);
+ /* and then turn it into a non constant declaration only. */
+ SvREFCNT_dec(CvXSUBANY(cv).any_ptr);
+ CvCONST_off(cv);
+ CvXSUB(cv) = NULL;
+ CvXSUBANY(cv).any_ptr = NULL;
+ }
+#ifndef SYMBIAN
+ if (!hv_store(${c_subname}_missing, value_for_notfound->name,
+ value_for_notfound->namelen, &PL_sv_yes, 0))
+ Perl_croak($athx "Couldn't add key '%s' to missing_hash",
+ value_for_notfound->name);
+#endif
+DONT
+
+ print $xs_fh <<"EOBOOT";
+
+ ++value_for_notfound;
+ }
+EOBOOT
+
+ foreach my $item (@$trouble) {
+ my ($name, $namelen, $value, $macro)
+ = $self->name_len_value_macro($item);
+ my $ifdef = $self->macro_to_ifdef($macro);
+ my $type = $item->{type};
+ my $type_to_value = $self->type_to_C_value($type);
+
+ print $xs_fh $ifdef;
+ if ($item->{invert_macro}) {
+ print $xs_fh
+ " /* This is the default value: */\n" if $type;
+ print $xs_fh "#else\n";
+ }
+ my $generator = $type_to_sv{$type};
+ die "Can't find generator code for type $type"
+ unless defined $generator;
+
+ print $xs_fh " {\n";
+ # We need to use a temporary value because some really troublesome
+ # items use C pre processor directives in their values, and in turn
+ # these don't fit nicely in the macro-ised generator functions
+ my $counter = 0;
+ printf $xs_fh " %s temp%d;\n", $_, $counter++
+ foreach @{$type_temporary{$type}};
+
+ print $xs_fh " $item->{pre}\n" if $item->{pre};
+
+ # And because the code in pre might be both declarations and
+ # statements, we can't declare and assign to the temporaries in one.
+ $counter = 0;
+ printf $xs_fh " temp%d = %s;\n", $counter++, $_
+ foreach &$type_to_value($value);
+
+ my @tempvarnames = map {sprintf 'temp%d', $_} 0 .. $counter - 1;
+ printf $xs_fh <<"EOBOOT", $name, &$generator(@tempvarnames);
+ ${c_subname}_add_symbol($athx symbol_table, "%s",
+ $namelen, %s);
+EOBOOT
+ print $xs_fh " $item->{post}\n" if $item->{post};
+ print $xs_fh " }\n";
+
+ print $xs_fh $self->macro_to_endif($macro);
+ }
+
+ print $xs_fh <<EOBOOT;
+ /* As we've been creating subroutines, we better invalidate any cached
+ methods */
+ ++PL_sub_generation;
+ }
+EOBOOT
+
+ print $xs_fh $explosives ? <<"EXPLODE" : <<"DONT";
+
+void
+$xs_subname(sv)
+ INPUT:
+ SV * sv;
+ PPCODE:
+ sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf
+ ", used", sv);
+ PUSHs(sv_2mortal(sv));
+EXPLODE
+
+void
+$xs_subname(sv)
+ PREINIT:
+ STRLEN len;
+ INPUT:
+ SV * sv;
+ const char * s = SvPV(sv, len);
+ PPCODE:
+#ifdef SYMBIAN
+ sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro", sv);
+#else
+ HV *${c_subname}_missing = get_missing_hash(aTHX);
+ if (hv_exists(${c_subname}_missing, s, SvUTF8(sv) ? -(I32)len : (I32)len)) {
+ sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf
+ ", used", sv);
+ } else {
+ sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro",
+ sv);
+ }
+#endif
+ PUSHs(sv_2mortal(sv));
+DONT
+
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm
new file mode 100644
index 00000000000..016507c72a6
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm
@@ -0,0 +1,131 @@
+package ExtUtils::Constant::Utils;
+
+use strict;
+use vars qw($VERSION @EXPORT_OK @ISA $is_perl56);
+use Carp;
+
+@ISA = 'Exporter';
+@EXPORT_OK = qw(C_stringify perl_stringify);
+$VERSION = '0.02';
+
+$is_perl56 = ($] < 5.007 && $] > 5.005_50);
+
+=head1 NAME
+
+ExtUtils::Constant::Utils - helper functions for ExtUtils::Constant
+
+=head1 SYNOPSIS
+
+ use ExtUtils::Constant::Utils qw (C_stringify);
+ $C_code = C_stringify $stuff;
+
+=head1 DESCRIPTION
+
+ExtUtils::Constant::Utils packages up utility subroutines used by
+ExtUtils::Constant, ExtUtils::Constant::Base and derived classes. All its
+functions are explicitly exportable.
+
+=head1 USAGE
+
+=over 4
+
+=item C_stringify NAME
+
+A function which returns a 7 bit ASCII correctly \ escaped version of the
+string passed suitable for C's "" or ''. It will die if passed Unicode
+characters.
+
+=cut
+
+# Hopefully make a happy C identifier.
+sub C_stringify {
+ local $_ = shift;
+ return unless defined $_;
+ # grr 5.6.1
+ confess "Wide character in '$_' intended as a C identifier"
+ if tr/\0-\377// != length;
+ # grr 5.6.1 moreso because its regexps will break on data that happens to
+ # be utf8, which includes my 8 bit test cases.
+ $_ = pack 'C*', unpack 'U*', $_ . pack 'U*' if $is_perl56;
+ s/\\/\\\\/g;
+ s/([\"\'])/\\$1/g; # Grr. fix perl mode.
+ s/\n/\\n/g; # Ensure newlines don't end up in octal
+ s/\r/\\r/g;
+ s/\t/\\t/g;
+ s/\f/\\f/g;
+ s/\a/\\a/g;
+ if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike.
+ s/([[:^print:]])/sprintf "\\%03o", ord $1/ge;
+ } else {
+ s/([^\0-\177])/sprintf "\\%03o", ord $1/ge;
+ }
+ unless ($] < 5.006) {
+ # This will elicit a warning on 5.005_03 about [: :] being reserved unless
+ # I cheat
+ my $cheat = '([[:^print:]])';
+ s/$cheat/sprintf "\\%03o", ord $1/ge;
+ } else {
+ require POSIX;
+ s/([^A-Za-z0-9_])/POSIX::isprint($1) ? $1 : sprintf "\\%03o", ord $1/ge;
+ }
+ $_;
+}
+
+=item perl_stringify NAME
+
+A function which returns a 7 bit ASCII correctly \ escaped version of the
+string passed suitable for a perl "" string.
+
+=cut
+
+# Hopefully make a happy perl identifier.
+sub perl_stringify {
+ local $_ = shift;
+ return unless defined $_;
+ s/\\/\\\\/g;
+ s/([\"\'])/\\$1/g; # Grr. fix perl mode.
+ s/\n/\\n/g; # Ensure newlines don't end up in octal
+ s/\r/\\r/g;
+ s/\t/\\t/g;
+ s/\f/\\f/g;
+ s/\a/\\a/g;
+ unless ($] < 5.006) {
+ if ($] > 5.007) {
+ if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike.
+ s/([[:^print:]])/sprintf "\\x{%X}", ord $1/ge;
+ } else {
+ s/([^\0-\177])/sprintf "\\x{%X}", ord $1/ge;
+ }
+ } else {
+ # Grr 5.6.1. And I don't think I can use utf8; to force the regexp
+ # because 5.005_03 will fail.
+ # This is grim, but I also can't split on //
+ my $copy;
+ foreach my $index (0 .. length ($_) - 1) {
+ my $char = substr ($_, $index, 1);
+ $copy .= ($char le "\177") ? $char : sprintf "\\x{%X}", ord $char;
+ }
+ $_ = $copy;
+ }
+ # This will elicit a warning on 5.005_03 about [: :] being reserved unless
+ # I cheat
+ my $cheat = '([[:^print:]])';
+ s/$cheat/sprintf "\\%03o", ord $1/ge;
+ } else {
+ # Turns out "\x{}" notation only arrived with 5.6
+ s/([^\0-\177])/sprintf "\\x%02X", ord $1/ge;
+ require POSIX;
+ s/([^A-Za-z0-9_])/POSIX::isprint($1) ? $1 : sprintf "\\%03o", ord $1/ge;
+ }
+ $_;
+}
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and
+others
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/XS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/XS.pm
new file mode 100644
index 00000000000..14eb8097146
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/XS.pm
@@ -0,0 +1,259 @@
+package ExtUtils::Constant::XS;
+
+use strict;
+use vars qw($VERSION %XS_Constant %XS_TypeSet @ISA @EXPORT_OK $is_perl56);
+use Carp;
+use ExtUtils::Constant::Utils 'perl_stringify';
+require ExtUtils::Constant::Base;
+
+
+@ISA = qw(ExtUtils::Constant::Base Exporter);
+@EXPORT_OK = qw(%XS_Constant %XS_TypeSet);
+
+$VERSION = '0.03';
+
+$is_perl56 = ($] < 5.007 && $] > 5.005_50);
+
+=head1 NAME
+
+ExtUtils::Constant::XS - generate C code for XS modules' constants.
+
+=head1 SYNOPSIS
+
+ require ExtUtils::Constant::XS;
+
+=head1 DESCRIPTION
+
+ExtUtils::Constant::XS overrides ExtUtils::Constant::Base to generate C
+code for XS modules' constants.
+
+=head1 BUGS
+
+Nothing is documented.
+
+Probably others.
+
+=head1 AUTHOR
+
+Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and
+others
+
+=cut
+
+# '' is used as a flag to indicate non-ascii macro names, and hence the need
+# to pass in the utf8 on/off flag.
+%XS_Constant = (
+ '' => '',
+ IV => 'PUSHi(iv)',
+ UV => 'PUSHu((UV)iv)',
+ NV => 'PUSHn(nv)',
+ PV => 'PUSHp(pv, strlen(pv))',
+ PVN => 'PUSHp(pv, iv)',
+ SV => 'PUSHs(sv)',
+ YES => 'PUSHs(&PL_sv_yes)',
+ NO => 'PUSHs(&PL_sv_no)',
+ UNDEF => '', # implicit undef
+);
+
+%XS_TypeSet = (
+ IV => '*iv_return = ',
+ UV => '*iv_return = (IV)',
+ NV => '*nv_return = ',
+ PV => '*pv_return = ',
+ PVN => ['*pv_return = ', '*iv_return = (IV)'],
+ SV => '*sv_return = ',
+ YES => undef,
+ NO => undef,
+ UNDEF => undef,
+);
+
+sub header {
+ my $start = 1;
+ my @lines;
+ push @lines, "#define PERL_constant_NOTFOUND\t$start\n"; $start++;
+ push @lines, "#define PERL_constant_NOTDEF\t$start\n"; $start++;
+ foreach (sort keys %XS_Constant) {
+ next if $_ eq '';
+ push @lines, "#define PERL_constant_IS$_\t$start\n"; $start++;
+ }
+ push @lines, << 'EOT';
+
+#ifndef NVTYPE
+typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */
+#endif
+#ifndef aTHX_
+#define aTHX_ /* 5.6 or later define this for threading support. */
+#endif
+#ifndef pTHX_
+#define pTHX_ /* 5.6 or later define this for threading support. */
+#endif
+EOT
+
+ return join '', @lines;
+}
+
+sub valid_type {
+ my ($self, $type) = @_;
+ return exists $XS_TypeSet{$type};
+}
+
+# This might actually be a return statement
+sub assignment_clause_for_type {
+ my $self = shift;
+ my $args = shift;
+ my $type = $args->{type};
+ my $typeset = $XS_TypeSet{$type};
+ if (ref $typeset) {
+ die "Type $type is aggregate, but only single value given"
+ if @_ == 1;
+ return map {"$typeset->[$_]$_[$_];"} 0 .. $#$typeset;
+ } elsif (defined $typeset) {
+ confess "Aggregate value given for type $type"
+ if @_ > 1;
+ return "$typeset$_[0];";
+ }
+ return ();
+}
+
+sub return_statement_for_type {
+ my ($self, $type) = @_;
+ # In the future may pass in an options hash
+ $type = $type->{type} if ref $type;
+ "return PERL_constant_IS$type;";
+}
+
+sub return_statement_for_notdef {
+ # my ($self) = @_;
+ "return PERL_constant_NOTDEF;";
+}
+
+sub return_statement_for_notfound {
+ # my ($self) = @_;
+ "return PERL_constant_NOTFOUND;";
+}
+
+sub default_type {
+ 'IV';
+}
+
+sub macro_from_name {
+ my ($self, $item) = @_;
+ my $macro = $item->{name};
+ $macro = $item->{value} unless defined $macro;
+ $macro;
+}
+
+sub macro_from_item {
+ my ($self, $item) = @_;
+ my $macro = $item->{macro};
+ $macro = $self->macro_from_name($item) unless defined $macro;
+ $macro;
+}
+
+# Keep to the traditional perl source macro
+sub memEQ {
+ "memEQ";
+}
+
+sub params {
+ my ($self, $what) = @_;
+ foreach (sort keys %$what) {
+ warn "ExtUtils::Constant doesn't know how to handle values of type $_" unless defined $XS_Constant{$_};
+ }
+ my $params = {};
+ $params->{''} = 1 if $what->{''};
+ $params->{IV} = 1 if $what->{IV} || $what->{UV} || $what->{PVN};
+ $params->{NV} = 1 if $what->{NV};
+ $params->{PV} = 1 if $what->{PV} || $what->{PVN};
+ $params->{SV} = 1 if $what->{SV};
+ return $params;
+}
+
+
+sub C_constant_prefix_param {
+ "aTHX_ ";
+}
+
+sub C_constant_prefix_param_defintion {
+ "pTHX_ ";
+}
+
+sub namelen_param_definition {
+ 'STRLEN ' . $_[0] -> namelen_param;
+}
+
+sub C_constant_other_params_defintion {
+ my ($self, $params) = @_;
+ my $body = '';
+ $body .= ", int utf8" if $params->{''};
+ $body .= ", IV *iv_return" if $params->{IV};
+ $body .= ", NV *nv_return" if $params->{NV};
+ $body .= ", const char **pv_return" if $params->{PV};
+ $body .= ", SV **sv_return" if $params->{SV};
+ $body;
+}
+
+sub C_constant_other_params {
+ my ($self, $params) = @_;
+ my $body = '';
+ $body .= ", utf8" if $params->{''};
+ $body .= ", iv_return" if $params->{IV};
+ $body .= ", nv_return" if $params->{NV};
+ $body .= ", pv_return" if $params->{PV};
+ $body .= ", sv_return" if $params->{SV};
+ $body;
+}
+
+sub dogfood {
+ my ($self, $args, @items) = @_;
+ my ($package, $subname, $default_type, $what, $indent, $breakout) =
+ @{$args}{qw(package subname default_type what indent breakout)};
+ my $result = <<"EOT";
+ /* When generated this function returned values for the list of names given
+ in this section of perl code. Rather than manually editing these functions
+ to add or remove constants, which would result in this comment and section
+ of code becoming inaccurate, we recommend that you edit this section of
+ code, and use it to regenerate a new set of constant functions which you
+ then use to replace the originals.
+
+ Regenerate these constant functions by feeding this entire source file to
+ perl -x
+
+#!$^X -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+EOT
+ $result .= $self->dump_names ({default_type=>$default_type, what=>$what,
+ indent=>0, declare_types=>1},
+ @items);
+ $result .= <<'EOT';
+
+print constant_types(), "\n"; # macro defs
+EOT
+ $package = perl_stringify($package);
+ $result .=
+ "foreach (C_constant (\"$package\", '$subname', '$default_type', \$types, ";
+ # The form of the indent parameter isn't defined. (Yet)
+ if (defined $indent) {
+ require Data::Dumper;
+ $Data::Dumper::Terse=1;
+ $Data::Dumper::Terse=1; # Not used once. :-)
+ chomp ($indent = Data::Dumper::Dumper ($indent));
+ $result .= $indent;
+ } else {
+ $result .= 'undef';
+ }
+ $result .= ", $breakout" . ', @names) ) {
+ print $_, "\n"; # C constant subs
+}
+print "\n#### XS Section:\n";
+print XS_constant ("' . $package . '", $types);
+__END__
+ */
+
+';
+
+ $result;
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm
new file mode 100644
index 00000000000..24ae9092f52
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm
@@ -0,0 +1,511 @@
+# $Id: Embed.pm,v 1.1.1.1 2002/01/16 19:27:19 schwern Exp $
+require 5.002;
+
+package ExtUtils::Embed;
+require Exporter;
+require FileHandle;
+use Config;
+use Getopt::Std;
+use File::Spec;
+
+#Only when we need them
+#require ExtUtils::MakeMaker;
+#require ExtUtils::Liblist;
+
+use vars qw(@ISA @EXPORT $VERSION
+ @Extensions $Verbose $lib_ext
+ $opt_o $opt_s
+ );
+use strict;
+
+# This is not a dual-life module, so no need for development version numbers
+$VERSION = '1.28';
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&xsinit &ldopts
+ &ccopts &ccflags &ccdlflags &perl_inc
+ &xsi_header &xsi_protos &xsi_body);
+
+#let's have Miniperl borrow from us instead
+#require ExtUtils::Miniperl;
+#*canon = \&ExtUtils::Miniperl::canon;
+
+$Verbose = 0;
+$lib_ext = $Config{lib_ext} || '.a';
+
+sub is_cmd { $0 eq '-e' }
+
+sub my_return {
+ my $val = shift;
+ if(is_cmd) {
+ print $val;
+ }
+ else {
+ return $val;
+ }
+}
+
+sub xsinit {
+ my($file, $std, $mods) = @_;
+ my($fh,@mods,%seen);
+ $file ||= "perlxsi.c";
+ my $xsinit_proto = "pTHX";
+
+ if (@_) {
+ @mods = @$mods if $mods;
+ }
+ else {
+ getopts('o:s:');
+ $file = $opt_o if defined $opt_o;
+ $std = $opt_s if defined $opt_s;
+ @mods = @ARGV;
+ }
+ $std = 1 unless scalar @mods;
+
+ if ($file eq "STDOUT") {
+ $fh = \*STDOUT;
+ }
+ else {
+ $fh = new FileHandle "> $file";
+ }
+
+ push(@mods, static_ext()) if defined $std;
+ @mods = grep(!$seen{$_}++, @mods);
+
+ print $fh &xsi_header();
+ print $fh "EXTERN_C void xs_init ($xsinit_proto);\n\n";
+ print $fh &xsi_protos(@mods);
+
+ print $fh "\nEXTERN_C void\nxs_init($xsinit_proto)\n{\n";
+ print $fh &xsi_body(@mods);
+ print $fh "}\n";
+
+}
+
+sub xsi_header {
+ return <<EOF;
+#include <EXTERN.h>
+#include <perl.h>
+
+EOF
+}
+
+sub xsi_protos {
+ my(@exts) = @_;
+ my(@retval,%seen);
+ my $boot_proto = "pTHX_ CV* cv";
+ foreach $_ (@exts){
+ my($pname) = canon('/', $_);
+ my($mname, $cname);
+ ($mname = $pname) =~ s!/!::!g;
+ ($cname = $pname) =~ s!/!__!g;
+ my($ccode) = "EXTERN_C void boot_${cname} ($boot_proto);\n";
+ next if $seen{$ccode}++;
+ push(@retval, $ccode);
+ }
+ return join '', @retval;
+}
+
+sub xsi_body {
+ my(@exts) = @_;
+ my($pname,@retval,%seen);
+ my($dl) = canon('/','DynaLoader');
+ push(@retval, "\tchar *file = __FILE__;\n");
+ push(@retval, "\tdXSUB_SYS;\n") if $] > 5.002;
+ push(@retval, "\n");
+
+ foreach $_ (@exts){
+ my($pname) = canon('/', $_);
+ my($mname, $cname, $ccode);
+ ($mname = $pname) =~ s!/!::!g;
+ ($cname = $pname) =~ s!/!__!g;
+ if ($pname eq $dl){
+ # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+ # boot_DynaLoader is called directly in DynaLoader.pm
+ $ccode = "\t/* DynaLoader is a special case */\n\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
+ push(@retval, $ccode) unless $seen{$ccode}++;
+ } else {
+ $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
+ push(@retval, $ccode) unless $seen{$ccode}++;
+ }
+ }
+ return join '', @retval;
+}
+
+sub static_ext {
+ unless (scalar @Extensions) {
+ my $static_ext = $Config{static_ext};
+ $static_ext =~ s/^\s+//;
+ @Extensions = sort split /\s+/, $static_ext;
+ unshift @Extensions, qw(DynaLoader);
+ }
+ @Extensions;
+}
+
+sub _escape {
+ my $arg = shift;
+ $$arg =~ s/([\(\)])/\\$1/g;
+}
+
+sub _ldflags {
+ my $ldflags = $Config{ldflags};
+ _escape(\$ldflags);
+ return $ldflags;
+}
+
+sub _ccflags {
+ my $ccflags = $Config{ccflags};
+ _escape(\$ccflags);
+ return $ccflags;
+}
+
+sub _ccdlflags {
+ my $ccdlflags = $Config{ccdlflags};
+ _escape(\$ccdlflags);
+ return $ccdlflags;
+}
+
+sub ldopts {
+ require ExtUtils::MakeMaker;
+ require ExtUtils::Liblist;
+ my($std,$mods,$link_args,$path) = @_;
+ my(@mods,@link_args,@argv);
+ my($dllib,$config_libs,@potential_libs,@path);
+ local($") = ' ' unless $" eq ' ';
+ if (scalar @_) {
+ @link_args = @$link_args if $link_args;
+ @mods = @$mods if $mods;
+ }
+ else {
+ @argv = @ARGV;
+ #hmm
+ while($_ = shift @argv) {
+ /^-std$/ && do { $std = 1; next; };
+ /^--$/ && do { @link_args = @argv; last; };
+ /^-I(.*)/ && do { $path = $1 || shift @argv; next; };
+ push(@mods, $_);
+ }
+ }
+ $std = 1 unless scalar @link_args;
+ my $sep = $Config{path_sep} || ':';
+ @path = $path ? split(/\Q$sep/, $path) : @INC;
+
+ push(@potential_libs, @link_args) if scalar @link_args;
+ # makemaker includes std libs on windows by default
+ if ($^O ne 'MSWin32' and defined($std)) {
+ push(@potential_libs, $Config{perllibs});
+ }
+
+ push(@mods, static_ext()) if $std;
+
+ my($mod,@ns,$root,$sub,$extra,$archive,@archives);
+ print STDERR "Searching (@path) for archives\n" if $Verbose;
+ foreach $mod (@mods) {
+ @ns = split(/::|\/|\\/, $mod);
+ $sub = $ns[-1];
+ $root = File::Spec->catdir(@ns);
+
+ print STDERR "searching for '$sub${lib_ext}'\n" if $Verbose;
+ foreach (@path) {
+ next unless -e ($archive = File::Spec->catdir($_,"auto",$root,"$sub$lib_ext"));
+ push @archives, $archive;
+ if(-e ($extra = File::Spec->catdir($_,"auto",$root,"extralibs.ld"))) {
+ local(*FH);
+ if(open(FH, $extra)) {
+ my($libs) = <FH>; chomp $libs;
+ push @potential_libs, split /\s+/, $libs;
+ }
+ else {
+ warn "Couldn't open '$extra'";
+ }
+ }
+ last;
+ }
+ }
+ #print STDERR "\@potential_libs = @potential_libs\n";
+
+ my $libperl;
+ if ($^O eq 'MSWin32') {
+ $libperl = $Config{libperl};
+ }
+ elsif ($^O eq 'os390' && $Config{usedl}) {
+ # Nothing for OS/390 (z/OS) dynamic.
+ } else {
+ $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0]
+ || ($Config{libperl} =~ /^lib(\w+)(\Q$lib_ext\E|\.\Q$Config{dlext}\E)$/
+ ? "-l$1" : '')
+ || "-lperl";
+ }
+
+ my $lpath = File::Spec->catdir($Config{archlibexp}, 'CORE');
+ $lpath = qq["$lpath"] if $^O eq 'MSWin32';
+ my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) =
+ MM->ext(join ' ', "-L$lpath", $libperl, @potential_libs);
+
+ my $ld_or_bs = $bsloadlibs || $ldloadlibs;
+ print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose;
+ my $ccdlflags = _ccdlflags();
+ my $ldflags = _ldflags();
+ my $linkage = "$ccdlflags $ldflags @archives $ld_or_bs";
+ print STDERR "ldopts: '$linkage'\n" if $Verbose;
+
+ return $linkage if scalar @_;
+ my_return("$linkage\n");
+}
+
+sub ccflags {
+ my $ccflags = _ccflags();
+ my_return(" $ccflags ");
+}
+
+sub ccdlflags {
+ my $ccdlflags = _ccdlflags();
+ my_return(" $ccdlflags ");
+}
+
+sub perl_inc {
+ my $dir = File::Spec->catdir($Config{archlibexp}, 'CORE');
+ $dir = qq["$dir"] if $^O eq 'MSWin32';
+ my_return(" -I$dir ");
+}
+
+sub ccopts {
+ ccflags . perl_inc;
+}
+
+sub canon {
+ my($as, @ext) = @_;
+ foreach(@ext) {
+ # might be X::Y or lib/auto/X/Y/Y.a
+ next if s!::!/!g;
+ s:^(lib|ext)/(auto/)?::;
+ s:/\w+\.\w+$::;
+ }
+ map(s:/:$as:, @ext) if ($as ne '/');
+ @ext;
+}
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications
+
+=head1 SYNOPSIS
+
+
+ perl -MExtUtils::Embed -e xsinit
+ perl -MExtUtils::Embed -e ccopts
+ perl -MExtUtils::Embed -e ldopts
+
+=head1 DESCRIPTION
+
+ExtUtils::Embed provides utility functions for embedding a Perl interpreter
+and extensions in your C/C++ applications.
+Typically, an application B<Makefile> will invoke ExtUtils::Embed
+functions while building your application.
+
+=head1 @EXPORT
+
+ExtUtils::Embed exports the following functions:
+
+xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(),
+ccdlflags(), xsi_header(), xsi_protos(), xsi_body()
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item xsinit()
+
+Generate C/C++ code for the XS initializer function.
+
+When invoked as C<`perl -MExtUtils::Embed -e xsinit --`>
+the following options are recognized:
+
+B<-o> E<lt>output filenameE<gt> (Defaults to B<perlxsi.c>)
+
+B<-o STDOUT> will print to STDOUT.
+
+B<-std> (Write code for extensions that are linked with the current Perl.)
+
+Any additional arguments are expected to be names of modules
+to generate code for.
+
+When invoked with parameters the following are accepted and optional:
+
+C<xsinit($filename,$std,[@modules])>
+
+Where,
+
+B<$filename> is equivalent to the B<-o> option.
+
+B<$std> is boolean, equivalent to the B<-std> option.
+
+B<[@modules]> is an array ref, same as additional arguments mentioned above.
+
+=item Examples
+
+
+ perl -MExtUtils::Embed -e xsinit -- -o xsinit.c Socket
+
+
+This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function
+to the C B<boot_Socket> function and writes it to a file named F<xsinit.c>.
+
+Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly.
+
+ perl -MExtUtils::Embed -e xsinit
+
+
+This will generate code for linking with B<DynaLoader> and
+each static extension found in B<$Config{static_ext}>.
+The code is written to the default file name B<perlxsi.c>.
+
+
+ perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle
+
+
+Here, code is written for all the currently linked extensions along with code
+for B<DBI> and B<DBD::Oracle>.
+
+If you have a working B<DynaLoader> then there is rarely any need to statically link in any
+other extensions.
+
+=item ldopts()
+
+Output arguments for linking the Perl library and extensions to your
+application.
+
+When invoked as C<`perl -MExtUtils::Embed -e ldopts --`>
+the following options are recognized:
+
+B<-std>
+
+Output arguments for linking the Perl library and any extensions linked
+with the current Perl.
+
+B<-I> E<lt>path1:path2E<gt>
+
+Search path for ModuleName.a archives.
+Default path is B<@INC>.
+Library archives are expected to be found as
+B</some/path/auto/ModuleName/ModuleName.a>
+For example, when looking for B<Socket.a> relative to a search path,
+we should find B<auto/Socket/Socket.a>
+
+When looking for B<DBD::Oracle> relative to a search path,
+we should find B<auto/DBD/Oracle/Oracle.a>
+
+Keep in mind that you can always supply B</my/own/path/ModuleName.a>
+as an additional linker argument.
+
+B<--> E<lt>list of linker argsE<gt>
+
+Additional linker arguments to be considered.
+
+Any additional arguments found before the B<--> token
+are expected to be names of modules to generate code for.
+
+When invoked with parameters the following are accepted and optional:
+
+C<ldopts($std,[@modules],[@link_args],$path)>
+
+Where:
+
+B<$std> is boolean, equivalent to the B<-std> option.
+
+B<[@modules]> is equivalent to additional arguments found before the B<--> token.
+
+B<[@link_args]> is equivalent to arguments found after the B<--> token.
+
+B<$path> is equivalent to the B<-I> option.
+
+In addition, when ldopts is called with parameters, it will return the argument string
+rather than print it to STDOUT.
+
+=item Examples
+
+
+ perl -MExtUtils::Embed -e ldopts
+
+
+This will print arguments for linking with B<libperl> and
+extensions found in B<$Config{static_ext}>. This includes libraries
+found in B<$Config{libs}> and the first ModuleName.a library
+for each extension that is found by searching B<@INC> or the path
+specified by the B<-I> option.
+In addition, when ModuleName.a is found, additional linker arguments
+are picked up from the B<extralibs.ld> file in the same directory.
+
+
+ perl -MExtUtils::Embed -e ldopts -- -std Socket
+
+
+This will do the same as the above example, along with printing additional arguments for linking with the B<Socket> extension.
+
+ perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql
+
+Any arguments after the second '--' token are additional linker
+arguments that will be examined for potential conflict. If there is no
+conflict, the additional arguments will be part of the output.
+
+
+=item perl_inc()
+
+For including perl header files this function simply prints:
+
+ -I$Config{archlibexp}/CORE
+
+So, rather than having to say:
+
+ perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"'
+
+Just say:
+
+ perl -MExtUtils::Embed -e perl_inc
+
+=item ccflags(), ccdlflags()
+
+These functions simply print $Config{ccflags} and $Config{ccdlflags}
+
+=item ccopts()
+
+This function combines perl_inc(), ccflags() and ccdlflags() into one.
+
+=item xsi_header()
+
+This function simply returns a string defining the same B<EXTERN_C> macro as
+B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>.
+
+=item xsi_protos(@modules)
+
+This function returns a string of B<boot_$ModuleName> prototypes for each @modules.
+
+=item xsi_body(@modules)
+
+This function returns a string of calls to B<newXS()> that glue the module B<bootstrap>
+function to B<boot_ModuleName> for each @modules.
+
+B<xsinit()> uses the xsi_* functions to generate most of its code.
+
+=back
+
+=head1 EXAMPLES
+
+For examples on how to use B<ExtUtils::Embed> for building C/C++ applications
+with embedded perl, see L<perlembed>.
+
+=head1 SEE ALSO
+
+L<perlembed>
+
+=head1 AUTHOR
+
+Doug MacEachern E<lt>F<dougm@osf.org>E<gt>
+
+Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and
+B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce.
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm
new file mode 100644
index 00000000000..da583650fdf
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm
@@ -0,0 +1,1365 @@
+package ExtUtils::Install;
+use strict;
+
+use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config);
+
+use AutoSplit;
+use Carp ();
+use Config qw(%Config);
+use Cwd qw(cwd);
+use Exporter;
+use ExtUtils::Packlist;
+use File::Basename qw(dirname);
+use File::Compare qw(compare);
+use File::Copy;
+use File::Find qw(find);
+use File::Path;
+use File::Spec;
+
+
+@ISA = ('Exporter');
+@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
+
+=pod
+
+=head1 NAME
+
+ExtUtils::Install - install files from here to there
+
+=head1 SYNOPSIS
+
+ use ExtUtils::Install;
+
+ install({ 'blib/lib' => 'some/install/dir' } );
+
+ uninstall($packlist);
+
+ pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
+
+=head1 VERSION
+
+1.55
+
+=cut
+
+$VERSION = '1.55'; # <---- dont forget to update the POD section just above this line!
+$VERSION = eval $VERSION;
+
+=pod
+
+=head1 DESCRIPTION
+
+Handles the installing and uninstalling of perl modules, scripts, man
+pages, etc...
+
+Both install() and uninstall() are specific to the way
+ExtUtils::MakeMaker handles the installation and deinstallation of
+perl modules. They are not designed as general purpose tools.
+
+On some operating systems such as Win32 installation may not be possible
+until after a reboot has occured. This can have varying consequences:
+removing an old DLL does not impact programs using the new one, but if
+a new DLL cannot be installed properly until reboot then anything
+depending on it must wait. The package variable
+
+ $ExtUtils::Install::MUST_REBOOT
+
+is used to store this status.
+
+If this variable is true then such an operation has occured and
+anything depending on this module cannot proceed until a reboot
+has occured.
+
+If this value is defined but false then such an operation has
+ocurred, but should not impact later operations.
+
+=begin _private
+
+=over
+
+=item _chmod($$;$)
+
+Wrapper to chmod() for debugging and error trapping.
+
+=item _warnonce(@)
+
+Warns about something only once.
+
+=item _choke(@)
+
+Dies with a special message.
+
+=back
+
+=end _private
+
+=cut
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_VMS_noefs = $Is_VMS;
+my $Is_MacPerl = $^O eq 'MacOS';
+my $Is_Win32 = $^O eq 'MSWin32';
+my $Is_cygwin = $^O eq 'cygwin';
+my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin);
+
+ if( $Is_VMS ) {
+ my $vms_unix_rpt;
+ my $vms_efs;
+ my $vms_case;
+
+ if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+ $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+ $vms_efs = VMS::Feature::current("efs_charset");
+ $vms_case = VMS::Feature::current("efs_case_preserve");
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ $vms_case = $efs_case =~ /^[ET1]/i;
+ }
+ $Is_VMS_noefs = 0 if ($vms_efs);
+ }
+
+
+
+# *note* CanMoveAtBoot is only incidentally the same condition as below
+# this needs not hold true in the future.
+my $Has_Win32API_File = ($Is_Win32 || $Is_cygwin)
+ ? (eval {require Win32API::File; 1} || 0)
+ : 0;
+
+
+my $Inc_uninstall_warn_handler;
+
+# install relative to here
+
+my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
+
+my $Curdir = File::Spec->curdir;
+my $Updir = File::Spec->updir;
+
+sub _estr(@) {
+ return join "\n",'!' x 72,@_,'!' x 72,'';
+}
+
+{my %warned;
+sub _warnonce(@) {
+ my $first=shift;
+ my $msg=_estr "WARNING: $first",@_;
+ warn $msg unless $warned{$msg}++;
+}}
+
+sub _choke(@) {
+ my $first=shift;
+ my $msg=_estr "ERROR: $first",@_;
+ Carp::croak($msg);
+}
+
+
+sub _chmod($$;$) {
+ my ( $mode, $item, $verbose )=@_;
+ $verbose ||= 0;
+ if (chmod $mode, $item) {
+ printf "chmod(0%o, %s)\n",$mode, $item if $verbose > 1;
+ } else {
+ my $err="$!";
+ _warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n",
+ $mode, $item, $err
+ if -e $item;
+ }
+}
+
+=begin _private
+
+=over
+
+=item _move_file_at_boot( $file, $target, $moan )
+
+OS-Specific, Win32/Cygwin
+
+Schedules a file to be moved/renamed/deleted at next boot.
+$file should be a filespec of an existing file
+$target should be a ref to an array if the file is to be deleted
+otherwise it should be a filespec for a rename. If the file is existing
+it will be replaced.
+
+Sets $MUST_REBOOT to 0 to indicate a deletion operation has occured
+and sets it to 1 to indicate that a move operation has been requested.
+
+returns 1 on success, on failure if $moan is false errors are fatal.
+If $moan is true then returns 0 on error and warns instead of dies.
+
+=end _private
+
+=cut
+
+
+
+sub _move_file_at_boot { #XXX OS-SPECIFIC
+ my ( $file, $target, $moan )= @_;
+ Carp::confess("Panic: Can't _move_file_at_boot on this platform!")
+ unless $CanMoveAtBoot;
+
+ my $descr= ref $target
+ ? "'$file' for deletion"
+ : "'$file' for installation as '$target'";
+
+ if ( ! $Has_Win32API_File ) {
+
+ my @msg=(
+ "Cannot schedule $descr at reboot.",
+ "Try installing Win32API::File to allow operations on locked files",
+ "to be scheduled during reboot. Or try to perform the operation by",
+ "hand yourself. (You may need to close other perl processes first)"
+ );
+ if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
+ return 0;
+ }
+ my $opts= Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();
+ $opts= $opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()
+ unless ref $target;
+
+ _chmod( 0666, $file );
+ _chmod( 0666, $target ) unless ref $target;
+
+ if (Win32API::File::MoveFileEx( $file, $target, $opts )) {
+ $MUST_REBOOT ||= ref $target ? 0 : 1;
+ return 1;
+ } else {
+ my @msg=(
+ "MoveFileEx $descr at reboot failed: $^E",
+ "You may try to perform the operation by hand yourself. ",
+ "(You may need to close other perl processes first).",
+ );
+ if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
+ }
+ return 0;
+}
+
+
+=begin _private
+
+
+=item _unlink_or_rename( $file, $tryhard, $installing )
+
+OS-Specific, Win32/Cygwin
+
+Tries to get a file out of the way by unlinking it or renaming it. On
+some OS'es (Win32 based) DLL files can end up locked such that they can
+be renamed but not deleted. Likewise sometimes a file can be locked such
+that it cant even be renamed or changed except at reboot. To handle
+these cases this routine finds a tempfile name that it can either rename
+the file out of the way or use as a proxy for the install so that the
+rename can happen later (at reboot).
+
+ $file : the file to remove.
+ $tryhard : should advanced tricks be used for deletion
+ $installing : we are not merely deleting but we want to overwrite
+
+When $tryhard is not true if the unlink fails its fatal. When $tryhard
+is true then the file is attempted to be renamed. The renamed file is
+then scheduled for deletion. If the rename fails then $installing
+governs what happens. If it is false the failure is fatal. If it is true
+then an attempt is made to schedule installation at boot using a
+temporary file to hold the new file. If this fails then a fatal error is
+thrown, if it succeeds it returns the temporary file name (which will be
+a derivative of the original in the same directory) so that the caller can
+use it to install under. In all other cases of success returns $file.
+On failure throws a fatal error.
+
+=back
+
+=end _private
+
+=cut
+
+
+
+sub _unlink_or_rename { #XXX OS-SPECIFIC
+ my ( $file, $tryhard, $installing )= @_;
+
+ _chmod( 0666, $file );
+ my $unlink_count = 0;
+ while (unlink $file) { $unlink_count++; }
+ return $file if $unlink_count > 0;
+ my $error="$!";
+
+ _choke("Cannot unlink '$file': $!")
+ unless $CanMoveAtBoot && $tryhard;
+
+ my $tmp= "AAA";
+ ++$tmp while -e "$file.$tmp";
+ $tmp= "$file.$tmp";
+
+ warn "WARNING: Unable to unlink '$file': $error\n",
+ "Going to try to rename it to '$tmp'.\n";
+
+ if ( rename $file, $tmp ) {
+ warn "Rename succesful. Scheduling '$tmp'\nfor deletion at reboot.\n";
+ # when $installing we can set $moan to true.
+ # IOW, if we cant delete the renamed file at reboot its
+ # not the end of the world. The other cases are more serious
+ # and need to be fatal.
+ _move_file_at_boot( $tmp, [], $installing );
+ return $file;
+ } elsif ( $installing ) {
+ _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor".
+ " installation as '$file' at reboot.\n");
+ _move_file_at_boot( $tmp, $file );
+ return $tmp;
+ } else {
+ _choke("Rename failed:$!", "Cannot procede.");
+ }
+
+}
+
+
+=pod
+
+=head2 Functions
+
+=begin _private
+
+=over
+
+=item _get_install_skip
+
+Handles loading the INSTALL.SKIP file. Returns an array of patterns to use.
+
+=cut
+
+
+
+sub _get_install_skip {
+ my ( $skip, $verbose )= @_;
+ if ($ENV{EU_INSTALL_IGNORE_SKIP}) {
+ print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n"
+ if $verbose>2;
+ return [];
+ }
+ if ( ! defined $skip ) {
+ print "Looking for install skip list\n"
+ if $verbose>2;
+ for my $file ( 'INSTALL.SKIP', $ENV{EU_INSTALL_SITE_SKIPFILE} ) {
+ next unless $file;
+ print "\tChecking for $file\n"
+ if $verbose>2;
+ if (-e $file) {
+ $skip= $file;
+ last;
+ }
+ }
+ }
+ if ($skip && !ref $skip) {
+ print "Reading skip patterns from '$skip'.\n"
+ if $verbose;
+ if (open my $fh,$skip ) {
+ my @patterns;
+ while (<$fh>) {
+ chomp;
+ next if /^\s*(?:#|$)/;
+ print "\tSkip pattern: $_\n" if $verbose>3;
+ push @patterns, $_;
+ }
+ $skip= \@patterns;
+ } else {
+ warn "Can't read skip file:'$skip':$!\n";
+ $skip=[];
+ }
+ } elsif ( UNIVERSAL::isa($skip,'ARRAY') ) {
+ print "Using array for skip list\n"
+ if $verbose>2;
+ } elsif ($verbose) {
+ print "No skip list found.\n"
+ if $verbose>1;
+ $skip= [];
+ }
+ warn "Got @{[0+@$skip]} skip patterns.\n"
+ if $verbose>3;
+ return $skip
+}
+
+=pod
+
+=item _have_write_access
+
+Abstract a -w check that tries to use POSIX::access() if possible.
+
+=cut
+
+{
+ my $has_posix;
+ sub _have_write_access {
+ my $dir=shift;
+ unless (defined $has_posix) {
+ $has_posix= (!$Is_cygwin && !$Is_Win32
+ && eval 'local $^W; require POSIX; 1') || 0;
+ }
+ if ($has_posix) {
+ return POSIX::access($dir, POSIX::W_OK());
+ } else {
+ return -w $dir;
+ }
+ }
+}
+
+=pod
+
+=item _can_write_dir(C<$dir>)
+
+Checks whether a given directory is writable, taking account
+the possibility that the directory might not exist and would have to
+be created first.
+
+Returns a list, containing: C<($writable, $determined_by, @create)>
+
+C<$writable> says whether whether the directory is (hypothetically) writable
+
+C<$determined_by> is the directory the status was determined from. It will be
+either the C<$dir>, or one of its parents.
+
+C<@create> is a list of directories that would probably have to be created
+to make the requested directory. It may not actually be correct on
+relative paths with C<..> in them. But for our purposes it should work ok
+
+=cut
+
+
+sub _can_write_dir {
+ my $dir=shift;
+ return
+ unless defined $dir and length $dir;
+
+ my ($vol, $dirs, $file) = File::Spec->splitpath($dir,1);
+ my @dirs = File::Spec->splitdir($dirs);
+ unshift @dirs, File::Spec->curdir
+ unless File::Spec->file_name_is_absolute($dir);
+
+ my $path='';
+ my @make;
+ while (@dirs) {
+ if ($Is_VMS_noefs) {
+ # There is a bug in catdir that is fixed when the EFS character
+ # set is enabled, which requires this VMS specific code.
+ $dir = File::Spec->catdir($vol,@dirs);
+ }
+ else {
+ $dir = File::Spec->catdir(@dirs);
+ $dir = File::Spec->catpath($vol,$dir,'')
+ if defined $vol and length $vol;
+ }
+ next if ( $dir eq $path );
+ if ( ! -e $dir ) {
+ unshift @make,$dir;
+ next;
+ }
+ if ( _have_write_access($dir) ) {
+ return 1,$dir,@make
+ } else {
+ return 0,$dir,@make
+ }
+ } continue {
+ pop @dirs;
+ }
+ return 0;
+}
+
+=pod
+
+=item _mkpath($dir,$show,$mode,$verbose,$dry_run)
+
+Wrapper around File::Path::mkpath() to handle errors.
+
+If $verbose is true and >1 then additional diagnostics will be produced, also
+this will force $show to true.
+
+If $dry_run is true then the directory will not be created but a check will be
+made to see whether it would be possible to write to the directory, or that
+it would be possible to create the directory.
+
+If $dry_run is not true dies if the directory can not be created or is not
+writable.
+
+=cut
+
+sub _mkpath {
+ my ($dir,$show,$mode,$verbose,$dry_run)=@_;
+ if ( $verbose && $verbose > 1 && ! -d $dir) {
+ $show= 1;
+ printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode;
+ }
+ if (!$dry_run) {
+ if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) {
+ _choke("Can't create '$dir'","$@");
+ }
+
+ }
+ my ($can,$root,@make)=_can_write_dir($dir);
+ if (!$can) {
+ my @msg=(
+ "Can't create '$dir'",
+ $root ? "Do not have write permissions on '$root'"
+ : "Unknown Error"
+ );
+ if ($dry_run) {
+ _warnonce @msg;
+ } else {
+ _choke @msg;
+ }
+ } elsif ($show and $dry_run) {
+ print "$_\n" for @make;
+ }
+
+}
+
+=pod
+
+=item _copy($from,$to,$verbose,$dry_run)
+
+Wrapper around File::Copy::copy to handle errors.
+
+If $verbose is true and >1 then additional dignostics will be emitted.
+
+If $dry_run is true then the copy will not actually occur.
+
+Dies if the copy fails.
+
+=cut
+
+
+sub _copy {
+ my ( $from, $to, $verbose, $dry_run)=@_;
+ if ($verbose && $verbose>1) {
+ printf "copy(%s,%s)\n", $from, $to;
+ }
+ if (!$dry_run) {
+ File::Copy::copy($from,$to)
+ or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" );
+ }
+}
+
+=pod
+
+=item _chdir($from)
+
+Wrapper around chdir to catch errors.
+
+If not called in void context returns the cwd from before the chdir.
+
+dies on error.
+
+=cut
+
+sub _chdir {
+ my ($dir)= @_;
+ my $ret;
+ if (defined wantarray) {
+ $ret= cwd;
+ }
+ chdir $dir
+ or _choke("Couldn't chdir to '$dir': $!");
+ return $ret;
+}
+
+=pod
+
+=end _private
+
+=item B<install>
+
+ # deprecated forms
+ install(\%from_to);
+ install(\%from_to, $verbose, $dry_run, $uninstall_shadows,
+ $skip, $always_copy, \%result);
+
+ # recommended form as of 1.47
+ install([
+ from_to => \%from_to,
+ verbose => 1,
+ dry_run => 0,
+ uninstall_shadows => 1,
+ skip => undef,
+ always_copy => 1,
+ result => \%install_results,
+ ]);
+
+
+Copies each directory tree of %from_to to its corresponding value
+preserving timestamps and permissions.
+
+There are two keys with a special meaning in the hash: "read" and
+"write". These contain packlist files. After the copying is done,
+install() will write the list of target files to $from_to{write}. If
+$from_to{read} is given the contents of this file will be merged into
+the written file. The read and the written file may be identical, but
+on AFS it is quite likely that people are installing to a different
+directory than the one where the files later appear.
+
+If $verbose is true, will print out each file removed. Default is
+false. This is "make install VERBINST=1". $verbose values going
+up to 5 show increasingly more diagnostics output.
+
+If $dry_run is true it will only print what it was going to do
+without actually doing it. Default is false.
+
+If $uninstall_shadows is true any differing versions throughout @INC
+will be uninstalled. This is "make install UNINST=1"
+
+As of 1.37_02 install() supports the use of a list of patterns to filter out
+files that shouldn't be installed. If $skip is omitted or undefined then
+install will try to read the list from INSTALL.SKIP in the CWD. This file is
+a list of regular expressions and is just like the MANIFEST.SKIP file used
+by L<ExtUtils::Manifest>.
+
+A default site INSTALL.SKIP may be provided by setting then environment
+variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there isn't a
+distribution specific INSTALL.SKIP. If the environment variable
+EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be
+performed.
+
+If $skip is undefined then the skip file will be autodetected and used if it
+is found. If $skip is a reference to an array then it is assumed the array
+contains the list of patterns, if $skip is a true non reference it is
+assumed to be the filename holding the list of patterns, any other value of
+$skip is taken to mean that no install filtering should occur.
+
+B<Changes As of Version 1.47>
+
+As of version 1.47 the following additions were made to the install interface.
+Note that the new argument style and use of the %result hash is recommended.
+
+The $always_copy parameter which when true causes files to be updated
+regardles as to whether they have changed, if it is defined but false then
+copies are made only if the files have changed, if it is undefined then the
+value of the environment variable EU_INSTALL_ALWAYS_COPY is used as default.
+
+The %result hash will be populated with the various keys/subhashes reflecting
+the install. Currently these keys and their structure are:
+
+ install => { $target => $source },
+ install_fail => { $target => $source },
+ install_unchanged => { $target => $source },
+
+ install_filtered => { $source => $pattern },
+
+ uninstall => { $uninstalled => $source },
+ uninstall_fail => { $uninstalled => $source },
+
+where C<$source> is the filespec of the file being installed. C<$target> is where
+it is being installed to, and C<$uninstalled> is any shadow file that is in C<@INC>
+or C<$ENV{PERL5LIB}> or other standard locations, and C<$pattern> is the pattern that
+caused a source file to be skipped. In future more keys will be added, such as to
+show created directories, however this requires changes in other modules and must
+therefore wait.
+
+These keys will be populated before any exceptions are thrown should there be an
+error.
+
+Note that all updates of the %result are additive, the hash will not be
+cleared before use, thus allowing status results of many installs to be easily
+aggregated.
+
+B<NEW ARGUMENT STYLE>
+
+If there is only one argument and it is a reference to an array then
+the array is assumed to contain a list of key-value pairs specifying
+the options. In this case the option "from_to" is mandatory. This style
+means that you dont have to supply a cryptic list of arguments and can
+use a self documenting argument list that is easier to understand.
+
+This is now the recommended interface to install().
+
+B<RETURN>
+
+If all actions were successful install will return a hashref of the results
+as described above for the $result parameter. If any action is a failure
+then install will die, therefore it is recommended to pass in the $result
+parameter instead of using the return value. If the result parameter is
+provided then the returned hashref will be the passed in hashref.
+
+=cut
+
+sub install { #XXX OS-SPECIFIC
+ my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result) = @_;
+ if (@_==1 and eval { 1+@$from_to }) {
+ my %opts = @$from_to;
+ $from_to = $opts{from_to}
+ or Carp::confess("from_to is a mandatory parameter");
+ $verbose = $opts{verbose};
+ $dry_run = $opts{dry_run};
+ $uninstall_shadows = $opts{uninstall_shadows};
+ $skip = $opts{skip};
+ $always_copy = $opts{always_copy};
+ $result = $opts{result};
+ }
+
+ $result ||= {};
+ $verbose ||= 0;
+ $dry_run ||= 0;
+
+ $skip= _get_install_skip($skip,$verbose);
+ $always_copy = $ENV{EU_INSTALL_ALWAYS_COPY}
+ || $ENV{EU_ALWAYS_COPY}
+ || 0
+ unless defined $always_copy;
+
+ my(%from_to) = %$from_to;
+ my(%pack, $dir, %warned);
+ my($packlist) = ExtUtils::Packlist->new();
+
+ local(*DIR);
+ for (qw/read write/) {
+ $pack{$_}=$from_to{$_};
+ delete $from_to{$_};
+ }
+ my $tmpfile = install_rooted_file($pack{"read"});
+ $packlist->read($tmpfile) if (-f $tmpfile);
+ my $cwd = cwd();
+ my @found_files;
+ my %check_dirs;
+
+ MOD_INSTALL: foreach my $source (sort keys %from_to) {
+ #copy the tree to the target directory without altering
+ #timestamp and permission and remember for the .packlist
+ #file. The packlist file contains the absolute paths of the
+ #install locations. AFS users may call this a bug. We'll have
+ #to reconsider how to add the means to satisfy AFS users also.
+
+ #October 1997: we want to install .pm files into archlib if
+ #there are any files in arch. So we depend on having ./blib/arch
+ #hardcoded here.
+
+ my $targetroot = install_rooted_dir($from_to{$source});
+
+ my $blib_lib = File::Spec->catdir('blib', 'lib');
+ my $blib_arch = File::Spec->catdir('blib', 'arch');
+ if ($source eq $blib_lib and
+ exists $from_to{$blib_arch} and
+ directory_not_empty($blib_arch)
+ ){
+ $targetroot = install_rooted_dir($from_to{$blib_arch});
+ print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
+ }
+
+ next unless -d $source;
+ _chdir($source);
+ # 5.5.3's File::Find missing no_chdir option
+ # XXX OS-SPECIFIC
+ # File::Find seems to always be Unixy except on MacPerl :(
+ my $current_directory= $Is_MacPerl ? $Curdir : '.';
+ find(sub {
+ my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
+
+ return if !-f _;
+ my $origfile = $_;
+
+ return if $origfile eq ".exists";
+ my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
+ my $targetfile = File::Spec->catfile($targetdir, $origfile);
+ my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
+ my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
+
+ for my $pat (@$skip) {
+ if ( $sourcefile=~/$pat/ ) {
+ print "Skipping $targetfile (filtered)\n"
+ if $verbose>1;
+ $result->{install_filtered}{$sourcefile} = $pat;
+ return;
+ }
+ }
+ # we have to do this for back compat with old File::Finds
+ # and because the target is relative
+ my $save_cwd = _chdir($cwd);
+ my $diff = 0;
+ # XXX: I wonder how useful this logic is actually -- demerphq
+ if ( $always_copy or !-f $targetfile or -s $targetfile != $size) {
+ $diff++;
+ } else {
+ # we might not need to copy this file
+ $diff = compare($sourcefile, $targetfile);
+ }
+ $check_dirs{$targetdir}++
+ unless -w $targetfile;
+
+ push @found_files,
+ [ $diff, $File::Find::dir, $origfile,
+ $mode, $size, $atime, $mtime,
+ $targetdir, $targetfile, $sourcedir, $sourcefile,
+
+ ];
+ #restore the original directory we were in when File::Find
+ #called us so that it doesnt get horribly confused.
+ _chdir($save_cwd);
+ }, $current_directory );
+ _chdir($cwd);
+ }
+ foreach my $targetdir (sort keys %check_dirs) {
+ _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
+ }
+ foreach my $found (@found_files) {
+ my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime,
+ $targetdir, $targetfile, $sourcedir, $sourcefile)= @$found;
+
+ my $realtarget= $targetfile;
+ if ($diff) {
+ eval {
+ if (-f $targetfile) {
+ print "_unlink_or_rename($targetfile)\n" if $verbose>1;
+ $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
+ unless $dry_run;
+ } elsif ( ! -d $targetdir ) {
+ _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
+ }
+ print "Installing $targetfile\n";
+
+ _copy( $sourcefile, $targetfile, $verbose, $dry_run, );
+
+
+ #XXX OS-SPECIFIC
+ print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
+ utime($atime,$mtime + $Is_VMS,$targetfile) unless $dry_run>1;
+
+
+ $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+ $mode = $mode | 0222
+ if $realtarget ne $targetfile;
+ _chmod( $mode, $targetfile, $verbose );
+ $result->{install}{$targetfile} = $sourcefile;
+ 1
+ } or do {
+ $result->{install_fail}{$targetfile} = $sourcefile;
+ die $@;
+ };
+ } else {
+ $result->{install_unchanged}{$targetfile} = $sourcefile;
+ print "Skipping $targetfile (unchanged)\n" if $verbose;
+ }
+
+ if ( $uninstall_shadows ) {
+ inc_uninstall($sourcefile,$ffd, $verbose,
+ $dry_run,
+ $realtarget ne $targetfile ? $realtarget : "",
+ $result);
+ }
+
+ # Record the full pathname.
+ $packlist->{$targetfile}++;
+ }
+
+ if ($pack{'write'}) {
+ $dir = install_rooted_dir(dirname($pack{'write'}));
+ _mkpath( $dir, 0, 0755, $verbose, $dry_run );
+ print "Writing $pack{'write'}\n" if $verbose;
+ $packlist->write(install_rooted_file($pack{'write'})) unless $dry_run;
+ }
+
+ _do_cleanup($verbose);
+ return $result;
+}
+
+=begin _private
+
+=item _do_cleanup
+
+Standardize finish event for after another instruction has occured.
+Handles converting $MUST_REBOOT to a die for instance.
+
+=end _private
+
+=cut
+
+sub _do_cleanup {
+ my ($verbose) = @_;
+ if ($MUST_REBOOT) {
+ die _estr "Operation not completed! ",
+ "You must reboot to complete the installation.",
+ "Sorry.";
+ } elsif (defined $MUST_REBOOT & $verbose) {
+ warn _estr "Installation will be completed at the next reboot.\n",
+ "However it is not necessary to reboot immediately.\n";
+ }
+}
+
+=begin _undocumented
+
+=item install_rooted_file( $file )
+
+Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT
+is defined.
+
+=item install_rooted_dir( $dir )
+
+Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT
+is defined.
+
+=end _undocumented
+
+=cut
+
+
+sub install_rooted_file {
+ if (defined $INSTALL_ROOT) {
+ File::Spec->catfile($INSTALL_ROOT, $_[0]);
+ } else {
+ $_[0];
+ }
+}
+
+
+sub install_rooted_dir {
+ if (defined $INSTALL_ROOT) {
+ File::Spec->catdir($INSTALL_ROOT, $_[0]);
+ } else {
+ $_[0];
+ }
+}
+
+=begin _undocumented
+
+=item forceunlink( $file, $tryhard )
+
+Tries to delete a file. If $tryhard is true then we will use whatever
+devious tricks we can to delete the file. Currently this only applies to
+Win32 in that it will try to use Win32API::File to schedule a delete at
+reboot. A wrapper for _unlink_or_rename().
+
+=end _undocumented
+
+=cut
+
+
+sub forceunlink {
+ my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC
+ _unlink_or_rename( $file, $tryhard, not("installing") );
+}
+
+=begin _undocumented
+
+=item directory_not_empty( $dir )
+
+Returns 1 if there is an .exists file somewhere in a directory tree.
+Returns 0 if there is not.
+
+=end _undocumented
+
+=cut
+
+sub directory_not_empty ($) {
+ my($dir) = @_;
+ my $files = 0;
+ find(sub {
+ return if $_ eq ".exists";
+ if (-f) {
+ $File::Find::prune++;
+ $files = 1;
+ }
+ }, $dir);
+ return $files;
+}
+
+=pod
+
+=item B<install_default> I<DISCOURAGED>
+
+ install_default();
+ install_default($fullext);
+
+Calls install() with arguments to copy a module from blib/ to the
+default site installation location.
+
+$fullext is the name of the module converted to a directory
+(ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
+will attempt to read it from @ARGV.
+
+This is primarily useful for install scripts.
+
+B<NOTE> This function is not really useful because of the hard-coded
+install location with no way to control site vs core vs vendor
+directories and the strange way in which the module name is given.
+Consider its use discouraged.
+
+=cut
+
+sub install_default {
+ @_ < 2 or Carp::croak("install_default should be called with 0 or 1 argument");
+ my $FULLEXT = @_ ? shift : $ARGV[0];
+ defined $FULLEXT or die "Do not know to where to write install log";
+ my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
+ my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
+ my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
+ my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
+ my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
+ my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
+
+ my @INST_HTML;
+ if($Config{installhtmldir}) {
+ my $INST_HTMLDIR = File::Spec->catdir($Curdir,'blib','html');
+ @INST_HTML = ($INST_HTMLDIR => $Config{installhtmldir});
+ }
+
+ install({
+ read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
+ write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
+ $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
+ $Config{installsitearch} :
+ $Config{installsitelib},
+ $INST_ARCHLIB => $Config{installsitearch},
+ $INST_BIN => $Config{installbin} ,
+ $INST_SCRIPT => $Config{installscript},
+ $INST_MAN1DIR => $Config{installman1dir},
+ $INST_MAN3DIR => $Config{installman3dir},
+ @INST_HTML,
+ },1,0,0);
+}
+
+
+=item B<uninstall>
+
+ uninstall($packlist_file);
+ uninstall($packlist_file, $verbose, $dont_execute);
+
+Removes the files listed in a $packlist_file.
+
+If $verbose is true, will print out each file removed. Default is
+false.
+
+If $dont_execute is true it will only print what it was going to do
+without actually doing it. Default is false.
+
+=cut
+
+sub uninstall {
+ my($fil,$verbose,$dry_run) = @_;
+ $verbose ||= 0;
+ $dry_run ||= 0;
+
+ die _estr "ERROR: no packlist file found: '$fil'"
+ unless -f $fil;
+ # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+ # require $my_req; # Hairy, but for the first
+ my ($packlist) = ExtUtils::Packlist->new($fil);
+ foreach (sort(keys(%$packlist))) {
+ chomp;
+ print "unlink $_\n" if $verbose;
+ forceunlink($_,'tryhard') unless $dry_run;
+ }
+ print "unlink $fil\n" if $verbose;
+ forceunlink($fil, 'tryhard') unless $dry_run;
+ _do_cleanup($verbose);
+}
+
+=begin _undocumented
+
+=item inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results)
+
+Remove shadowed files. If $ignore is true then it is assumed to hold
+a filename to ignore. This is used to prevent spurious warnings from
+occuring when doing an install at reboot.
+
+We now only die when failing to remove a file that has precedence over
+our own, when our install has precedence we only warn.
+
+$results is assumed to contain a hashref which will have the keys
+'uninstall' and 'uninstall_fail' populated with keys for the files
+removed and values of the source files they would shadow.
+
+=end _undocumented
+
+=cut
+
+sub inc_uninstall {
+ my($filepath,$libdir,$verbose,$dry_run,$ignore,$results) = @_;
+ my($dir);
+ $ignore||="";
+ my $file = (File::Spec->splitpath($filepath))[2];
+ my %seen_dir = ();
+
+ my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
+ ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
+
+ my @dirs=( @PERL_ENV_LIB,
+ @INC,
+ @Config{qw(archlibexp
+ privlibexp
+ sitearchexp
+ sitelibexp)});
+
+ #warn join "\n","---",@dirs,"---";
+ my $seen_ours;
+ foreach $dir ( @dirs ) {
+ my $canonpath = $Is_VMS ? $dir : File::Spec->canonpath($dir);
+ next if $canonpath eq $Curdir;
+ next if $seen_dir{$canonpath}++;
+ my $targetfile = File::Spec->catfile($canonpath,$libdir,$file);
+ next unless -f $targetfile;
+
+ # The reason why we compare file's contents is, that we cannot
+ # know, which is the file we just installed (AFS). So we leave
+ # an identical file in place
+ my $diff = 0;
+ if ( -f $targetfile && -s _ == -s $filepath) {
+ # We have a good chance, we can skip this one
+ $diff = compare($filepath,$targetfile);
+ } else {
+ $diff++;
+ }
+ print "#$file and $targetfile differ\n" if $diff && $verbose > 1;
+
+ if (!$diff or $targetfile eq $ignore) {
+ $seen_ours = 1;
+ next;
+ }
+ if ($dry_run) {
+ $results->{uninstall}{$targetfile} = $filepath;
+ if ($verbose) {
+ $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();
+ $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
+ $Inc_uninstall_warn_handler->add(
+ File::Spec->catfile($libdir, $file),
+ $targetfile
+ );
+ }
+ # if not verbose, we just say nothing
+ } else {
+ print "Unlinking $targetfile (shadowing?)\n" if $verbose;
+ eval {
+ die "Fake die for testing"
+ if $ExtUtils::Install::Testing and
+ ucase(File::Spec->canonpath($ExtUtils::Install::Testing)) eq ucase($targetfile);
+ forceunlink($targetfile,'tryhard');
+ $results->{uninstall}{$targetfile} = $filepath;
+ 1;
+ } or do {
+ $results->{fail_uninstall}{$targetfile} = $filepath;
+ if ($seen_ours) {
+ warn "Failed to remove probably harmless shadow file '$targetfile'\n";
+ } else {
+ die "$@\n";
+ }
+ };
+ }
+ }
+}
+
+=begin _undocumented
+
+=item run_filter($cmd,$src,$dest)
+
+Filter $src using $cmd into $dest.
+
+=end _undocumented
+
+=cut
+
+sub run_filter {
+ my ($cmd, $src, $dest) = @_;
+ local(*CMD, *SRC);
+ open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
+ open(SRC, $src) || die "Cannot open $src: $!";
+ my $buf;
+ my $sz = 1024;
+ while (my $len = sysread(SRC, $buf, $sz)) {
+ syswrite(CMD, $buf, $len);
+ }
+ close SRC;
+ close CMD or die "Filter command '$cmd' failed for $src";
+}
+
+=pod
+
+=item B<pm_to_blib>
+
+ pm_to_blib(\%from_to, $autosplit_dir);
+ pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
+
+Copies each key of %from_to to its corresponding value efficiently.
+Filenames with the extension .pm are autosplit into the $autosplit_dir.
+Any destination directories are created.
+
+$filter_cmd is an optional shell command to run each .pm file through
+prior to splitting and copying. Input is the contents of the module,
+output the new module contents.
+
+You can have an environment variable PERL_INSTALL_ROOT set which will
+be prepended as a directory to each installed file (and directory).
+
+=cut
+
+sub pm_to_blib {
+ my($fromto,$autodir,$pm_filter) = @_;
+
+ _mkpath($autodir,0,0755);
+ while(my($from, $to) = each %$fromto) {
+ if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
+ print "Skip $to (unchanged)\n";
+ next;
+ }
+
+ # When a pm_filter is defined, we need to pre-process the source first
+ # to determine whether it has changed or not. Therefore, only perform
+ # the comparison check when there's no filter to be ran.
+ # -- RAM, 03/01/2001
+
+ my $need_filtering = defined $pm_filter && length $pm_filter &&
+ $from =~ /\.pm$/;
+
+ if (!$need_filtering && 0 == compare($from,$to)) {
+ print "Skip $to (unchanged)\n";
+ next;
+ }
+ if (-f $to){
+ # we wont try hard here. its too likely to mess things up.
+ forceunlink($to);
+ } else {
+ _mkpath(dirname($to),0,0755);
+ }
+ if ($need_filtering) {
+ run_filter($pm_filter, $from, $to);
+ print "$pm_filter <$from >$to\n";
+ } else {
+ _copy( $from, $to );
+ print "cp $from $to\n";
+ }
+ my($mode,$atime,$mtime) = (stat $from)[2,8,9];
+ utime($atime,$mtime+$Is_VMS,$to);
+ _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
+ next unless $from =~ /\.pm$/;
+ _autosplit($to,$autodir);
+ }
+}
+
+
+=begin _private
+
+=item _autosplit
+
+From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
+the file being split. This causes problems on systems with mandatory
+locking (ie. Windows). So we wrap it and close the filehandle.
+
+=end _private
+
+=cut
+
+sub _autosplit { #XXX OS-SPECIFIC
+ my $retval = autosplit(@_);
+ close *AutoSplit::IN if defined *AutoSplit::IN{IO};
+
+ return $retval;
+}
+
+
+package ExtUtils::Install::Warn;
+
+sub new { bless {}, shift }
+
+sub add {
+ my($self,$file,$targetfile) = @_;
+ push @{$self->{$file}}, $targetfile;
+}
+
+sub DESTROY {
+ unless(defined $INSTALL_ROOT) {
+ my $self = shift;
+ my($file,$i,$plural);
+ foreach $file (sort keys %$self) {
+ $plural = @{$self->{$file}} > 1 ? "s" : "";
+ print "## Differing version$plural of $file found. You might like to\n";
+ for (0..$#{$self->{$file}}) {
+ print "rm ", $self->{$file}[$_], "\n";
+ $i++;
+ }
+ }
+ $plural = $i>1 ? "all those files" : "this file";
+ my $inst = (_invokant() eq 'ExtUtils::MakeMaker')
+ ? ( $Config::Config{make} || 'make' ).' install'
+ . ( $Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1' )
+ : './Build install uninst=1';
+ print "## Running '$inst' will unlink $plural for you.\n";
+ }
+}
+
+=begin _private
+
+=item _invokant
+
+Does a heuristic on the stack to see who called us for more intelligent
+error messages. Currently assumes we will be called only by Module::Build
+or by ExtUtils::MakeMaker.
+
+=end _private
+
+=cut
+
+sub _invokant {
+ my @stack;
+ my $frame = 0;
+ while (my $file = (caller($frame++))[1]) {
+ push @stack, (File::Spec->splitpath($file))[2];
+ }
+
+ my $builder;
+ my $top = pop @stack;
+ if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})) {
+ $builder = 'Module::Build';
+ } else {
+ $builder = 'ExtUtils::MakeMaker';
+ }
+ return $builder;
+}
+
+=pod
+
+=back
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item B<PERL_INSTALL_ROOT>
+
+Will be prepended to each install path.
+
+=item B<EU_INSTALL_IGNORE_SKIP>
+
+Will prevent the automatic use of INSTALL.SKIP as the install skip file.
+
+=item B<EU_INSTALL_SITE_SKIPFILE>
+
+If there is no INSTALL.SKIP file in the make directory then this value
+can be used to provide a default.
+
+=item B<EU_INSTALL_ALWAYS_COPY>
+
+If this environment variable is true then normal install processes will
+always overwrite older identical files during the install process.
+
+Note that the alias EU_ALWAYS_COPY will be supported if EU_INSTALL_ALWAYS_COPY
+is not defined until at least the 1.50 release. Please ensure you use the
+correct EU_INSTALL_ALWAYS_COPY.
+
+=back
+
+=head1 AUTHOR
+
+Original author lost in the mists of time. Probably the same as Makemaker.
+
+Production release currently maintained by demerphq C<yves at cpan.org>,
+extensive changes by Michael G. Schwern.
+
+Send bug reports via http://rt.cpan.org/. Please send your
+generated Makefile along with your report.
+
+=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
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm
new file mode 100644
index 00000000000..9cb1fc10d75
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm
@@ -0,0 +1,462 @@
+package ExtUtils::Installed;
+
+use 5.00503;
+use strict;
+#use warnings; # XXX requires 5.6
+use Carp qw();
+use ExtUtils::Packlist;
+use ExtUtils::MakeMaker;
+use Config;
+use File::Find;
+use File::Basename;
+use File::Spec;
+
+my $Is_VMS = $^O eq 'VMS';
+my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);
+
+require VMS::Filespec if $Is_VMS;
+
+use vars qw($VERSION);
+$VERSION = '1.999_001';
+$VERSION = eval $VERSION;
+
+sub _is_prefix {
+ my ($self, $path, $prefix) = @_;
+ return unless defined $prefix && defined $path;
+
+ if( $Is_VMS ) {
+ $prefix = VMS::Filespec::unixify($prefix);
+ $path = VMS::Filespec::unixify($path);
+ }
+
+ # Unix path normalization.
+ $prefix = File::Spec->canonpath($prefix);
+
+ return 1 if substr($path, 0, length($prefix)) eq $prefix;
+
+ if ($DOSISH) {
+ $path =~ s|\\|/|g;
+ $prefix =~ s|\\|/|g;
+ return 1 if $path =~ m{^\Q$prefix\E}i;
+ }
+ return(0);
+}
+
+sub _is_doc {
+ my ($self, $path) = @_;
+
+ my $man1dir = $self->{':private:'}{Config}{man1direxp};
+ my $man3dir = $self->{':private:'}{Config}{man3direxp};
+ return(($man1dir && $self->_is_prefix($path, $man1dir))
+ ||
+ ($man3dir && $self->_is_prefix($path, $man3dir))
+ ? 1 : 0)
+}
+
+sub _is_type {
+ my ($self, $path, $type) = @_;
+ return 1 if $type eq "all";
+
+ return($self->_is_doc($path)) if $type eq "doc";
+ my $conf= $self->{':private:'}{Config};
+ if ($type eq "prog") {
+ return($self->_is_prefix($path, $conf->{prefix} || $conf->{prefixexp})
+ && !($self->_is_doc($path)) ? 1 : 0);
+ }
+ return(0);
+}
+
+sub _is_under {
+ my ($self, $path, @under) = @_;
+ $under[0] = "" if (! @under);
+ foreach my $dir (@under) {
+ return(1) if ($self->_is_prefix($path, $dir));
+ }
+
+ return(0);
+}
+
+sub _fix_dirs {
+ my ($self, @dirs)= @_;
+ # File::Find does not know how to deal with VMS filepaths.
+ if( $Is_VMS ) {
+ $_ = VMS::Filespec::unixify($_)
+ for @dirs;
+ }
+
+ if ($DOSISH) {
+ s|\\|/|g for @dirs;
+ }
+ return wantarray ? @dirs : $dirs[0];
+}
+
+sub _make_entry {
+ my ($self, $module, $packlist_file, $modfile)= @_;
+
+ my $data= {
+ module => $module,
+ packlist => scalar(ExtUtils::Packlist->new($packlist_file)),
+ packlist_file => $packlist_file,
+ };
+
+ if (!$modfile) {
+ $data->{version} = $self->{':private:'}{Config}{version};
+ } else {
+ $data->{modfile} = $modfile;
+ # Find the top-level module file in @INC
+ $data->{version} = '';
+ foreach my $dir (@{$self->{':private:'}{INC}}) {
+ my $p = File::Spec->catfile($dir, $modfile);
+ if (-r $p) {
+ $module = _module_name($p, $module) if $Is_VMS;
+
+ $data->{version} = MM->parse_version($p);
+ $data->{version_from} = $p;
+ $data->{packlist_valid} = exists $data->{packlist}{$p};
+ last;
+ }
+ }
+ }
+ $self->{$module}= $data;
+}
+
+our $INSTALLED;
+sub new {
+ my ($class) = shift(@_);
+ $class = ref($class) || $class;
+
+ my %args = @_;
+
+ return $INSTALLED if $INSTALLED and ($args{default_get} || $args{default});
+
+ my $self = bless {}, $class;
+
+ $INSTALLED= $self if $args{default_set} || $args{default};
+
+
+ if ($args{config_override}) {
+ eval {
+ $self->{':private:'}{Config} = { %{$args{config_override}} };
+ } or Carp::croak(
+ "The 'config_override' parameter must be a hash reference."
+ );
+ }
+ else {
+ $self->{':private:'}{Config} = \%Config;
+ }
+
+ for my $tuple ([inc_override => INC => [ @INC ] ],
+ [ extra_libs => EXTRA => [] ])
+ {
+ my ($arg,$key,$val)=@$tuple;
+ if ( $args{$arg} ) {
+ eval {
+ $self->{':private:'}{$key} = [ @{$args{$arg}} ];
+ } or Carp::croak(
+ "The '$arg' parameter must be an array reference."
+ );
+ }
+ elsif ($val) {
+ $self->{':private:'}{$key} = $val;
+ }
+ }
+ {
+ my %dupe;
+ @{$self->{':private:'}{LIBDIRS}} = grep { -e $_ && !$dupe{$_}++ }
+ @{$self->{':private:'}{EXTRA}}, @{$self->{':private:'}{INC}};
+ }
+
+ my @dirs= $self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}});
+
+ # Read the core packlist
+ my $archlib = $self->_fix_dirs($self->{':private:'}{Config}{archlibexp});
+ $self->_make_entry("Perl",File::Spec->catfile($archlib, '.packlist'));
+
+ my $root;
+ # Read the module packlists
+ my $sub = sub {
+ # Only process module .packlists
+ return if $_ ne ".packlist" || $File::Find::dir eq $archlib;
+
+ # Hack of the leading bits of the paths & convert to a module name
+ my $module = $File::Find::name;
+ my $found = $module =~ s!^.*?/auto/(.*)/.packlist!$1!s
+ or do {
+ # warn "Woah! \$_=$_\n\$module=$module\n\$File::Find::dir=$File::Find::dir\n",
+ # join ("\n",@dirs);
+ return;
+ };
+
+ my $modfile = "$module.pm";
+ $module =~ s!/!::!g;
+
+ return if $self->{$module}; #shadowing?
+ $self->_make_entry($module,$File::Find::name,$modfile);
+ };
+ while (@dirs) {
+ $root= shift @dirs;
+ next if !-d $root;
+ find($sub,$root);
+ }
+
+ return $self;
+}
+
+# VMS's non-case preserving file-system means the package name can't
+# be reconstructed from the filename.
+sub _module_name {
+ my($file, $orig_module) = @_;
+
+ my $module = '';
+ if (open PACKFH, $file) {
+ while (<PACKFH>) {
+ if (/package\s+(\S+)\s*;/) {
+ my $pack = $1;
+ # Make a sanity check, that lower case $module
+ # is identical to lowercase $pack before
+ # accepting it
+ if (lc($pack) eq lc($orig_module)) {
+ $module = $pack;
+ last;
+ }
+ }
+ }
+ close PACKFH;
+ }
+
+ print STDERR "Couldn't figure out the package name for $file\n"
+ unless $module;
+
+ return $module;
+}
+
+sub modules {
+ my ($self) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+
+ # Bug/feature of sort in scalar context requires this.
+ return wantarray
+ ? sort grep { not /^:private:$/ } keys %$self
+ : grep { not /^:private:$/ } keys %$self;
+}
+
+sub files {
+ my ($self, $module, $type, @under) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+
+ # Validate arguments
+ Carp::croak("$module is not installed") if (! exists($self->{$module}));
+ $type = "all" if (! defined($type));
+ Carp::croak('type must be "all", "prog" or "doc"')
+ if ($type ne "all" && $type ne "prog" && $type ne "doc");
+
+ my (@files);
+ foreach my $file (keys(%{$self->{$module}{packlist}})) {
+ push(@files, $file)
+ if ($self->_is_type($file, $type) &&
+ $self->_is_under($file, @under));
+ }
+ return(@files);
+}
+
+sub directories {
+ my ($self, $module, $type, @under) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+ my (%dirs);
+ foreach my $file ($self->files($module, $type, @under)) {
+ $dirs{dirname($file)}++;
+ }
+ return sort keys %dirs;
+}
+
+sub directory_tree {
+ my ($self, $module, $type, @under) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+ my (%dirs);
+ foreach my $dir ($self->directories($module, $type, @under)) {
+ $dirs{$dir}++;
+ my ($last) = ("");
+ while ($last ne $dir) {
+ $last = $dir;
+ $dir = dirname($dir);
+ last if !$self->_is_under($dir, @under);
+ $dirs{$dir}++;
+ }
+ }
+ return(sort(keys(%dirs)));
+}
+
+sub validate {
+ my ($self, $module, $remove) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+ Carp::croak("$module is not installed") if (! exists($self->{$module}));
+ return($self->{$module}{packlist}->validate($remove));
+}
+
+sub packlist {
+ my ($self, $module) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+ Carp::croak("$module is not installed") if (! exists($self->{$module}));
+ return($self->{$module}{packlist});
+}
+
+sub version {
+ my ($self, $module) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+ Carp::croak("$module is not installed") if (! exists($self->{$module}));
+ return($self->{$module}{version});
+}
+
+sub debug_dump {
+ my ($self, $module) = @_;
+ $self= $self->new(default=>1) if !ref $self;
+ local $self->{":private:"}{Config};
+ require Data::Dumper;
+ print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump();
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Installed - Inventory management of installed modules
+
+=head1 SYNOPSIS
+
+ use ExtUtils::Installed;
+ my ($inst) = ExtUtils::Installed->new();
+ my (@modules) = $inst->modules();
+ my (@missing) = $inst->validate("DBI");
+ my $all_files = $inst->files("DBI");
+ my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
+ my $all_dirs = $inst->directories("DBI");
+ my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
+ my $packlist = $inst->packlist("DBI");
+
+=head1 DESCRIPTION
+
+ExtUtils::Installed provides a standard way to find out what core and module
+files have been installed. It uses the information stored in .packlist files
+created during installation to provide this information. In addition it
+provides facilities to classify the installed files and to extract directory
+information from the .packlist files.
+
+=head1 USAGE
+
+The new() function searches for all the installed .packlists on the system, and
+stores their contents. The .packlists can be queried with the functions
+described below. Where it searches by default is determined by the settings found
+in C<%Config::Config>, and what the value is of the PERL5LIB environment variable.
+
+=head1 METHODS
+
+Unless specified otherwise all method can be called as class methods, or as object
+methods. If called as class methods then the "default" object will be used, and if
+necessary created using the current processes %Config and @INC. See the
+'default' option to new() for details.
+
+
+=over 4
+
+=item new()
+
+This takes optional named parameters. Without parameters, this
+searches for all the installed .packlists on the system using
+information from C<%Config::Config> and the default module search
+paths C<@INC>. The packlists are read using the
+L<ExtUtils::Packlist> module.
+
+If the named parameter C<config_override> is specified,
+it should be a reference to a hash which contains all information
+usually found in C<%Config::Config>. For example, you can obtain
+the configuration information for a separate perl installation and
+pass that in.
+
+ my $yoda_cfg = get_fake_config('yoda');
+ my $yoda_inst = ExtUtils::Installed->new(config_override=>$yoda_cfg);
+
+Similarly, the parameter C<inc_override> may be a reference to an
+array which is used in place of the default module search paths
+from C<@INC>.
+
+ use Config;
+ my @dirs = split(/\Q$Config{path_sep}\E/, $ENV{PERL5LIB});
+ my $p5libs = ExtUtils::Installed->new(inc_override=>\@dirs);
+
+B<Note>: You probably do not want to use these options alone, almost always
+you will want to set both together.
+
+The parameter c<extra_libs> can be used to specify B<additional> paths to
+search for installed modules. For instance
+
+ my $installed = ExtUtils::Installed->new(extra_libs=>["/my/lib/path"]);
+
+This should only be necessary if C</my/lib/path> is not in PERL5LIB.
+
+Finally there is the 'default', and the related 'default_get' and 'default_set'
+options. These options control the "default" object which is provided by the
+class interface to the methods. Setting C<default_get> to true tells the constructor
+to return the default object if it is defined. Setting C<default_set> to true tells
+the constructor to make the default object the constructed object. Setting the
+C<default> option is like setting both to true. This is used primarily internally
+and probably isn't interesting to any real user.
+
+=item modules()
+
+This returns a list of the names of all the installed modules. The perl 'core'
+is given the special name 'Perl'.
+
+=item files()
+
+This takes one mandatory parameter, the name of a module. It returns a list of
+all the filenames from the package. To obtain a list of core perl files, use
+the module name 'Perl'. Additional parameters are allowed. The first is one
+of the strings "prog", "doc" or "all", to select either just program files,
+just manual files or all files. The remaining parameters are a list of
+directories. The filenames returned will be restricted to those under the
+specified directories.
+
+=item directories()
+
+This takes one mandatory parameter, the name of a module. It returns a list of
+all the directories from the package. Additional parameters are allowed. The
+first is one of the strings "prog", "doc" or "all", to select either just
+program directories, just manual directories or all directories. The remaining
+parameters are a list of directories. The directories returned will be
+restricted to those under the specified directories. This method returns only
+the leaf directories that contain files from the specified module.
+
+=item directory_tree()
+
+This is identical in operation to directories(), except that it includes all the
+intermediate directories back up to the specified directories.
+
+=item validate()
+
+This takes one mandatory parameter, the name of a module. It checks that all
+the files listed in the modules .packlist actually exist, and returns a list of
+any missing files. If an optional second argument which evaluates to true is
+given any missing files will be removed from the .packlist
+
+=item packlist()
+
+This returns the ExtUtils::Packlist object for the specified module.
+
+=item version()
+
+This returns the version number for the specified module.
+
+=back
+
+=head1 EXAMPLE
+
+See the example in L<ExtUtils::Packlist>.
+
+=head1 AUTHOR
+
+Alan Burlison <Alan.Burlison@uk.sun.com>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm
new file mode 100644
index 00000000000..ea4dac4ae7c
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm
@@ -0,0 +1,286 @@
+package ExtUtils::Liblist;
+
+use strict;
+
+our $VERSION = '6.56';
+
+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
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm
new file mode 100644
index 00000000000..b807e97cc86
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm
@@ -0,0 +1,546 @@
+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;
+our $VERSION = 6.56;
+
+use 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";
+
+
+ # 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 (-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;
+
+ my $cc = $Config{cc};
+ my $VC = $cc =~ /^cl/i;
+ my $BC = $cc =~ /^bcc/i;
+ my $GC = $cc =~ /^gcc/i;
+ my $so = $Config{'so'};
+ my $libs = $Config{'perllibs'};
+ my $libpth = $Config{'libpth'};
+ my $libext = $Config{'lib_ext'} || ".lib";
+ my(@libs, %libs_seen);
+
+ if ($libs and $potential_libs !~ /:nodefault/i) {
+ # If Config.pm defines a set of default libs, we always
+ # tack them on to the user-supplied list, unless the user
+ # specified :nodefault
+
+ $potential_libs .= " " if $potential_libs;
+ $potential_libs .= $libs;
+ }
+ warn "Potential libraries are '$potential_libs':\n" if $verbose;
+
+ # normalize to forward slashes
+ $libpth =~ s,\\,/,g;
+ $potential_libs =~ s,\\,/,g;
+
+ # compute $extralibs from $potential_libs
+
+ my @searchpath; # from "-L/path" in $potential_libs
+ my @libpath = Text::ParseWords::quotewords('\s+', 0, $libpth);
+ my @extralibs;
+ my $pwd = cwd(); # from Cwd.pm
+ my $lib = '';
+ my $found = 0;
+ my $search = 1;
+ my($fullname);
+
+ # add "$Config{installarchlib}/CORE" to default search path
+ push @libpath, "$Config{installarchlib}/CORE";
+
+ if ($VC and exists $ENV{LIB} and $ENV{LIB}) {
+ push @libpath, split /;/, $ENV{LIB};
+ }
+
+ foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){
+
+ my $thislib = $_;
+
+ # see if entry is a flag
+ if (/^:\w+$/) {
+ $search = 0 if lc eq ':nosearch';
+ $search = 1 if lc eq ':search';
+ warn "Ignoring unknown flag '$thislib'\n"
+ if $verbose and !/^:(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, $_);
+ $found++;
+ next;
+ }
+
+ # handle possible linker path arguments
+ if (s/^-L// and not -d) {
+ warn "$thislib ignored, directory does not exist\n"
+ if $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;
+ }
+
+ # handle possible library arguments
+ if (s/^-l// and $GC and !/^lib/i) {
+ $_ = "lib$_";
+ }
+ $_ .= $libext if !/\Q$libext\E$/i;
+
+ my $secondpass = 0;
+ LOOKAGAIN:
+
+ # look for the file itself
+ if (-f) {
+ warn "'$thislib' found as '$_'\n" if $verbose;
+ $found++;
+ push(@extralibs, $_);
+ next;
+ }
+
+ my $found_lib = 0;
+ foreach my $thispth (@searchpath, @libpath){
+ unless (-f ($fullname="$thispth\\$_")) {
+ warn "'$thislib' not found as '$fullname'\n" if $verbose;
+ next;
+ }
+ warn "'$thislib' found as '$fullname'\n" if $verbose;
+ $found++;
+ $found_lib++;
+ push(@extralibs, $fullname);
+ push @libs, $fullname unless $libs_seen{$fullname}++;
+ last;
+ }
+
+ # do another pass with (or without) leading 'lib' if they used -l
+ if (!$found_lib and $thislib =~ /^-l/ and !$secondpass++) {
+ if ($GC) {
+ goto LOOKAGAIN if s/^lib//i;
+ }
+ elsif (!/^lib/i) {
+ $_ = "lib$_";
+ goto LOOKAGAIN;
+ }
+ }
+
+ # give up
+ warn "Note (probably harmless): "
+ ."No library found for $thislib\n"
+ unless $found_lib>0;
+
+ }
+
+ return ('','','','', ($give_libs ? \@libs : ())) unless $found;
+
+ # make sure paths with spaces are properly quoted
+ @extralibs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @extralibs;
+ @libs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @libs;
+ $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;
+
+ warn "Result: $lib\n" if $verbose;
+ wantarray ? ($lib, '', $lib, '', ($give_libs ? \@libs : ())) : $lib;
+}
+
+
+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;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP b/Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP
new file mode 100644
index 00000000000..e50a7b390f7
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP
@@ -0,0 +1,51 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+\B\.cvsignore$
+
+# Avoid VMS specific MakeMaker generated files
+\bDescrip.MMS$
+\bDESCRIP.MMS$
+\bdescrip.mms$
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+\bBuild.bat$
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+\.tmp$
+\.#
+\.rej$
+
+# Avoid OS-specific files/dirs
+# Mac OSX metadata
+\B\.DS_Store
+# Mac OSX SMB mount metadata files
+\B\._
+
+# Avoid Devel::Cover files.
+\bcover_db\b
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm
new file mode 100644
index 00000000000..eac5f483494
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm
@@ -0,0 +1,90 @@
+package ExtUtils::MM;
+
+use strict;
+use ExtUtils::MakeMaker::Config;
+
+our $VERSION = '6.56';
+
+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;
+}
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm
new file mode 100644
index 00000000000..5179be4bc2a
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm
@@ -0,0 +1,79 @@
+package ExtUtils::MM_AIX;
+
+use strict;
+our $VERSION = '6.56';
+
+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 <schwern@pobox.com> with code from ExtUtils::MM_Unix
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm
new file mode 100644
index 00000000000..4905aebc642
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm
@@ -0,0 +1,2334 @@
+package ExtUtils::MM_Any;
+
+use strict;
+our $VERSION = '6.56';
+
+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)
+ 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;
+}
+
+
+=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};
+metafile :
+ $(NOECHO) $(NOOP)
+MAKE_FRAG
+
+ my @metadata = $self->metafile_data(
+ $self->{META_ADD} || {},
+ $self->{META_MERGE} || {},
+ );
+ my $meta = $self->metafile_file(@metadata);
+ my @write_meta = $self->echo($meta, 'META_new.yml');
+
+ return sprintf <<'MAKE_FRAG', join("\n\t", @write_meta);
+metafile : create_distdir
+ $(NOECHO) $(ECHO) Generating META.yml
+ %s
+ -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
+MAKE_FRAG
+
+}
+
+
+=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) = @_;
+
+ # The order in which standard meta keys should be written.
+ my @meta_order = qw(
+ name
+ version
+ abstract
+ author
+ license
+ distribution_type
+
+ configure_requires
+ build_requires
+ requires
+
+ resources
+
+ provides
+ no_index
+
+ generated_by
+ meta-spec
+ );
+
+ # Check the original args so we can tell between the user setting it
+ # to an empty hash and it just being initialized.
+ my $configure_requires;
+ if( $self->{ARGS}{CONFIGURE_REQUIRES} ) {
+ $configure_requires = $self->{CONFIGURE_REQUIRES};
+ } else {
+ $configure_requires = {
+ 'ExtUtils::MakeMaker' => 0,
+ };
+ }
+ my $build_requires;
+ if( $self->{ARGS}{BUILD_REQUIRES} ) {
+ $build_requires = $self->{BUILD_REQUIRES};
+ } else {
+ $build_requires = {
+ 'ExtUtils::MakeMaker' => 0,
+ };
+ }
+
+ my %meta = (
+ name => $self->{DISTNAME},
+ version => $self->{VERSION},
+ abstract => $self->{ABSTRACT},
+ license => $self->{LICENSE} || 'unknown',
+ distribution_type => $self->{PM} ? 'module' : 'script',
+
+ configure_requires => $configure_requires,
+
+ build_requires => $build_requires,
+
+ 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}] : [];
+
+ $meta{requires} = $self->{PREREQ_PM} if defined $self->{PREREQ_PM};
+ $meta{requires}{perl} = $self->{MIN_PERL_VERSION} if $self->{MIN_PERL_VERSION};
+
+ while( my($key, $val) = each %$meta_add ) {
+ $meta{$key} = $val;
+ }
+
+ while( my($key, $val) = each %$meta_merge ) {
+ $self->_hash_merge(\%meta, $key, $val);
+ }
+
+ my @meta_pairs;
+
+ # Put the standard keys first in the proper order.
+ for my $key (@meta_order) {
+ next unless exists $meta{$key};
+
+ push @meta_pairs, $key, delete $meta{$key};
+ }
+
+ # Then tack everything else onto the end, alpha sorted.
+ for my $key (sort {lc $a cmp lc $b} keys %meta) {
+ push @meta_pairs, $key, $meta{$key};
+ }
+
+ return @meta_pairs
+}
+
+=begin private
+
+=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']);
+eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) }
+ or print "Could not add META.yml to MANIFEST: $${'@'}\n"
+CODE
+
+ my $add_meta_to_distdir = $self->cd('$(DISTVNAME)', $add_meta);
+
+ return sprintf <<'MAKE', $add_meta_to_distdir;
+distmeta : create_distdir metafile
+ $(NOECHO) %s
+
+MAKE
+
+}
+
+
+=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 <schwern@pobox.com> and the denizens of
+makemaker@perl.org with code from ExtUtils::MM_Unix and
+ExtUtils::MM_Win32.
+
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm
new file mode 100644
index 00000000000..0b7c8db9225
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm
@@ -0,0 +1,61 @@
+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.56';
+
+
+=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__
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm
new file mode 100644
index 00000000000..394fbc68a75
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm
@@ -0,0 +1,123 @@
+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.56';
+
+
+=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);
+}
+
+=back
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm
new file mode 100644
index 00000000000..fc0a7947235
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm
@@ -0,0 +1,65 @@
+package ExtUtils::MM_DOS;
+
+use strict;
+
+our $VERSION = 6.56;
+
+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 <schwern@pobox.com> with code from ExtUtils::MM_Unix
+
+=head1 SEE ALSO
+
+L<ExtUtils::MM_Unix>, L<ExtUtils::MakeMaker>
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm
new file mode 100644
index 00000000000..1cb87c78815
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm
@@ -0,0 +1,47 @@
+package ExtUtils::MM_Darwin;
+
+use strict;
+
+BEGIN {
+ require ExtUtils::MM_Unix;
+ our @ISA = qw( ExtUtils::MM_Unix );
+}
+
+our $VERSION = '6.56';
+
+
+=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;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm
new file mode 100644
index 00000000000..cfc82051e1b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm
@@ -0,0 +1,40 @@
+package ExtUtils::MM_MacOS;
+
+use strict;
+
+our $VERSION = 6.56;
+
+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 makemaker@perl.org, but we
+really encourage you to work on Module::Build instead.
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm
new file mode 100644
index 00000000000..0c8f6c0affb
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm
@@ -0,0 +1,269 @@
+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.56';
+
+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
+
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm
new file mode 100644
index 00000000000..680502baf24
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm
@@ -0,0 +1,152 @@
+package ExtUtils::MM_OS2;
+
+use strict;
+
+use ExtUtils::MakeMaker qw(neatvalue);
+use File::Spec;
+
+our $VERSION = '6.56';
+
+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;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm
new file mode 100644
index 00000000000..f78d5e8a9ee
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm
@@ -0,0 +1,57 @@
+package ExtUtils::MM_QNX;
+
+use strict;
+our $VERSION = '6.56';
+
+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 <schwern@pobox.com> with code from ExtUtils::MM_Unix
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm
new file mode 100644
index 00000000000..5adc46ea8d2
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm
@@ -0,0 +1,64 @@
+package ExtUtils::MM_UWIN;
+
+use strict;
+our $VERSION = 6.56;
+
+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 <schwern@pobox.com> with code from ExtUtils::MM_Unix
+
+=head1 SEE ALSO
+
+L<ExtUtils::MM_Win32>, L<ExtUtils::MakeMaker>
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm
new file mode 100644
index 00000000000..239d6df826c
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm
@@ -0,0 +1,3634 @@
+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.56';
+
+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 makemaker@perl.org 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 ) = @_;
+
+ my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/;
+ 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.
+ # 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 ($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;
+ next;
+ }
+
+ 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);
+}
+
+
+=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\s-\s)(.*)/;
+ $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)/;
+ 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)/cc_runtime.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/</&lt;/g;
+ $abstract =~ s/>/&gt;/g;
+
+ my $author = $self->{AUTHOR} || '';
+ $author =~ s/</&lt;/g;
+ $author =~ s/>/&gt;/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__
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm
new file mode 100644
index 00000000000..2066d035976
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm
@@ -0,0 +1,1994 @@
+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.56';
+
+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 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.
+
+=cut
+
+sub extra_clean_files {
+ return qw(
+ *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso
+ .MM_Tmp
+ );
+}
+
+
+=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)cc_runtime.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<bailey@newman.upenn.edu>
+
+Maintained by Michael G Schwern F<schwern@pobox.com>
+
+See L<ExtUtils::MakeMaker> for patching and contact information.
+
+
+=cut
+
+1;
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm
new file mode 100644
index 00000000000..1814a1dae4c
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm
@@ -0,0 +1,50 @@
+package ExtUtils::MM_VOS;
+
+use strict;
+our $VERSION = '6.56';
+
+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 <schwern@pobox.com> with code from ExtUtils::MM_Unix
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm
new file mode 100644
index 00000000000..19e462de593
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm
@@ -0,0 +1,585 @@
+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.56';
+
+$ENV{EMXSHELL} = 'sh'; # to run `commands`
+
+my $BORLAND = $Config{'cc'} =~ /^bcc/i ? 1 : 0;
+my $GCC = $Config{'cc'} =~ /\bgcc$/i ? 1 : 0;
+my $DLLTOOL = $Config{'dlltool'} || '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;
+}
+
+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 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);
+
+# one thing for GCC/Mingw32:
+# we try to overcome non-relocateable-DLL problems by generating
+# a (hopefully unique) image-base from the dll's name
+# -- BKS, 10-19-1999
+ if ($GCC) {
+ my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
+ $dllname =~ /(....)(.{0,4})/;
+ my $baseaddr = unpack("n", $1 ^ $2);
+ $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
+ }
+
+ 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 $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
+ if exist $@.manifest del $@.manifest});
+ }
+ 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) = @_;
+
+ # I don't know if this is correct, but it seems to work on
+ # Win98's command.com
+ $text =~ s{"}{\\"}g;
+
+ # 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
+
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm
new file mode 100644
index 00000000000..c47147695e8
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm
@@ -0,0 +1,124 @@
+package ExtUtils::MM_Win95;
+
+use strict;
+
+our $VERSION = '6.56';
+
+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<schwern@pobox.com>.
+
+Send patches and ideas to C<makemaker@perl.org>.
+
+See http://www.makemaker.org.
+
+=cut
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm
new file mode 100644
index 00000000000..bed177d210a
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm
@@ -0,0 +1,40 @@
+package ExtUtils::MY;
+
+use strict;
+require ExtUtils::MM;
+
+our $VERSION = 6.56;
+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
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm
new file mode 100644
index 00000000000..4422b686ce7
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm
@@ -0,0 +1,2807 @@
+# $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.56';
+
+# 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 {
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ require ExtUtils::MY;
+ my %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 = (
+ 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 _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) = @_;
+ Carp::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::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 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);
+
+ # Store the original args passed to WriteMakefile()
+ foreach my $k (keys %$self) {
+ $self->{ARGS}{$k} = $self->{$k};
+ }
+
+ $self = {} unless defined $self;
+
+ $self->{PREREQ_PM} ||= {};
+ $self->{BUILD_REQUIRES} ||= {};
+
+ # 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";
+
+ 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"){
+ 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) {
+ warn <<'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};
+
+ $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};
+
+ $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}}};
+ $self = { %$self, %configure_att };
+ } else {
+ Carp::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::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 {
+ Carp::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";
+ }
+
+ close $fh;
+ _rename("MakeMaker.tmp", $finalname) or
+ warn "rename MakeMaker.tmp => $finalname: $!";
+ chmod 0644, $finalname unless $Is_VMS;
+
+ 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)." }";
+}
+
+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
+
+String containing name (and email address) of package author(s). Is used
+in 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 F<META.yml>.
+
+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 F<META.yml>.
+
+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 F<META.yml>.
+
+They differ in how they behave if they have the same key as the
+default metadata. META_ADD will override the default value with it's
+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 module meta-data file during 'make distdir'.
+
+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.
+
+The only situation where it is appropriate is when you have
+dependencies that are indispensible to actually I<write> a
+F<Makefile>. For example, MakeMaker's F<Makefile.PL> needs L<File::Spec>.
+If its not available it cannot write the F<Makefile>.
+
+Note: see L<Test::Harness> for a shortcut for stopping tests early
+if you are missing dependencies and are afraid that users might
+use your module with an incomplete environment.
+
+=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 F<META.yml>.
+
+ 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<makemaker@perl.org>
+
+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 a META.yml 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
+
+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>. To this end a simple module
+meta-data file has been introduced, F<META.yml>.
+
+F<META.yml> is a YAML document (see http://www.yaml.org) containing
+basic information about the module (name, version, prerequisites...)
+in an easy to read format. The format is developed and defined by the
+Module::Build developers (see
+http://module-build.sourceforge.net/META-spec.html)
+
+MakeMaker will automatically generate a F<META.yml> file for you and
+add it 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.
+
+
+=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.
+
+=head1 AUTHORS
+
+Andy Dougherty C<doughera@lafayette.edu>, Andreas KE<ouml>nig
+C<andreas.koenig@mind.de>, Tim Bunce C<timb@cpan.org>. VMS
+support by Charles Bailey C<bailey@newman.upenn.edu>. OS/2 support
+by Ilya Zakharevich C<ilya@math.ohio-state.edu>.
+
+Currently maintained by Michael G Schwern C<schwern@pobox.com>
+
+Send patches and ideas to C<makemaker@perl.org>.
+
+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>.
+
+=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
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm
new file mode 100644
index 00000000000..38b60affdda
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm
@@ -0,0 +1,39 @@
+package ExtUtils::MakeMaker::Config;
+
+use strict;
+
+our $VERSION = '6.56';
+
+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
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod
new file mode 100644
index 00000000000..d33f82e53b9
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod
@@ -0,0 +1,431 @@
+package ExtUtils::MakeMaker::FAQ;
+
+our $VERSION = '1.12';
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::MakeMaker::FAQ - Frequently Asked Questions About MakeMaker
+
+=head1 DESCRIPTION
+
+FAQs, tricks and tips for C<ExtUtils::MakeMaker>.
+
+
+=head2 Module Installation
+
+=over 4
+
+=item How do I install a module into my home directory?
+
+If you're not the Perl administrator you probably don't have
+permission to install a module to its default location. Then you
+should install it for your own use into your home directory like so:
+
+ # Non-unix folks, replace ~ with /path/to/your/home/dir
+ perl Makefile.PL INSTALL_BASE=~
+
+This will put modules into F<~/lib/perl5>, man pages into F<~/man> and
+programs into F<~/bin>.
+
+To ensure your Perl programs can see these newly installed modules,
+set your C<PERL5LIB> environment variable to F<~/lib/perl5> or tell
+each of your programs to look in that directory with the following:
+
+ use lib "$ENV{HOME}/lib/perl5";
+
+or if $ENV{HOME} isn't set and you don't want to set it for some
+reason, do it the long way.
+
+ use lib "/path/to/your/home/dir/lib/perl5";
+
+
+=item How do I get MakeMaker and Module::Build to install to the same place?
+
+Module::Build, as of 0.28, supports two ways to install to the same
+location as MakeMaker.
+
+1) Use INSTALL_BASE / C<--install_base>
+
+MakeMaker (as of 6.31) and Module::Build (as of 0.28) both can install
+to the same locations using the "install_base" concept. See
+L<ExtUtils::MakeMaker/INSTALL_BASE> for details. To get MM and MB to
+install to the same location simply set INSTALL_BASE in MM and
+C<--install_base> in MB to the same location.
+
+ perl Makefile.PL INSTALL_BASE=/whatever
+ perl Build.PL --install_base /whatever
+
+2) Use PREFIX / C<--prefix>
+
+Module::Build 0.28 added support for C<--prefix> which works like
+MakeMaker's PREFIX.
+
+ perl Makefile.PL PREFIX=/whatever
+ perl Build.PL --prefix /whatever
+
+
+=item How do I keep from installing man pages?
+
+Recent versions of MakeMaker will only install man pages on Unix like
+operating systems.
+
+For an individual module:
+
+ perl Makefile.PL INSTALLMAN1DIR=none INSTALLMAN3DIR=none
+
+If you want to suppress man page installation for all modules you have
+to reconfigure Perl and tell it 'none' when it asks where to install
+man pages.
+
+
+=item How do I use a module without installing it?
+
+Two ways. One is to build the module normally...
+
+ perl Makefile.PL
+ make
+ make test
+
+...and then set the PERL5LIB environment variable to point at the
+blib/lib and blib/arch directories.
+
+The other is to install the module in a temporary location.
+
+ perl Makefile.PL INSTALL_BASE=~/tmp
+ make
+ make test
+ make install
+
+And then set PERL5LIB to F<~/tmp/lib/perl5>. This works well when you
+have multiple modules to work with. It also ensures that the module
+goes through its full installation process which may modify it.
+
+=item PREFIX vs INSTALL_BASE from Module::Build::Cookbook
+
+The behavior of PREFIX is complicated and depends closely on how your
+Perl is configured. The resulting installation locations will vary from
+machine to machine and even different installations of Perl on the same machine.
+Because of this, its difficult to document where prefix will place your modules.
+
+In contrast, INSTALL_BASE has predictable, easy to explain installation locations.
+Now that Module::Build and MakeMaker both have INSTALL_BASE there is little reason
+to use PREFIX other than to preserve your existing installation locations. If you
+are starting a fresh Perl installation we encourage you to use INSTALL_BASE. If
+you have an existing installation installed via PREFIX, consider moving it to an
+installation structure matching INSTALL_BASE and using that instead.
+
+=back
+
+
+=head2 Philosophy and History
+
+=over 4
+
+=item Why not just use <insert other build config tool here>?
+
+Why did MakeMaker reinvent the build configuration wheel? Why not
+just use autoconf or automake or ppm or Ant or ...
+
+There are many reasons, but the major one is cross-platform
+compatibility.
+
+Perl is one of the most ported pieces of software ever. It works on
+operating systems I've never even heard of (see perlport for details).
+It needs a build tool that can work on all those platforms and with
+any wacky C compilers and linkers they might have.
+
+No such build tool exists. Even make itself has wildly different
+dialects. So we have to build our own.
+
+
+=item What is Module::Build and how does it relate to MakeMaker?
+
+Module::Build is a project by Ken Williams to supplant MakeMaker.
+Its primary advantages are:
+
+=over 8
+
+=item * pure perl. no make, no shell commands
+
+=item * easier to customize
+
+=item * cleaner internals
+
+=item * less cruft
+
+=back
+
+Module::Build is the official heir apparent to MakeMaker and we
+encourage people to work on M::B rather than spending time adding features
+to MakeMaker.
+
+=back
+
+
+=head2 Module Writing
+
+=over 4
+
+=item How do I keep my $VERSION up to date without resetting it manually?
+
+Often you want to manually set the $VERSION in the main module
+distribution because this is the version that everybody sees on CPAN
+and maybe you want to customize it a bit. But for all the other
+modules in your dist, $VERSION is really just bookkeeping and all that's
+important is it goes up every time the module is changed. Doing this
+by hand is a pain and you often forget.
+
+Simplest way to do it automatically is to use your version control
+system's revision number (you are using version control, right?).
+
+In CVS, RCS and SVN you use $Revision$ (see the documentation of your
+version control system for details). Every time the file is checked
+in the $Revision$ will be updated, updating your $VERSION.
+
+SVN uses a simple integer for $Revision$ so you can adapt it for your
+$VERSION like so:
+
+ ($VERSION) = q$Revision$ =~ /(\d+)/;
+
+In CVS and RCS version 1.9 is followed by 1.10. Since CPAN compares
+version numbers numerically we use a sprintf() to convert 1.9 to 1.009
+and 1.10 to 1.010 which compare properly.
+
+ $VERSION = sprintf "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/g;
+
+If branches are involved (ie. $Revision: 1.5.3.4$) its a little more
+complicated.
+
+ # must be all on one line or MakeMaker will get confused.
+ $VERSION = do { my @r = (q$Revision$ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
+
+In SVN, $Revision$ should be the same for every file in the project so
+they would all have the same $VERSION. CVS and RCS have a different
+$Revision$ per file so each file will have a differnt $VERSION.
+Distributed version control systems, such as SVK, may have a different
+$Revision$ based on who checks out the file leading to a different $VERSION
+on each machine! Finally, some distributed version control systems, such
+as darcs, have no concept of revision number at all.
+
+
+=item What's this F<META.yml> thing and how did it get in my F<MANIFEST>?!
+
+F<META.yml> is a module meta-data file pioneered by Module::Build and
+automatically generated as part of the 'distdir' target (and thus
+'dist'). See L<ExtUtils::MakeMaker/"Module Meta-Data">.
+
+To shut off its generation, pass the C<NO_META> flag to C<WriteMakefile()>.
+
+
+=item How do I delete everything not in my F<MANIFEST>?
+
+Some folks are surpried that C<make distclean> does not delete
+everything not listed in their MANIFEST (thus making a clean
+distribution) but only tells them what they need to delete. This is
+done because it is considered too dangerous. While developing your
+module you might write a new file, not add it to the MANIFEST, then
+run a C<distclean> and be sad because your new work was deleted.
+
+If you really want to do this, you can use
+C<ExtUtils::Manifest::manifind()> to read the MANIFEST and File::Find
+to delete the files. But you have to be careful. Here's a script to
+do that. Use at your own risk. Have fun blowing holes in your foot.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+
+ use File::Spec;
+ use File::Find;
+ use ExtUtils::Manifest qw(maniread);
+
+ my %manifest = map {( $_ => 1 )}
+ grep { File::Spec->canonpath($_) }
+ keys %{ maniread() };
+
+ if( !keys %manifest ) {
+ print "No files found in MANIFEST. Stopping.\n";
+ exit;
+ }
+
+ find({
+ wanted => sub {
+ my $path = File::Spec->canonpath($_);
+
+ return unless -f $path;
+ return if exists $manifest{ $path };
+
+ print "unlink $path\n";
+ unlink $path;
+ },
+ no_chdir => 1
+ },
+ "."
+ );
+
+
+=item Which zip should I use on Windows for '[nd]make zipdist'?
+
+We recommend InfoZIP: L<http://www.info-zip.org/Zip.html>
+
+
+=back
+
+=head2 XS
+
+=over 4
+
+=item How to I prevent "object version X.XX does not match bootstrap parameter Y.YY" errors?
+
+XS code is very sensitive to the module version number and will
+complain if the version number in your Perl module doesn't match. If
+you change your module's version # without rerunning Makefile.PL the old
+version number will remain in the Makefile causing the XS code to be built
+with the wrong number.
+
+To avoid this, you can force the Makefile to be rebuilt whenever you
+change the module containing the version number by adding this to your
+WriteMakefile() arguments.
+
+ depend => { '$(FIRST_MAKEFILE)' => '$(VERSION_FROM)' }
+
+
+=item How do I make two or more XS files coexist in the same directory?
+
+Sometimes you need to have two and more XS files in the same package.
+One way to go is to put them into separate directories, but sometimes
+this is not the most suitable solution. The following technique allows
+you to put two (and more) XS files in the same directory.
+
+Let's assume that we have a package C<Cool::Foo>, which includes
+C<Cool::Foo> and C<Cool::Bar> modules each having a separate XS
+file. First we use the following I<Makefile.PL>:
+
+ use ExtUtils::MakeMaker;
+
+ WriteMakefile(
+ NAME => 'Cool::Foo',
+ VERSION_FROM => 'Foo.pm',
+ OBJECT => q/$(O_FILES)/,
+ # ... other attrs ...
+ );
+
+Notice the C<OBJECT> attribute. MakeMaker generates the following
+variables in I<Makefile>:
+
+ # Handy lists of source code files:
+ XS_FILES= Bar.xs \
+ Foo.xs
+ C_FILES = Bar.c \
+ Foo.c
+ O_FILES = Bar.o \
+ Foo.o
+
+Therefore we can use the C<O_FILES> variable to tell MakeMaker to use
+these objects into the shared library.
+
+That's pretty much it. Now write I<Foo.pm> and I<Foo.xs>, I<Bar.pm>
+and I<Bar.xs>, where I<Foo.pm> bootstraps the shared library and
+I<Bar.pm> simply loading I<Foo.pm>.
+
+The only issue left is to how to bootstrap I<Bar.xs>. This is done
+from I<Foo.xs>:
+
+ MODULE = Cool::Foo PACKAGE = Cool::Foo
+
+ BOOT:
+ # boot the second XS file
+ boot_Cool__Bar(aTHX_ cv);
+
+If you have more than two files, this is the place where you should
+boot extra XS files from.
+
+The following four files sum up all the details discussed so far.
+
+ Foo.pm:
+ -------
+ package Cool::Foo;
+
+ require DynaLoader;
+
+ our @ISA = qw(DynaLoader);
+ our $VERSION = '0.01';
+ bootstrap Cool::Foo $VERSION;
+
+ 1;
+
+ Bar.pm:
+ -------
+ package Cool::Bar;
+
+ use Cool::Foo; # bootstraps Bar.xs
+
+ 1;
+
+ Foo.xs:
+ -------
+ #include "EXTERN.h"
+ #include "perl.h"
+ #include "XSUB.h"
+
+ MODULE = Cool::Foo PACKAGE = Cool::Foo
+
+ BOOT:
+ # boot the second XS file
+ boot_Cool__Bar(aTHX_ cv);
+
+ MODULE = Cool::Foo PACKAGE = Cool::Foo PREFIX = cool_foo_
+
+ void
+ cool_foo_perl_rules()
+
+ CODE:
+ fprintf(stderr, "Cool::Foo says: Perl Rules\n");
+
+ Bar.xs:
+ -------
+ #include "EXTERN.h"
+ #include "perl.h"
+ #include "XSUB.h"
+
+ MODULE = Cool::Bar PACKAGE = Cool::Bar PREFIX = cool_bar_
+
+ void
+ cool_bar_perl_rules()
+
+ CODE:
+ fprintf(stderr, "Cool::Bar says: Perl Rules\n");
+
+And of course a very basic test:
+
+ t/cool.t:
+ --------
+ use Test;
+ BEGIN { plan tests => 1 };
+ use Cool::Foo;
+ use Cool::Bar;
+ Cool::Foo::perl_rules();
+ Cool::Bar::perl_rules();
+ ok 1;
+
+This tip has been brought to you by Nick Ing-Simmons and Stas Bekman.
+
+=back
+
+=head1 PATCHING
+
+If you have a question you'd like to see added to the FAQ (whether or
+not you have the answer) please send it to makemaker@perl.org.
+
+=head1 AUTHOR
+
+The denizens of makemaker@perl.org.
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod
new file mode 100644
index 00000000000..8ad72649b1a
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod
@@ -0,0 +1,180 @@
+package ExtUtils::MakeMaker::Tutorial;
+
+our $VERSION = 0.02;
+
+
+=head1 NAME
+
+ExtUtils::MakeMaker::Tutorial - Writing a module with MakeMaker
+
+=head1 SYNOPSIS
+
+ use ExtUtils::MakeMaker;
+
+ WriteMakefile(
+ NAME => 'Your::Module',
+ VERSION_FROM => 'lib/Your/Module.pm'
+ );
+
+=head1 DESCRIPTION
+
+This is a short tutorial on writing a simple module with MakeMaker.
+Its really not that hard.
+
+
+=head2 The Mantra
+
+MakeMaker modules are installed using this simple mantra
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+There are lots more commands and options, but the above will do it.
+
+
+=head2 The Layout
+
+The basic files in a module look something like this.
+
+ Makefile.PL
+ MANIFEST
+ lib/Your/Module.pm
+
+That's all that's strictly necessary. There's additional files you might
+want:
+
+ lib/Your/Other/Module.pm
+ t/some_test.t
+ t/some_other_test.t
+ Changes
+ README
+ INSTALL
+ MANIFEST.SKIP
+ bin/some_program
+
+=over 4
+
+=item Makefile.PL
+
+When you run Makefile.PL, it makes a Makefile. That's the whole point of
+MakeMaker. The Makefile.PL is a simple program which loads
+ExtUtils::MakeMaker and runs the WriteMakefile() function to generate a
+Makefile.
+
+Here's an example of what you need for a simple module:
+
+ use ExtUtils::MakeMaker;
+
+ WriteMakefile(
+ NAME => 'Your::Module',
+ VERSION_FROM => 'lib/Your/Module.pm'
+ );
+
+NAME is the top-level namespace of your module. VERSION_FROM is the file
+which contains the $VERSION variable for the entire distribution. Typically
+this is the same as your top-level module.
+
+
+=item MANIFEST
+
+A simple listing of all the files in your distribution.
+
+ Makefile.PL
+ MANIFEST
+ lib/Your/Module.pm
+
+File paths in a MANIFEST always use Unix conventions (ie. /) even if you're
+not on Unix.
+
+You can write this by hand or generate it with 'make manifest'.
+
+See L<ExtUtils::Manifest> for more details.
+
+
+=item lib/
+
+This is the directory where your .pm and .pod files you wish to have
+installed go. They are layed out according to namespace. So Foo::Bar
+is F<lib/Foo/Bar.pm>.
+
+
+=item t/
+
+Tests for your modules go here. Each test filename ends with a .t.
+So F<t/foo.t>/ 'make test' will run these tests. The directory is flat,
+you cannot, for example, have t/foo/bar.t run by 'make test'.
+
+Tests are run from the top level of your distribution. So inside a test
+you would refer to ./lib to enter the lib directory, for example.
+
+
+=item Changes
+
+A log of changes you've made to this module. The layout is free-form.
+Here's an example:
+
+ 1.01 Fri Apr 11 00:21:25 PDT 2003
+ - thing() does some stuff now
+ - fixed the wiggy bug in withit()
+
+ 1.00 Mon Apr 7 00:57:15 PDT 2003
+ - "Rain of Frogs" now supported
+
+
+=item README
+
+A short description of your module, what it does, why someone would use it
+and its limitations. CPAN automatically pulls your README file out of
+the archive and makes it available to CPAN users, it is the first thing
+they will read to decide if your module is right for them.
+
+
+=item INSTALL
+
+Instructions on how to install your module along with any dependencies.
+Suggested information to include here:
+
+ any extra modules required for use
+ the minimum version of Perl required
+ if only works on certain operating systems
+
+
+=item MANIFEST.SKIP
+
+A file full of regular expressions to exclude when using 'make
+manifest' to generate the MANIFEST. These regular expressions
+are checked against each file path found in the distribution (so
+you're matching against "t/foo.t" not "foo.t").
+
+Here's a sample:
+
+ ~$ # ignore emacs and vim backup files
+ .bak$ # ignore manual backups
+ \# # ignore CVS old revision files and emacs temp files
+
+Since # can be used for comments, # must be escaped.
+
+MakeMaker comes with a default MANIFEST.SKIP to avoid things like
+version control directories and backup files. Specifying your own
+will override this default.
+
+
+=item bin/
+
+
+=back
+
+=head1 SEE ALSO
+
+L<perlmodstyle> gives stylistic help writing a module.
+
+L<perlnewmod> gives more information about how to write a module.
+
+There are modules to help you through the process of writing a module:
+L<ExtUtils::ModuleMaker>, L<Module::Install>, L<PAR>
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm
new file mode 100644
index 00000000000..df621d5f435
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm
@@ -0,0 +1,881 @@
+package ExtUtils::Manifest;
+
+require Exporter;
+use Config;
+use File::Basename;
+use File::Copy 'copy';
+use File::Find;
+use File::Spec;
+use Carp;
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT_OK
+ $Is_MacOS $Is_VMS $Is_VMS_mode $Is_VMS_lc $Is_VMS_nodot
+ $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
+
+$VERSION = '1.57';
+@ISA=('Exporter');
+@EXPORT_OK = qw(mkmanifest
+ manicheck filecheck fullcheck skipcheck
+ manifind maniread manicopy maniadd
+ maniskip
+ );
+
+$Is_MacOS = $^O eq 'MacOS';
+$Is_VMS = $^O eq 'VMS';
+$Is_VMS_mode = 0;
+$Is_VMS_lc = 0;
+$Is_VMS_nodot = 0; # No dots in dir names or double dots in files
+
+if ($Is_VMS) {
+ require VMS::Filespec if $Is_VMS;
+ my $vms_unix_rpt;
+ my $vms_efs;
+ my $vms_case;
+
+ $Is_VMS_mode = 1;
+ $Is_VMS_lc = 1;
+ $Is_VMS_nodot = 1;
+ if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+ $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+ $vms_efs = VMS::Feature::current("efs_charset");
+ $vms_case = VMS::Feature::current("efs_case_preserve");
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ $vms_case = $efs_case =~ /^[ET1]/i;
+ }
+ $Is_VMS_lc = 0 if ($vms_case);
+ $Is_VMS_mode = 0 if ($vms_unix_rpt);
+ $Is_VMS_nodot = 0 if ($vms_efs);
+}
+
+$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
+$Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
+ $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
+$Quiet = 0;
+$MANIFEST = 'MANIFEST';
+
+$DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" );
+
+
+=head1 NAME
+
+ExtUtils::Manifest - utilities to write and check a MANIFEST file
+
+=head1 SYNOPSIS
+
+ use ExtUtils::Manifest qw(...funcs to import...);
+
+ mkmanifest();
+
+ my @missing_files = manicheck;
+ my @skipped = skipcheck;
+ my @extra_files = filecheck;
+ my($missing, $extra) = fullcheck;
+
+ my $found = manifind();
+
+ my $manifest = maniread();
+
+ manicopy($read,$target);
+
+ maniadd({$file => $comment, ...});
+
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+ExtUtils::Manifest exports no functions by default. The following are
+exported on request
+
+=over 4
+
+=item mkmanifest
+
+ mkmanifest();
+
+Writes all files in and below the current directory to your F<MANIFEST>.
+It works similar to the result of the Unix command
+
+ find . > MANIFEST
+
+All files that match any regular expression in a file F<MANIFEST.SKIP>
+(if it exists) are ignored.
+
+Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.
+
+=cut
+
+sub _sort {
+ return sort { lc $a cmp lc $b } @_;
+}
+
+sub mkmanifest {
+ my $manimiss = 0;
+ my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
+ $read = {} if $manimiss;
+ local *M;
+ my $bakbase = $MANIFEST;
+ $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots
+ rename $MANIFEST, "$bakbase.bak" unless $manimiss;
+ open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!";
+ my $skip = maniskip();
+ my $found = manifind();
+ my($key,$val,$file,%all);
+ %all = (%$found, %$read);
+ $all{$MANIFEST} = ($Is_VMS_mode ? "$MANIFEST\t\t" : '') .
+ 'This list of files'
+ if $manimiss; # add new MANIFEST to known file list
+ foreach $file (_sort keys %all) {
+ if ($skip->($file)) {
+ # Policy: only remove files if they're listed in MANIFEST.SKIP.
+ # Don't remove files just because they don't exist.
+ warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
+ next;
+ }
+ if ($Verbose){
+ warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
+ }
+ my $text = $all{$file};
+ $file = _unmacify($file);
+ my $tabs = (5 - (length($file)+1)/8);
+ $tabs = 1 if $tabs < 1;
+ $tabs = 0 unless $text;
+ if ($file =~ /\s/) {
+ $file =~ s/([\\'])/\\$1/g;
+ $file = "'$file'";
+ }
+ print M $file, "\t" x $tabs, $text, "\n";
+ }
+ close M;
+}
+
+# Geez, shouldn't this use File::Spec or File::Basename or something?
+# Why so careful about dependencies?
+sub clean_up_filename {
+ my $filename = shift;
+ $filename =~ s|^\./||;
+ $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
+ return $filename;
+}
+
+
+=item manifind
+
+ my $found = manifind();
+
+returns a hash reference. The keys of the hash are the files found
+below the current directory.
+
+=cut
+
+sub manifind {
+ my $p = shift || {};
+ my $found = {};
+
+ my $wanted = sub {
+ my $name = clean_up_filename($File::Find::name);
+ warn "Debug: diskfile $name\n" if $Debug;
+ return if -d $_;
+
+ if( $Is_VMS_lc ) {
+ $name =~ s#(.*)\.$#\L$1#;
+ $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
+ }
+ $found->{$name} = "";
+ };
+
+ # We have to use "$File::Find::dir/$_" in preprocess, because
+ # $File::Find::name is unavailable.
+ # Also, it's okay to use / here, because MANIFEST files use Unix-style
+ # paths.
+ find({wanted => $wanted},
+ $Is_MacOS ? ":" : ".");
+
+ return $found;
+}
+
+
+=item manicheck
+
+ my @missing_files = manicheck();
+
+checks if all the files within a C<MANIFEST> in the current directory
+really do exist. If C<MANIFEST> and the tree below the current
+directory are in sync it silently returns an empty list.
+Otherwise it returns a list of files which are listed in the
+C<MANIFEST> but missing from the directory, and by default also
+outputs these names to STDERR.
+
+=cut
+
+sub manicheck {
+ return _check_files();
+}
+
+
+=item filecheck
+
+ my @extra_files = filecheck();
+
+finds files below the current directory that are not mentioned in the
+C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be
+consulted. Any file matching a regular expression in such a file will
+not be reported as missing in the C<MANIFEST> file. The list of any
+extraneous files found is returned, and by default also reported to
+STDERR.
+
+=cut
+
+sub filecheck {
+ return _check_manifest();
+}
+
+
+=item fullcheck
+
+ my($missing, $extra) = fullcheck();
+
+does both a manicheck() and a filecheck(), returning then as two array
+refs.
+
+=cut
+
+sub fullcheck {
+ return [_check_files()], [_check_manifest()];
+}
+
+
+=item skipcheck
+
+ my @skipped = skipcheck();
+
+lists all the files that are skipped due to your C<MANIFEST.SKIP>
+file.
+
+=cut
+
+sub skipcheck {
+ my($p) = @_;
+ my $found = manifind();
+ my $matches = maniskip();
+
+ my @skipped = ();
+ foreach my $file (_sort keys %$found){
+ if (&$matches($file)){
+ warn "Skipping $file\n" unless $Quiet;
+ push @skipped, $file;
+ next;
+ }
+ }
+
+ return @skipped;
+}
+
+
+sub _check_files {
+ my $p = shift;
+ my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
+ my $read = maniread() || {};
+ my $found = manifind($p);
+
+ my(@missfile) = ();
+ foreach my $file (_sort keys %$read){
+ warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
+ if ($dosnames){
+ $file = lc $file;
+ $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
+ $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
+ }
+ unless ( exists $found->{$file} ) {
+ warn "No such file: $file\n" unless $Quiet;
+ push @missfile, $file;
+ }
+ }
+
+ return @missfile;
+}
+
+
+sub _check_manifest {
+ my($p) = @_;
+ my $read = maniread() || {};
+ my $found = manifind($p);
+ my $skip = maniskip();
+
+ my @missentry = ();
+ foreach my $file (_sort keys %$found){
+ next if $skip->($file);
+ warn "Debug: manicheck checking from disk $file\n" if $Debug;
+ unless ( exists $read->{$file} ) {
+ my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
+ warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
+ push @missentry, $file;
+ }
+ }
+
+ return @missentry;
+}
+
+
+=item maniread
+
+ my $manifest = maniread();
+ my $manifest = maniread($manifest_file);
+
+reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current
+directory) and returns a HASH reference with files being the keys and
+comments being the values of the HASH. Blank lines and lines which
+start with C<#> in the C<MANIFEST> file are discarded.
+
+=cut
+
+sub maniread {
+ my ($mfile) = @_;
+ $mfile ||= $MANIFEST;
+ my $read = {};
+ local *M;
+ unless (open M, "< $mfile"){
+ warn "Problem opening $mfile: $!";
+ return $read;
+ }
+ local $_;
+ while (<M>){
+ chomp;
+ next if /^\s*#/;
+
+ my($file, $comment);
+
+ # filename may contain spaces if enclosed in ''
+ # (in which case, \\ and \' are escapes)
+ if (($file, $comment) = /^'(\\[\\']|.+)+'\s*(.*)/) {
+ $file =~ s/\\([\\'])/$1/g;
+ }
+ else {
+ ($file, $comment) = /^(\S+)\s*(.*)/;
+ }
+ next unless $file;
+
+ if ($Is_MacOS) {
+ $file = _macify($file);
+ $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
+ }
+ elsif ($Is_VMS_mode) {
+ require File::Basename;
+ my($base,$dir) = File::Basename::fileparse($file);
+ # Resolve illegal file specifications in the same way as tar
+ if ($Is_VMS_nodot) {
+ $dir =~ tr/./_/;
+ my(@pieces) = split(/\./,$base);
+ if (@pieces > 2)
+ { $base = shift(@pieces) . '.' . join('_',@pieces); }
+ my $okfile = "$dir$base";
+ warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
+ $file = $okfile;
+ }
+ $file = lc($file)
+ unless $Is_VMS_lc &&($file =~ /^MANIFEST(\.SKIP)?$/);
+ }
+
+ $read->{$file} = $comment;
+ }
+ close M;
+ $read;
+}
+
+=item maniskip
+
+ my $skipchk = maniskip();
+ my $skipchk = maniskip($manifest_skip_file);
+
+ if ($skipchk->($file)) { .. }
+
+reads a named C<MANIFEST.SKIP> file (defaults to C<MANIFEST.SKIP> in
+the current directory) and returns a CODE reference that tests whether
+a given filename should be skipped.
+
+=cut
+
+# returns an anonymous sub that decides if an argument matches
+sub maniskip {
+ my @skip ;
+ my $mfile = shift || "$MANIFEST.SKIP";
+ _check_mskip_directives($mfile) if -f $mfile;
+ local(*M, $_);
+ open M, "< $mfile" or open M, "< $DEFAULT_MSKIP" or return sub {0};
+ while (<M>){
+ chomp;
+ s/\r//;
+ $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$};
+ #my $comment = $3;
+ my $filename = $2;
+ if ( defined($1) ) {
+ $filename = $1;
+ $filename =~ s/\\(['\\])/$1/g;
+ }
+ next if (not defined($filename) or not $filename);
+ push @skip, _macify($filename);
+ }
+ close M;
+ return sub {0} unless (scalar @skip > 0);
+
+ my $opts = $Is_VMS_mode ? '(?i)' : '';
+
+ # Make sure each entry is isolated in its own parentheses, in case
+ # any of them contain alternations
+ my $regex = join '|', map "(?:$_)", @skip;
+
+ return sub { $_[0] =~ qr{$opts$regex} };
+}
+
+# checks for the special directives
+# #!include_default
+# #!include /path/to/some/manifest.skip
+# in a custom MANIFEST.SKIP for, for including
+# the content of, respectively, the default MANIFEST.SKIP
+# and an external manifest.skip file
+sub _check_mskip_directives {
+ my $mfile = shift;
+ local (*M, $_);
+ my @lines = ();
+ my $flag = 0;
+ unless (open M, "< $mfile") {
+ warn "Problem opening $mfile: $!";
+ return;
+ }
+ while (<M>) {
+ if (/^#!include_default\s*$/) {
+ if (my @default = _include_mskip_file()) {
+ push @lines, @default;
+ warn "Debug: Including default MANIFEST.SKIP\n" if $Debug;
+ $flag++;
+ }
+ next;
+ }
+ if (/^#!include\s+(.*)\s*$/) {
+ my $external_file = $1;
+ if (my @external = _include_mskip_file($external_file)) {
+ push @lines, @external;
+ warn "Debug: Including external $external_file\n" if $Debug;
+ $flag++;
+ }
+ next;
+ }
+ push @lines, $_;
+ }
+ close M;
+ return unless $flag;
+ my $bakbase = $mfile;
+ $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots
+ rename $mfile, "$bakbase.bak";
+ warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug;
+ unless (open M, "> $mfile") {
+ warn "Problem opening $mfile: $!";
+ return;
+ }
+ print M $_ for (@lines);
+ close M;
+ return;
+}
+
+# returns an array containing the lines of an external
+# manifest.skip file, if given, or $DEFAULT_MSKIP
+sub _include_mskip_file {
+ my $mskip = shift || $DEFAULT_MSKIP;
+ unless (-f $mskip) {
+ warn qq{Included file "$mskip" not found - skipping};
+ return;
+ }
+ local (*M, $_);
+ unless (open M, "< $mskip") {
+ warn "Problem opening $mskip: $!";
+ return;
+ }
+ my @lines = ();
+ push @lines, "\n#!start included $mskip\n";
+ push @lines, $_ while <M>;
+ close M;
+ push @lines, "#!end included $mskip\n\n";
+ return @lines;
+}
+
+=item manicopy
+
+ manicopy(\%src, $dest_dir);
+ manicopy(\%src, $dest_dir, $how);
+
+Copies the files that are the keys in %src to the $dest_dir. %src is
+typically returned by the maniread() function.
+
+ manicopy( maniread(), $dest_dir );
+
+This function is useful for producing a directory tree identical to the
+intended distribution tree.
+
+$how can be used to specify a different methods of "copying". Valid
+values are C<cp>, which actually copies the files, C<ln> which creates
+hard links, and C<best> which mostly links the files but copies any
+symbolic link to make a tree without any symbolic link. C<cp> is the
+default.
+
+=cut
+
+sub manicopy {
+ my($read,$target,$how)=@_;
+ croak "manicopy() called without target argument" unless defined $target;
+ $how ||= 'cp';
+ require File::Path;
+ require File::Basename;
+
+ $target = VMS::Filespec::unixify($target) if $Is_VMS_mode;
+ File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
+ foreach my $file (keys %$read){
+ if ($Is_MacOS) {
+ if ($file =~ m!:!) {
+ my $dir = _maccat($target, $file);
+ $dir =~ s/[^:]+$//;
+ File::Path::mkpath($dir,1,0755);
+ }
+ cp_if_diff($file, _maccat($target, $file), $how);
+ } else {
+ $file = VMS::Filespec::unixify($file) if $Is_VMS_mode;
+ if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
+ my $dir = File::Basename::dirname($file);
+ $dir = VMS::Filespec::unixify($dir) if $Is_VMS_mode;
+ File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
+ }
+ cp_if_diff($file, "$target/$file", $how);
+ }
+ }
+}
+
+sub cp_if_diff {
+ my($from, $to, $how)=@_;
+ if (! -f $from) {
+ carp "$from not found";
+ return;
+ }
+ my($diff) = 0;
+ local(*F,*T);
+ open(F,"< $from\0") or die "Can't read $from: $!\n";
+ if (open(T,"< $to\0")) {
+ local $_;
+ while (<F>) { $diff++,last if $_ ne <T>; }
+ $diff++ unless eof(T);
+ close T;
+ }
+ else { $diff++; }
+ close F;
+ if ($diff) {
+ if (-e $to) {
+ unlink($to) or confess "unlink $to: $!";
+ }
+ STRICT_SWITCH: {
+ best($from,$to), last STRICT_SWITCH if $how eq 'best';
+ cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
+ ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
+ croak("ExtUtils::Manifest::cp_if_diff " .
+ "called with illegal how argument [$how]. " .
+ "Legal values are 'best', 'cp', and 'ln'.");
+ }
+ }
+}
+
+sub cp {
+ my ($srcFile, $dstFile) = @_;
+ my ($access,$mod) = (stat $srcFile)[8,9];
+
+ copy($srcFile,$dstFile);
+ utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
+ _manicopy_chmod($srcFile, $dstFile);
+}
+
+
+sub ln {
+ my ($srcFile, $dstFile) = @_;
+ # Fix-me - VMS can support links.
+ return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
+ link($srcFile, $dstFile);
+
+ unless( _manicopy_chmod($srcFile, $dstFile) ) {
+ unlink $dstFile;
+ return;
+ }
+ 1;
+}
+
+# 1) Strip off all group and world permissions.
+# 2) Let everyone read it.
+# 3) If the owner can execute it, everyone can.
+sub _manicopy_chmod {
+ my($srcFile, $dstFile) = @_;
+
+ my $perm = 0444 | (stat $srcFile)[2] & 0700;
+ chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $dstFile );
+}
+
+# Files that are often modified in the distdir. Don't hard link them.
+my @Exceptions = qw(MANIFEST META.yml SIGNATURE);
+sub best {
+ my ($srcFile, $dstFile) = @_;
+
+ my $is_exception = grep $srcFile =~ /$_/, @Exceptions;
+ if ($is_exception or !$Config{d_link} or -l $srcFile) {
+ cp($srcFile, $dstFile);
+ } else {
+ ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
+ }
+}
+
+sub _macify {
+ my($file) = @_;
+
+ return $file unless $Is_MacOS;
+
+ $file =~ s|^\./||;
+ if ($file =~ m|/|) {
+ $file =~ s|/+|:|g;
+ $file = ":$file";
+ }
+
+ $file;
+}
+
+sub _maccat {
+ my($f1, $f2) = @_;
+
+ return "$f1/$f2" unless $Is_MacOS;
+
+ $f1 .= ":$f2";
+ $f1 =~ s/([^:]:):/$1/g;
+ return $f1;
+}
+
+sub _unmacify {
+ my($file) = @_;
+
+ return $file unless $Is_MacOS;
+
+ $file =~ s|^:||;
+ $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
+ $file =~ y|:|/|;
+
+ $file;
+}
+
+
+=item maniadd
+
+ maniadd({ $file => $comment, ...});
+
+Adds an entry to an existing F<MANIFEST> unless its already there.
+
+$file will be normalized (ie. Unixified). B<UNIMPLEMENTED>
+
+=cut
+
+sub maniadd {
+ my($additions) = shift;
+
+ _normalize($additions);
+ _fix_manifest($MANIFEST);
+
+ my $manifest = maniread();
+ my @needed = grep { !exists $manifest->{$_} } keys %$additions;
+ return 1 unless @needed;
+
+ open(MANIFEST, ">>$MANIFEST") or
+ die "maniadd() could not open $MANIFEST: $!";
+
+ foreach my $file (_sort @needed) {
+ my $comment = $additions->{$file} || '';
+ if ($file =~ /\s/) {
+ $file =~ s/([\\'])/\\$1/g;
+ $file = "'$file'";
+ }
+ printf MANIFEST "%-40s %s\n", $file, $comment;
+ }
+ close MANIFEST or die "Error closing $MANIFEST: $!";
+
+ return 1;
+}
+
+
+# Sometimes MANIFESTs are missing a trailing newline. Fix this.
+sub _fix_manifest {
+ my $manifest_file = shift;
+
+ open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
+
+ # Yes, we should be using seek(), but I'd like to avoid loading POSIX
+ # to get SEEK_*
+ my @manifest = <MANIFEST>;
+ close MANIFEST;
+
+ unless( $manifest[-1] =~ /\n\z/ ) {
+ open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
+ print MANIFEST "\n";
+ close MANIFEST;
+ }
+}
+
+
+# UNIMPLEMENTED
+sub _normalize {
+ return;
+}
+
+
+=back
+
+=head2 MANIFEST
+
+A list of files in the distribution, one file per line. The MANIFEST
+always uses Unix filepath conventions even if you're not on Unix. This
+means F<foo/bar> style not F<foo\bar>.
+
+Anything between white space and an end of line within a C<MANIFEST>
+file is considered to be a comment. Any line beginning with # is also
+a comment. Beginning with ExtUtils::Manifest 1.52, a filename may
+contain whitespace characters if it is enclosed in single quotes; single
+quotes or backslashes in that filename must be backslash-escaped.
+
+ # this a comment
+ some/file
+ some/other/file comment about some/file
+ 'some/third file' comment
+
+
+=head2 MANIFEST.SKIP
+
+The file MANIFEST.SKIP may contain regular expressions of files that
+should be ignored by mkmanifest() and filecheck(). The regular
+expressions should appear one on each line. Blank lines and lines
+which start with C<#> are skipped. Use C<\#> if you need a regular
+expression to start with a C<#>.
+
+For example:
+
+ # Version control files and dirs.
+ \bRCS\b
+ \bCVS\b
+ ,v$
+ \B\.svn\b
+
+ # Makemaker generated files and dirs.
+ ^MANIFEST\.
+ ^Makefile$
+ ^blib/
+ ^MakeMaker-\d
+
+ # Temp, old and emacs backup files.
+ ~$
+ \.old$
+ ^#.*#$
+ ^\.#
+
+If no MANIFEST.SKIP file is found, a default set of skips will be
+used, similar to the example above. If you want nothing skipped,
+simply make an empty MANIFEST.SKIP file.
+
+In one's own MANIFEST.SKIP file, certain directives
+can be used to include the contents of other MANIFEST.SKIP
+files. At present two such directives are recognized.
+
+=over 4
+
+=item #!include_default
+
+This inserts the contents of the default MANIFEST.SKIP file
+
+=item #!include /Path/to/another/manifest.skip
+
+This inserts the contents of the specified external file
+
+=back
+
+The included contents will be inserted into the MANIFEST.SKIP
+file in between I<#!start included /path/to/manifest.skip>
+and I<#!end included /path/to/manifest.skip> markers.
+The original MANIFEST.SKIP is saved as MANIFEST.SKIP.bak.
+
+=head2 EXPORT_OK
+
+C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
+C<&maniread>, and C<&manicopy> are exportable.
+
+=head2 GLOBAL VARIABLES
+
+C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
+results in both a different C<MANIFEST> and a different
+C<MANIFEST.SKIP> file. This is useful if you want to maintain
+different distributions for different audiences (say a user version
+and a developer version including RCS).
+
+C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
+all functions act silently.
+
+C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value,
+or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
+produced.
+
+=head1 DIAGNOSTICS
+
+All diagnostic output is sent to C<STDERR>.
+
+=over 4
+
+=item C<Not in MANIFEST:> I<file>
+
+is reported if a file is found which is not in C<MANIFEST>.
+
+=item C<Skipping> I<file>
+
+is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
+
+=item C<No such file:> I<file>
+
+is reported if a file mentioned in a C<MANIFEST> file does not
+exist.
+
+=item C<MANIFEST:> I<$!>
+
+is reported if C<MANIFEST> could not be opened.
+
+=item C<Added to MANIFEST:> I<file>
+
+is reported by mkmanifest() if $Verbose is set and a file is added
+to MANIFEST. $Verbose is set to 1 by default.
+
+=back
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item B<PERL_MM_MANIFEST_DEBUG>
+
+Turns on debugging
+
+=back
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
+
+=head1 AUTHOR
+
+Andreas Koenig C<andreas.koenig@anima.de>
+
+Maintained by Michael G Schwern C<schwern@pobox.com> within the
+ExtUtils-MakeMaker package and, as a separate CPAN package, by
+Randy Kobes C<r.kobes@uwinnipeg.ca>.
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm
new file mode 100644
index 00000000000..493cb347e44
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm
@@ -0,0 +1,280 @@
+# This File keeps the contents of miniperlmain.c.
+#
+# It was generated automatically by minimod.PL from the contents
+# of miniperlmain.c. Don't edit this file!
+#
+# ANY CHANGES MADE HERE WILL BE LOST!
+#
+
+
+package ExtUtils::Miniperl;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(&writemain);
+
+$head= <<'EOF!HEAD';
+/* miniperlmain.c
+ *
+ * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
+ * 2004, 2005, 2006, 2007, by Larry Wall and others
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * The Road goes ever on and on
+ * Down from the door where it began.
+ *
+ * [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
+ * [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"]
+ */
+
+/* This file contains the main() function for the perl interpreter.
+ * Note that miniperlmain.c contains main() for the 'miniperl' binary,
+ * while perlmain.c contains main() for the 'perl' binary.
+ *
+ * Miniperl is like perl except that it does not support dynamic loading,
+ * and in fact is used to build the dynamic modules needed for the 'real'
+ * perl executable.
+ */
+
+#ifdef OEMVS
+#ifdef MYMALLOC
+/* sbrk is limited to first heap segment so make it big */
+#pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
+#else
+#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
+#endif
+#endif
+
+
+#include "EXTERN.h"
+#define PERL_IN_MINIPERLMAIN_C
+#include "perl.h"
+#include "XSUB.h"
+
+static void xs_init (pTHX);
+static PerlInterpreter *my_perl;
+
+#if defined (atarist)
+/* The Atari operating system doesn't have a dynamic stack. The
+ stack size is determined from this value. */
+long _stksize = 64 * 1024;
+#endif
+
+#if defined(PERL_GLOBAL_STRUCT_PRIVATE)
+/* The static struct perl_vars* may seem counterproductive since the
+ * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note
+ * that this static is not in the shared perl library, the globals PL_Vars
+ * and PL_VarsPtr will stay away. */
+static struct perl_vars* my_plvarsp;
+struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
+#endif
+
+#ifdef NO_ENV_ARRAY_IN_MAIN
+extern char **environ;
+int
+main(int argc, char **argv)
+#else
+int
+main(int argc, char **argv, char **env)
+#endif
+{
+ dVAR;
+ int exitstatus, i;
+#ifdef PERL_GLOBAL_STRUCT
+ struct perl_vars *plvarsp = init_global_struct();
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ my_vars = my_plvarsp = plvarsp;
+# endif
+#endif /* PERL_GLOBAL_STRUCT */
+ (void)env;
+#ifndef PERL_USE_SAFE_PUTENV
+ PL_use_safe_putenv = 0;
+#endif /* PERL_USE_SAFE_PUTENV */
+
+ /* if user wants control of gprof profiling off by default */
+ /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
+ PERL_GPROF_MONCONTROL(0);
+
+#ifdef NO_ENV_ARRAY_IN_MAIN
+ PERL_SYS_INIT3(&argc,&argv,&environ);
+#else
+ PERL_SYS_INIT3(&argc,&argv,&env);
+#endif
+
+#if defined(USE_ITHREADS)
+ /* XXX Ideally, this should really be happening in perl_alloc() or
+ * perl_construct() to keep libperl.a transparently fork()-safe.
+ * It is currently done here only because Apache/mod_perl have
+ * problems due to lack of a call to cancel pthread_atfork()
+ * handlers when shared objects that contain the handlers may
+ * be dlclose()d. This forces applications that embed perl to
+ * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
+ * been called at least once before in the current process.
+ * --GSAR 2001-07-20 */
+ PTHREAD_ATFORK(Perl_atfork_lock,
+ Perl_atfork_unlock,
+ Perl_atfork_unlock);
+#endif
+
+ if (!PL_do_undump) {
+ my_perl = perl_alloc();
+ if (!my_perl)
+ exit(1);
+ perl_construct(my_perl);
+ PL_perl_destruct_level = 0;
+ }
+ PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+ exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
+ if (!exitstatus)
+ perl_run(my_perl);
+
+ /* Unregister our signal handler before destroying my_perl */
+ for (i = 0; PL_sig_name[i]; i++) {
+ if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) {
+ rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL);
+ }
+ }
+
+ exitstatus = perl_destruct(my_perl);
+
+ perl_free(my_perl);
+
+#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN)
+ /*
+ * The old environment may have been freed by perl_free()
+ * when PERL_TRACK_MEMPOOL is defined, but without having
+ * been restored by perl_destruct() before (this is only
+ * done if destruct_level > 0).
+ *
+ * It is important to have a valid environment for atexit()
+ * routines that are eventually called.
+ */
+ environ = env;
+#endif
+
+#ifdef PERL_GLOBAL_STRUCT
+ free_global_struct(plvarsp);
+#endif /* PERL_GLOBAL_STRUCT */
+
+ PERL_SYS_TERM();
+
+ exit(exitstatus);
+ return exitstatus;
+}
+
+/* Register any extra external extensions */
+
+EOF!HEAD
+$tail=<<'EOF!TAIL';
+
+static void
+xs_init(pTHX)
+{
+ PERL_UNUSED_CONTEXT;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
+EOF!TAIL
+
+sub writemain{
+ my(@exts) = @_;
+
+ my($pname);
+ my($dl) = canon('/','DynaLoader');
+ print $head;
+
+ foreach $_ (@exts){
+ my($pname) = canon('/', $_);
+ my($mname, $cname);
+ ($mname = $pname) =~ s!/!::!g;
+ ($cname = $pname) =~ s!/!__!g;
+ print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
+ }
+
+ my ($tail1,$tail2,$tail3) = ( $tail =~ /\A(.*{\s*\n)(.*\n)(\s*\}.*)\Z/s );
+
+ print $tail1;
+ print "\tconst char file[] = __FILE__;\n";
+ print "\tdXSUB_SYS;\n" if $] > 5.002;
+ print $tail2;
+
+ foreach $_ (@exts){
+ my($pname) = canon('/', $_);
+ my($mname, $cname, $ccode);
+ ($mname = $pname) =~ s!/!::!g;
+ ($cname = $pname) =~ s!/!__!g;
+ print "\t{\n";
+ if ($pname eq $dl){
+ # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+ # boot_DynaLoader is called directly in DynaLoader.pm
+ $ccode = "\t/* DynaLoader is a special case */\n
+\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
+ print $ccode unless $SEEN{$ccode}++;
+ } else {
+ $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
+ print $ccode unless $SEEN{$ccode}++;
+ }
+ print "\t}\n";
+ }
+ print $tail3;
+}
+
+sub canon{
+ my($as, @ext) = @_;
+ foreach(@ext){
+ # might be X::Y or lib/auto/X/Y/Y.a
+ next if s!::!/!g;
+ s:^(lib|ext)/(auto/)?::;
+ s:/\w+\.\w+$::;
+ }
+ grep(s:/:$as:, @ext) if ($as ne '/');
+ @ext;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::Miniperl, writemain - write the C code for perlmain.c
+
+=head1 SYNOPSIS
+
+C<use ExtUtils::Miniperl;>
+
+C<writemain(@directories);>
+
+=head1 DESCRIPTION
+
+This whole module is written when perl itself is built from a script
+called minimod.PL. In case you want to patch it, please patch
+minimod.PL in the perl distribution instead.
+
+writemain() takes an argument list of directories containing archive
+libraries that relate to perl modules and should be linked into a new
+perl binary. It writes to STDOUT a corresponding perlmain.c file that
+is a plain C file containing all the bootstrap code to make the
+modules associated with the libraries available from within perl.
+
+The typical usage is from within a Makefile generated by
+ExtUtils::MakeMaker. So under normal circumstances you won't have to
+deal with this module directly.
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm
new file mode 100644
index 00000000000..707466a98dd
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm
@@ -0,0 +1,109 @@
+package ExtUtils::Mkbootstrap;
+
+# There's just too much Dynaloader incest here to turn on strict vars.
+use strict 'refs';
+
+our $VERSION = '6.56';
+
+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
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm
new file mode 100644
index 00000000000..962c67fd57f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm
@@ -0,0 +1,312 @@
+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.56';
+
+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 = 'perl5-porters@perl.org';
+ $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>bailey@newman.upenn.eduE<gt>>
+
+=head1 REVISION
+
+Last revised 14-Feb-1996, for Perl 5.002.
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm
new file mode 100644
index 00000000000..b77a556be50
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm
@@ -0,0 +1,352 @@
+package ExtUtils::Packlist;
+
+use 5.00503;
+use strict;
+use Carp qw();
+use Config;
+use vars qw($VERSION $Relocations);
+$VERSION = '1.44';
+$VERSION = eval $VERSION;
+
+# Used for generating filehandle globs. IO::File might not be available!
+my $fhname = "FH1";
+
+=begin _undocumented
+
+=over
+
+=item mkfh()
+
+Make a filehandle. Same kind of idea as Symbol::gensym().
+
+=cut
+
+sub mkfh()
+{
+no strict;
+my $fh = \*{$fhname++};
+use strict;
+return($fh);
+}
+
+=item __find_relocations
+
+Works out what absolute paths in the configuration have been located at run
+time relative to $^X, and generates a regexp that matches them
+
+=end _undocumented
+
+=back
+
+=cut
+
+sub __find_relocations
+{
+ my %paths;
+ while (my ($raw_key, $raw_val) = each %Config) {
+ my $exp_key = $raw_key . "exp";
+ next unless exists $Config{$exp_key};
+ next unless $raw_val =~ m!\.\.\./!;
+ $paths{$Config{$exp_key}}++;
+ }
+ # Longest prefixes go first in the alternatives
+ my $alternations = join "|", map {quotemeta $_}
+ sort {length $b <=> length $a} keys %paths;
+ qr/^($alternations)/o;
+}
+
+sub new($$)
+{
+my ($class, $packfile) = @_;
+$class = ref($class) || $class;
+my %self;
+tie(%self, $class, $packfile);
+return(bless(\%self, $class));
+}
+
+sub TIEHASH
+{
+my ($class, $packfile) = @_;
+my $self = { packfile => $packfile };
+bless($self, $class);
+$self->read($packfile) if (defined($packfile) && -f $packfile);
+return($self);
+}
+
+sub STORE
+{
+$_[0]->{data}->{$_[1]} = $_[2];
+}
+
+sub FETCH
+{
+return($_[0]->{data}->{$_[1]});
+}
+
+sub FIRSTKEY
+{
+my $reset = scalar(keys(%{$_[0]->{data}}));
+return(each(%{$_[0]->{data}}));
+}
+
+sub NEXTKEY
+{
+return(each(%{$_[0]->{data}}));
+}
+
+sub EXISTS
+{
+return(exists($_[0]->{data}->{$_[1]}));
+}
+
+sub DELETE
+{
+return(delete($_[0]->{data}->{$_[1]}));
+}
+
+sub CLEAR
+{
+%{$_[0]->{data}} = ();
+}
+
+sub DESTROY
+{
+}
+
+sub read($;$)
+{
+my ($self, $packfile) = @_;
+$self = tied(%$self) || $self;
+
+if (defined($packfile)) { $self->{packfile} = $packfile; }
+else { $packfile = $self->{packfile}; }
+Carp::croak("No packlist filename specified") if (! defined($packfile));
+my $fh = mkfh();
+open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!");
+$self->{data} = {};
+my ($line);
+while (defined($line = <$fh>))
+ {
+ chomp $line;
+ my ($key, $data) = $line;
+ if ($key =~ /^(.*?)( \w+=.*)$/)
+ {
+ $key = $1;
+ $data = { map { split('=', $_) } split(' ', $2)};
+
+ if ($Config{userelocatableinc} && $data->{relocate_as})
+ {
+ require File::Spec;
+ require Cwd;
+ my ($vol, $dir) = File::Spec->splitpath($packfile);
+ my $newpath = File::Spec->catpath($vol, $dir, $data->{relocate_as});
+ $key = Cwd::realpath($newpath);
+ }
+ }
+ $key =~ s!/\./!/!g; # Some .packlists have spurious '/./' bits in the paths
+ $self->{data}->{$key} = $data;
+ }
+close($fh);
+}
+
+sub write($;$)
+{
+my ($self, $packfile) = @_;
+$self = tied(%$self) || $self;
+if (defined($packfile)) { $self->{packfile} = $packfile; }
+else { $packfile = $self->{packfile}; }
+Carp::croak("No packlist filename specified") if (! defined($packfile));
+my $fh = mkfh();
+open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
+foreach my $key (sort(keys(%{$self->{data}})))
+ {
+ my $data = $self->{data}->{$key};
+ if ($Config{userelocatableinc}) {
+ $Relocations ||= __find_relocations();
+ if ($packfile =~ $Relocations) {
+ # We are writing into a subdirectory of a run-time relocated
+ # path. Figure out if the this file is also within a subdir.
+ my $prefix = $1;
+ if (File::Spec->no_upwards(File::Spec->abs2rel($key, $prefix)))
+ {
+ # The relocated path is within the found prefix
+ my $packfile_prefix;
+ (undef, $packfile_prefix)
+ = File::Spec->splitpath($packfile);
+
+ my $relocate_as
+ = File::Spec->abs2rel($key, $packfile_prefix);
+
+ if (!ref $data) {
+ $data = {};
+ }
+ $data->{relocate_as} = $relocate_as;
+ }
+ }
+ }
+ print $fh ("$key");
+ if (ref($data))
+ {
+ foreach my $k (sort(keys(%$data)))
+ {
+ print $fh (" $k=$data->{$k}");
+ }
+ }
+ print $fh ("\n");
+ }
+close($fh);
+}
+
+sub validate($;$)
+{
+my ($self, $remove) = @_;
+$self = tied(%$self) || $self;
+my @missing;
+foreach my $key (sort(keys(%{$self->{data}})))
+ {
+ if (! -e $key)
+ {
+ push(@missing, $key);
+ delete($self->{data}{$key}) if ($remove);
+ }
+ }
+return(@missing);
+}
+
+sub packlist_file($)
+{
+my ($self) = @_;
+$self = tied(%$self) || $self;
+return($self->{packfile});
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Packlist - manage .packlist files
+
+=head1 SYNOPSIS
+
+ use ExtUtils::Packlist;
+ my ($pl) = ExtUtils::Packlist->new('.packlist');
+ $pl->read('/an/old/.packlist');
+ my @missing_files = $pl->validate();
+ $pl->write('/a/new/.packlist');
+
+ $pl->{'/some/file/name'}++;
+ or
+ $pl->{'/some/other/file/name'} = { type => 'file',
+ from => '/some/file' };
+
+=head1 DESCRIPTION
+
+ExtUtils::Packlist provides a standard way to manage .packlist files.
+Functions are provided to read and write .packlist files. The original
+.packlist format is a simple list of absolute pathnames, one per line. In
+addition, this package supports an extended format, where as well as a filename
+each line may contain a list of attributes in the form of a space separated
+list of key=value pairs. This is used by the installperl script to
+differentiate between files and links, for example.
+
+=head1 USAGE
+
+The hash reference returned by the new() function can be used to examine and
+modify the contents of the .packlist. Items may be added/deleted from the
+.packlist by modifying the hash. If the value associated with a hash key is a
+scalar, the entry written to the .packlist by any subsequent write() will be a
+simple filename. If the value is a hash, the entry written will be the
+filename followed by the key=value pairs from the hash. Reading back the
+.packlist will recreate the original entries.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item new()
+
+This takes an optional parameter, the name of a .packlist. If the file exists,
+it will be opened and the contents of the file will be read. The new() method
+returns a reference to a hash. This hash holds an entry for each line in the
+.packlist. In the case of old-style .packlists, the value associated with each
+key is undef. In the case of new-style .packlists, the value associated with
+each key is a hash containing the key=value pairs following the filename in the
+.packlist.
+
+=item read()
+
+This takes an optional parameter, the name of the .packlist to be read. If
+no file is specified, the .packlist specified to new() will be read. If the
+.packlist does not exist, Carp::croak will be called.
+
+=item write()
+
+This takes an optional parameter, the name of the .packlist to be written. If
+no file is specified, the .packlist specified to new() will be overwritten.
+
+=item validate()
+
+This checks that every file listed in the .packlist actually exists. If an
+argument which evaluates to true is given, any missing files will be removed
+from the internal hash. The return value is a list of the missing files, which
+will be empty if they all exist.
+
+=item packlist_file()
+
+This returns the name of the associated .packlist file
+
+=back
+
+=head1 EXAMPLE
+
+Here's C<modrm>, a little utility to cleanly remove an installed module.
+
+ #!/usr/local/bin/perl -w
+
+ use strict;
+ use IO::Dir;
+ use ExtUtils::Packlist;
+ use ExtUtils::Installed;
+
+ sub emptydir($) {
+ my ($dir) = @_;
+ my $dh = IO::Dir->new($dir) || return(0);
+ my @count = $dh->read();
+ $dh->close();
+ return(@count == 2 ? 1 : 0);
+ }
+
+ # Find all the installed packages
+ print("Finding all installed modules...\n");
+ my $installed = ExtUtils::Installed->new();
+
+ foreach my $module (grep(!/^Perl$/, $installed->modules())) {
+ my $version = $installed->version($module) || "???";
+ print("Found module $module Version $version\n");
+ print("Do you want to delete $module? [n] ");
+ my $r = <STDIN>; chomp($r);
+ if ($r && $r =~ /^y/i) {
+ # Remove all the files
+ foreach my $file (sort($installed->files($module))) {
+ print("rm $file\n");
+ unlink($file);
+ }
+ my $pf = $installed->packlist($module)->packlist_file();
+ print("rm $pf\n");
+ unlink($pf);
+ foreach my $dir (sort($installed->directory_tree($module))) {
+ if (emptydir($dir)) {
+ print("rmdir $dir\n");
+ rmdir($dir);
+ }
+ }
+ }
+ }
+
+=head1 AUTHOR
+
+Alan Burlison <Alan.Burlison@uk.sun.com>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm
new file mode 100644
index 00000000000..05c3e690027
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm
@@ -0,0 +1,2111 @@
+package ExtUtils::ParseXS;
+
+use 5.006; # We use /??{}/ in regexes
+use Cwd;
+use Config;
+use File::Basename;
+use File::Spec;
+use Symbol;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(process_file);
+
+# use strict; # One of these days...
+
+my(@XSStack); # Stack of conditionals and INCLUDEs
+my($XSS_work_idx, $cpp_next_tmp);
+
+use vars qw($VERSION);
+$VERSION = '2.21';
+$VERSION = eval $VERSION if $VERSION =~ /_/;
+
+use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
+ $cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
+ $WantOptimize $process_inout $process_argtypes @tm
+ $dir $filename $filepathname %IncludedFiles
+ %type_kind %proto_letter
+ %targetable $BLOCK_re $lastline $lastline_no
+ $Package $Prefix @line @BootCode %args_match %defaults %var_types %arg_list @proto_arg
+ $processing_arg_with_types %argtype_seen @outlist %in_out %lengthof
+ $proto_in_this_xsub $scope_in_this_xsub $interface $prepush_done $interface_macro $interface_macro_set
+ $ProtoThisXSUB $ScopeThisXSUB $xsreturn
+ @line_no $ret_type $func_header $orig_args
+ ); # Add these just to get compilation to happen.
+
+
+sub process_file {
+
+ # Allow for $package->process_file(%hash) in the future
+ my ($pkg, %args) = @_ % 2 ? @_ : (__PACKAGE__, @_);
+
+ $ProtoUsed = exists $args{prototypes};
+
+ # Set defaults.
+ %args = (
+ # 'C++' => 0, # Doesn't seem to *do* anything...
+ hiertype => 0,
+ except => 0,
+ prototypes => 0,
+ versioncheck => 1,
+ linenumbers => 1,
+ optimize => 1,
+ prototypes => 0,
+ inout => 1,
+ argtypes => 1,
+ typemap => [],
+ output => \*STDOUT,
+ csuffix => '.c',
+ %args,
+ );
+
+ # Global Constants
+
+ my ($Is_VMS, $SymSet);
+ if ($^O eq 'VMS') {
+ $Is_VMS = 1;
+ # Establish set of global symbols with max length 28, since xsubpp
+ # will later add the 'XS_' prefix.
+ require ExtUtils::XSSymSet;
+ $SymSet = new ExtUtils::XSSymSet 28;
+ }
+ @XSStack = ({type => 'none'});
+ ($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
+ @InitFileCode = ();
+ $FH = Symbol::gensym();
+ $proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
+ $Overload = 0;
+ $errors = 0;
+ $Fallback = '&PL_sv_undef';
+
+ # Most of the 1500 lines below uses these globals. We'll have to
+ # clean this up sometime, probably. For now, we just pull them out
+ # of %args. -Ken
+
+ $cplusplus = $args{'C++'};
+ $hiertype = $args{hiertype};
+ $WantPrototypes = $args{prototypes};
+ $WantVersionChk = $args{versioncheck};
+ $except = $args{except} ? ' TRY' : '';
+ $WantLineNumbers = $args{linenumbers};
+ $WantOptimize = $args{optimize};
+ $process_inout = $args{inout};
+ $process_argtypes = $args{argtypes};
+ @tm = ref $args{typemap} ? @{$args{typemap}} : ($args{typemap});
+
+ for ($args{filename}) {
+ die "Missing required parameter 'filename'" unless $_;
+ $filepathname = $_;
+ ($dir, $filename) = (dirname($_), basename($_));
+ $filepathname =~ s/\\/\\\\/g;
+ $IncludedFiles{$_}++;
+ }
+
+ # Open the input file
+ open($FH, $args{filename}) or die "cannot open $args{filename}: $!\n";
+
+ # Open the output file if given as a string. If they provide some
+ # other kind of reference, trust them that we can print to it.
+ if (not ref $args{output}) {
+ open my($fh), "> $args{output}" or die "Can't create $args{output}: $!";
+ $args{outfile} = $args{output};
+ $args{output} = $fh;
+ }
+
+ # Really, we shouldn't have to chdir() or select() in the first
+ # place. For now, just save & restore.
+ my $orig_cwd = cwd();
+ my $orig_fh = select();
+
+ chdir($dir);
+ my $pwd = cwd();
+ my $csuffix = $args{csuffix};
+
+ if ($WantLineNumbers) {
+ my $cfile;
+ if ( $args{outfile} ) {
+ $cfile = $args{outfile};
+ } else {
+ $cfile = $args{filename};
+ $cfile =~ s/\.xs$/$csuffix/i or $cfile .= $csuffix;
+ }
+ tie(*PSEUDO_STDOUT, 'ExtUtils::ParseXS::CountLines', $cfile, $args{output});
+ select PSEUDO_STDOUT;
+ } else {
+ select $args{output};
+ }
+
+ foreach my $typemap (@tm) {
+ die "Can't find $typemap in $pwd\n" unless -r $typemap;
+ }
+
+ push @tm, standard_typemap_locations();
+
+ foreach my $typemap (@tm) {
+ next unless -f $typemap ;
+ # skip directories, binary files etc.
+ warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
+ unless -T $typemap ;
+ open(TYPEMAP, $typemap)
+ or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
+ my $mode = 'Typemap';
+ my $junk = "" ;
+ my $current = \$junk;
+ while (<TYPEMAP>) {
+ next if /^\s* #/;
+ my $line_no = $. + 1;
+ if (/^INPUT\s*$/) {
+ $mode = 'Input'; $current = \$junk; next;
+ }
+ if (/^OUTPUT\s*$/) {
+ $mode = 'Output'; $current = \$junk; next;
+ }
+ if (/^TYPEMAP\s*$/) {
+ $mode = 'Typemap'; $current = \$junk; next;
+ }
+ if ($mode eq 'Typemap') {
+ chomp;
+ my $line = $_ ;
+ TrimWhitespace($_) ;
+ # skip blank lines and comment lines
+ next if /^$/ or /^#/ ;
+ my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
+ warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
+ $type = TidyType($type) ;
+ $type_kind{$type} = $kind ;
+ # prototype defaults to '$'
+ $proto = "\$" unless $proto ;
+ warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
+ unless ValidProtoString($proto) ;
+ $proto_letter{$type} = C_string($proto) ;
+ } elsif (/^\s/) {
+ $$current .= $_;
+ } elsif ($mode eq 'Input') {
+ s/\s+$//;
+ $input_expr{$_} = '';
+ $current = \$input_expr{$_};
+ } else {
+ s/\s+$//;
+ $output_expr{$_} = '';
+ $current = \$output_expr{$_};
+ }
+ }
+ close(TYPEMAP);
+ }
+
+ foreach my $value (values %input_expr) {
+ $value =~ s/;*\s+\z//;
+ # Move C pre-processor instructions to column 1 to be strictly ANSI
+ # conformant. Some pre-processors are fussy about this.
+ $value =~ s/^\s+#/#/mg;
+ }
+ foreach my $value (values %output_expr) {
+ # And again.
+ $value =~ s/^\s+#/#/mg;
+ }
+
+ my ($cast, $size);
+ our $bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*]; # ()-balanced
+ $cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?]; # Optional (SV*) cast
+ $size = qr[,\s* (??{ $bal }) ]x; # Third arg (to setpvn)
+
+ foreach my $key (keys %output_expr) {
+ # We can still bootstrap compile 're', because in code re.pm is
+ # available to miniperl, and does not attempt to load the XS code.
+ use re 'eval';
+
+ my ($t, $with_size, $arg, $sarg) =
+ ($output_expr{$key} =~
+ m[^ \s+ sv_set ( [iunp] ) v (n)? # Type, is_setpvn
+ \s* \( \s* $cast \$arg \s* ,
+ \s* ( (??{ $bal }) ) # Set from
+ ( (??{ $size }) )? # Possible sizeof set-from
+ \) \s* ; \s* $
+ ]x);
+ $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t;
+ }
+
+ my $END = "!End!\n\n"; # "impossible" keyword (multiple newline)
+
+ # Match an XS keyword
+ $BLOCK_re= '\s*(' . join('|', qw(
+ REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
+ CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+ SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
+ )) . "|$END)\\s*:";
+
+
+ our ($C_group_rex, $C_arg);
+ # Group in C (no support for comments or literals)
+ $C_group_rex = qr/ [({\[]
+ (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
+ [)}\]] /x ;
+ # Chunk in C without comma at toplevel (no comments):
+ $C_arg = qr/ (?: (?> [^()\[\]{},"']+ )
+ | (??{ $C_group_rex })
+ | " (?: (?> [^\\"]+ )
+ | \\.
+ )* " # String literal
+ | ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal
+ )* /xs;
+
+ # Identify the version of xsubpp used
+ print <<EOM ;
+/*
+ * This file was generated automatically by ExtUtils::ParseXS version $VERSION from the
+ * contents of $filename. Do not edit this file, edit $filename instead.
+ *
+ * ANY CHANGES MADE HERE WILL BE LOST!
+ *
+ */
+
+EOM
+
+
+ print("#line 1 \"$filepathname\"\n")
+ if $WantLineNumbers;
+
+ firstmodule:
+ while (<$FH>) {
+ if (/^=/) {
+ my $podstartline = $.;
+ do {
+ if (/^=cut\s*$/) {
+ # We can't just write out a /* */ comment, as our embedded
+ # POD might itself be in a comment. We can't put a /**/
+ # comment inside #if 0, as the C standard says that the source
+ # file is decomposed into preprocessing characters in the stage
+ # before preprocessing commands are executed.
+ # I don't want to leave the text as barewords, because the spec
+ # isn't clear whether macros are expanded before or after
+ # preprocessing commands are executed, and someone pathological
+ # may just have defined one of the 3 words as a macro that does
+ # something strange. Multiline strings are illegal in C, so
+ # the "" we write must be a string literal. And they aren't
+ # concatenated until 2 steps later, so we are safe.
+ # - Nicholas Clark
+ print("#if 0\n \"Skipped embedded POD.\"\n#endif\n");
+ printf("#line %d \"$filepathname\"\n", $. + 1)
+ if $WantLineNumbers;
+ next firstmodule
+ }
+
+ } while (<$FH>);
+ # At this point $. is at end of file so die won't state the start
+ # of the problem, and as we haven't yet read any lines &death won't
+ # show the correct line in the message either.
+ die ("Error: Unterminated pod in $filename, line $podstartline\n")
+ unless $lastline;
+ }
+ last if ($Package, $Prefix) =
+ /^MODULE\s*=\s*[\w:]+(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
+
+ print $_;
+ }
+ unless (defined $_) {
+ warn "Didn't find a 'MODULE ... PACKAGE ... PREFIX' line\n";
+ exit 0; # Not a fatal error for the caller process
+ }
+
+ print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+
+ print <<"EOF";
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(var) if (0) var = var
+#endif
+
+EOF
+
+ print <<"EOF";
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
+
+/* prototype to pass -Wmissing-prototypes */
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);
+
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+{
+ const GV *const gv = CvGV(cv);
+
+ PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+ if (gv) {
+ const char *const gvname = GvNAME(gv);
+ const HV *const stash = GvSTASH(gv);
+ const char *const hvname = stash ? HvNAME(stash) : NULL;
+
+ if (hvname)
+ Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
+ else
+ Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
+ } else {
+ /* Pants. I don't think that it should be possible to get here. */
+ Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
+ }
+}
+#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b)
+#else
+#define croak_xs_usage S_croak_xs_usage
+#endif
+
+#endif
+
+/* NOTE: the prototype of newXSproto() is different in versions of perls,
+ * so we define a portable version of newXSproto()
+ */
+#ifdef newXS_flags
+#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
+#else
+#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
+#endif /* !defined(newXS_flags) */
+
+EOF
+
+ print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+
+ $lastline = $_;
+ $lastline_no = $.;
+
+ PARAGRAPH:
+ while (fetch_para()) {
+ # Print initial preprocessor statements and blank lines
+ while (@line && $line[0] !~ /^[^\#]/) {
+ my $line = shift(@line);
+ print $line, "\n";
+ next unless $line =~ /^\#\s*((if)(?:n?def)?|elsif|else|endif)\b/;
+ my $statement = $+;
+ if ($statement eq 'if') {
+ $XSS_work_idx = @XSStack;
+ push(@XSStack, {type => 'if'});
+ } else {
+ death ("Error: `$statement' with no matching `if'")
+ if $XSStack[-1]{type} ne 'if';
+ if ($XSStack[-1]{varname}) {
+ push(@InitFileCode, "#endif\n");
+ push(@BootCode, "#endif");
+ }
+
+ my(@fns) = keys %{$XSStack[-1]{functions}};
+ if ($statement ne 'endif') {
+ # Hide the functions defined in other #if branches, and reset.
+ @{$XSStack[-1]{other_functions}}{@fns} = (1) x @fns;
+ @{$XSStack[-1]}{qw(varname functions)} = ('', {});
+ } else {
+ my($tmp) = pop(@XSStack);
+ 0 while (--$XSS_work_idx
+ && $XSStack[$XSS_work_idx]{type} ne 'if');
+ # Keep all new defined functions
+ push(@fns, keys %{$tmp->{other_functions}});
+ @{$XSStack[$XSS_work_idx]{functions}}{@fns} = (1) x @fns;
+ }
+ }
+ }
+
+ next PARAGRAPH unless @line;
+
+ if ($XSS_work_idx && !$XSStack[$XSS_work_idx]{varname}) {
+ # We are inside an #if, but have not yet #defined its xsubpp variable.
+ print "#define $cpp_next_tmp 1\n\n";
+ push(@InitFileCode, "#if $cpp_next_tmp\n");
+ push(@BootCode, "#if $cpp_next_tmp");
+ $XSStack[$XSS_work_idx]{varname} = $cpp_next_tmp++;
+ }
+
+ death ("Code is not inside a function"
+ ." (maybe last function was ended by a blank line "
+ ." followed by a statement on column one?)")
+ if $line[0] =~ /^\s/;
+
+ my ($class, $externC, $static, $ellipsis, $wantRETVAL, $RETVAL_no_return);
+ my (@fake_INPUT_pre); # For length(s) generated variables
+ my (@fake_INPUT);
+
+ # initialize info arrays
+ undef(%args_match);
+ undef(%var_types);
+ undef(%defaults);
+ undef(%arg_list) ;
+ undef(@proto_arg) ;
+ undef($processing_arg_with_types) ;
+ undef(%argtype_seen) ;
+ undef(@outlist) ;
+ undef(%in_out) ;
+ undef(%lengthof) ;
+ undef($proto_in_this_xsub) ;
+ undef($scope_in_this_xsub) ;
+ undef($interface);
+ undef($prepush_done);
+ $interface_macro = 'XSINTERFACE_FUNC' ;
+ $interface_macro_set = 'XSINTERFACE_FUNC_SET' ;
+ $ProtoThisXSUB = $WantPrototypes ;
+ $ScopeThisXSUB = 0;
+ $xsreturn = 0;
+
+ $_ = shift(@line);
+ while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE|SCOPE")) {
+ &{"${kwd}_handler"}() ;
+ next PARAGRAPH unless @line ;
+ $_ = shift(@line);
+ }
+
+ if (check_keyword("BOOT")) {
+ &check_cpp;
+ push (@BootCode, "#line $line_no[@line_no - @line] \"$filepathname\"")
+ if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/;
+ push (@BootCode, @line, "") ;
+ next PARAGRAPH ;
+ }
+
+
+ # extract return type, function name and arguments
+ ($ret_type) = TidyType($_);
+ $RETVAL_no_return = 1 if $ret_type =~ s/^NO_OUTPUT\s+//;
+
+ # Allow one-line ANSI-like declaration
+ unshift @line, $2
+ if $process_argtypes
+ and $ret_type =~ s/^(.*?\w.*?)\s*\b(\w+\s*\(.*)/$1/s;
+
+ # a function definition needs at least 2 lines
+ blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
+ unless @line ;
+
+ $externC = 1 if $ret_type =~ s/^extern "C"\s+//;
+ $static = 1 if $ret_type =~ s/^static\s+//;
+
+ $func_header = shift(@line);
+ blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
+ unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s;
+
+ ($class, $func_name, $orig_args) = ($1, $2, $3) ;
+ $class = "$4 $class" if $4;
+ ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
+ ($clean_func_name = $func_name) =~ s/^$Prefix//;
+ $Full_func_name = "${Packid}_$clean_func_name";
+ if ($Is_VMS) {
+ $Full_func_name = $SymSet->addsym($Full_func_name);
+ }
+
+ # Check for duplicate function definition
+ for my $tmp (@XSStack) {
+ next unless defined $tmp->{functions}{$Full_func_name};
+ Warn("Warning: duplicate function definition '$clean_func_name' detected");
+ last;
+ }
+ $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
+ %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = ();
+ $DoSetMagic = 1;
+
+ $orig_args =~ s/\\\s*/ /g; # process line continuations
+ my @args;
+
+ my %only_C_inlist; # Not in the signature of Perl function
+ if ($process_argtypes and $orig_args =~ /\S/) {
+ my $args = "$orig_args ,";
+ if ($args =~ /^( (??{ $C_arg }) , )* $ /x) {
+ @args = ($args =~ /\G ( (??{ $C_arg }) ) , /xg);
+ for ( @args ) {
+ s/^\s+//;
+ s/\s+$//;
+ my ($arg, $default) = / ( [^=]* ) ( (?: = .* )? ) /x;
+ my ($pre, $name) = ($arg =~ /(.*?) \s*
+ \b ( \w+ | length\( \s*\w+\s* \) )
+ \s* $ /x);
+ next unless defined($pre) && length($pre);
+ my $out_type = '';
+ my $inout_var;
+ if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) {
+ my $type = $1;
+ $out_type = $type if $type ne 'IN';
+ $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
+ $pre =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
+ }
+ my $islength;
+ if ($name =~ /^length\( \s* (\w+) \s* \)\z/x) {
+ $name = "XSauto_length_of_$1";
+ $islength = 1;
+ die "Default value on length() argument: `$_'"
+ if length $default;
+ }
+ if (length $pre or $islength) { # Has a type
+ if ($islength) {
+ push @fake_INPUT_pre, $arg;
+ } else {
+ push @fake_INPUT, $arg;
+ }
+ # warn "pushing '$arg'\n";
+ $argtype_seen{$name}++;
+ $_ = "$name$default"; # Assigns to @args
+ }
+ $only_C_inlist{$_} = 1 if $out_type eq "OUTLIST" or $islength;
+ push @outlist, $name if $out_type =~ /OUTLIST$/;
+ $in_out{$name} = $out_type if $out_type;
+ }
+ } else {
+ @args = split(/\s*,\s*/, $orig_args);
+ Warn("Warning: cannot parse argument list '$orig_args', fallback to split");
+ }
+ } else {
+ @args = split(/\s*,\s*/, $orig_args);
+ for (@args) {
+ if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\s+//) {
+ my $out_type = $1;
+ next if $out_type eq 'IN';
+ $only_C_inlist{$_} = 1 if $out_type eq "OUTLIST";
+ push @outlist, $name if $out_type =~ /OUTLIST$/;
+ $in_out{$_} = $out_type;
+ }
+ }
+ }
+ if (defined($class)) {
+ my $arg0 = ((defined($static) or $func_name eq 'new')
+ ? "CLASS" : "THIS");
+ unshift(@args, $arg0);
+ }
+ my $extra_args = 0;
+ @args_num = ();
+ $num_args = 0;
+ my $report_args = '';
+ foreach my $i (0 .. $#args) {
+ if ($args[$i] =~ s/\.\.\.//) {
+ $ellipsis = 1;
+ if ($args[$i] eq '' && $i == $#args) {
+ $report_args .= ", ...";
+ pop(@args);
+ last;
+ }
+ }
+ if ($only_C_inlist{$args[$i]}) {
+ push @args_num, undef;
+ } else {
+ push @args_num, ++$num_args;
+ $report_args .= ", $args[$i]";
+ }
+ if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) {
+ $extra_args++;
+ $args[$i] = $1;
+ $defaults{$args[$i]} = $2;
+ $defaults{$args[$i]} =~ s/"/\\"/g;
+ }
+ $proto_arg[$i+1] = '$' ;
+ }
+ $min_args = $num_args - $extra_args;
+ $report_args =~ s/"/\\"/g;
+ $report_args =~ s/^,\s+//;
+ my @func_args = @args;
+ shift @func_args if defined($class);
+
+ for (@func_args) {
+ s/^/&/ if $in_out{$_};
+ }
+ $func_args = join(", ", @func_args);
+ @args_match{@args} = @args_num;
+
+ $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
+ $CODE = grep(/^\s*CODE\s*:/, @line);
+ # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
+ # to set explicit return values.
+ $EXPLICIT_RETURN = ($CODE &&
+ ("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
+ $ALIAS = grep(/^\s*ALIAS\s*:/, @line);
+ $INTERFACE = grep(/^\s*INTERFACE\s*:/, @line);
+
+ $xsreturn = 1 if $EXPLICIT_RETURN;
+
+ $externC = $externC ? qq[extern "C"] : "";
+
+ # print function header
+ print Q(<<"EOF");
+#$externC
+#XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
+#XS(XS_${Full_func_name})
+#[[
+##ifdef dVAR
+# dVAR; dXSARGS;
+##else
+# dXSARGS;
+##endif
+EOF
+ print Q(<<"EOF") if $ALIAS ;
+# dXSI32;
+EOF
+ print Q(<<"EOF") if $INTERFACE ;
+# dXSFUNCTION($ret_type);
+EOF
+ if ($ellipsis) {
+ $cond = ($min_args ? qq(items < $min_args) : 0);
+ } elsif ($min_args == $num_args) {
+ $cond = qq(items != $min_args);
+ } else {
+ $cond = qq(items < $min_args || items > $num_args);
+ }
+
+ print Q(<<"EOF") if $except;
+# char errbuf[1024];
+# *errbuf = '\0';
+EOF
+
+ if($cond) {
+ print Q(<<"EOF");
+# if ($cond)
+# croak_xs_usage(cv, "$report_args");
+EOF
+ } else {
+ # cv likely to be unused
+ print Q(<<"EOF");
+# PERL_UNUSED_VAR(cv); /* -W */
+EOF
+ }
+
+ #gcc -Wall: if an xsub has PPCODE is used
+ #it is possible none of ST, XSRETURN or XSprePUSH macros are used
+ #hence `ax' (setup by dXSARGS) is unused
+ #XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
+ #but such a move could break third-party extensions
+ print Q(<<"EOF") if $PPCODE;
+# PERL_UNUSED_VAR(ax); /* -Wall */
+EOF
+
+ print Q(<<"EOF") if $PPCODE;
+# SP -= items;
+EOF
+
+ # Now do a block of some sort.
+
+ $condnum = 0;
+ $cond = ''; # last CASE: condidional
+ push(@line, "$END:");
+ push(@line_no, $line_no[-1]);
+ $_ = '';
+ &check_cpp;
+ while (@line) {
+ &CASE_handler if check_keyword("CASE");
+ print Q(<<"EOF");
+# $except [[
+EOF
+
+ # do initialization of input variables
+ $thisdone = 0;
+ $retvaldone = 0;
+ $deferred = "";
+ %arg_list = () ;
+ $gotRETVAL = 0;
+
+ INPUT_handler() ;
+ process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE|OVERLOAD") ;
+
+ print Q(<<"EOF") if $ScopeThisXSUB;
+# ENTER;
+# [[
+EOF
+
+ if (!$thisdone && defined($class)) {
+ if (defined($static) or $func_name eq 'new') {
+ print "\tchar *";
+ $var_types{"CLASS"} = "char *";
+ &generate_init("char *", 1, "CLASS");
+ }
+ else {
+ print "\t$class *";
+ $var_types{"THIS"} = "$class *";
+ &generate_init("$class *", 1, "THIS");
+ }
+ }
+
+ # do code
+ if (/^\s*NOT_IMPLEMENTED_YET/) {
+ print "\n\tPerl_croak(aTHX_ \"$pname: not implemented yet\");\n";
+ $_ = '' ;
+ } else {
+ if ($ret_type ne "void") {
+ print "\t" . &map_type($ret_type, 'RETVAL') . ";\n"
+ if !$retvaldone;
+ $args_match{"RETVAL"} = 0;
+ $var_types{"RETVAL"} = $ret_type;
+ print "\tdXSTARG;\n"
+ if $WantOptimize and $targetable{$type_kind{$ret_type}};
+ }
+
+ if (@fake_INPUT or @fake_INPUT_pre) {
+ unshift @line, @fake_INPUT_pre, @fake_INPUT, $_;
+ $_ = "";
+ $processing_arg_with_types = 1;
+ INPUT_handler() ;
+ }
+ print $deferred;
+
+ process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS|OVERLOAD") ;
+
+ if (check_keyword("PPCODE")) {
+ print_section();
+ death ("PPCODE must be last thing") if @line;
+ print "\tLEAVE;\n" if $ScopeThisXSUB;
+ print "\tPUTBACK;\n\treturn;\n";
+ } elsif (check_keyword("CODE")) {
+ print_section() ;
+ } elsif (defined($class) and $func_name eq "DESTROY") {
+ print "\n\t";
+ print "delete THIS;\n";
+ } else {
+ print "\n\t";
+ if ($ret_type ne "void") {
+ print "RETVAL = ";
+ $wantRETVAL = 1;
+ }
+ if (defined($static)) {
+ if ($func_name eq 'new') {
+ $func_name = "$class";
+ } else {
+ print "${class}::";
+ }
+ } elsif (defined($class)) {
+ if ($func_name eq 'new') {
+ $func_name .= " $class";
+ } else {
+ print "THIS->";
+ }
+ }
+ $func_name =~ s/^\Q$args{'s'}//
+ if exists $args{'s'};
+ $func_name = 'XSFUNCTION' if $interface;
+ print "$func_name($func_args);\n";
+ }
+ }
+
+ # do output variables
+ $gotRETVAL = 0; # 1 if RETVAL seen in OUTPUT section;
+ undef $RETVAL_code ; # code to set RETVAL (from OUTPUT section);
+ # $wantRETVAL set if 'RETVAL =' autogenerated
+ ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
+ undef %outargs ;
+ process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE|OVERLOAD");
+
+ &generate_output($var_types{$_}, $args_match{$_}, $_, $DoSetMagic)
+ for grep $in_out{$_} =~ /OUT$/, keys %in_out;
+
+ # all OUTPUT done, so now push the return value on the stack
+ if ($gotRETVAL && $RETVAL_code) {
+ print "\t$RETVAL_code\n";
+ } elsif ($gotRETVAL || $wantRETVAL) {
+ my $t = $WantOptimize && $targetable{$type_kind{$ret_type}};
+ my $var = 'RETVAL';
+ my $type = $ret_type;
+
+ # 0: type, 1: with_size, 2: how, 3: how_size
+ if ($t and not $t->[1] and $t->[0] eq 'p') {
+ # PUSHp corresponds to setpvn. Treate setpv directly
+ my $what = eval qq("$t->[2]");
+ warn $@ if $@;
+
+ print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n";
+ $prepush_done = 1;
+ }
+ elsif ($t) {
+ my $what = eval qq("$t->[2]");
+ warn $@ if $@;
+
+ my $size = $t->[3];
+ $size = '' unless defined $size;
+ $size = eval qq("$size");
+ warn $@ if $@;
+ print "\tXSprePUSH; PUSH$t->[0]($what$size);\n";
+ $prepush_done = 1;
+ }
+ else {
+ # RETVAL almost never needs SvSETMAGIC()
+ &generate_output($ret_type, 0, 'RETVAL', 0);
+ }
+ }
+
+ $xsreturn = 1 if $ret_type ne "void";
+ my $num = $xsreturn;
+ my $c = @outlist;
+ print "\tXSprePUSH;" if $c and not $prepush_done;
+ print "\tEXTEND(SP,$c);\n" if $c;
+ $xsreturn += $c;
+ generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist;
+
+ # do cleanup
+ process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE|OVERLOAD") ;
+
+ print Q(<<"EOF") if $ScopeThisXSUB;
+# ]]
+EOF
+ print Q(<<"EOF") if $ScopeThisXSUB and not $PPCODE;
+# LEAVE;
+EOF
+
+ # print function trailer
+ print Q(<<"EOF");
+# ]]
+EOF
+ print Q(<<"EOF") if $except;
+# BEGHANDLERS
+# CATCHALL
+# sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
+# ENDHANDLERS
+EOF
+ if (check_keyword("CASE")) {
+ blurt ("Error: No `CASE:' at top of function")
+ unless $condnum;
+ $_ = "CASE: $_"; # Restore CASE: label
+ next;
+ }
+ last if $_ eq "$END:";
+ death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function ($_)");
+ }
+
+ print Q(<<"EOF") if $except;
+# if (errbuf[0])
+# Perl_croak(aTHX_ errbuf);
+EOF
+
+ if ($xsreturn) {
+ print Q(<<"EOF") unless $PPCODE;
+# XSRETURN($xsreturn);
+EOF
+ } else {
+ print Q(<<"EOF") unless $PPCODE;
+# XSRETURN_EMPTY;
+EOF
+ }
+
+ print Q(<<"EOF");
+#]]
+#
+EOF
+
+ our $newXS = "newXS" ;
+ our $proto = "" ;
+
+ # Build the prototype string for the xsub
+ if ($ProtoThisXSUB) {
+ $newXS = "newXSproto_portable";
+
+ if ($ProtoThisXSUB eq 2) {
+ # User has specified empty prototype
+ }
+ elsif ($ProtoThisXSUB eq 1) {
+ my $s = ';';
+ if ($min_args < $num_args) {
+ $s = '';
+ $proto_arg[$min_args] .= ";" ;
+ }
+ push @proto_arg, "$s\@"
+ if $ellipsis ;
+
+ $proto = join ("", grep defined, @proto_arg);
+ }
+ else {
+ # User has specified a prototype
+ $proto = $ProtoThisXSUB;
+ }
+ $proto = qq{, "$proto"};
+ }
+
+ if (%XsubAliases) {
+ $XsubAliases{$pname} = 0
+ unless defined $XsubAliases{$pname} ;
+ while ( ($name, $value) = each %XsubAliases) {
+ push(@InitFileCode, Q(<<"EOF"));
+# cv = ${newXS}(\"$name\", XS_$Full_func_name, file$proto);
+# XSANY.any_i32 = $value ;
+EOF
+ }
+ }
+ elsif (@Attributes) {
+ push(@InitFileCode, Q(<<"EOF"));
+# cv = ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);
+# apply_attrs_string("$Package", cv, "@Attributes", 0);
+EOF
+ }
+ elsif ($interface) {
+ while ( ($name, $value) = each %Interfaces) {
+ $name = "$Package\::$name" unless $name =~ /::/;
+ push(@InitFileCode, Q(<<"EOF"));
+# cv = ${newXS}(\"$name\", XS_$Full_func_name, file$proto);
+# $interface_macro_set(cv,$value) ;
+EOF
+ }
+ }
+ else {
+ push(@InitFileCode,
+ " (void)${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
+ }
+ }
+
+ if ($Overload) # make it findable with fetchmethod
+ {
+ print Q(<<"EOF");
+#XS(XS_${Packid}_nil); /* prototype to pass -Wmissing-prototypes */
+#XS(XS_${Packid}_nil)
+#{
+# dXSARGS;
+# XSRETURN_EMPTY;
+#}
+#
+EOF
+ unshift(@InitFileCode, <<"MAKE_FETCHMETHOD_WORK");
+ /* Making a sub named "${Package}::()" allows the package */
+ /* to be findable via fetchmethod(), and causes */
+ /* overload::Overloaded("${Package}") to return true. */
+ (void)${newXS}("${Package}::()", XS_${Packid}_nil, file$proto);
+MAKE_FETCHMETHOD_WORK
+ }
+
+ # print initialization routine
+
+ print Q(<<"EOF");
+##ifdef __cplusplus
+#extern "C"
+##endif
+EOF
+
+ print Q(<<"EOF");
+#XS(boot_$Module_cname); /* prototype to pass -Wmissing-prototypes */
+#XS(boot_$Module_cname)
+EOF
+
+ print Q(<<"EOF");
+#[[
+##ifdef dVAR
+# dVAR; dXSARGS;
+##else
+# dXSARGS;
+##endif
+EOF
+
+ #Under 5.8.x and lower, newXS is declared in proto.h as expecting a non-const
+ #file name argument. If the wrong qualifier is used, it causes breakage with
+ #C++ compilers and warnings with recent gcc.
+ #-Wall: if there is no $Full_func_name there are no xsubs in this .xs
+ #so `file' is unused
+ print Q(<<"EOF") if $Full_func_name;
+##if (PERL_REVISION == 5 && PERL_VERSION < 9)
+# char* file = __FILE__;
+##else
+# const char* file = __FILE__;
+##endif
+EOF
+
+ print Q("#\n");
+
+ print Q(<<"EOF");
+# PERL_UNUSED_VAR(cv); /* -W */
+# PERL_UNUSED_VAR(items); /* -W */
+EOF
+
+ print Q(<<"EOF") if $WantVersionChk ;
+# XS_VERSION_BOOTCHECK ;
+#
+EOF
+
+ print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces ;
+# {
+# CV * cv ;
+#
+EOF
+
+ print Q(<<"EOF") if ($Overload);
+# /* register the overloading (type 'A') magic */
+# PL_amagic_generation++;
+# /* The magic for overload gets a GV* via gv_fetchmeth as */
+# /* mentioned above, and looks in the SV* slot of it for */
+# /* the "fallback" status. */
+# sv_setsv(
+# get_sv( "${Package}::()", TRUE ),
+# $Fallback
+# );
+EOF
+
+ print @InitFileCode;
+
+ print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces ;
+# }
+EOF
+
+ if (@BootCode)
+ {
+ print "\n /* Initialisation Section */\n\n" ;
+ @line = @BootCode;
+ print_section();
+ print "\n /* End of Initialisation Section */\n\n" ;
+ }
+
+ print Q(<<'EOF');
+##if (PERL_REVISION == 5 && PERL_VERSION >= 9)
+# if (PL_unitcheckav)
+# call_list(PL_scopestack_ix, PL_unitcheckav);
+##endif
+EOF
+
+ print Q(<<"EOF");
+# XSRETURN_YES;
+#]]
+#
+EOF
+
+ warn("Please specify prototyping behavior for $filename (see perlxs manual)\n")
+ unless $ProtoUsed ;
+
+ chdir($orig_cwd);
+ select($orig_fh);
+ untie *PSEUDO_STDOUT if tied *PSEUDO_STDOUT;
+ close $FH;
+
+ return 1;
+}
+
+sub errors { $errors }
+
+sub standard_typemap_locations {
+ # Add all the default typemap locations to the search path
+ my @tm = qw(typemap);
+
+ my $updir = File::Spec->updir;
+ foreach my $dir (File::Spec->catdir(($updir) x 1), File::Spec->catdir(($updir) x 2),
+ File::Spec->catdir(($updir) x 3), File::Spec->catdir(($updir) x 4)) {
+
+ unshift @tm, File::Spec->catfile($dir, 'typemap');
+ unshift @tm, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
+ }
+ foreach my $dir (@INC) {
+ my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
+ unshift @tm, $file if -e $file;
+ }
+ return @tm;
+}
+
+sub TrimWhitespace
+{
+ $_[0] =~ s/^\s+|\s+$//go ;
+}
+
+sub TidyType
+ {
+ local ($_) = @_ ;
+
+ # rationalise any '*' by joining them into bunches and removing whitespace
+ s#\s*(\*+)\s*#$1#g;
+ s#(\*+)# $1 #g ;
+
+ # change multiple whitespace into a single space
+ s/\s+/ /g ;
+
+ # trim leading & trailing whitespace
+ TrimWhitespace($_) ;
+
+ $_ ;
+}
+
+# Input: ($_, @line) == unparsed input.
+# Output: ($_, @line) == (rest of line, following lines).
+# Return: the matched keyword if found, otherwise 0
+sub check_keyword {
+ $_ = shift(@line) while !/\S/ && @line;
+ s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;
+}
+
+sub print_section {
+ # the "do" is required for right semantics
+ do { $_ = shift(@line) } while !/\S/ && @line;
+
+ print("#line ", $line_no[@line_no - @line -1], " \"$filepathname\"\n")
+ if $WantLineNumbers && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/;
+ for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) {
+ print "$_\n";
+ }
+ print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+}
+
+sub merge_section {
+ my $in = '';
+
+ while (!/\S/ && @line) {
+ $_ = shift(@line);
+ }
+
+ for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) {
+ $in .= "$_\n";
+ }
+ chomp $in;
+ return $in;
+ }
+
+sub process_keyword($)
+ {
+ my($pattern) = @_ ;
+ my $kwd ;
+
+ &{"${kwd}_handler"}()
+ while $kwd = check_keyword($pattern) ;
+ }
+
+sub CASE_handler {
+ blurt ("Error: `CASE:' after unconditional `CASE:'")
+ if $condnum && $cond eq '';
+ $cond = $_;
+ TrimWhitespace($cond);
+ print " ", ($condnum++ ? " else" : ""), ($cond ? " if ($cond)\n" : "\n");
+ $_ = '' ;
+}
+
+sub INPUT_handler {
+ for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ last if /^\s*NOT_IMPLEMENTED_YET/;
+ next unless /\S/; # skip blank lines
+
+ TrimWhitespace($_) ;
+ my $line = $_ ;
+
+ # remove trailing semicolon if no initialisation
+ s/\s*;$//g unless /[=;+].*\S/ ;
+
+ # Process the length(foo) declarations
+ if (s/^([^=]*)\blength\(\s*(\w+)\s*\)\s*$/$1 XSauto_length_of_$2=NO_INIT/x) {
+ print "\tSTRLEN\tSTRLEN_length_of_$2;\n";
+ $lengthof{$2} = $name;
+ # $islengthof{$name} = $1;
+ $deferred .= "\n\tXSauto_length_of_$2 = STRLEN_length_of_$2;\n";
+ }
+
+ # check for optional initialisation code
+ my $var_init = '' ;
+ $var_init = $1 if s/\s*([=;+].*)$//s ;
+ $var_init =~ s/"/\\"/g;
+
+ s/\s+/ /g;
+ my ($var_type, $var_addr, $var_name) = /^(.*?[^&\s])\s*(\&?)\s*\b(\w+)$/s
+ or blurt("Error: invalid argument declaration '$line'"), next;
+
+ # Check for duplicate definitions
+ blurt ("Error: duplicate definition of argument '$var_name' ignored"), next
+ if $arg_list{$var_name}++
+ or defined $argtype_seen{$var_name} and not $processing_arg_with_types;
+
+ $thisdone |= $var_name eq "THIS";
+ $retvaldone |= $var_name eq "RETVAL";
+ $var_types{$var_name} = $var_type;
+ # XXXX This check is a safeguard against the unfinished conversion of
+ # generate_init(). When generate_init() is fixed,
+ # one can use 2-args map_type() unconditionally.
+ if ($var_type =~ / \( \s* \* \s* \) /x) {
+ # Function pointers are not yet supported with &output_init!
+ print "\t" . &map_type($var_type, $var_name);
+ $name_printed = 1;
+ } else {
+ print "\t" . &map_type($var_type);
+ $name_printed = 0;
+ }
+ $var_num = $args_match{$var_name};
+
+ $proto_arg[$var_num] = ProtoString($var_type)
+ if $var_num ;
+ $func_args =~ s/\b($var_name)\b/&$1/ if $var_addr;
+ if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/
+ or $in_out{$var_name} and $in_out{$var_name} =~ /^OUT/
+ and $var_init !~ /\S/) {
+ if ($name_printed) {
+ print ";\n";
+ } else {
+ print "\t$var_name;\n";
+ }
+ } elsif ($var_init =~ /\S/) {
+ &output_init($var_type, $var_num, $var_name, $var_init, $name_printed);
+ } elsif ($var_num) {
+ # generate initialization code
+ &generate_init($var_type, $var_num, $var_name, $name_printed);
+ } else {
+ print ";\n";
+ }
+ }
+}
+
+sub OUTPUT_handler {
+ for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ next unless /\S/;
+ if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) {
+ $DoSetMagic = ($1 eq "ENABLE" ? 1 : 0);
+ next;
+ }
+ my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ;
+ blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
+ if $outargs{$outarg} ++ ;
+ if (!$gotRETVAL and $outarg eq 'RETVAL') {
+ # deal with RETVAL last
+ $RETVAL_code = $outcode ;
+ $gotRETVAL = 1 ;
+ next ;
+ }
+ blurt ("Error: OUTPUT $outarg not an argument"), next
+ unless defined($args_match{$outarg});
+ blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
+ unless defined $var_types{$outarg} ;
+ $var_num = $args_match{$outarg};
+ if ($outcode) {
+ print "\t$outcode\n";
+ print "\tSvSETMAGIC(ST(" , $var_num-1 , "));\n" if $DoSetMagic;
+ } else {
+ &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic);
+ }
+ delete $in_out{$outarg} # No need to auto-OUTPUT
+ if exists $in_out{$outarg} and $in_out{$outarg} =~ /OUT$/;
+ }
+}
+
+sub C_ARGS_handler() {
+ my $in = merge_section();
+
+ TrimWhitespace($in);
+ $func_args = $in;
+}
+
+sub INTERFACE_MACRO_handler() {
+ my $in = merge_section();
+
+ TrimWhitespace($in);
+ if ($in =~ /\s/) { # two
+ ($interface_macro, $interface_macro_set) = split ' ', $in;
+ } else {
+ $interface_macro = $in;
+ $interface_macro_set = 'UNKNOWN_CVT'; # catch later
+ }
+ $interface = 1; # local
+ $Interfaces = 1; # global
+}
+
+sub INTERFACE_handler() {
+ my $in = merge_section();
+
+ TrimWhitespace($in);
+
+ foreach (split /[\s,]+/, $in) {
+ my $name = $_;
+ $name =~ s/^$Prefix//;
+ $Interfaces{$name} = $_;
+ }
+ print Q(<<"EOF");
+# XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
+EOF
+ $interface = 1; # local
+ $Interfaces = 1; # global
+}
+
+sub CLEANUP_handler() { print_section() }
+sub PREINIT_handler() { print_section() }
+sub POSTCALL_handler() { print_section() }
+sub INIT_handler() { print_section() }
+
+sub GetAliases
+ {
+ my ($line) = @_ ;
+ my ($orig) = $line ;
+ my ($alias) ;
+ my ($value) ;
+
+ # Parse alias definitions
+ # format is
+ # alias = value alias = value ...
+
+ while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) {
+ $alias = $1 ;
+ $orig_alias = $alias ;
+ $value = $2 ;
+
+ # check for optional package definition in the alias
+ $alias = $Packprefix . $alias if $alias !~ /::/ ;
+
+ # check for duplicate alias name & duplicate value
+ Warn("Warning: Ignoring duplicate alias '$orig_alias'")
+ if defined $XsubAliases{$alias} ;
+
+ Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values")
+ if $XsubAliasValues{$value} ;
+
+ $XsubAliases = 1;
+ $XsubAliases{$alias} = $value ;
+ $XsubAliasValues{$value} = $orig_alias ;
+ }
+
+ blurt("Error: Cannot parse ALIAS definitions from '$orig'")
+ if $line ;
+ }
+
+sub ATTRS_handler ()
+ {
+ for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ next unless /\S/;
+ TrimWhitespace($_) ;
+ push @Attributes, $_;
+ }
+ }
+
+sub ALIAS_handler ()
+ {
+ for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ next unless /\S/;
+ TrimWhitespace($_) ;
+ GetAliases($_) if $_ ;
+ }
+ }
+
+sub OVERLOAD_handler()
+{
+ for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ next unless /\S/;
+ TrimWhitespace($_) ;
+ while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) {
+ $Overload = 1 unless $Overload;
+ my $overload = "$Package\::(".$1 ;
+ push(@InitFileCode,
+ " (void)${newXS}(\"$overload\", XS_$Full_func_name, file$proto);\n");
+ }
+ }
+}
+
+sub FALLBACK_handler()
+{
+ # the rest of the current line should contain either TRUE,
+ # FALSE or UNDEF
+
+ TrimWhitespace($_) ;
+ my %map = (
+ TRUE => "&PL_sv_yes", 1 => "&PL_sv_yes",
+ FALSE => "&PL_sv_no", 0 => "&PL_sv_no",
+ UNDEF => "&PL_sv_undef",
+ ) ;
+
+ # check for valid FALLBACK value
+ death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_} ;
+
+ $Fallback = $map{uc $_} ;
+}
+
+
+sub REQUIRE_handler ()
+ {
+ # the rest of the current line should contain a version number
+ my ($Ver) = $_ ;
+
+ TrimWhitespace($Ver) ;
+
+ death ("Error: REQUIRE expects a version number")
+ unless $Ver ;
+
+ # check that the version number is of the form n.n
+ death ("Error: REQUIRE: expected a number, got '$Ver'")
+ unless $Ver =~ /^\d+(\.\d*)?/ ;
+
+ death ("Error: xsubpp $Ver (or better) required--this is only $VERSION.")
+ unless $VERSION >= $Ver ;
+ }
+
+sub VERSIONCHECK_handler ()
+ {
+ # the rest of the current line should contain either ENABLE or
+ # DISABLE
+
+ TrimWhitespace($_) ;
+
+ # check for ENABLE/DISABLE
+ death ("Error: VERSIONCHECK: ENABLE/DISABLE")
+ unless /^(ENABLE|DISABLE)/i ;
+
+ $WantVersionChk = 1 if $1 eq 'ENABLE' ;
+ $WantVersionChk = 0 if $1 eq 'DISABLE' ;
+
+ }
+
+sub PROTOTYPE_handler ()
+ {
+ my $specified ;
+
+ death("Error: Only 1 PROTOTYPE definition allowed per xsub")
+ if $proto_in_this_xsub ++ ;
+
+ for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ next unless /\S/;
+ $specified = 1 ;
+ TrimWhitespace($_) ;
+ if ($_ eq 'DISABLE') {
+ $ProtoThisXSUB = 0
+ } elsif ($_ eq 'ENABLE') {
+ $ProtoThisXSUB = 1
+ } else {
+ # remove any whitespace
+ s/\s+//g ;
+ death("Error: Invalid prototype '$_'")
+ unless ValidProtoString($_) ;
+ $ProtoThisXSUB = C_string($_) ;
+ }
+ }
+
+ # If no prototype specified, then assume empty prototype ""
+ $ProtoThisXSUB = 2 unless $specified ;
+
+ $ProtoUsed = 1 ;
+
+ }
+
+sub SCOPE_handler ()
+ {
+ death("Error: Only 1 SCOPE declaration allowed per xsub")
+ if $scope_in_this_xsub ++ ;
+
+ TrimWhitespace($_);
+ death ("Error: SCOPE: ENABLE/DISABLE")
+ unless /^(ENABLE|DISABLE)\b/i;
+ $ScopeThisXSUB = ( uc($1) eq 'ENABLE' );
+ }
+
+sub PROTOTYPES_handler ()
+ {
+ # the rest of the current line should contain either ENABLE or
+ # DISABLE
+
+ TrimWhitespace($_) ;
+
+ # check for ENABLE/DISABLE
+ death ("Error: PROTOTYPES: ENABLE/DISABLE")
+ unless /^(ENABLE|DISABLE)/i ;
+
+ $WantPrototypes = 1 if $1 eq 'ENABLE' ;
+ $WantPrototypes = 0 if $1 eq 'DISABLE' ;
+ $ProtoUsed = 1 ;
+
+ }
+
+sub INCLUDE_handler ()
+ {
+ # the rest of the current line should contain a valid filename
+
+ TrimWhitespace($_) ;
+
+ death("INCLUDE: filename missing")
+ unless $_ ;
+
+ death("INCLUDE: output pipe is illegal")
+ if /^\s*\|/ ;
+
+ # simple minded recursion detector
+ death("INCLUDE loop detected")
+ if $IncludedFiles{$_} ;
+
+ ++ $IncludedFiles{$_} unless /\|\s*$/ ;
+
+ # Save the current file context.
+ push(@XSStack, {
+ type => 'file',
+ LastLine => $lastline,
+ LastLineNo => $lastline_no,
+ Line => \@line,
+ LineNo => \@line_no,
+ Filename => $filename,
+ Filepathname => $filepathname,
+ Handle => $FH,
+ }) ;
+
+ $FH = Symbol::gensym();
+
+ # open the new file
+ open ($FH, "$_") or death("Cannot open '$_': $!") ;
+
+ print Q(<<"EOF");
+#
+#/* INCLUDE: Including '$_' from '$filename' */
+#
+EOF
+
+ $filename = $_ ;
+ $filepathname = "$dir/$filename";
+
+ # Prime the pump by reading the first
+ # non-blank line
+
+ # skip leading blank lines
+ while (<$FH>) {
+ last unless /^\s*$/ ;
+ }
+
+ $lastline = $_ ;
+ $lastline_no = $. ;
+
+ }
+
+sub PopFile()
+ {
+ return 0 unless $XSStack[-1]{type} eq 'file' ;
+
+ my $data = pop @XSStack ;
+ my $ThisFile = $filename ;
+ my $isPipe = ($filename =~ /\|\s*$/) ;
+
+ -- $IncludedFiles{$filename}
+ unless $isPipe ;
+
+ close $FH ;
+
+ $FH = $data->{Handle} ;
+ # $filename is the leafname, which for some reason isused for diagnostic
+ # messages, whereas $filepathname is the full pathname, and is used for
+ # #line directives.
+ $filename = $data->{Filename} ;
+ $filepathname = $data->{Filepathname} ;
+ $lastline = $data->{LastLine} ;
+ $lastline_no = $data->{LastLineNo} ;
+ @line = @{ $data->{Line} } ;
+ @line_no = @{ $data->{LineNo} } ;
+
+ if ($isPipe and $? ) {
+ -- $lastline_no ;
+ print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n" ;
+ exit 1 ;
+ }
+
+ print Q(<<"EOF");
+#
+#/* INCLUDE: Returning to '$filename' from '$ThisFile' */
+#
+EOF
+
+ return 1 ;
+ }
+
+sub ValidProtoString ($)
+ {
+ my($string) = @_ ;
+
+ if ( $string =~ /^$proto_re+$/ ) {
+ return $string ;
+ }
+
+ return 0 ;
+ }
+
+sub C_string ($)
+ {
+ my($string) = @_ ;
+
+ $string =~ s[\\][\\\\]g ;
+ $string ;
+ }
+
+sub ProtoString ($)
+ {
+ my ($type) = @_ ;
+
+ $proto_letter{$type} or "\$" ;
+ }
+
+sub check_cpp {
+ my @cpp = grep(/^\#\s*(?:if|e\w+)/, @line);
+ if (@cpp) {
+ my ($cpp, $cpplevel);
+ for $cpp (@cpp) {
+ if ($cpp =~ /^\#\s*if/) {
+ $cpplevel++;
+ } elsif (!$cpplevel) {
+ Warn("Warning: #else/elif/endif without #if in this function");
+ print STDERR " (precede it with a blank line if the matching #if is outside the function)\n"
+ if $XSStack[-1]{type} eq 'if';
+ return;
+ } elsif ($cpp =~ /^\#\s*endif/) {
+ $cpplevel--;
+ }
+ }
+ Warn("Warning: #if without #endif in this function") if $cpplevel;
+ }
+}
+
+
+sub Q {
+ my($text) = @_;
+ $text =~ s/^#//gm;
+ $text =~ s/\[\[/{/g;
+ $text =~ s/\]\]/}/g;
+ $text;
+}
+
+# Read next xsub into @line from ($lastline, <$FH>).
+sub fetch_para {
+ # parse paragraph
+ death ("Error: Unterminated `#if/#ifdef/#ifndef'")
+ if !defined $lastline && $XSStack[-1]{type} eq 'if';
+ @line = ();
+ @line_no = () ;
+ return PopFile() if !defined $lastline;
+
+ if ($lastline =~
+ /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
+ $Module = $1;
+ $Package = defined($2) ? $2 : ''; # keep -w happy
+ $Prefix = defined($3) ? $3 : ''; # keep -w happy
+ $Prefix = quotemeta $Prefix ;
+ ($Module_cname = $Module) =~ s/\W/_/g;
+ ($Packid = $Package) =~ tr/:/_/;
+ $Packprefix = $Package;
+ $Packprefix .= "::" if $Packprefix ne "";
+ $lastline = "";
+ }
+
+ for (;;) {
+ # Skip embedded PODs
+ while ($lastline =~ /^=/) {
+ while ($lastline = <$FH>) {
+ last if ($lastline =~ /^=cut\s*$/);
+ }
+ death ("Error: Unterminated pod") unless $lastline;
+ $lastline = <$FH>;
+ chomp $lastline;
+ $lastline =~ s/^\s+$//;
+ }
+ if ($lastline !~ /^\s*#/ ||
+ # CPP directives:
+ # ANSI: if ifdef ifndef elif else endif define undef
+ # line error pragma
+ # gcc: warning include_next
+ # obj-c: import
+ # others: ident (gcc notes that some cpps have this one)
+ $lastline =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) {
+ last if $lastline =~ /^\S/ && @line && $line[-1] eq "";
+ push(@line, $lastline);
+ push(@line_no, $lastline_no) ;
+ }
+
+ # Read next line and continuation lines
+ last unless defined($lastline = <$FH>);
+ $lastline_no = $.;
+ my $tmp_line;
+ $lastline .= $tmp_line
+ while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>));
+
+ chomp $lastline;
+ $lastline =~ s/^\s+$//;
+ }
+ pop(@line), pop(@line_no) while @line && $line[-1] eq "";
+ 1;
+}
+
+sub output_init {
+ local($type, $num, $var, $init, $name_printed) = @_;
+ local($arg) = "ST(" . ($num - 1) . ")";
+
+ if ( $init =~ /^=/ ) {
+ if ($name_printed) {
+ eval qq/print " $init\\n"/;
+ } else {
+ eval qq/print "\\t$var $init\\n"/;
+ }
+ warn $@ if $@;
+ } else {
+ if ( $init =~ s/^\+// && $num ) {
+ &generate_init($type, $num, $var, $name_printed);
+ } elsif ($name_printed) {
+ print ";\n";
+ $init =~ s/^;//;
+ } else {
+ eval qq/print "\\t$var;\\n"/;
+ warn $@ if $@;
+ $init =~ s/^;//;
+ }
+ $deferred .= eval qq/"\\n\\t$init\\n"/;
+ warn $@ if $@;
+ }
+}
+
+sub Warn
+ {
+ # work out the line number
+ my $line_no = $line_no[@line_no - @line -1] ;
+
+ print STDERR "@_ in $filename, line $line_no\n" ;
+ }
+
+sub blurt
+ {
+ Warn @_ ;
+ $errors ++
+ }
+
+sub death
+ {
+ Warn @_ ;
+ exit 1 ;
+ }
+
+sub generate_init {
+ local($type, $num, $var) = @_;
+ local($arg) = "ST(" . ($num - 1) . ")";
+ local($argoff) = $num - 1;
+ local($ntype);
+ local($tk);
+
+ $type = TidyType($type) ;
+ blurt("Error: '$type' not in typemap"), return
+ unless defined($type_kind{$type});
+
+ ($ntype = $type) =~ s/\s*\*/Ptr/g;
+ ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+ $tk = $type_kind{$type};
+ $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
+ if ($tk eq 'T_PV' and exists $lengthof{$var}) {
+ print "\t$var" unless $name_printed;
+ print " = ($type)SvPV($arg, STRLEN_length_of_$var);\n";
+ die "default value not supported with length(NAME) supplied"
+ if defined $defaults{$var};
+ return;
+ }
+ $type =~ tr/:/_/ unless $hiertype;
+ blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
+ unless defined $input_expr{$tk} ;
+ $expr = $input_expr{$tk};
+ if ($expr =~ /DO_ARRAY_ELEM/) {
+ blurt("Error: '$subtype' not in typemap"), return
+ unless defined($type_kind{$subtype});
+ blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
+ unless defined $input_expr{$type_kind{$subtype}} ;
+ $subexpr = $input_expr{$type_kind{$subtype}};
+ $subexpr =~ s/\$type/\$subtype/g;
+ $subexpr =~ s/ntype/subtype/g;
+ $subexpr =~ s/\$arg/ST(ix_$var)/g;
+ $subexpr =~ s/\n\t/\n\t\t/g;
+ $subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
+ $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
+ $expr =~ s/DO_ARRAY_ELEM/$subexpr/;
+ }
+ if ($expr =~ m#/\*.*scope.*\*/#i) { # "scope" in C comments
+ $ScopeThisXSUB = 1;
+ }
+ if (defined($defaults{$var})) {
+ $expr =~ s/(\t+)/$1 /g;
+ $expr =~ s/ /\t/g;
+ if ($name_printed) {
+ print ";\n";
+ } else {
+ eval qq/print "\\t$var;\\n"/;
+ warn $@ if $@;
+ }
+ if ($defaults{$var} eq 'NO_INIT') {
+ $deferred .= eval qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/;
+ } else {
+ $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
+ }
+ warn $@ if $@;
+ } elsif ($ScopeThisXSUB or $expr !~ /^\s*\$var =/) {
+ if ($name_printed) {
+ print ";\n";
+ } else {
+ eval qq/print "\\t$var;\\n"/;
+ warn $@ if $@;
+ }
+ $deferred .= eval qq/"\\n$expr;\\n"/;
+ warn $@ if $@;
+ } else {
+ die "panic: do not know how to handle this branch for function pointers"
+ if $name_printed;
+ eval qq/print "$expr;\\n"/;
+ warn $@ if $@;
+ }
+}
+
+sub generate_output {
+ local($type, $num, $var, $do_setmagic, $do_push) = @_;
+ local($arg) = "ST(" . ($num - ($num != 0)) . ")";
+ local($argoff) = $num - 1;
+ local($ntype);
+
+ $type = TidyType($type) ;
+ if ($type =~ /^array\(([^,]*),(.*)\)/) {
+ print "\t$arg = sv_newmortal();\n";
+ print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";
+ print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+ } else {
+ blurt("Error: '$type' not in typemap"), return
+ unless defined($type_kind{$type});
+ blurt("Error: No OUTPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
+ unless defined $output_expr{$type_kind{$type}} ;
+ ($ntype = $type) =~ s/\s*\*/Ptr/g;
+ $ntype =~ s/\(\)//g;
+ ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+ $expr = $output_expr{$type_kind{$type}};
+ if ($expr =~ /DO_ARRAY_ELEM/) {
+ blurt("Error: '$subtype' not in typemap"), return
+ unless defined($type_kind{$subtype});
+ blurt("Error: No OUTPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
+ unless defined $output_expr{$type_kind{$subtype}} ;
+ $subexpr = $output_expr{$type_kind{$subtype}};
+ $subexpr =~ s/ntype/subtype/g;
+ $subexpr =~ s/\$arg/ST(ix_$var)/g;
+ $subexpr =~ s/\$var/${var}[ix_$var]/g;
+ $subexpr =~ s/\n\t/\n\t\t/g;
+ $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
+ eval "print qq\a$expr\a";
+ warn $@ if $@;
+ print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic;
+ } elsif ($var eq 'RETVAL') {
+ if ($expr =~ /^\t\$arg = new/) {
+ # We expect that $arg has refcnt 1, so we need to
+ # mortalize it.
+ eval "print qq\a$expr\a";
+ warn $@ if $@;
+ print "\tsv_2mortal(ST($num));\n";
+ print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic;
+ } elsif ($expr =~ /^\s*\$arg\s*=/) {
+ # We expect that $arg has refcnt >=1, so we need
+ # to mortalize it!
+ eval "print qq\a$expr\a";
+ warn $@ if $@;
+ print "\tsv_2mortal(ST(0));\n";
+ print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
+ } else {
+ # Just hope that the entry would safely write it
+ # over an already mortalized value. By
+ # coincidence, something like $arg = &sv_undef
+ # works too.
+ print "\tST(0) = sv_newmortal();\n";
+ eval "print qq\a$expr\a";
+ warn $@ if $@;
+ # new mortals don't have set magic
+ }
+ } elsif ($do_push) {
+ print "\tPUSHs(sv_newmortal());\n";
+ $arg = "ST($num)";
+ eval "print qq\a$expr\a";
+ warn $@ if $@;
+ print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+ } elsif ($arg =~ /^ST\(\d+\)$/) {
+ eval "print qq\a$expr\a";
+ warn $@ if $@;
+ print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+ }
+ }
+}
+
+sub map_type {
+ my($type, $varname) = @_;
+
+ # C++ has :: in types too so skip this
+ $type =~ tr/:/_/ unless $hiertype;
+ $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
+ if ($varname) {
+ if ($varname && $type =~ / \( \s* \* (?= \s* \) ) /xg) {
+ (substr $type, pos $type, 0) = " $varname ";
+ } else {
+ $type .= "\t$varname";
+ }
+ }
+ $type;
+}
+
+
+#########################################################
+package
+ ExtUtils::ParseXS::CountLines;
+use strict;
+use vars qw($SECTION_END_MARKER);
+
+sub TIEHANDLE {
+ my ($class, $cfile, $fh) = @_;
+ $cfile =~ s/\\/\\\\/g;
+ $SECTION_END_MARKER = qq{#line --- "$cfile"};
+
+ return bless {buffer => '',
+ fh => $fh,
+ line_no => 1,
+ }, $class;
+}
+
+sub PRINT {
+ my $self = shift;
+ for (@_) {
+ $self->{buffer} .= $_;
+ while ($self->{buffer} =~ s/^([^\n]*\n)//) {
+ my $line = $1;
+ ++ $self->{line_no};
+ $line =~ s|^\#line\s+---(?=\s)|#line $self->{line_no}|;
+ print {$self->{fh}} $line;
+ }
+ }
+}
+
+sub PRINTF {
+ my $self = shift;
+ my $fmt = shift;
+ $self->PRINT(sprintf($fmt, @_));
+}
+
+sub DESTROY {
+ # Not necessary if we're careful to end with a "\n"
+ my $self = shift;
+ print {$self->{fh}} $self->{buffer};
+}
+
+sub UNTIE {
+ # This sub does nothing, but is neccessary for references to be released.
+}
+
+sub end_marker {
+ return $SECTION_END_MARKER;
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::ParseXS - converts Perl XS code into C code
+
+=head1 SYNOPSIS
+
+ use ExtUtils::ParseXS qw(process_file);
+
+ process_file( filename => 'foo.xs' );
+
+ process_file( filename => 'foo.xs',
+ output => 'bar.c',
+ 'C++' => 1,
+ typemap => 'path/to/typemap',
+ hiertype => 1,
+ except => 1,
+ prototypes => 1,
+ versioncheck => 1,
+ linenumbers => 1,
+ optimize => 1,
+ prototypes => 1,
+ );
+=head1 DESCRIPTION
+
+C<ExtUtils::ParseXS> will compile XS code into C code by embedding the constructs
+necessary to let C functions manipulate Perl values and creates the glue
+necessary to let Perl access those functions. The compiler uses typemaps to
+determine how to map C function parameters and variables to Perl values.
+
+The compiler will search for typemap files called I<typemap>. It will use
+the following search path to find default typemaps, with the rightmost
+typemap taking precedence.
+
+ ../../../typemap:../../typemap:../typemap:typemap
+
+=head1 EXPORT
+
+None by default. C<process_file()> may be exported upon request.
+
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item process_xs()
+
+This function processes an XS file and sends output to a C file.
+Named parameters control how the processing is done. The following
+parameters are accepted:
+
+=over 4
+
+=item B<C++>
+
+Adds C<extern "C"> to the C code. Default is false.
+
+=item B<hiertype>
+
+Retains C<::> in type names so that C++ hierachical types can be
+mapped. Default is false.
+
+=item B<except>
+
+Adds exception handling stubs to the C code. Default is false.
+
+=item B<typemap>
+
+Indicates that a user-supplied typemap should take precedence over the
+default typemaps. A single typemap may be specified as a string, or
+multiple typemaps can be specified in an array reference, with the
+last typemap having the highest precedence.
+
+=item B<prototypes>
+
+Generates prototype code for all xsubs. Default is false.
+
+=item B<versioncheck>
+
+Makes sure at run time that the object file (derived from the C<.xs>
+file) and the C<.pm> files have the same version number. Default is
+true.
+
+=item B<linenumbers>
+
+Adds C<#line> directives to the C output so error messages will look
+like they came from the original XS file. Default is true.
+
+=item B<optimize>
+
+Enables certain optimizations. The only optimization that is currently
+affected is the use of I<target>s by the output C code (see L<perlguts>).
+Not optimizing may significantly slow down the generated code, but this is the way
+B<xsubpp> of 5.005 and earlier operated. Default is to optimize.
+
+=item B<inout>
+
+Enable recognition of C<IN>, C<OUT_LIST> and C<INOUT_LIST>
+declarations. Default is true.
+
+=item B<argtypes>
+
+Enable recognition of ANSI-like descriptions of function signature.
+Default is true.
+
+=item B<s>
+
+I have no clue what this does. Strips function prefixes?
+
+=back
+
+=item errors()
+
+This function returns the number of [a certain kind of] errors
+encountered during processing of the XS file.
+
+=back
+
+=head1 AUTHOR
+
+Based on xsubpp code, written by Larry Wall.
+
+Maintained by:
+
+=over 4
+
+=item *
+
+Ken Williams, <ken@mathforum.org>
+
+=item *
+
+David Golden, <dagolden@cpan.org>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2002-2009 by Ken Williams, David Golden and other contributors. All
+rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Based on the ExtUtils::xsubpp code by Larry Wall and the Perl 5
+Porters, which was released under the same license terms.
+
+=head1 SEE ALSO
+
+L<perl>, ExtUtils::xsubpp, ExtUtils::MakeMaker, L<perlxs>, L<perlxstut>.
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm b/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm
new file mode 100644
index 00000000000..fe01beb0e1e
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm
@@ -0,0 +1,41 @@
+package ExtUtils::testlib;
+
+use strict;
+use warnings;
+
+our $VERSION = 6.56;
+
+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.
+
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/typemap b/Master/tlpkg/tlperl/lib/ExtUtils/typemap
new file mode 100644
index 00000000000..f88858762d5
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/typemap
@@ -0,0 +1,336 @@
+# basic C types
+int T_IV
+unsigned T_UV
+unsigned int T_UV
+long T_IV
+unsigned long T_UV
+short T_IV
+unsigned short T_UV
+char T_CHAR
+unsigned char T_U_CHAR
+char * T_PV
+unsigned char * T_PV
+const char * T_PV
+caddr_t T_PV
+wchar_t * T_PV
+wchar_t T_IV
+# bool_t is defined in <rpc/rpc.h>
+bool_t T_IV
+size_t T_UV
+ssize_t T_IV
+time_t T_NV
+unsigned long * T_OPAQUEPTR
+char ** T_PACKEDARRAY
+void * T_PTR
+Time_t * T_PV
+SV * T_SV
+SVREF T_SVREF
+AV * T_AVREF
+HV * T_HVREF
+CV * T_CVREF
+
+IV T_IV
+UV T_UV
+NV T_NV
+I32 T_IV
+I16 T_IV
+I8 T_IV
+STRLEN T_UV
+U32 T_U_LONG
+U16 T_U_SHORT
+U8 T_UV
+Result T_U_CHAR
+Boolean T_BOOL
+float T_FLOAT
+double T_DOUBLE
+SysRet T_SYSRET
+SysRetLong T_SYSRET
+FILE * T_STDIO
+PerlIO * T_INOUT
+FileHandle T_PTROBJ
+InputStream T_IN
+InOutStream T_INOUT
+OutputStream T_OUT
+bool T_BOOL
+
+#############################################################################
+INPUT
+T_SV
+ $var = $arg
+T_SVREF
+ if (SvROK($arg))
+ $var = (SV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_AVREF
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
+ $var = (AV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not an array reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_HVREF
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
+ $var = (HV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a hash reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_CVREF
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
+ $var = (CV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a code reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_SYSRET
+ $var NOT IMPLEMENTED
+T_UV
+ $var = ($type)SvUV($arg)
+T_IV
+ $var = ($type)SvIV($arg)
+T_INT
+ $var = (int)SvIV($arg)
+T_ENUM
+ $var = ($type)SvIV($arg)
+T_BOOL
+ $var = (bool)SvTRUE($arg)
+T_U_INT
+ $var = (unsigned int)SvUV($arg)
+T_SHORT
+ $var = (short)SvIV($arg)
+T_U_SHORT
+ $var = (unsigned short)SvUV($arg)
+T_LONG
+ $var = (long)SvIV($arg)
+T_U_LONG
+ $var = (unsigned long)SvUV($arg)
+T_CHAR
+ $var = (char)*SvPV_nolen($arg)
+T_U_CHAR
+ $var = (unsigned char)SvUV($arg)
+T_FLOAT
+ $var = (float)SvNV($arg)
+T_NV
+ $var = ($type)SvNV($arg)
+T_DOUBLE
+ $var = (double)SvNV($arg)
+T_PV
+ $var = ($type)SvPV_nolen($arg)
+T_PTR
+ $var = INT2PTR($type,SvIV($arg))
+T_PTRREF
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_REF_IV_REF
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *INT2PTR($type *, tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_REF_IV_PTR
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type, tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_PTROBJ
+ if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_PTRDESC
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ ${type}_desc = (\U${type}_DESC\E*) tmp;
+ $var = ${type}_desc->ptr;
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_REFREF
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_REFOBJ
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_OPAQUE
+ $var = *($type *)SvPV_nolen($arg)
+T_OPAQUEPTR
+ $var = ($type)SvPV_nolen($arg)
+T_PACKED
+ $var = XS_unpack_$ntype($arg)
+T_PACKEDARRAY
+ $var = XS_unpack_$ntype($arg)
+T_CALLBACK
+ $var = make_perl_cb_$type($arg)
+T_ARRAY
+ U32 ix_$var = $argoff;
+ $var = $ntype(items -= $argoff);
+ while (items--) {
+ DO_ARRAY_ELEM;
+ ix_$var++;
+ }
+ /* this is the number of elements in the array */
+ ix_$var -= $argoff
+T_STDIO
+ $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
+T_IN
+ $var = IoIFP(sv_2io($arg))
+T_INOUT
+ $var = IoIFP(sv_2io($arg))
+T_OUT
+ $var = IoOFP(sv_2io($arg))
+#############################################################################
+OUTPUT
+T_SV
+ $arg = $var;
+T_SVREF
+ $arg = newRV((SV*)$var);
+T_AVREF
+ $arg = newRV((SV*)$var);
+T_HVREF
+ $arg = newRV((SV*)$var);
+T_CVREF
+ $arg = newRV((SV*)$var);
+T_IV
+ sv_setiv($arg, (IV)$var);
+T_UV
+ sv_setuv($arg, (UV)$var);
+T_INT
+ sv_setiv($arg, (IV)$var);
+T_SYSRET
+ if ($var != -1) {
+ if ($var == 0)
+ sv_setpvn($arg, "0 but true", 10);
+ else
+ sv_setiv($arg, (IV)$var);
+ }
+T_ENUM
+ sv_setiv($arg, (IV)$var);
+T_BOOL
+ $arg = boolSV($var);
+T_U_INT
+ sv_setuv($arg, (UV)$var);
+T_SHORT
+ sv_setiv($arg, (IV)$var);
+T_U_SHORT
+ sv_setuv($arg, (UV)$var);
+T_LONG
+ sv_setiv($arg, (IV)$var);
+T_U_LONG
+ sv_setuv($arg, (UV)$var);
+T_CHAR
+ sv_setpvn($arg, (char *)&$var, 1);
+T_U_CHAR
+ sv_setuv($arg, (UV)$var);
+T_FLOAT
+ sv_setnv($arg, (double)$var);
+T_NV
+ sv_setnv($arg, (NV)$var);
+T_DOUBLE
+ sv_setnv($arg, (double)$var);
+T_PV
+ sv_setpv((SV*)$arg, $var);
+T_PTR
+ sv_setiv($arg, PTR2IV($var));
+T_PTRREF
+ sv_setref_pv($arg, Nullch, (void*)$var);
+T_REF_IV_REF
+ sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
+T_REF_IV_PTR
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTROBJ
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTRDESC
+ sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
+T_REFREF
+ NOT_IMPLEMENTED
+T_REFOBJ
+ NOT IMPLEMENTED
+T_OPAQUE
+ sv_setpvn($arg, (char *)&$var, sizeof($var));
+T_OPAQUEPTR
+ sv_setpvn($arg, (char *)$var, sizeof(*$var));
+T_PACKED
+ XS_pack_$ntype($arg, $var);
+T_PACKEDARRAY
+ XS_pack_$ntype($arg, $var, count_$ntype);
+T_DATAUNIT
+ sv_setpvn($arg, $var.chp(), $var.size());
+T_CALLBACK
+ sv_setpvn($arg, $var.context.value().chp(),
+ $var.context.value().size());
+T_ARRAY
+ {
+ U32 ix_$var;
+ EXTEND(SP,size_$var);
+ for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
+ ST(ix_$var) = sv_newmortal();
+ DO_ARRAY_ELEM
+ }
+ }
+T_STDIO
+ {
+ GV *gv = newGVgen("$Package");
+ PerlIO *fp = PerlIO_importFILE($var,0);
+ if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_IN
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_INOUT
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_OUT
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/xsubpp b/Master/tlpkg/tlperl/lib/ExtUtils/xsubpp
new file mode 100644
index 00000000000..e4e5b774d82
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/xsubpp
@@ -0,0 +1,156 @@
+#!./miniperl
+
+require 5.002;
+use ExtUtils::ParseXS qw(process_file);
+use Getopt::Long;
+
+my %args = ();
+
+my $usage = "Usage: xsubpp [-v] [-csuffix csuffix] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
+
+Getopt::Long::Configure qw(no_auto_abbrev no_ignore_case);
+
+@ARGV = grep {$_ ne '-C++'} @ARGV; # Allow -C++ for backward compatibility
+GetOptions(\%args, qw(hiertype!
+ prototypes!
+ versioncheck!
+ linenumbers!
+ optimize!
+ inout!
+ argtypes!
+ object_capi!
+ except!
+ v
+ typemap=s@
+ output=s
+ s=s
+ csuffix=s
+ ))
+ or die $usage;
+
+if ($args{v}) {
+ print "xsubpp version $ExtUtils::ParseXS::VERSION\n";
+ exit;
+}
+
+@ARGV == 1 or die $usage;
+
+$args{filename} = shift @ARGV;
+
+process_file(%args);
+exit( ExtUtils::ParseXS::errors() ? 1 : 0 );
+
+__END__
+
+=head1 NAME
+
+xsubpp - compiler to convert Perl XS code into C code
+
+=head1 SYNOPSIS
+
+B<xsubpp> [B<-v>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] [B<-output filename>]... file.xs
+
+=head1 DESCRIPTION
+
+This compiler is typically run by the makefiles created by L<ExtUtils::MakeMaker>.
+
+I<xsubpp> will compile XS code into C code by embedding the constructs
+necessary to let C functions manipulate Perl values and creates the glue
+necessary to let Perl access those functions. The compiler uses typemaps to
+determine how to map C function parameters and variables to Perl values.
+
+The compiler will search for typemap files called I<typemap>. It will use
+the following search path to find default typemaps, with the rightmost
+typemap taking precedence.
+
+ ../../../typemap:../../typemap:../typemap:typemap
+
+It will also use a default typemap installed as C<ExtUtils::typemap>.
+
+=head1 OPTIONS
+
+Note that the C<XSOPT> MakeMaker option may be used to add these options to
+any makefiles generated by MakeMaker.
+
+=over 5
+
+=item B<-hiertype>
+
+Retains '::' in type names so that C++ hierarchical types can be mapped.
+
+=item B<-except>
+
+Adds exception handling stubs to the C code.
+
+=item B<-typemap typemap>
+
+Indicates that a user-supplied typemap should take precedence over the
+default typemaps. This option may be used multiple times, with the last
+typemap having the highest precedence.
+
+=item B<-output filename>
+
+Specifies the name of the output file to generate. If no file is
+specified, output will be written to standard output.
+
+=item B<-v>
+
+Prints the I<xsubpp> version number to standard output, then exits.
+
+=item B<-prototypes>
+
+By default I<xsubpp> will not automatically generate prototype code for
+all xsubs. This flag will enable prototypes.
+
+=item B<-noversioncheck>
+
+Disables the run time test that determines if the object file (derived
+from the C<.xs> file) and the C<.pm> files have the same version
+number.
+
+=item B<-nolinenumbers>
+
+Prevents the inclusion of `#line' directives in the output.
+
+=item B<-nooptimize>
+
+Disables certain optimizations. The only optimization that is currently
+affected is the use of I<target>s by the output C code (see L<perlguts>).
+This may significantly slow down the generated code, but this is the way
+B<xsubpp> of 5.005 and earlier operated.
+
+=item B<-noinout>
+
+Disable recognition of C<IN>, C<OUT_LIST> and C<INOUT_LIST> declarations.
+
+=item B<-noargtypes>
+
+Disable recognition of ANSI-like descriptions of function signature.
+
+=item B<-C++>
+
+Currently doesn't do anything at all. This flag has been a no-op for
+many versions of perl, at least as far back as perl5.003_07. It's
+allowed here for backwards compatibility.
+
+=back
+
+=head1 ENVIRONMENT
+
+No environment variables are used.
+
+=head1 AUTHOR
+
+Originally by Larry Wall. Turned into the C<ExtUtils::ParseXS> module
+by Ken Williams.
+
+=head1 MODIFICATION HISTORY
+
+See the file F<Changes>.
+
+=head1 SEE ALSO
+
+perl(1), perlxs(1), perlxstut(1), ExtUtils::ParseXS
+
+=cut
+