diff options
Diffstat (limited to 'contrib/perl5/lib/ExtUtils')
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Command.pm | 211 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Embed.pm | 502 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Install.pm | 374 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Installed.pm | 272 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Liblist.pm | 750 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/MM_OS2.pm | 85 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/MM_Unix.pm | 3539 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/MM_VMS.pm | 2391 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/MM_Win32.pm | 823 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/MakeMaker.pm | 1933 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Manifest.pm | 408 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Mkbootstrap.pm | 103 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Mksymlists.pm | 276 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/Packlist.pm | 288 | ||||
-rwxr-xr-x | contrib/perl5/lib/ExtUtils/inst | 139 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/testlib.pm | 26 | ||||
-rw-r--r-- | contrib/perl5/lib/ExtUtils/typemap | 289 | ||||
-rwxr-xr-x | contrib/perl5/lib/ExtUtils/xsubpp | 1512 |
18 files changed, 13921 insertions, 0 deletions
diff --git a/contrib/perl5/lib/ExtUtils/Command.pm b/contrib/perl5/lib/ExtUtils/Command.pm new file mode 100644 index 0000000..2f5f1e1 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Command.pm @@ -0,0 +1,211 @@ +package ExtUtils::Command; +use strict; +# use AutoLoader; +use Carp; +use File::Copy; +use File::Compare; +use File::Basename; +use File::Path qw(rmtree); +require Exporter; +use vars qw(@ISA @EXPORT $VERSION); +@ISA = qw(Exporter); +@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f); +$VERSION = '1.01'; + +=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 file... + perl -MExtUtils::Command -e rm_rf directories... + perl -MExtUtils::Command -e mkpath directories... + perl -MExtUtils::Command -e eqtime source destination + perl -MExtUtils::Command -e chmod mode files... + perl -MExtUtils::Command -e test_f file + +=head1 DESCRIPTION + +The module is used in Win32 port to replace common UNIX commands. +Most commands are wrapers on generic modules File::Path and File::Basename. + +=over 4 + +=cut + +sub expand_wildcards +{ + @ARGV = map(/[\*\?]/ ? glob($_) : $_,@ARGV); +} + +=item cat + +Concatenates all files mentioned on command line to STDOUT. + +=cut + +sub cat () +{ + expand_wildcards(); + print while (<>); +} + +=item eqtime src dst + +Sets modified time of dst to that of src + +=cut + +sub eqtime +{ + my ($src,$dst) = @ARGV; + open(F,">$dst"); + close(F); + utime((stat($src))[8,9],$dst); +} + +=item rm_f files.... + +Removes directories - recursively (even if readonly) + +=cut + +sub rm_rf +{ + rmtree([grep -e $_,expand_wildcards()],0,0); +} + +=item rm_f files.... + +Removes files (even if readonly) + +=cut + +sub rm_f +{ + foreach (expand_wildcards()) + { + next unless -f $_; + next if unlink($_); + chmod(0777,$_); + next if unlink($_); + carp "Cannot delete $_:$!"; + } +} + +=item touch files ... + +Makes files exist, with current timestamp + +=cut + +sub touch +{ + expand_wildcards(); + my $t = time; + while (@ARGV) + { + my $file = shift(@ARGV); + open(FILE,">>$file") || die "Cannot write $file:$!"; + close(FILE); + utime($t,$t,$file); + } +} + +=item mv source... destination + +Moves source to destination. +Multiple sources are allowed if destination is an existing directory. + +=cut + +sub mv +{ + my $dst = pop(@ARGV); + expand_wildcards(); + croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); + while (@ARGV) + { + my $src = shift(@ARGV); + move($src,$dst); + } +} + +=item cp source... destination + +Copies source to destination. +Multiple sources are allowed if destination is an existing directory. + +=cut + +sub cp +{ + my $dst = pop(@ARGV); + expand_wildcards(); + croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); + while (@ARGV) + { + my $src = shift(@ARGV); + copy($src,$dst); + } +} + +=item chmod mode files... + +Sets UNIX like permissions 'mode' on all the files. + +=cut + +sub chmod +{ + my $mode = shift(@ARGV); + chmod($mode,expand_wildcards()) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!"; +} + +=item mkpath directory... + +Creates directory, including any parent directories. + +=cut + +sub mkpath +{ + File::Path::mkpath([expand_wildcards()],1,0777); +} + +=item test_f file + +Tests if a file exists + +=cut + +sub test_f +{ + exit !-f shift(@ARGV); +} + + +1; +__END__ + +=back + +=head1 BUGS + +Should probably be Auto/Self loaded. + +=head1 SEE ALSO + +ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32 + +=head1 AUTHOR + +Nick Ing-Simmons <F<nick@ni-s.u-net.com>>. + +=cut + diff --git a/contrib/perl5/lib/ExtUtils/Embed.pm b/contrib/perl5/lib/ExtUtils/Embed.pm new file mode 100644 index 0000000..e41ca40 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Embed.pm @@ -0,0 +1,502 @@ +# $Id: Embed.pm,v 1.2501 $ +require 5.002; + +package ExtUtils::Embed; +require Exporter; +require FileHandle; +use Config; +use Getopt::Std; + +#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; + +$VERSION = sprintf("%d.%02d", q$Revision: 1.2505 $ =~ /(\d+)\.(\d+)/); + +@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 is_perl_object { + $Config{ccflags} =~ /-DPERL_OBJECT/; +} + +sub xsinit { + my($file, $std, $mods) = @_; + my($fh,@mods,%seen); + $file ||= "perlxsi.c"; + my $xsinit_proto = is_perl_object() ? "CPERLarg" : "void"; + + 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; +#if defined(__cplusplus) && !defined(PERL_OBJECT) +#define is_cplusplus +#endif + +#ifdef is_cplusplus +extern "C" { +#endif + +#include <EXTERN.h> +#include <perl.h> +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#include <XSUB.h> +#include "win32iop.h" +#include <fcntl.h> +#include <perlhost.h> +#endif +#ifdef is_cplusplus +} +# ifndef EXTERN_C +# define EXTERN_C extern "C" +# endif +#else +# ifndef EXTERN_C +# define EXTERN_C extern +# endif +#endif + +EOF +} + +sub xsi_protos { + my(@exts) = @_; + my(@retval,%seen); + my $boot_proto = is_perl_object() ? + "CV* cv _CPERLarg" : "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) { + @Extensions = sort split /\s+/, $Config{static_ext}; + unshift @Extensions, qw(DynaLoader); + } + @Extensions; +} + +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 ' '; + my $MM = bless {} => 'MY'; + 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; + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; + push(@potential_libs, $Config{libs}) if defined $std; + + 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 = $MM->catdir(@ns); + + print STDERR "searching for '$sub${lib_ext}'\n" if $Verbose; + foreach (@path) { + next unless -e ($archive = $MM->catdir($_,"auto",$root,"$sub$lib_ext")); + push @archives, $archive; + if(-e ($extra = $MM->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 = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl"; + + my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) = + $MM->ext(join ' ', + $MM->catdir("-L$Config{archlibexp}", "CORE"), " $libperl", + @potential_libs); + + my $ld_or_bs = $bsloadlibs || $ldloadlibs; + print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose; + my $linkage = "$Config{ccdlflags} $Config{ldflags} @archives $ld_or_bs"; + print STDERR "ldopts: '$linkage'\n" if $Verbose; + + return $linkage if scalar @_; + my_return("$linkage\n"); +} + +sub ccflags { + my_return(" $Config{ccflags} "); +} + +sub ccdlflags { + my_return(" $Config{ccdlflags} "); +} + +sub perl_inc { + my_return(" -I$Config{archlibexp}/CORE "); +} + +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+$::; + } + grep(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 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 + +=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 "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, 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.a>, B<DynaLoader> 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 +specifed 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 -- DynaLoader + + +This will print arguments for linking with just the B<DynaLoader> extension +and B<libperl.a>. + + + 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 it's code. + +=back + +=head1 EXAMPLES + +For examples on how to use B<ExtUtils::Embed> for building C/C++ applications +with embedded perl, see the eg/ directory and 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/contrib/perl5/lib/ExtUtils/Install.pm b/contrib/perl5/lib/ExtUtils/Install.pm new file mode 100644 index 0000000..6a5c184 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Install.pm @@ -0,0 +1,374 @@ +package ExtUtils::Install; + +$VERSION = substr q$Revision: 1.28 $, 10; +# $Date: 1998/01/25 07:08:24 $ + +use Exporter; +use Carp (); +use Config qw(%Config); +use vars qw(@ISA @EXPORT $VERSION); +@ISA = ('Exporter'); +@EXPORT = ('install','uninstall','pm_to_blib', 'install_default'); +$Is_VMS = $^O eq 'VMS'; + +my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':'; +my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || ''; +my $Inc_uninstall_warn_handler; + +#use vars qw( @EXPORT @ISA $Is_VMS ); +#use strict; + +sub forceunlink { + chmod 0666, $_[0]; + unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!") +} + +sub install { + my($hash,$verbose,$nonono,$inc_uninstall) = @_; + $verbose ||= 0; + $nonono ||= 0; + + use Cwd qw(cwd); + use ExtUtils::MakeMaker; # to implement a MY class + use ExtUtils::Packlist; + use File::Basename qw(dirname); + use File::Copy qw(copy); + use File::Find qw(find); + use File::Path qw(mkpath); + use File::Compare qw(compare); + + my(%hash) = %$hash; + my(%pack, $dir, $warn_permissions); + my($packlist) = ExtUtils::Packlist->new(); + # -w doesn't work reliably on FAT dirs + $warn_permissions++ if $^O eq 'MSWin32'; + local(*DIR); + for (qw/read write/) { + $pack{$_}=$hash{$_}; + delete $hash{$_}; + } + my($source_dir_or_file); + foreach $source_dir_or_file (sort keys %hash) { + #Check if there are files, and if yes, look if the corresponding + #target directory is writable for us + opendir DIR, $source_dir_or_file or next; + for (readdir DIR) { + next if $_ eq "." || $_ eq ".." || $_ eq ".exists"; + if (-w $hash{$source_dir_or_file} || + mkpath($hash{$source_dir_or_file})) { + last; + } else { + warn "Warning: You do not have permissions to " . + "install into $hash{$source_dir_or_file}" + unless $warn_permissions++; + } + } + closedir DIR; + } + $packlist->read($pack{"read"}) if (-f $pack{"read"}); + my $cwd = cwd(); + my $umask = umask 0 unless $Is_VMS; + + my($source); + MOD_INSTALL: foreach $source (sort keys %hash) { + #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 = $hash{$source}; + if ($source eq "blib/lib" and + exists $hash{"blib/arch"} and + directory_not_empty("blib/arch")) { + $targetroot = $hash{"blib/arch"}; + print "Files found in blib/arch --> Installing files in " + . "blib/lib into architecture dependend library tree!\n" + ; #if $verbose>1; + } + chdir($source) or next; + find(sub { + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) = stat; + return unless -f _; + return if $_ eq ".exists"; + my $targetdir = MY->catdir($targetroot,$File::Find::dir); + my $targetfile = MY->catfile($targetdir,$_); + + my $diff = 0; + if ( -f $targetfile && -s _ == $size) { + # We have a good chance, we can skip this one + $diff = compare($_,$targetfile); + } else { + print "$_ differs\n" if $verbose>1; + $diff++; + } + + if ($diff){ + if (-f $targetfile){ + forceunlink($targetfile) unless $nonono; + } else { + mkpath($targetdir,0,0755) unless $nonono; + print "mkpath($targetdir,0,0755)\n" if $verbose>1; + } + copy($_,$targetfile) unless $nonono; + print "Installing $targetfile\n"; + utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1; + print "utime($atime,$mtime,$targetfile)\n" if $verbose>1; + $mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); + chmod $mode, $targetfile; + print "chmod($mode, $targetfile)\n" if $verbose>1; + } else { + print "Skipping $targetfile (unchanged)\n" if $verbose; + } + + if (! defined $inc_uninstall) { # it's called + } elsif ($inc_uninstall == 0){ + inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1 + } else { + inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0 + } + $packlist->{$targetfile}++; + + }, "."); + chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!"); + } + umask $umask unless $Is_VMS; + if ($pack{'write'}) { + $dir = dirname($pack{'write'}); + mkpath($dir,0,0755); + print "Writing $pack{'write'}\n"; + $packlist->write($pack{'write'}); + } +} + +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; +} + +sub install_default { + @_ < 2 or die "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 = MM->catdir(MM->curdir,"blib","lib"); + my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch"); + my $INST_BIN = MM->catdir(MM->curdir,'blib','bin'); + my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script'); + my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1'); + my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3'); + 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}, + },1,0,0); +} + +sub uninstall { + use ExtUtils::Packlist; + my($fil,$verbose,$nonono) = @_; + die "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($_) unless $nonono; + } + print "unlink $fil\n" if $verbose; + close P; + forceunlink($fil) unless $nonono; +} + +sub inc_uninstall { + my($file,$libdir,$verbose,$nonono) = @_; + my($dir); + my %seen_dir = (); + foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp + privlibexp + sitearchexp + sitelibexp)}) { + next if $dir eq "."; + next if $seen_dir{$dir}++; + my($targetfile) = MY->catfile($dir,$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 $file) { + # We have a good chance, we can skip this one + $diff = compare($file,$targetfile); + } else { + print "#$file and $targetfile differ\n" if $verbose>1; + $diff++; + } + + next unless $diff; + if ($nonono) { + if ($verbose) { + $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn; + $libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier. + $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile); + } + # if not verbose, we just say nothing + } else { + print "Unlinking $targetfile (shadowing?)\n"; + forceunlink($targetfile); + } + } +} + +sub pm_to_blib { + my($fromto,$autodir) = @_; + + use File::Basename qw(dirname); + use File::Copy qw(copy); + use File::Path qw(mkpath); + use File::Compare qw(compare); + use AutoSplit; + # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al)); + # require $my_req; # Hairy, but for the first + + if (!ref($fromto) && -r $fromto) + { + # Win32 has severe command line length limitations, but + # can generate temporary files on-the-fly + # so we pass name of file here - eval it to get hash + open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!"; + my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}'; + eval $str; + close(FROMTO); + } + + my $umask = umask 0022 unless $Is_VMS; + mkpath($autodir,0,0755); + foreach (keys %$fromto) { + next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_; + unless (compare($_,$fromto->{$_})){ + print "Skip $fromto->{$_} (unchanged)\n"; + next; + } + if (-f $fromto->{$_}){ + forceunlink($fromto->{$_}); + } else { + mkpath(dirname($fromto->{$_}),0,0755); + } + copy($_,$fromto->{$_}); + my($mode,$atime,$mtime) = (stat)[2,8,9]; + utime($atime,$mtime+$Is_VMS,$fromto->{$_}); + chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_}); + print "cp $_ $fromto->{$_}\n"; + next unless /\.pm$/; + autosplit($fromto->{$_},$autodir); + } + umask $umask unless $Is_VMS; +} + +package ExtUtils::Install::Warn; + +sub new { bless {}, shift } + +sub add { + my($self,$file,$targetfile) = @_; + push @{$self->{$file}}, $targetfile; +} + +sub DESTROY { + 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"; + print "## Running 'make install UNINST=1' will unlink $plural for you.\n"; +} + +1; + +__END__ + +=head1 NAME + +ExtUtils::Install - install files from here to there + +=head1 SYNOPSIS + +B<use ExtUtils::Install;> + +B<install($hashref,$verbose,$nonono);> + +B<uninstall($packlistfile,$verbose,$nonono);> + +B<pm_to_blib($hashref);> + +=head1 DESCRIPTION + +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. + +install() takes three arguments. A reference to a hash, a verbose +switch and a don't-really-do-it switch. The hash ref contains a +mapping of directories: each key/value pair is a combination of +directories to be copied. Key is a directory to copy from, value is a +directory to copy to. The whole tree below the "from" directory will +be copied preserving timestamps and permissions. + +There are two keys with a special meaning in the hash: "read" and +"write". After the copying is done, install will write the list of +target files to the file named by C<$hashref-E<gt>{write}>. If there is +another file named by C<$hashref-E<gt>{read}>, 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, people are installing to a +different directory than the one where the files later appear. + +install_default() takes one or less arguments. If no arguments are +specified, it takes $ARGV[0] as if it was specified as an argument. +The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>. +This function calls install() with the same arguments as the defaults +the MakeMaker would use. + +The argumement-less form is convenient for install scripts like + + perl -MExtUtils::Install -e install_default Tk/Canvas + +Assuming this command is executed in a directory with populated F<blib> +directory, it will proceed as if the F<blib> was build by MakeMaker on +this machine. This is useful for binary distributions. + +uninstall() takes as first argument a file containing filenames to be +unlinked. The second argument is a verbose switch, the third is a +no-don't-really-do-it-now switch. + +pm_to_blib() takes a hashref as the first argument and copies all keys +of the hash to the corresponding values efficiently. Filenames with +the extension pm are autosplit. Second argument is the autosplit +directory. + +=cut diff --git a/contrib/perl5/lib/ExtUtils/Installed.pm b/contrib/perl5/lib/ExtUtils/Installed.pm new file mode 100644 index 0000000..dda594e --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Installed.pm @@ -0,0 +1,272 @@ +package ExtUtils::Installed; +use strict; +use Carp qw(); +use ExtUtils::Packlist; +use ExtUtils::MakeMaker; +use Config; +use File::Find; +use File::Basename; +use vars qw($VERSION); +$VERSION = '0.02'; + +sub _is_type($$$) +{ +my ($self, $path, $type) = @_; +return(1) if ($type eq "all"); +if ($type eq "doc") + { + return(substr($path, 0, length($Config{installman1dir})) + eq $Config{installman1dir} + || + substr($path, 0, length($Config{installman3dir})) + eq $Config{installman3dir} + ? 1 : 0) + } +if ($type eq "prog") + { + return(substr($path, 0, length($Config{prefix})) eq $Config{prefix} + && + substr($path, 0, length($Config{installman1dir})) + ne $Config{installman1dir} + && + substr($path, 0, length($Config{installman3dir})) + ne $Config{installman3dir} + ? 1 : 0); + } +return(0); +} + +sub _is_under($$;) +{ +my ($self, $path, @under) = @_; +$under[0] = "" if (! @under); +foreach my $dir (@under) + { + return(1) if (substr($path, 0, length($dir)) eq $dir); + } +return(0); +} + +sub new($) +{ +my ($class) = @_; +$class = ref($class) || $class; +my $self = {}; + +# Read the core packlist +$self->{Perl}{packlist} = + ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); +$self->{Perl}{version} = $]; + +# Read the module packlists +my $sub = sub + { + # Only process module .packlists + return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib}; + + # Hack of the leading bits of the paths & convert to a module name + my $module = $File::Find::name; + $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!; + $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!; + my $modfile = "$module.pm"; + $module =~ s!/!::!g; + + # Find the top-level module file in @INC + $self->{$module}{version} = ''; + foreach my $dir (@INC) + { + my $p = MM->catfile($dir, $modfile); + if (-f $p) + { + $self->{$module}{version} = MM->parse_version($p); + last; + } + } + + # Read the .packlist + $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name); + }; +find($sub, $Config{archlib}, $Config{sitearch}); + +return(bless($self, $class)); +} + +sub modules($) +{ +my ($self) = @_; +return(sort(keys(%$self))); +} + +sub files($$;$) +{ +my ($self, $module, $type, @under) = @_; + +# 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) = @_; +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) = @_; +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) = @_; +Carp::croak("$module is not installed") if (! exists($self->{$module})); +return($self->{$module}{packlist}->validate($remove)); +} + +sub packlist($$) +{ +my ($self, $module) = @_; +Carp::croak("$module is not installed") if (! exists($self->{$module})); +return($self->{$module}{packlist}); +} + +sub version($$) +{ +my ($self, $module) = @_; +Carp::croak("$module is not installed") if (! exists($self->{$module})); +return($self->{$module}{version}); +} + +sub DESTROY +{ +} + +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. + +=head1 FUNCTIONS + +=over + +=item new() + +This takes no parameters, and searches for all the installed .packlists on the +system. The packlists are read using the ExtUtils::packlist module. + +=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", "man" 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", "man" 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 directory(), 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/contrib/perl5/lib/ExtUtils/Liblist.pm b/contrib/perl5/lib/ExtUtils/Liblist.pm new file mode 100644 index 0000000..b072c12 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Liblist.pm @@ -0,0 +1,750 @@ +package ExtUtils::Liblist; +use vars qw($VERSION); +# Broken out of MakeMaker from version 4.11 + +$VERSION = substr q$Revision: 1.25 $, 10; + +use Config; +use Cwd 'cwd'; +use File::Basename; + +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) = @_; + if ($^O =~ 'os2' and $Config{libs}) { + # 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{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; + my($libs) = $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($fullname, $thislib, $thispth, @fullname); + my($pwd) = cwd(); # from Cwd.pm + my($found) = 0; + + foreach $thislib (split ' ', $potential_libs){ + + # Handle possible linker path arguments. + if ($thislib =~ s/^(-[LR])//){ # save path flag type + my($ptype) = $1; + unless (-d $thislib){ + warn "$ptype$thislib ignored, directory does not exist\n" + if $verbose; + next; + } + unless ($self->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, "$ptype$thislib"); + next; + } + + # Handle possible library arguments. + unless ($thislib =~ s/^-l//){ + warn "Unrecognized argument in LIBS ignored: '$thislib'\n"; + next; + } + + my($found_lib)=0; + foreach $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") + && ($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/Slib$thislib$Config_libext")){ + } elsif ($^O eq 'dgux' + && -l ($fullname="$thispth/lib$thislib$Config_libext") + && readlink($fullname) =~ /^elink:/) { + # 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; + my($fullnamedir) = dirname($fullname); + push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++; + $found++; + $found_lib++; + + # Now update library lists + + # what do we know about this library... + my $is_dyna = ($fullname !~ /\Q$Config_libext\E$/); + my $in_perl = ($libs =~ /\B-l\Q$ {thislib}\E\b/s); + + # 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; + } + return ('','','','') unless $found; + ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path)); +} + +sub _win32_ext { + + require Text::ParseWords; + + my($self, $potential_libs, $verbose) = @_; + + # If user did not supply a list, we punt. + # (caller should probably use the list in $Config{libs}) + return ("", "", "", "") unless $potential_libs; + + my $cc = $Config{cc}; + my $VC = 1 if $cc =~ /^cl/i; + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; + my $libs = $Config{'libs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + + 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, $thislib, $thispth); + + foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){ + + $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/-libpath:/ if $VC; + s/^-l(.+)$/$1.lib/ unless $GC; + 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 ($self->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 $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); + 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 ('','','','') unless $found; + + # make sure paths with spaces are properly quoted + @extralibs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @extralibs; + $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, '') : $lib; +} + + +sub _vms_ext { + my($self, $potential_libs,$verbose) = @_; + my(@crtls,$crtlstr); + my($dbgqual) = $self->{OPTIMIZE} || $Config{'optimize'} || + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + 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($lib,$locspec,$type); + foreach $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, ''); + } + + my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj,$ldlib); + my $cwd = cwd(); + my($so,$lib_ext,$obj_ext) = @Config{'so','lib_ext','obj_ext'}; + # List of common Unix library names and there VMS equivalents + # (VMS equivalent of '' indicates that the library is automatially + # searched by the linker, and should be skipped here.) + 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 + 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(' ',$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 ($self->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 $lib (@libs) { + if (exists $libmap{$lib}) { + next unless length $libmap{$lib}; + $lib = $libmap{$lib}; + } + + my(@variants,$variant,$name,$test,$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) { + foreach $dir (@dirs) { + my($type); + + $name = "$dir$variant"; + warn "\tChecking $name\n" if $verbose > 2; + if (-f ($test = VMS::Filespec::rmsexpand($name))) { + # It's got its own suffix, so we'll have to figure out the type + if ($test =~ /(?:$so|exe)$/i) { $type = 'sh'; } + elsif ($test =~ /(?:$lib_ext|olb)$/i) { $type = 'olb'; } + elsif ($test =~ /(?:$obj_ext|obj)$/i) { + warn "Note (probably harmless): " + ."Plain object file $test found in library list\n"; + $type = 'obj'; + } + else { + warn "Note (probably harmless): " + ."Unknown library type for $test; assuming shared\n"; + $type = 'sh'; + } + } + elsif (-f ($test = VMS::Filespec::rmsexpand($name,$so)) or + -f ($test = VMS::Filespec::rmsexpand($name,'.exe'))) { + $type = 'sh'; + $name = $test unless $test =~ /exe;?\d*$/i; + } + elsif (not length($ctype) and # If we've got a lib already, don't bother + ( -f ($test = VMS::Filespec::rmsexpand($name,$lib_ext)) or + -f ($test = VMS::Filespec::rmsexpand($name,'.olb')))) { + $type = 'olb'; + $name = $test unless $test =~ /olb;?\d*$/i; + } + elsif (not length($ctype) and # If we've got a lib already, don't bother + ( -f ($test = VMS::Filespec::rmsexpand($name,$obj_ext)) or + -f ($test = VMS::Filespec::rmsexpand($name,'.obj')))) { + warn "Note (probably harmless): " + ."Plain object file $test found in library list\n"; + $type = 'obj'; + $name = $test unless $test =~ /obj;?\d*$/i; + } + if (defined $type) { + $ctype = $type; $cand = $name; + last if $ctype eq 'sh'; + } + } + if ($ctype) { + eval '$' . $ctype . "{'$cand'}++"; + die "Error recording library: $@" if $@; + warn "\tFound as $cand (really $test), type $ctype\n" if $verbose > 1; + next LIB; + } + } + warn "Note (probably harmless): " + ."No library found for $lib\n"; + } + + @libs = sort keys %obj; + # This has to precede any other CRTLs, so just make it first + if ($olb{VAXCCURSE}) { + push(@libs,"$olb{VAXCCURSE}/Library"); + delete $olb{VAXCCURSE}; + } + push(@libs, map { "$_/Library" } sort keys %olb); + push(@libs, map { "$_/Share" } sort keys %sh); + $lib = join(' ',@libs); + + $ldlib = $crtlstr ? "$lib $crtlstr" : $lib; + warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose; + wantarray ? ($lib, '', $ldlib, '') : $lib; +} + +1; + +__END__ + +=head1 NAME + +ExtUtils::Liblist - determine libraries to use and how to use them + +=head1 SYNOPSIS + +C<require ExtUtils::Liblist;> + +C<ExtUtils::Liblist::ext($self, $potential_libs, $verbose);> + +=head1 DESCRIPTION + +This utility takes a list of libraries in the form C<-llib1 -llib2 +-llib3> and prints out 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 scalar values: EXTRALIBS, BSLOADLIBS, +LDLOADLIBS, and LD_RUN_PATH. Some of these don't mean anything +on VMS and Win32. See the details about those platform specifics +below. + +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 + +by the ld command when the shared object is built/linked. See +LDLOADLIBS below. + +=item * For dynamic extensions + +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 B<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> prefices 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 accomodate 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{libs}> (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> +as well as in C<$Config{libpth}>. 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> prefices 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 <-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{libs}> (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{libs}>. + +=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/contrib/perl5/lib/ExtUtils/MM_OS2.pm b/contrib/perl5/lib/ExtUtils/MM_OS2.pm new file mode 100644 index 0000000..8bddb42 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/MM_OS2.pm @@ -0,0 +1,85 @@ +package ExtUtils::MM_OS2; + +#use Config; +#use Cwd; +#use File::Basename; +require Exporter; + +Exporter::import('ExtUtils::MakeMaker', + qw( $Verbose &neatvalue)); + +unshift @MM::ISA, 'ExtUtils::MM_OS2'; + +sub dlsyms { + my($self,%attribs) = @_; + + my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; + my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + 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" => "', $self->{NAME}, + '", "DLBASE" => "',$self->{DLBASE}, + '", "DL_FUNCS" => ',neatvalue($funcs), + ', "IMPORTS" => ',neatvalue($imports), + ', "VERSION" => "',$self->{VERSION}, + '", "DL_VARS" => ', neatvalue($vars), ');\' +'); + } + join('',@m); +} + +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; +} + +sub file_name_is_absolute { + my($self,$file) = @_; + $file =~ m{^([a-z]:)?[\\/]}i ; +} + +sub perl_archive +{ + return "\$(PERL_INC)/libperl\$(LIB_EXT)"; +} + +sub export_list +{ + my ($self) = @_; + return "$self->{BASEEXT}.def"; +} + +1; +__END__ + +=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. + diff --git a/contrib/perl5/lib/ExtUtils/MM_Unix.pm b/contrib/perl5/lib/ExtUtils/MM_Unix.pm new file mode 100644 index 0000000..9a96504 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/MM_Unix.pm @@ -0,0 +1,3539 @@ +package ExtUtils::MM_Unix; + +use Exporter (); +use Config; +use File::Basename qw(basename dirname fileparse); +use DirHandle; +use strict; +use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT + $Verbose %pm %static $Xsubpp_Version); + +$VERSION = substr q$Revision: 1.12601 $, 10; +# $Id: MM_Unix.pm,v 1.126 1998/06/28 21:32:49 k Exp k $ + +Exporter::import('ExtUtils::MakeMaker', + qw( $Verbose &neatvalue)); + +$Is_OS2 = $^O eq 'os2'; +$Is_Mac = $^O eq 'MacOS'; +$Is_Win32 = $^O eq 'MSWin32'; +$Is_Dos = $^O eq 'dos'; + +$Is_PERL_OBJECT = 1 if $Config{'ccflags'} =~ /-DPERL_OBJECT/; + +if ($Is_VMS = $^O eq 'VMS') { + require VMS::Filespec; + import VMS::Filespec qw( &vmsify ); +} + +=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 mailing list. + +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 (See +L<ExtUtils::MM_VMS>) and L<ExtUtils::MM_OS2>). + +=head2 Preloaded methods + +=over 2 + +=item canonpath + +No physical check on the filesystem, but a logical cleanup of a +path. On UNIX eliminated successive slashes and successive "/.". + +=cut + +sub canonpath { + my($self,$path) = @_; + my $node = ''; + if ( $^O eq 'qnx' && $path =~ s|^(//\d+)/|/| ) { + $node = $1; + } + $path =~ s|/+|/|g ; # xx////xx -> xx/xx + $path =~ s|(/\.)+/|/|g ; # xx/././xx -> xx/xx + $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx + $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx + "$node$path"; +} + +=item catdir + +Concatenate two or more directory names to form a complete path ending +with a directory. But remove the trailing slash from the resulting +string, because it doesn't look good, isn't necessary and confuses +OS2. Of course, if this is the root directory, don't cut off the +trailing slash :-) + +=cut + +# '; + +sub catdir { + my $self = shift @_; + my @args = @_; + for (@args) { + # append a slash to each argument unless it has one there + $_ .= "/" if $_ eq '' or substr($_,-1) ne "/"; + } + $self->canonpath(join('', @args)); +} + +=item catfile + +Concatenate one or more directory names and a filename to form a +complete path ending with a filename + +=cut + +sub catfile { + my $self = shift @_; + my $file = pop @_; + return $self->canonpath($file) unless @_; + my $dir = $self->catdir(@_); + for ($dir) { + $_ .= "/" unless substr($_,length($_)-1,1) eq "/"; + } + return $self->canonpath($dir.$file); +} + +=item curdir + +Returns a string representing of the current directory. "." on UNIX. + +=cut + +sub curdir { + return "." ; +} + +=item rootdir + +Returns a string representing of the root directory. "/" on UNIX. + +=cut + +sub rootdir { + return "/"; +} + +=item updir + +Returns a string representing of the parent directory. ".." on UNIX. + +=cut + +sub updir { + return ".."; +} + +sub ExtUtils::MM_Unix::c_o ; +sub ExtUtils::MM_Unix::clean ; +sub ExtUtils::MM_Unix::const_cccmd ; +sub ExtUtils::MM_Unix::const_config ; +sub ExtUtils::MM_Unix::const_loadlibs ; +sub ExtUtils::MM_Unix::constants ; +sub ExtUtils::MM_Unix::depend ; +sub ExtUtils::MM_Unix::dir_target ; +sub ExtUtils::MM_Unix::dist ; +sub ExtUtils::MM_Unix::dist_basics ; +sub ExtUtils::MM_Unix::dist_ci ; +sub ExtUtils::MM_Unix::dist_core ; +sub ExtUtils::MM_Unix::dist_dir ; +sub ExtUtils::MM_Unix::dist_test ; +sub ExtUtils::MM_Unix::dlsyms ; +sub ExtUtils::MM_Unix::dynamic ; +sub ExtUtils::MM_Unix::dynamic_bs ; +sub ExtUtils::MM_Unix::dynamic_lib ; +sub ExtUtils::MM_Unix::exescan ; +sub ExtUtils::MM_Unix::export_list ; +sub ExtUtils::MM_Unix::extliblist ; +sub ExtUtils::MM_Unix::file_name_is_absolute ; +sub ExtUtils::MM_Unix::find_perl ; +sub ExtUtils::MM_Unix::fixin ; +sub ExtUtils::MM_Unix::force ; +sub ExtUtils::MM_Unix::guess_name ; +sub ExtUtils::MM_Unix::has_link_code ; +sub ExtUtils::MM_Unix::init_dirscan ; +sub ExtUtils::MM_Unix::init_main ; +sub ExtUtils::MM_Unix::init_others ; +sub ExtUtils::MM_Unix::install ; +sub ExtUtils::MM_Unix::installbin ; +sub ExtUtils::MM_Unix::libscan ; +sub ExtUtils::MM_Unix::linkext ; +sub ExtUtils::MM_Unix::lsdir ; +sub ExtUtils::MM_Unix::macro ; +sub ExtUtils::MM_Unix::makeaperl ; +sub ExtUtils::MM_Unix::makefile ; +sub ExtUtils::MM_Unix::manifypods ; +sub ExtUtils::MM_Unix::maybe_command ; +sub ExtUtils::MM_Unix::maybe_command_in_dirs ; +sub ExtUtils::MM_Unix::needs_linking ; +sub ExtUtils::MM_Unix::nicetext ; +sub ExtUtils::MM_Unix::parse_version ; +sub ExtUtils::MM_Unix::pasthru ; +sub ExtUtils::MM_Unix::path ; +sub ExtUtils::MM_Unix::perl_archive; +sub ExtUtils::MM_Unix::perl_script ; +sub ExtUtils::MM_Unix::perldepend ; +sub ExtUtils::MM_Unix::pm_to_blib ; +sub ExtUtils::MM_Unix::post_constants ; +sub ExtUtils::MM_Unix::post_initialize ; +sub ExtUtils::MM_Unix::postamble ; +sub ExtUtils::MM_Unix::ppd ; +sub ExtUtils::MM_Unix::prefixify ; +sub ExtUtils::MM_Unix::processPL ; +sub ExtUtils::MM_Unix::realclean ; +sub ExtUtils::MM_Unix::replace_manpage_separator ; +sub ExtUtils::MM_Unix::static ; +sub ExtUtils::MM_Unix::static_lib ; +sub ExtUtils::MM_Unix::staticmake ; +sub ExtUtils::MM_Unix::subdir_x ; +sub ExtUtils::MM_Unix::subdirs ; +sub ExtUtils::MM_Unix::test ; +sub ExtUtils::MM_Unix::test_via_harness ; +sub ExtUtils::MM_Unix::test_via_script ; +sub ExtUtils::MM_Unix::tool_autosplit ; +sub ExtUtils::MM_Unix::tool_xsubpp ; +sub ExtUtils::MM_Unix::tools_other ; +sub ExtUtils::MM_Unix::top_targets ; +sub ExtUtils::MM_Unix::writedoc ; +sub ExtUtils::MM_Unix::xs_c ; +sub ExtUtils::MM_Unix::xs_o ; +sub ExtUtils::MM_Unix::xsubpp_version ; + +package ExtUtils::MM_Unix; + +use SelfLoader; + +1; + +__DATA__ + +=back + +=head2 SelfLoaded methods + +=over 2 + +=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); + push @m, ' +.c$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c +'; + push @m, ' +.C$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C +' if $^O ne 'os2' and $^O ne 'MSWin32' and $^O ne 'dos'; #Case-specific + push @m, ' +.cpp$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp + +.cxx$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cxx + +.cc$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cc +'; + 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 large split shellflags)} + = @Config{qw(cc ccflags optimize large split 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::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}\" + large=\"$cflags{large}\" + split=\"$cflags{'split'}\" + eval '$prog' + echo cc=\$cc + echo ccflags=\$ccflags + echo optimize=\$optimize + echo perltype=\$perltype + echo optdebug=\$optdebug + echo large=\$large + echo split=\$split + `; + my($line); + foreach $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 large split)) { + $cflags{$_} =~ s/^\s+//; + $cflags{$_} =~ s/\s+/ /g; + $cflags{$_} =~ s/\s+$//; + $self->{uc $_} ||= $cflags{$_} + } + + if ($self->{CAPI} && $Is_PERL_OBJECT == 1) { + $self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//; + $self->{CCFLAGS} .= '-DPERL_CAPI'; + if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) { + # Turn off C++ mode of the MSC compiler + $self->{CCFLAGS} =~ s/-TP(\s|$)//; + $self->{OPTIMIZE} =~ s/-TP(\s|$)//; + } + } + return $self->{CFLAGS} = qq{ +CCFLAGS = $self->{CCFLAGS} +OPTIMIZE = $self->{OPTIMIZE} +PERLTYPE = $self->{PERLTYPE} +LARGE = $self->{LARGE} +SPLIT = $self->{SPLIT} +}; + +} + +=item clean (o) + +Defines the clean target. + +=cut + +sub clean { +# --- Cleanup and Distribution Sections --- + + my($self, %attribs) = @_; + my(@m,$dir); + 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 subdirectories first + for $dir (@{$self->{DIR}}) { + push @m, "\t-cd $dir && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) clean\n"; + } + + my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files + push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; + push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all + perlmain.c mon.out core so_locations pm_to_blib + *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe + $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def + $(BASEEXT).exp + ]); + push @m, "\t-$self->{RM_RF} @otherfiles\n"; + # See realclean and ext/utils/make_ext for usage of Makefile.old + push(@m, + "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old \$(DEV_NULL)\n"); + push(@m, + "\t$attribs{POSTOP}\n") if $attribs{POSTOP}; + join("", @m); +} + +=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 $(INC) $(CCFLAGS) $(OPTIMIZE) \\ + $(PERLTYPE) $(LARGE) $(SPLIT) $(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,$m); + push(@m,"\n# These definitions are from config.sh (via $INC{'Config.pm'})\n"); + push(@m,"\n# They may have been overridden via Makefile.PL or on the command line\n"); + my(%once_only); + foreach $m (@{$self->{CONFIG}}){ + # SITE*EXP macros are defined in &constants; avoid duplicates here + next if $once_only{$m} or $m eq 'sitelibexp' or $m eq 'sitearchexp'; + push @m, "\U$m\E = ".$self->{uc $m}."\n"; + $once_only{$m} = 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 +# +}; + my($tmp); + for $tmp (qw/ + EXTRALIBS LDLOADLIBS BSLOADLIBS LD_RUN_PATH + /) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + return join "", @m; +} + +=item constants (o) + +Initializes lots of constants and .SUFFIXES and .PHONY + +=cut + +sub constants { + my($self) = @_; + my(@m,$tmp); + + for $tmp (qw/ + + AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION + VERSION_SYM XS_VERSION INST_BIN INST_EXE INST_LIB + INST_ARCHLIB INST_SCRIPT PREFIX INSTALLDIRS + INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB + INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB + PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB + FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC + PERL_INC PERL FULLPERL + + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, qq{ +VERSION_MACRO = VERSION +DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\" +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\" +}; + + push @m, qq{ +MAKEMAKER = $INC{'ExtUtils/MakeMaker.pm'} +MM_VERSION = $ExtUtils::MakeMaker::VERSION +}; + + push @m, q{ +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!! +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +}; + + for $tmp (qw/ + FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT + LDFROM LINKTYPE + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, " +# Handy lists of source code files: +XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})." +C_FILES = ".join(" \\\n\t", @{$self->{C}})." +O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})." +H_FILES = ".join(" \\\n\t", @{$self->{H}})." +MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})." +MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})." +"; + + for $tmp (qw/ + INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT + /) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + for $tmp (qw( + PERM_RW PERM_RWX + ) + ) { + my $method = lc($tmp); + # warn "self[$self] method[$method]"; + push @m, "$tmp = ", $self->$method(), "\n"; + } + + push @m, q{ +.NO_CONFIG_REC: Makefile +} if $ENV{CLEARCASE_ROOT}; + + # why not q{} ? -- emacs + push @m, qq{ +# work around a famous dec-osf make(1) feature(?): +makemakerdflt: all + +.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT) + +# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that +# some make implementations will delete the Makefile when we rebuild it. Because +# we call false(1) when we rebuild it. So make(1) is not completely wrong when it +# does so. Our milage may vary. +# .PRECIOUS: Makefile # seems to be not necessary anymore + +.PHONY: all config static dynamic test linkext manifest + +# Where is the Config information that we are using/depend on +CONFIGDEP = \$(PERL_ARCHLIB)/Config.pm \$(PERL_INC)/config.h +}; + + my @parentdir = split(/::/, $self->{PARENT_NAME}); + push @m, q{ +# Where to put things: +INST_LIBDIR = }. $self->catdir('$(INST_LIB)',@parentdir) .q{ +INST_ARCHLIBDIR = }. $self->catdir('$(INST_ARCHLIB)',@parentdir) .q{ + +INST_AUTODIR = }. $self->catdir('$(INST_LIB)','auto','$(FULLEXT)') .q{ +INST_ARCHAUTODIR = }. $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)') .q{ +}; + + if ($self->has_link_code()) { + push @m, ' +INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT) +INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs +'; + } else { + push @m, ' +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = +'; + } + + $tmp = $self->export_list; + push @m, " +EXPORT_LIST = $tmp +"; + $tmp = $self->perl_archive; + push @m, " +PERL_ARCHIVE = $tmp +"; + +# push @m, q{ +#INST_PM = }.join(" \\\n\t", sort values %{$self->{PM}}).q{ +# +#PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ +#}; + + push @m, q{ +TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{ + +PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ +}; + + 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 dir_target (o) + +Takes an array of directories that need to exist and returns a +Makefile entry for a .exists file in these directories. Returns +nothing, if the entry has already been processed. We're helpless +though, if the same directory comes as $(FOO) _and_ as "bar". Both of +them get an entry, that's why we use "::". + +=cut + +sub dir_target { +# --- Make-Directories section (internal method) --- +# dir_target(@array) returns a Makefile entry for the file .exists in each +# named directory. Returns nothing, if the entry has already been processed. +# We're helpless though, if the same directory comes as $(FOO) _and_ as "bar". +# Both of them get an entry, that's why we use "::". I chose '$(PERL)' as the +# prerequisite, because there has to be one, something that doesn't change +# too often :) + + my($self,@dirs) = @_; + my(@m,$dir,$targdir); + foreach $dir (@dirs) { + my($src) = $self->catfile($self->{PERL_INC},'perl.h'); + my($targ) = $self->catfile($dir,'.exists'); + # catfile may have adapted syntax of $dir to target OS, so... + if ($Is_VMS) { # Just remove file name; dirspec is often in macro + ($targdir = $targ) =~ s:/?\.exists$::; + } + else { # while elsewhere we expect to see the dir separator in $targ + $targdir = dirname($targ); + } + next if $self->{DIR_TARGET}{$self}{$targdir}++; + push @m, qq{ +$targ :: $src + $self->{NOECHO}\$(MKPATH) $targdir + $self->{NOECHO}\$(EQUALIZE_TIMESTAMP) $src $targ +}; + push(@m, qq{ + -$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $targdir +}) unless $Is_VMS; + } + join "", @m; +} + +=item dist (o) + +Defines a lot of macros for distribution support. + +=cut + +sub dist { + my($self, %attribs) = @_; + + my(@m); + # VERSION should be sanitised before use as a file name + my($version) = $attribs{VERSION} || '$(VERSION)'; + my($name) = $attribs{NAME} || '$(DISTNAME)'; + my($tar) = $attribs{TAR} || 'tar'; # eg /usr/bin/gnutar + my($tarflags) = $attribs{TARFLAGS} || 'cvf'; + my($zip) = $attribs{ZIP} || 'zip'; # eg pkzip Yuck! + my($zipflags) = $attribs{ZIPFLAGS} || '-r'; + my($compress) = $attribs{COMPRESS} || 'gzip --best'; + my($suffix) = $attribs{SUFFIX} || '.gz'; # eg .gz + my($shar) = $attribs{SHAR} || 'shar'; # eg "shar --gzip" + my($preop) = $attribs{PREOP} || "$self->{NOECHO}\$(NOOP)"; # eg update MANIFEST + my($postop) = $attribs{POSTOP} || "$self->{NOECHO}\$(NOOP)"; # eg remove the distdir + + my($to_unix) = $attribs{TO_UNIX} || ($Is_OS2 + ? "$self->{NOECHO}" + . '$(TEST_F) tmp.zip && $(RM) tmp.zip;' + . ' $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM) tmp.zip' + : "$self->{NOECHO}\$(NOOP)"); + + my($ci) = $attribs{CI} || 'ci -u'; + my($rcs_label)= $attribs{RCS_LABEL}|| 'rcs -Nv$(VERSION_SYM): -q'; + my($dist_cp) = $attribs{DIST_CP} || 'best'; + my($dist_default) = $attribs{DIST_DEFAULT} || 'tardist'; + + push @m, " +DISTVNAME = ${name}-$version +TAR = $tar +TARFLAGS = $tarflags +ZIP = $zip +ZIPFLAGS = $zipflags +COMPRESS = $compress +SUFFIX = $suffix +SHAR = $shar +PREOP = $preop +POSTOP = $postop +TO_UNIX = $to_unix +CI = $ci +RCS_LABEL = $rcs_label +DIST_CP = $dist_cp +DIST_DEFAULT = $dist_default +"; + join "", @m; +} + +=item dist_basics (o) + +Defines the targets distclean, distcheck, skipcheck, manifest. + +=cut + +sub dist_basics { + my($self) = shift; + my @m; + push @m, q{ +distclean :: realclean distcheck +}; + + push @m, q{ +distcheck : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \\ + -e fullcheck +}; + + push @m, q{ +skipcheck : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \\ + -e skipcheck +}; + + push @m, q{ +manifest : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \\ + -e mkmanifest +}; + join "", @m; +} + +=item dist_ci (o) + +Defines a check in target for RCS. + +=cut + +sub dist_ci { + my($self) = shift; + my @m; + push @m, q{ +ci : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\ + -e "@all = keys %{ maniread() };" \\ + -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\ + -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");' +}; + join "", @m; +} + +=item dist_core (o) + +Defeines the targets dist, tardist, zipdist, uutardist, shdist + +=cut + +sub dist_core { + my($self) = shift; + my @m; + push @m, q{ +dist : $(DIST_DEFAULT) + }.$self->{NOECHO}.q{$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \ + -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "}.$self->{MAKEFILE}.q{";' + +tardist : $(DISTVNAME).tar$(SUFFIX) + +zipdist : $(DISTVNAME).zip + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) \\ + $(DISTVNAME).tar$(SUFFIX) > \\ + $(DISTVNAME).tar$(SUFFIX)_uu + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) +}; + join "", @m; +} + +=item dist_dir (o) + +Defines the scratch directory target that will hold the distribution +before tar-ing (or shar-ing). + +=cut + +sub dist_dir { + my($self) = shift; + my @m; + push @m, q{ +distdir : + $(RM_RF) $(DISTVNAME) + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \\ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" +}; + join "", @m; +} + +=item dist_test (o) + +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 @m; + push @m, q{ +disttest : distdir + cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL + cd $(DISTVNAME) && $(MAKE) + cd $(DISTVNAME) && $(MAKE) test +}; + join "", @m; +} + +=item dlsyms (o) + +Used by AIX and VMS to define DL_FUNCS and DL_VARS and write the *.exp +files. + +=cut + +sub dlsyms { + my($self,%attribs) = @_; + + return '' unless ($^O eq 'aix' && $self->needs_linking() ); + + my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; + my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + 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 +",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\ + Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ', + neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\' +'); + + join('',@m); +} + +=item dynamic (o) + +Defines the dynamic target. + +=cut + +sub dynamic { +# --- Dynamic 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 dynamic" +#dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM) +dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT) + '.$self->{NOECHO}.'$(NOOP) +'; +} + +=item dynamic_bs (o) + +Defines targets for bootstrap files. + +=cut + +sub dynamic_bs { + my($self, %attribs) = @_; + return ' +BOOTSTRAP = +' unless $self->has_link_code(); + + return ' +BOOTSTRAP = '."$self->{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): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exists + '.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" + '.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ + -MExtUtils::Mkbootstrap \ + -e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');" + '.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP) + $(CHMOD) $(PERM_RW) $@ + +$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists + '."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT) + -'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT) + $(CHMOD) $(PERM_RW) $@ +'; +} + +=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 ($^O eq 'dec_osf' and $armaybe eq ':'); + my(@m); + push(@m,' +# This section creates the dynamically loadable $(INST_DYNAMIC) +# from $(OBJECT) and possibly $(MYEXTLIB). +ARMAYBE = '.$armaybe.' +OTHERLDFLAGS = '.$otherldflags.' +INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' + +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(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 ($^O eq 'dec_osf'); + + # Brain dead solaris linker does not use LD_RUN_PATH? + # This fixes dynamic extensions which need shared libs + my $ldrun = ''; + $ldrun = join ' ', map "-R$_", split /:/, $self->{LD_RUN_PATH} + if ($^O eq 'solaris'); + + # The IRIX linker also doesn't use LD_RUN_PATH + $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"} + if ($^O eq 'irix' && $self->{LD_RUN_PATH}); + + push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom. + ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)'); + push @m, ' + $(CHMOD) $(PERM_RWX) $@ +'; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + 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 file_name_is_absolute + +Takes as argument a path and returns true, if it is an absolute path. + +=cut + +sub file_name_is_absolute { + my($self,$file) = @_; + if ($Is_Dos){ + $file =~ m{^([a-z]:)?[\\/]}i ; + } + else { + $file =~ m:^/: ; + } +} + +=item find_perl + +Finds the executables PERL and FULLPERL + +=cut + +sub find_perl { + my($self, $ver, $names, $dirs, $trace) = @_; + my($name, $dir); + if ($trace >= 2){ + print "Looking for perl $ver by these names: +@$names +in these dirs: +@$dirs +"; + } + foreach $dir (@$dirs){ + next unless defined $dir; # $self->{PERL_SRC} may be undefined + foreach $name (@$names){ + 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->canonpath($self->catfile($self->curdir, $name)); + } + print "Checking $abs\n" if ($trace >= 2); + next unless $self->maybe_command($abs); + print "Executing $abs\n" if ($trace >= 2); + $val = `$abs -e 'require $ver; print "VER_OK\n" ' 2>&1`; + if ($val =~ /VER_OK/) { + print "Using PERL=$abs\n" if $trace; + return $abs; + } elsif ($trace >= 2) { + print "Result: `$val'\n"; + } + } + } + print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; + 0; # false and not empty +} + +=back + +=head2 Methods to actually produce chunks of text for the Makefile + +The methods here are called for each MakeMaker object in the order +specified by @ExtUtils::MakeMaker::MM_Sections. + +=over 2 + +=item fixin + +Inserts the sharpbang or equivalent magic number to a script + +=cut + +sub fixin { # stolen from the pink Camel book, more or less + my($self,@files) = @_; + my($does_shbang) = $Config::Config{'sharpbang'} =~ /^\s*\#\!/; + my($file,$interpreter); + for $file (@files) { + local(*FIXIN); + local(*FIXOUT); + open(FIXIN, $file) or Carp::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). + if ($cmd eq "perl") { + 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 = ''; + my($dir); + foreach $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; + } + + unless ( open(FIXOUT,">$file.new") ) { + warn "Can't create new $file: $!\n"; + next; + } + my($dev,$ino,$mode) = stat FIXIN; + # If they override perm_rwx, we won't notice it during fixin, + # because fixin is run through a new instance of MakeMaker. + # That is why we must run another CHMOD later. + $mode = oct($self->perm_rwx) unless $dev; + chmod $mode, $file; + + # Print out the new #! line (or equivalent). + local $\; + undef $/; + print FIXOUT $shb, <FIXIN>; + close FIXIN; + close FIXOUT; + # can't rename open files on some DOSISH platforms + 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 { + chmod oct($self->perm_rwx), $file or + die "Can't reset permissions for $file: $!\n"; + system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';; + } +} + +=item force (o) + +Just writes FORCE: + +=cut + +sub force { + my($self) = shift; + '# Phony target to force checking subdirectories. +FORCE: + '.$self->{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\.\-]+$||; # 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 + +Initializes DIR, XS, PM, C, O_FILES, H, PL_FILES, MAN*PODS, EXE_FILES. + +=cut + +sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) + my($self) = @_; + my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods); + local(%pm); #the sub in find() has to see this hash + @ignore{qw(Makefile.PL test.pl)} = (1,1); + $ignore{'makefile.pl'} = 1 if $Is_VMS; + foreach $name ($self->lsdir($self->curdir)){ + next if $name =~ /\#/; + next if $name eq $self->curdir or $name eq $self->updir or $ignore{$name}; + next unless $self->libscan($name); + if (-d $name){ + next if -l $name; # We do not support symlinks at all + $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL")); + } elsif ($name =~ /\.xs$/){ + my($c); ($c = $name) =~ s/\.xs$/.c/; + $xs{$name} = $c; + $c{$c} = 1; + } elsif ($name =~ /\.c(pp|xx|c)?$/i){ # .c .C .cpp .cxx .cc + $c{$name} = 1 + unless $name =~ m/perlmain\.c/; # See MAP_TARGET + } elsif ($name =~ /\.h$/i){ + $h{$name} = 1; + } elsif ($name =~ /\.PL$/) { + ($pl_files{$name} = $name) =~ s/\.PL$// ; + } elsif ($Is_VMS && $name =~ /\.pl$/) { # case-insensitive filesystem + local($/); open(PL,$name); my $txt = <PL>; close PL; + if ($txt =~ /Extracting \S+ \(with variable substitutions/) { + ($pl_files{$name} = $name) =~ s/\.pl$// ; + } + else { $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); } + } elsif ($name =~ /\.(p[ml]|pod)$/){ + $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); + } + } + + # 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. + + $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}] + unless $self->{PMLIBDIRS}; + + #only existing directories that aren't in $dir are allowed + + # Avoid $_ wherever possible: + # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}}; + my (@pmlibdirs) = @{$self->{PMLIBDIRS}}; + my ($pmlibdir); + @{$self->{PMLIBDIRS}} = (); + foreach $pmlibdir (@pmlibdirs) { + -d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir; + } + + if (@{$self->{PMLIBDIRS}}){ + print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n" + if ($Verbose >= 2); + require File::Find; + File::Find::find(sub { + if (-d $_){ + if ($_ eq "CVS" || $_ eq "RCS"){ + $File::Find::prune = 1; + } + return; + } + return if /\#/; + my($path, $prefix) = ($File::Find::name, '$(INST_LIBDIR)'); + my($striplibpath,$striplibname); + $prefix = '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:i); + ($striplibname,$striplibpath) = fileparse($striplibpath); + my($inst) = $self->catfile($prefix,$striplibpath,$striplibname); + local($_) = $inst; # for backwards compatibility + $inst = $self->libscan($inst); + print "libscan($path) => '$inst'\n" if ($Verbose >= 2); + return unless $inst; + $pm{$path} = $inst; + }, @{$self->{PMLIBDIRS}}); + } + + $self->{DIR} = [sort keys %dir] unless $self->{DIR}; + $self->{XS} = \%xs unless $self->{XS}; + $self->{PM} = \%pm unless $self->{PM}; + $self->{C} = [sort keys %c] unless $self->{C}; + my(@o_files) = @{$self->{C}}; + $self->{O_FILES} = [grep s/\.c(pp|xx|c)?$/$self->{OBJ_EXT}/i, @o_files] ; + $self->{H} = [sort keys %h] unless $self->{H}; + $self->{PL_FILES} = \%pl_files unless $self->{PL_FILES}; + + # Set up names of manual pages to generate from pods + if ($self->{MAN1PODS}) { + } elsif ( $self->{INST_MAN1DIR} =~ /^(none|\s*)$/ ) { + $self->{MAN1PODS} = {}; + } else { + my %manifypods = (); + if ( exists $self->{EXE_FILES} ) { + foreach $name (@{$self->{EXE_FILES}}) { +# use FileHandle (); +# my $fh = new FileHandle; + local *FH; + my($ispod)=0; +# if ($fh->open("<$name")) { + if (open(FH,"<$name")) { +# while (<$fh>) { + while (<FH>) { + if (/^=head1\s+\w+/) { + $ispod=1; + last; + } + } +# $fh->close; + close FH; + } else { + # If it doesn't exist yet, we assume, it has pods in it + $ispod = 1; + } + if( $ispod ) { + $manifypods{$name} = + $self->catfile('$(INST_MAN1DIR)', + basename($name).'.$(MAN1EXT)'); + } + } + } + $self->{MAN1PODS} = \%manifypods; + } + if ($self->{MAN3PODS}) { + } elsif ( $self->{INST_MAN3DIR} =~ /^(none|\s*)$/ ) { + $self->{MAN3PODS} = {}; + } else { + my %manifypods = (); # we collect the keys first, i.e. the files + # we have to convert to pod + foreach $name (keys %{$self->{PM}}) { + if ($name =~ /\.pod$/ ) { + $manifypods{$name} = $self->{PM}{$name}; + } elsif ($name =~ /\.p[ml]$/ ) { +# use FileHandle (); +# my $fh = new FileHandle; + local *FH; + my($ispod)=0; +# $fh->open("<$name"); + if (open(FH,"<$name")) { + # while (<$fh>) { + while (<FH>) { + if (/^=head1\s+\w+/) { + $ispod=1; + last; + } + } + # $fh->close; + close FH; + } else { + $ispod = 1; + } + if( $ispod ) { + $manifypods{$name} = $self->{PM}{$name}; + } + } + } + + # 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 $name (keys %manifypods) { + if ($name =~ /(config|setup).*\.pm/i) { + delete $manifypods{$name}; + next; + } + my($manpagename) = $name; + unless ($manpagename =~ s!^\W*lib\W+!!) { # everything below lib is ok + $manpagename = $self->catfile(split(/::/,$self->{PARENT_NAME}),$manpagename); + } + $manpagename =~ s/\.p(od|m|l)$//; + $manpagename = $self->replace_manpage_separator($manpagename); + $manifypods{$name} = $self->catfile("\$(INST_MAN3DIR)","$manpagename.\$(MAN3EXT)"); + } + $self->{MAN3PODS} = \%manifypods; + } +} + +=item init_main + +Initializes NAME, FULLEXT, BASEEXT, PARENT_NAME, DLBASE, PERL_SRC, +PERL_LIB, PERL_ARCHLIB, PERL_INC, INSTALLDIRS, INST_*, INSTALL*, +PREFIX, CONFIG, AR, AR_STATIC_ARGS, LD, OBJ_EXT, LIB_EXT, EXE_EXT, MAP_TARGET, +LIBPERL_A, VERSION_FROM, VERSION, DISTNAME, VERSION_SYM. + +=cut + +sub init_main { + my($self) = @_; + + # --- Initialize Module Name and Paths + + # NAME = Foo::Bar::Oracle + # FULLEXT = Foo/Bar/Oracle + # BASEEXT = Oracle + # ROOTEXT = Directory part of FULLEXT with leading /. !!! Deprecated from MM 5.32 !!! + # 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+)$! ; + + if (defined &DynaLoader::mod2fname) { + # As of 5.001m, dl_os2 appends '_' + $self->{DLBASE} = $modfname; + } else { + $self->{DLBASE} = '$(BASEEXT)'; + } + + + ### ROOTEXT deprecated from MM 5.32 +### ($self->{ROOTEXT} = +### $self->{FULLEXT}) =~ s#/?\Q$self->{BASEEXT}\E$## ; #eg. /BSD/Foo +### $self->{ROOTEXT} = ($Is_VMS ? '' : '/') . $self->{ROOTEXT} if $self->{ROOTEXT}; + + + # --- Initialize PERL_LIB, INST_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}){ + my($dir); + foreach $dir ($self->updir(),$self->catdir($self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir())){ + if ( + -f $self->catfile($dir,"config.sh") + && + -f $self->catfile($dir,"perl.h") + && + -f $self->catfile($dir,"lib","Exporter.pm") + ) { + $self->{PERL_SRC}=$dir ; + last; + } + } + } + if ($self->{PERL_SRC}){ + $self->{PERL_LIB} ||= $self->catdir("$self->{PERL_SRC}","lib"); + $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},'perlshr_attr.opt') + or + $Is_Mac + 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 + $self->{PERL_LIB} ||= $Config::Config{privlibexp}; + $self->{PERL_ARCHLIB} ||= $Config::Config{archlibexp}; + $self->{PERL_INC} = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now + my $perl_h; + unless (-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h"))){ + die qq{ +Error: Unable to locate installed Perl libraries or Perl source code. + +It is recommended that you install perl in a standard location before +building extensions. Some precompiled versions of perl do not contain +these header files, so you cannot build extensions. In such a case, +please build and install your perl from a fresh perl distribution. It +usually solves this kind of problem. + +\(You get this message, because MakeMaker could not find "$perl_h"\) +}; + } +# print STDOUT "Using header files found in $self->{PERL_INC}\n" +# if $Verbose && $self->needs_linking(); + + } + + # 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"; + + # 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::Config{privlibexp}. + unless ($self->{INST_LIB}){ + + + ##### XXXXX We have to change this nonsense + + if (defined $self->{PERL_SRC} and $self->{INSTALLDIRS} eq "perl") { + $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB}; + } else { + $self->{INST_LIB} = $self->catdir($self->curdir,"blib","lib"); + } + } + $self->{INST_ARCHLIB} ||= $self->catdir($self->curdir,"blib","arch"); + $self->{INST_BIN} ||= $self->catdir($self->curdir,'blib','bin'); + + # We need to set up INST_LIBDIR before init_libscan() for VMS + 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)'); + + # INST_EXE is deprecated, should go away March '97 + $self->{INST_EXE} ||= $self->catdir($self->curdir,'blib','script'); + $self->{INST_SCRIPT} ||= $self->catdir($self->curdir,'blib','script'); + + # The user who requests an installation directory explicitly + # should not have to tell us a 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. + # We do the same thing twice: for privlib/archlib and for sitelib/sitearch + my($libpair); + for $libpair ({l=>"privlib", a=>"archlib"}, {l=>"sitelib", a=>"sitearch"}) { + my $lib = "install$libpair->{l}"; + my $Lib = uc $lib; + my $Arch = uc "install$libpair->{a}"; + if( $self->{$Lib} && ! $self->{$Arch} ){ + my($ilib) = $Config{$lib}; + $ilib = VMS::Filespec::unixify($ilib) if $Is_VMS; + + $self->prefixify($Arch,$ilib,$self->{$Lib}); + + unless (-d $self->{$Arch}) { + print STDOUT "Directory $self->{$Arch} not found, thusly\n" if $Verbose; + $self->{$Arch} = $self->{$Lib}; + } + print STDOUT "Defaulting $Arch to $self->{$Arch}\n" if $Verbose; + } + } + + # we have to look at the relation between $Config{prefix} and the + # requested values. We're going to set the $Config{prefix} part of + # all the installation path variables to literally $(PREFIX), so + # the user can still say make PREFIX=foo + my($configure_prefix) = $Config{'prefix'}; + $configure_prefix = VMS::Filespec::unixify($configure_prefix) if $Is_VMS; + $self->{PREFIX} ||= $configure_prefix; + + + my($install_variable,$search_prefix,$replace_prefix); + + # The rule, taken from Configure, is that if prefix contains perl, + # we shape the tree + # perlprefix/lib/ INSTALLPRIVLIB + # perlprefix/lib/pod/ + # perlprefix/lib/site_perl/ INSTALLSITELIB + # perlprefix/bin/ INSTALLBIN + # perlprefix/man/ INSTALLMAN1DIR + # else + # prefix/lib/perl5/ INSTALLPRIVLIB + # prefix/lib/perl5/pod/ + # prefix/lib/perl5/site_perl/ INSTALLSITELIB + # prefix/bin/ INSTALLBIN + # prefix/lib/perl5/man/ INSTALLMAN1DIR + + $replace_prefix = qq[\$\(PREFIX\)]; + for $install_variable (qw/ + INSTALLBIN + INSTALLSCRIPT + /) { + $self->prefixify($install_variable,$configure_prefix,$replace_prefix); + } + $search_prefix = $configure_prefix =~ /perl/ ? + $self->catdir($configure_prefix,"lib") : + $self->catdir($configure_prefix,"lib","perl5"); + if ($self->{LIB}) { + $self->{INSTALLPRIVLIB} = $self->{INSTALLSITELIB} = $self->{LIB}; + $self->{INSTALLARCHLIB} = $self->{INSTALLSITEARCH} = + $self->catdir($self->{LIB},$Config{'archname'}); + } else { + $replace_prefix = $self->{PREFIX} =~ /perl/ ? + $self->catdir(qq[\$\(PREFIX\)],"lib") : + $self->catdir(qq[\$\(PREFIX\)],"lib","perl5"); + for $install_variable (qw/ + INSTALLPRIVLIB + INSTALLARCHLIB + INSTALLSITELIB + INSTALLSITEARCH + /) { + $self->prefixify($install_variable,$search_prefix,$replace_prefix); + } + } + $search_prefix = $configure_prefix =~ /perl/ ? + $self->catdir($configure_prefix,"man") : + $self->catdir($configure_prefix,"lib","perl5","man"); + $replace_prefix = $self->{PREFIX} =~ /perl/ ? + $self->catdir(qq[\$\(PREFIX\)],"man") : + $self->catdir(qq[\$\(PREFIX\)],"lib","perl5","man"); + for $install_variable (qw/ + INSTALLMAN1DIR + INSTALLMAN3DIR + /) { + $self->prefixify($install_variable,$search_prefix,$replace_prefix); + } + + # Now we head at the manpages. Maybe they DO NOT want manpages + # installed + $self->{INSTALLMAN1DIR} = $Config::Config{installman1dir} + unless defined $self->{INSTALLMAN1DIR}; + unless (defined $self->{INST_MAN1DIR}){ + if ($self->{INSTALLMAN1DIR} =~ /^(none|\s*)$/){ + $self->{INST_MAN1DIR} = $self->{INSTALLMAN1DIR}; + } else { + $self->{INST_MAN1DIR} = $self->catdir($self->curdir,'blib','man1'); + } + } + $self->{MAN1EXT} ||= $Config::Config{man1ext}; + + $self->{INSTALLMAN3DIR} = $Config::Config{installman3dir} + unless defined $self->{INSTALLMAN3DIR}; + unless (defined $self->{INST_MAN3DIR}){ + if ($self->{INSTALLMAN3DIR} =~ /^(none|\s*)$/){ + $self->{INST_MAN3DIR} = $self->{INSTALLMAN3DIR}; + } else { + $self->{INST_MAN3DIR} = $self->catdir($self->curdir,'blib','man3'); + } + } + $self->{MAN3EXT} ||= $Config::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::Config{shellflags}; + my(%once_only,$m); + foreach $m (@{$self->{CONFIG}}){ + next if $once_only{$m}; + print STDOUT "CONFIG key '$m' does not exist in Config.pm\n" + unless exists $Config::Config{$m}; + $self->{uc $m} ||= $Config::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->{LD} ||= 'ld'; + $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 Exporter + warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory + (Exporter.pm not found)" + unless -f $self->catfile("$self->{PERL_LIB}","Exporter.pm") || + $self->{NAME} eq "ExtUtils::MakeMaker"; + + # Determine VERSION and VERSION_FROM + ($self->{DISTNAME}=$self->{NAME}) =~ s#(::)#-#g unless $self->{DISTNAME}; + if ($self->{VERSION_FROM}){ + $self->{VERSION} = $self->parse_version($self->{VERSION_FROM}) or + Carp::carp "WARNING: Setting VERSION via file '$self->{VERSION_FROM}' failed\n" + } + + # strip blanks + if ($self->{VERSION}) { + $self->{VERSION} =~ s/^\s+//; + $self->{VERSION} =~ s/\s+$//; + } + + $self->{VERSION} ||= "0.10"; + ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g; + + + # 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}; + + # --- Initialize Perl Binary Locations + + # Find Perl 5. The only contract here is that both 'PERL' and 'FULLPERL' + # will be working versions of perl 5. miniperl has priority over perl + # for PERL to ensure that $(PERL) is usable while building ./ext/* + my ($component,@defpath); + foreach $component ($self->{PERL_SRC}, $self->path(), $Config::Config{binexp}) { + push @defpath, $component if defined $component; + } + $self->{PERL} ||= + $self->find_perl(5.0, [ $^X, 'miniperl','perl','perl5',"perl$]" ], + \@defpath, $Verbose ); + # don't check if perl is executable, maybe they have decided to + # supply switches with perl + + # Define 'FULLPERL' to be a non-miniperl (used in test: target) + ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/perl/i + unless ($self->{FULLPERL}); +} + +=item init_others + +Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH, +OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, NOOP, FIRST_MAKEFILE, +MAKEFILE, NOECHO, RM_F, RM_RF, TEST_F, TOUCH, CP, MV, CHMOD, UMASK_NULL + +=cut + +sub init_others { # --- Initialize Other Attributes + my($self) = shift; + + # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS} + # 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: + + # May check $Config{libs} too, thus not empty. + $self->{LIBS}=[''] unless $self->{LIBS}; + + $self->{LIBS}=[$self->{LIBS}] if ref \$self->{LIBS} eq 'SCALAR'; + $self->{LD_RUN_PATH} = ""; + my($libs); + foreach $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::Config{usedl} ? 'dynamic' : 'static'); + }; + + # These get overridden for VMS and maybe some other systems + $self->{NOOP} ||= '$(SHELL) -c true'; + $self->{FIRST_MAKEFILE} ||= "Makefile"; + $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE}; + $self->{MAKE_APERL_FILE} ||= "Makefile.aperl"; + $self->{NOECHO} = '@' unless defined $self->{NOECHO}; + $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->{UMASK_NULL} ||= "umask 0"; + $self->{DEV_NULL} ||= "> /dev/null 2>&1"; +} + +=item install (o) + +Defines the install target. + +=cut + +sub install { + my($self, %attribs) = @_; + my(@m); + + push @m, q{ +install :: all pure_install doc_install + +install_perl :: all pure_perl_install doc_perl_install + +install_site :: all pure_site_install doc_site_install + +install_ :: install_site + @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_install :: pure_$(INSTALLDIRS)_install + +doc_install :: doc_$(INSTALLDIRS)_install + }.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod + +pure__install : pure_site_install + @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: + }.$self->{NOECHO}.q{$(MOD_INSTALL) \ + read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \ + write }.$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \ + $(INST_LIB) $(INSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(INSTALLARCHLIB) \ + $(INST_BIN) $(INSTALLBIN) \ + $(INST_SCRIPT) $(INSTALLSCRIPT) \ + $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(INSTALLMAN3DIR) + }.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \ + }.$self->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{ + + +pure_site_install :: + }.$self->{NOECHO}.q{$(MOD_INSTALL) \ + read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \ + write }.$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{ \ + $(INST_LIB) $(INSTALLSITELIB) \ + $(INST_ARCHLIB) $(INSTALLSITEARCH) \ + $(INST_BIN) $(INSTALLBIN) \ + $(INST_SCRIPT) $(INSTALLSCRIPT) \ + $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(INSTALLMAN3DIR) + }.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \ + }.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{ + +doc_perl_install :: + -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLPRIVLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{ + +doc_site_install :: + -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{ + +}; + + push @m, q{ +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + +uninstall_from_perldirs :: + }.$self->{NOECHO}. + q{$(UNINSTALL) }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ + +uninstall_from_sitedirs :: + }.$self->{NOECHO}. + q{$(UNINSTALL) }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ +}; + + join("",@m); +} + +=item installbin (o) + +Defines targets to install EXE_FILES. + +=cut + +sub installbin { + my($self) = shift; + return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY"; + return "" unless @{$self->{EXE_FILES}}; + my(@m, $from, $to, %fromto, @to); + push @m, $self->dir_target(qw[$(INST_SCRIPT)]); + for $from (@{$self->{EXE_FILES}}) { + my($path)= $self->catfile('$(INST_SCRIPT)', basename($from)); + local($_) = $path; # for backwards compatibility + $to = $self->libscan($path); + print "libscan($from) => '$to'\n" if ($Verbose >=2); + $fromto{$from}=$to; + } + @to = values %fromto; + push(@m, qq{ +EXE_FILES = @{$self->{EXE_FILES}} + +} . ($Is_Win32 + ? q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + -e "system qq[pl2bat.bat ].shift" +} : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \ + -e "MY->fixin(shift)" +}).qq{ +all :: @to + $self->{NOECHO}\$(NOOP) + +realclean :: + $self->{RM_F} @to +}); + + while (($from,$to) = each %fromto) { + last unless defined $from; + my $todir = dirname($to); + push @m, " +$to: $from $self->{MAKEFILE} " . $self->catdir($todir,'.exists') . " + $self->{NOECHO}$self->{RM_F} $to + $self->{CP} $from $to + \$(FIXIN) $to + -$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $to +"; + } + join "", @m; +} + +=item libscan (o) + +Takes a path to a file that is found by init_dirscan and returns false +if we don't want to include this file in the library. Mainly used to +exclude RCS, CVS, and SCCS directories from installation. + +=cut + +# '; + +sub libscan { + my($self,$path) = @_; + return '' if $path =~ m:\b(RCS|CVS|SCCS)\b: ; + $path; +} + +=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 + $self->{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) -f $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) + }.$self->{NOECHO}.q{echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + }.$self->{NOECHO}.q{$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + 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::Config{cccdlflags}" + if ($Config::Config{useshrplib} eq 'true'); + $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/; + + # The front matter of the linkcommand... + $linkcmd = join ' ', "\$(CC)", + grep($_, @Config{qw(large split ldflags ccdlflags)}); + $linkcmd =~ s/\s+/ /g; + $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,; + + # Which *.a files could we make use of... + local(%static); + require File::Find; + File::Find::find(sub { + return unless m/\Q$self->{LIB_EXT}\E$/; + return if m/^libperl/; + # 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 $incl; + my $xx; + + ($xx = $File::Find::name) =~ s,.*?/auto/,,; + $xx =~ s,/?$_,,; + $xx =~ s,/,::,g; + + # Throw away anything not explicitly marked for inclusion. + # DynaLoader is implied. + foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){ + if( $xx eq $incl ){ + $found++; + last; + } + } + return unless $found; + } + elsif( exists $self->{EXCLUDE_EXT} ){ + my $excl; + my $xx; + + ($xx = $File::Find::name) =~ s,.*?/auto/,,; + $xx =~ s,/?$_,,; + $xx =~ s,/,::,g; + + # Throw away anything explicitly marked for exclusion + foreach $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}$:; + 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$/; + $_ = dirname($_) . "/extralibs.ld"; + push @$extra, $_; + } + + grep(s/^/-I/, @{$perlinc || []}); + + $target = "perl" unless $target; + $tmp = "." unless $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::Config{libs} $Config::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"; + $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 ($^O eq 'solaris' or $^O eq 'sunos') { + $lperl = $libperl = "$dir/$Config::Config{libperl}"; + # SUNOS ld does not take the full path to a shared library + $libperl = '' if $^O eq 'sunos'; + } + } + + 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})); + } + + push @m, " +MAP_LIBPERL = $libperl +"; + + push @m, " +\$(INST_ARCHAUTODIR)/extralibs.all: \$(INST_ARCHAUTODIR)/.exists ".join(" \\\n\t", @$extra)." + $self->{NOECHO}$self->{RM_F} \$\@ + $self->{NOECHO}\$(TOUCH) \$\@ +"; + + my $catfile; + foreach $catfile (@$extra){ + push @m, "\tcat $catfile >> \$\@\n"; + } + # SUNOS ld does not take the full path to a shared library + my $llibperl = ($libperl)?'$(MAP_LIBPERL)':'-lperl'; + + # Brain dead solaris linker does not use LD_RUN_PATH? + # This fixes dynamic extensions which need shared libs + my $ldfrom = ($^O eq 'solaris')? + join(' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}):''; + +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) + $self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call' + $self->{NOECHO}echo ' make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)' + $self->{NOECHO}echo 'To remove the intermediate files say' + $self->{NOECHO}echo ' make -f $makefilename map_clean' + +$tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c +"; + push @m, "\tcd $tmp && $cccmd -I\$(PERL_INC) perlmain.c\n"; + + push @m, qq{ +$tmp/perlmain.c: $makefilename}, q{ + }.$self->{NOECHO}.q{echo Writing $@ + }.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\ + -e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@ + +}; + push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain +} if (defined (&Dos::UseLFN) && Dos::UseLFN()==0); + + + push @m, q{ +doc_inst_perl: + }.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod + -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ + "Perl binary" "$(MAP_TARGET)" \ + MAP_STATIC "$(MAP_STATIC)" \ + MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \ + MAP_LIBPERL "$(MAP_LIBPERL)" \ + >> }.$self->catfile('$(INSTALLARCHLIB)','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('$(INSTALLBIN)','$(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. + push @m, ' +$(OBJECT) : $(FIRST_MAKEFILE) +' if $self->{OBJECT}; + + push @m, q{ +# We take a very conservative approach here, but it\'s worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +}.$self->{MAKEFILE}.q{ : Makefile.PL $(CONFIGDEP) + }.$self->{NOECHO}.q{echo "Makefile out-of-date with respect to $?" + }.$self->{NOECHO}.q{echo "Cleaning current config before rebuilding Makefile..." + -}.$self->{NOECHO}.q{$(RM_F) }."$self->{MAKEFILE}.old".q{ + -}.$self->{NOECHO}.q{$(MV) }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{ + -$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean $(DEV_NULL) || $(NOOP) + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{ + }.$self->{NOECHO}.q{echo "==> Your Makefile has been rebuilt. <==" + }.$self->{NOECHO}.q{echo "==> Please rerun the make command. <==" + false + +# To change behavior to :: would be nice, but would break Tk b9.02 +# so you find such a warning below the dist target. +#}.$self->{MAKEFILE}.q{ :: $(VERSION_FROM) +# }.$self->{NOECHO}.q{echo "Warning: Makefile possibly out of date with $(VERSION_FROM)" +}; + + join "", @m; +} + +=item manifypods (o) + +Defines targets and routines to translate the pods into manpages and +put them into the INST_* directories. + +=cut + +sub manifypods { + my($self, %attribs) = @_; + return "\nmanifypods : pure_all\n\t$self->{NOECHO}\$(NOOP)\n" unless + %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}}; + my($dist); + my($pod2man_exe); + if (defined $self->{PERL_SRC}) { + $pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man'); + } else { + $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man'); + } + unless ($self->perl_script($pod2man_exe)) { + # No pod2man but some MAN3PODS to be installed + print <<END; + +Warning: I could not locate your pod2man program. Please make sure, + your pod2man program is in your PATH before you execute 'make' + +END + $pod2man_exe = "-S pod2man"; + } + my(@m); + push @m, +qq[POD2MAN_EXE = $pod2man_exe\n], +qq[POD2MAN = \$(PERL) -we '%m=\@ARGV;for (keys %m){' \\\n], +q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "], + $self->{MAKEFILE}, q[";' \\ +-e 'print "Manifying $$m{$$_}\n";' \\ +-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\ +-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}' +]; + push @m, "\nmanifypods : pure_all "; + push @m, join " \\\n\t", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}; + + push(@m,"\n"); + if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) { + push @m, "\t$self->{NOECHO}\$(POD2MAN) \\\n\t"; + push @m, join " \\\n\t", %{$self->{MAN1PODS}}, %{$self->{MAN3PODS}}; + } + join('', @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 maybe_command_in_dirs + +method under development. Not yet used. Ask Ilya :-) + +=cut + +sub maybe_command_in_dirs { # $ver is optional argument if looking for perl +# Ilya's suggestion. Not yet used, want to understand it first, but at least the code is here + my($self, $names, $dirs, $trace, $ver) = @_; + my($name, $dir); + foreach $dir (@$dirs){ + next unless defined $dir; # $self->{PERL_SRC} may be undefined + foreach $name (@$names){ + my($abs,$tryabs); + if ($self->file_name_is_absolute($name)) { # /foo/bar + $abs = $name; + } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # bar + $abs = $self->catfile($dir, $name); + } else { # foo/bar + $abs = $self->catfile($self->curdir, $name); + } + print "Checking $abs for $name\n" if ($trace >= 2); + next unless $tryabs = $self->maybe_command($abs); + print "Substituting $tryabs instead of $abs\n" + if ($trace >= 2 and $tryabs ne $abs); + $abs = $tryabs; + if (defined $ver) { + print "Executing $abs\n" if ($trace >= 2); + if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) { + print "Using PERL=$abs\n" if $trace; + return $abs; + } + } else { # Do not look for perl + return $abs; + } + } + } +} + +=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($child,$caller); + $caller = (caller(0))[3]; + Carp::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 $child (keys %{$self->{CHILDREN}}) { + if ($self->{CHILDREN}->{$child}->needs_linking) { + $self->{NEEDS_LINKING} = 1; + return 1; + } + } + return $self->{NEEDS_LINKING} = 0; +} + +=item nicetext + +misnamed method (will have to be changed). The MM_Unix method just +returns the argument without further processing. + +On VMS used to insure that colons marking targets are preceded by +space - most Unix Makes don't need this, but it's necessary under VMS +to distinguish the target delimiter from a colon appearing as part of +a filespec. + +=cut + +sub nicetext { + my($self,$text) = @_; + $text; +} + +=item parse_version + +parse a file and return what you think is $VERSION in this file set to + +=cut + +sub parse_version { + my($self,$parsefile) = @_; + my $result; + local *FH; + local $/ = "\n"; + open(FH,$parsefile) or die "Could not open '$parsefile': $!"; + my $inpod = 0; + while (<FH>) { + $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; + next if $inpod; + chop; + # next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/; + next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/; + my $eval = qq{ + package ExtUtils::MakeMaker::_version; + no strict; + + local $1$2; + \$$2=undef; do { + $_ + }; \$$2 + }; + local($^W) = 0; + $result = eval($eval); + die "Could not eval '$eval' in $parsefile: $@" if $@; + $result = "undef" unless defined $result; + last; + } + close FH; + return $result; +} + +=item parse_abstract + +parse a file and return what you think is the ABSTRACT + +=cut + +sub parse_abstract { + my($self,$parsefile) = @_; + my $result; + local *FH; + local $/ = "\n"; + open(FH,$parsefile) or die "Could not open '$parsefile': $!"; + my $inpod = 0; + my $package = $self->{DISTNAME}; + $package =~ s/-/::/; + 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 pasthru (o) + +Defines the string that is passed to recursive make calls in +subdirectories. + +=cut + +sub pasthru { + my($self) = shift; + my(@m,$key); + + my(@pasthru); + my($sep) = $Is_VMS ? ',' : ''; + $sep .= "\\\n\t"; + + foreach $key (qw(LIB LIBPERL_A LINKTYPE PREFIX OPTIMIZE)){ + push @pasthru, "$key=\"\$($key)\""; + } + + push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n"; + join "", @m; +} + +=item path + +Takes no argument, returns the environment variable PATH as an array. + +=cut + +sub path { + my($self) = @_; + my $path_sep = ($Is_OS2 || $Is_Dos) ? ";" : ":"; + my $path = $ENV{PATH}; + $path =~ s:\\:/:g if $Is_OS2; + my @path = split $path_sep, $path; + foreach(@path) { $_ = '.' if $_ eq '' } + @path; +} + +=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); + push @m, q{ +# 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 + -}.$self->{NOECHO}.q{echo "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; false + +$(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh + }.$self->{NOECHO}.q{echo "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh" + cd $(PERL_SRC) && $(MAKE) lib/Config.pm +} if $self->{PERL_SRC}; + + return join "", @m unless $self->needs_linking; + + push @m, q{ +PERL_HDRS = \ +$(PERL_INC)/EXTERN.h $(PERL_INC)/gv.h $(PERL_INC)/pp.h \ +$(PERL_INC)/INTERN.h $(PERL_INC)/handy.h $(PERL_INC)/proto.h \ +$(PERL_INC)/XSUB.h $(PERL_INC)/hv.h $(PERL_INC)/regcomp.h \ +$(PERL_INC)/av.h $(PERL_INC)/keywords.h $(PERL_INC)/regexp.h \ +$(PERL_INC)/config.h $(PERL_INC)/mg.h $(PERL_INC)/scope.h \ +$(PERL_INC)/cop.h $(PERL_INC)/op.h $(PERL_INC)/sv.h \ +$(PERL_INC)/cv.h $(PERL_INC)/opcode.h $(PERL_INC)/unixish.h \ +$(PERL_INC)/dosish.h $(PERL_INC)/patchlevel.h $(PERL_INC)/util.h \ +$(PERL_INC)/embed.h $(PERL_INC)/perl.h $(PERL_INC)/iperlsys.h \ +$(PERL_INC)/form.h $(PERL_INC)/perly.h + +$(OBJECT) : $(PERL_HDRS) +} if $self->{OBJECT}; + + push @m, join(" ", values %{$self->{XS}})." : \$(XSUBPPDEPS)\n" if %{$self->{XS}}; + + join "\n", @m; +} + +=item ppd + +Defines target that creates a PPD (Perl Package Description) file +for a binary distribution. + +=cut + +sub ppd { + my($self) = @_; + my(@m); + if ($self->{ABSTRACT_FROM}){ + $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or + Carp::carp "WARNING: Setting ABSTRACT via file '$self->{ABSTRACT_FROM}' failed\n"; + } + my ($pack_ver) = join ",", (split (/\./, $self->{VERSION}), (0) x 4) [0 .. 3]; + push(@m, "# Creates a PPD (Perl Package Description) for a binary distribution.\n"); + push(@m, "ppd:\n"); + push(@m, "\t\@\$(PERL) -e \"print qq{<SOFTPKG NAME=\\\"$self->{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}"); + push(@m, ". qq{\\t<TITLE>$self->{DISTNAME}</TITLE>\\n}"); + my $abstract = $self->{ABSTRACT}; + $abstract =~ s/</</g; + $abstract =~ s/>/>/g; + push(@m, ". qq{\\t<ABSTRACT>$abstract</ABSTRACT>\\n}"); + my ($author) = $self->{AUTHOR}; + $author =~ s/@/\\@/g; + push(@m, ". qq{\\t<AUTHOR>$author</AUTHOR>\\n}"); + push(@m, ". qq{\\t<IMPLEMENTATION>\\n}"); + my ($prereq); + foreach $prereq (sort keys %{$self->{PREREQ_PM}}) { + my $pre_req = $prereq; + $pre_req =~ s/::/-/g; + push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" />\\n}"); + } + push(@m, ". qq{\\t\\t<OS NAME=\\\"\$(OSNAME)\\\" />\\n}"); + my ($bin_location) = $self->{BINARY_LOCATION}; + $bin_location =~ s/\\/\\\\/g; + if ($self->{PPM_INSTALL_SCRIPT}) { + if ($self->{PPM_INSTALL_EXEC}) { + push(@m, " . qq{\\t\\t<INSTALL EXEC=\\\"$self->{PPM_INSTALL_EXEC}\\\">$self->{PPM_INSTALL_SCRIPT}</INSTALL>\\n}"); + } + else { + push(@m, " . qq{\\t\\t<INSTALL>$self->{PPM_INSTALL_SCRIPT}</INSTALL>\\n}"); + } + } + push(@m, ". qq{\\t\\t<CODEBASE HREF=\\\"$bin_location\\\" />\\n}"); + push(@m, ". qq{\\t</IMPLEMENTATION>\\n}"); + push(@m, ". qq{</SOFTPKG>\\n}\" > $self->{DISTNAME}.ppd"); + + join("", @m); +} + +=item perm_rw (o) + +Returns the attribute C<PERM_RW> or the string C<644>. +Used as the string that is passed +to the C<chmod> command to set the permissions for read/writeable files. +MakeMaker chooses C<644> because it has turned out in the past that +relying on the umask provokes hard-to-track bugreports. +When the return value is used by the perl function C<chmod>, it is +interpreted as an octal value. + +=cut + +sub perm_rw { + shift->{PERM_RW} || "644"; +} + +=item perm_rwx (o) + +Returns the attribute C<PERM_RWX> or the string C<755>, +i.e. the string that is passed +to the C<chmod> command to set the permissions for executable files. +See also perl_rw. + +=cut + +sub perm_rwx { + shift->{PERM_RWX} || "755"; +} + +=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'); + return q{ +pm_to_blib: $(TO_INST_PM) + }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ + "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ + -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{')" + }.$self->{NOECHO}.q{$(TOUCH) $@ +}; +} + +=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{ + my($self) = shift; + ""; +} + +=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 { + my($self) = shift; + ""; +} + +=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 { + my($self) = shift; + ""; +} + +=item prefixify + +Check a path variable in $self from %Config, if it contains a prefix, +and replace it with another one. + +Takes as arguments an attribute name, a search prefix and a +replacement prefix. Changes the attribute in the object. + +=cut + +sub prefixify { + my($self,$var,$sprefix,$rprefix) = @_; + $self->{uc $var} ||= $Config{lc $var}; + $self->{uc $var} = VMS::Filespec::unixpath($self->{uc $var}) if $Is_VMS; + $self->{uc $var} =~ s/\Q$sprefix\E/$rprefix/; +} + +=item processPL (o) + +Defines targets to run *.PL files. + +=cut + +sub processPL { + my($self) = shift; + return "" unless $self->{PL_FILES}; + my(@m, $plfile); + foreach $plfile (sort keys %{$self->{PL_FILES}}) { + push @m, " +all :: $self->{PL_FILES}->{$plfile} + $self->{NOECHO}\$(NOOP) + +$self->{PL_FILES}->{$plfile} :: $plfile + \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile +"; + } + join "", @m; +} + +=item realclean (o) + +Defines the realclean target. + +=cut + +sub realclean { + my($self, %attribs) = @_; + my(@m); + push(@m,' +# Delete temporary files (via clean) and also delete installed files +realclean purge :: clean +'); + # realclean subdirectories first (already cleaned) + my $sub = "\t-cd %s && \$(TEST_F) %s && \$(MAKE) %s realclean\n"; + foreach(@{$self->{DIR}}){ + push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old")); + push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",'')); + } + push(@m, " $self->{RM_RF} \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n"); + if( $self->has_link_code ){ + push(@m, " $self->{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n"); + push(@m, " $self->{RM_F} \$(INST_STATIC)\n"); + } + push(@m, " $self->{RM_F} " . join(" ", values %{$self->{PM}}) . "\n") + if keys %{$self->{PM}}; + my(@otherfiles) = ($self->{MAKEFILE}, + "$self->{MAKEFILE}.old"); # Makefiles last + push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; + push(@m, " $self->{RM_RF} @otherfiles\n") if @otherfiles; + push(@m, " $attribs{POSTOP}\n") if $attribs{POSTOP}; + join("", @m); +} + +=item replace_manpage_separator + +Takes the name of a package, which may be a nested package, in the +form Foo/Bar and replaces the slash with C<::>. Returns the replacement. + +=cut + +sub replace_manpage_separator { + my($self,$man) = @_; + $man =~ s,/+,::,g; + $man; +} + +=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 :: '.$self->{MAKEFILE}.' $(INST_STATIC) $(INST_PM) +static :: '.$self->{MAKEFILE}.' $(INST_STATIC) + '.$self->{NOECHO}.'$(NOOP) +'; +} + +=item static_lib (o) + +Defines how to produce the *.a (or equivalent) files. + +=cut + +sub static_lib { + my($self) = @_; +# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC +# return '' unless $self->needs_linking(); #might be because of a subdir + + return '' unless $self->has_link_code; + + my(@m); + push(@m, <<'END'); +$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.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. + push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB}; + + push @m, +q{ $(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ + $(CHMOD) $(PERM_RWX) $@ + }.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld +}; + # Old mechanism - still available: + push @m, +"\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs +} if $self->{PERL_SRC} && $self->{EXTRALIBS}; + push @m, "\n"; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('', "\n",@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(@m); + qq{ + +subdirs :: + $self->{NOECHO}cd $subdir && \$(MAKE) all \$(PASTHRU) + +}; +} + +=item subdirs (o) + +Defines targets to process subdirectories. + +=cut + +sub subdirs { +# --- Sub-directory Sections --- + my($self) = shift; + my(@m,$dir); + # 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 $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 = $Is_Win32 ? join(' ', <t\\*.t>) : 't/*.t'; + } + # 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) +"); + push(@m, map("\t$self->{NOECHO}cd $_ && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n", + @{$self->{DIR}})); + push(@m, "\t$self->{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('$(FULLPERL)', '$(TEST_FILES)')) if $tests; + push(@m, $self->test_via_script('$(FULLPERL)', '$(TEST_FILE)')) if -f "test.pl"; + push(@m, "\n"); + + push(@m, "testdb_dynamic :: pure_all\n"); + push(@m, $self->test_via_script('$(FULLPERL) $(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 (o) + +Helper method to write the test targets + +=cut + +sub test_via_harness { + my($self, $perl, $tests) = @_; + $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32; + "\t$perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n"; +} + +=item test_via_script (o) + +Other helper method for test. + +=cut + +sub test_via_script { + my($self, $perl, $script) = @_; + $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32; + qq{\t$perl}.q{ -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) }.qq{$script +}; +} + +=item tool_autosplit (o) + +Defines a simple perl call that runs autosplit. May be deprecated by +pm_to_blib soon. + +=cut + +sub tool_autosplit { +# --- Tool Sections --- + + my($self, %attribs) = @_; + my($asl) = ""; + $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN}; + q{ +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;}.$asl.q{autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;' +}; +} + +=item tools_other (o) + +Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in +the Makefile. Also defines the perl programs MKPATH, +WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL. + +=cut + +sub tools_other { + my($self) = shift; + my @m; + my $bin_sh = $Config{sh} || '/bin/sh'; + push @m, qq{ +SHELL = $bin_sh +}; + + for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) { + push @m, "$_ = $self->{$_}\n"; + } + + push @m, q{ +# The following is a portable way to say mkdir -p +# To see which directories are created, change the if 0 to if 1 +MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath + +# This helps us to minimize the effect of the .exists files A yet +# better solution would be to have a stable file in the perl +# distribution with a timestamp of zero. But this solution doesn't +# need any changes to the core distribution and works with older perls +EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime +}; + + + return join "", @m if $self->{PARENT}; + + push @m, q{ +# Here we warn users that an old packlist file was found somewhere, +# and that they should call some uninstall routine +WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \\ +-e 'print "WARNING: I have found an old package in\n";' \\ +-e 'print "\t$$ARGV[0].\n";' \\ +-e 'print "Please make sure the two installations are not conflicting\n";' + +UNINST=0 +VERBINST=1 + +MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ +-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');" + +DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \ +-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \ +-e 'print "=over 4";' \ +-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \ +-e 'print "=back";' + +UNINSTALL = $(PERL) -MExtUtils::Install \ +-e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \ +-e 'print " packlist above carefully.\n There may be errors. Remove the";' \ +-e 'print " appropriate files manually.\n Sorry for the inconveniences.\n"' +}; + + return join "", @m; +} + +=item tool_xsubpp (o) + +Determines typemaps, xsubpp version, prototype behaviour. + +=cut + +sub tool_xsubpp { + my($self) = shift; + return "" unless $self->needs_linking; + my($xsdir) = $self->catdir($self->{PERL_LIB},"ExtUtils"); + my(@tmdeps) = $self->catdir('$(XSUBPPDIR)','typemap'); + if( $self->{TYPEMAPS} ){ + my $typemap; + foreach $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} ); + } + + + my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,"xsubpp")); + + # What are the correct thresholds for version 1 && 2 Paul? + if ( $xsubpp_version > 1.923 ){ + $self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG}; + } else { + if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) { + print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp. + Your version of xsubpp is $xsubpp_version and cannot handle this. + Please upgrade to a more recent version of xsubpp. +}; + } else { + $self->{XSPROTOARG} = ""; + } + } + + $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp"; + + return qq{ +XSUBPPDIR = $xsdir +XSUBPP = \$(XSUBPPDIR)/$xsubpp +XSPROTOARG = $self->{XSPROTOARG} +XSUBPPDEPS = @tmdeps +XSUBPPARGS = @tmargs +}; +}; + +sub xsubpp_version +{ + my($self,$xsubpp) = @_; + return $Xsubpp_Version if defined $Xsubpp_Version; # global variable + + my ($version) ; + + # try to figure out the version number of the xsubpp on the system + + # first try the -v flag, introduced in 1.921 & 2.000a2 + + return "" unless $self->needs_linking; + + my $command = "$self->{PERL} -I$self->{PERL_LIB} $xsubpp -v 2>&1"; + print "Running $command\n" if $Verbose >= 2; + $version = `$command` ; + warn "Running '$command' exits with status " . ($?>>8) if $?; + chop $version ; + + return $Xsubpp_Version = $1 if $version =~ /^xsubpp version (.*)/ ; + + # nope, then try something else + + my $counter = '000'; + my ($file) = 'temp' ; + $counter++ while -e "$file$counter"; # don't overwrite anything + $file .= $counter; + + open(F, ">$file") or die "Cannot open file '$file': $!\n" ; + print F <<EOM ; +MODULE = fred PACKAGE = fred + +int +fred(a) + int a; +EOM + + close F ; + + $command = "$self->{PERL} $xsubpp $file 2>&1"; + print "Running $command\n" if $Verbose >= 2; + my $text = `$command` ; + warn "Running '$command' exits with status " . ($?>>8) if $?; + unlink $file ; + + # gets 1.2 -> 1.92 and 2.000a1 + return $Xsubpp_Version = $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/ ; + + # it is either 1.0 or 1.1 + return $Xsubpp_Version = 1.1 if $text =~ /^Warning: ignored semicolon/ ; + + # none of the above, so 1.0 + return $Xsubpp_Version = "1.0" ; +} + +=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, ' +#all :: config $(INST_PM) subdirs linkext manifypods +'; + + push @m, ' +all :: pure_all manifypods + '.$self->{NOECHO}.'$(NOOP) +' + unless $self->{SKIPHASH}{'all'}; + + push @m, ' +pure_all :: config pm_to_blib subdirs linkext + '.$self->{NOECHO}.'$(NOOP) + +subdirs :: $(MYEXTLIB) + '.$self->{NOECHO}.'$(NOOP) + +config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)/.exists + '.$self->{NOECHO}.'$(NOOP) + +config :: $(INST_ARCHAUTODIR)/.exists + '.$self->{NOECHO}.'$(NOOP) + +config :: $(INST_AUTODIR)/.exists + '.$self->{NOECHO}.'$(NOOP) +'; + + push @m, qq{ +config :: Version_check + $self->{NOECHO}\$(NOOP) + +} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; + + push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); + + if (%{$self->{MAN1PODS}}) { + push @m, qq[ +config :: \$(INST_MAN1DIR)/.exists + $self->{NOECHO}\$(NOOP) + +]; + push @m, $self->dir_target(qw[$(INST_MAN1DIR)]); + } + if (%{$self->{MAN3PODS}}) { + push @m, qq[ +config :: \$(INST_MAN3DIR)/.exists + $self->{NOECHO}\$(NOOP) + +]; + push @m, $self->dir_target(qw[$(INST_MAN3DIR)]); + } + + push @m, ' +$(O_FILES): $(H_FILES) +' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; + + push @m, q{ +help: + perldoc ExtUtils::MakeMaker +}; + + push @m, q{ +Version_check: + }.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + -MExtUtils::MakeMaker=Version_check \ + -e "Version_check('$(MM_VERSION)')" +}; + + join('',@m); +} + +=item writedoc + +Obsolete, depecated 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: + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && $(MV) $*.tc $@ +'; +} + +=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): + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c + $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c +'; +} + +=item perl_archive + +This is internal method that returns path to libperl.a equivalent +to be linked to dynamic extensions. UNIX does not have one but OS2 +and Win32 do. + +=cut + +sub perl_archive +{ + return ""; +} + +=item export_list + +This is internal method that returns name of a file that is +passed to linker to define symbols to be exported. +UNIX does not have one but OS2 and Win32 do. + +=cut + +sub export_list +{ + return ""; +} + + +1; + +=back + +=head1 SEE ALSO + +L<ExtUtils::MakeMaker> + +=cut + +__END__ diff --git a/contrib/perl5/lib/ExtUtils/MM_VMS.pm b/contrib/perl5/lib/ExtUtils/MM_VMS.pm new file mode 100644 index 0000000..d7e59c2 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/MM_VMS.pm @@ -0,0 +1,2391 @@ +# MM_VMS.pm +# MakeMaker default methods for VMS +# This package is inserted into @ISA of MakeMaker's MM before the +# built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS. +# +# Author: Charles Bailey bailey@genetics.upenn.edu + +package ExtUtils::MM_VMS; + +use Carp qw( &carp ); +use Config; +require Exporter; +use VMS::Filespec; +use File::Basename; + +use vars qw($Revision); +$Revision = '5.42 (31-Mar-1997)'; + +unshift @MM::ISA, 'ExtUtils::MM_VMS'; + +Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue'); + +=head1 NAME + +ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker + +=head1 SYNOPSIS + + use ExtUtils::MM_VMS; # 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. + +=head2 Methods always loaded + +=over + +=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. + +=cut + +sub eliminate_macros { + my($self,$path) = @_; + unless ($path) { + print "eliminate_macros('') = ||\n" if $Verbose >= 3; + return ''; + } + my($npath) = unixify($path); + my($complex) = 0; + my($head,$macro,$tail); + + # perform m##g in scalar context so it acts as an iterator + while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#g) { + if ($self->{$2}) { + ($head,$macro,$tail) = ($1,$2,$3); + if (ref $self->{$macro}) { + if (ref $self->{$macro} eq 'ARRAY') { + print "Note: expanded array macro \$($macro) in $path\n" if $Verbose; + $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#/$##; } + $npath = "$head$macro$tail"; + } + } + if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#g; } + print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3; + $npath; +} + +=item fixpath + +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. + +If optional second argument has a TRUE value, then the return string is +a VMS-syntax directory specification, if it is FALSE, the return string +is a VMS-syntax file specification, and if it is not specified, fixpath() +checks to see whether it matches the name of a directory in the current +default directory, and returns a directory or file specification accordingly. + +=cut + +sub fixpath { + my($self,$path,$force_path) = @_; + unless ($path) { + print "eliminate_macros('') = ||\n" if $Verbose >= 3; + return ''; + } + my($fixedpath,$prefix,$name); + + if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) { + if ($force_path or $path =~ /(?:DIR\)|\])$/) { + $fixedpath = vmspath($self->eliminate_macros($path)); + } + else { + $fixedpath = vmsify($self->eliminate_macros($path)); + } + } + elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) { + my($vmspre) = $self->eliminate_macros("\$($prefix)"); + # is it a dir or just a name? + $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? 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/; + print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3; + $fixedpath; +} + +=item catdir + +Concatenates a list of file specifications, and returns the result as a +VMS-syntax directory specification. + +=cut + +sub catdir { + my($self,@dirs) = @_; + my($dir) = pop @dirs; + @dirs = grep($_,@dirs); + my($rslt); + if (@dirs) { + my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); + my($spath,$sdir) = ($path,$dir); + $spath =~ s/.dir$//; $sdir =~ s/.dir$//; + $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/; + $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); + } + else { + if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; } + else { $rslt = vmspath($dir); } + } + print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; + $rslt; +} + +=item catfile + +Concatenates a list of file specifications, and returns the result as a +VMS-syntax directory specification. + +=cut + +sub catfile { + my($self,@files) = @_; + my($file) = pop @files; + @files = grep($_,@files); + my($rslt); + if (@files) { + my($path) = (@files == 1 ? $files[0] : $self->catdir(@files)); + my($spath) = $path; + $spath =~ s/.dir$//; + if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; } + else { + $rslt = $self->eliminate_macros($spath); + $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file)); + } + } + else { $rslt = vmsify($file); } + print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; + $rslt; +} + +=item wraplist + +Converts a list into a string wrapped at approximately 80 columns. + +=cut + +sub wraplist { + my($self) = shift; + my($line,$hlen) = ('',0); + my($word); + + foreach $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; +} + +=item curdir (override) + +Returns a string representing of the current directory. + +=cut + +sub curdir { + return '[]'; +} + +=item rootdir (override) + +Returns a string representing of the root directory. + +=cut + +sub rootdir { + return ''; +} + +=item updir (override) + +Returns a string representing of the parent directory. + +=cut + +sub updir { + return '[-]'; +} + +package ExtUtils::MM_VMS; + +sub ExtUtils::MM_VMS::ext; +sub ExtUtils::MM_VMS::guess_name; +sub ExtUtils::MM_VMS::find_perl; +sub ExtUtils::MM_VMS::path; +sub ExtUtils::MM_VMS::maybe_command; +sub ExtUtils::MM_VMS::maybe_command_in_dirs; +sub ExtUtils::MM_VMS::perl_script; +sub ExtUtils::MM_VMS::file_name_is_absolute; +sub ExtUtils::MM_VMS::replace_manpage_separator; +sub ExtUtils::MM_VMS::init_others; +sub ExtUtils::MM_VMS::constants; +sub ExtUtils::MM_VMS::cflags; +sub ExtUtils::MM_VMS::const_cccmd; +sub ExtUtils::MM_VMS::pm_to_blib; +sub ExtUtils::MM_VMS::tool_autosplit; +sub ExtUtils::MM_VMS::tool_xsubpp; +sub ExtUtils::MM_VMS::xsubpp_version; +sub ExtUtils::MM_VMS::tools_other; +sub ExtUtils::MM_VMS::dist; +sub ExtUtils::MM_VMS::c_o; +sub ExtUtils::MM_VMS::xs_c; +sub ExtUtils::MM_VMS::xs_o; +sub ExtUtils::MM_VMS::top_targets; +sub ExtUtils::MM_VMS::dlsyms; +sub ExtUtils::MM_VMS::dynamic_lib; +sub ExtUtils::MM_VMS::dynamic_bs; +sub ExtUtils::MM_VMS::static_lib; +sub ExtUtils::MM_VMS::manifypods; +sub ExtUtils::MM_VMS::processPL; +sub ExtUtils::MM_VMS::installbin; +sub ExtUtils::MM_VMS::subdir_x; +sub ExtUtils::MM_VMS::clean; +sub ExtUtils::MM_VMS::realclean; +sub ExtUtils::MM_VMS::dist_basics; +sub ExtUtils::MM_VMS::dist_core; +sub ExtUtils::MM_VMS::dist_dir; +sub ExtUtils::MM_VMS::dist_test; +sub ExtUtils::MM_VMS::install; +sub ExtUtils::MM_VMS::perldepend; +sub ExtUtils::MM_VMS::makefile; +sub ExtUtils::MM_VMS::test; +sub ExtUtils::MM_VMS::test_via_harness; +sub ExtUtils::MM_VMS::test_via_script; +sub ExtUtils::MM_VMS::makeaperl; +sub ExtUtils::MM_VMS::ext; +sub ExtUtils::MM_VMS::nicetext; + +#use SelfLoader; +sub AUTOLOAD { + my $code; + if (defined fileno(DATA)) { + my $fh = select DATA; + my $o = $/; # For future reads from the file. + $/ = "\n__END__\n"; + $code = <DATA>; + $/ = $o; + select $fh; + close DATA; + eval $code; + if ($@) { + $@ =~ s/ at .*\n//; + Carp::croak $@; + } + } else { + warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; + } + defined(&$AUTOLOAD) or die "Myloader inconsistency error"; + goto &$AUTOLOAD; +} + +1; + +#__DATA__ + + +# This isn't really an override. It's just here because ExtUtils::MM_VMS +# appears in @MM::ISA before ExtUtils::Liblist, 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. +sub ext { + ExtUtils::Liblist::ext(@_); +} + +=back + +=head2 SelfLoaded 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 + +=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,$pm); + 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 = map { s/.pm$//; $_ } glob('*.pm'); + if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; } + elsif (@pm) { + %xs = map { s/.xs$//; ($_,1) } glob('*.xs'); + if (%xs) { foreach $pm (@pm) { $defpm = $pm, last if exists $xs{$pm}; } } + } + } + if (open(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($name,$dir,$vmsfile,@sdirs,@snames,@cand); + my($inabs) = 0; + # 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; + # Image names containing Perl version use '_' instead of '.' under VMS + foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; } + 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 $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 $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; } + $inabs++; # Should happen above in next $dir, but just in case . . . + } + foreach $name (@snames){ + if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); } + else { push(@cand,$self->fixpath($name,0)); } + } + } + foreach $name (@cand) { + print "Checking $name\n" if ($trace >= 2); + # If it looks like a potential command, try it without the MCR + if ($name =~ /^[\w\-\$]+$/ && + `$name -e "require $ver; print ""VER_OK\n"""` =~ /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); + if (`MCR $vmsfile -e "require $ver; print ""VER_OK\n"""` =~ /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 path (override) + +Translate logical name DCL$PATH as a searchlist, rather than trying +to C<split> string value of C<$ENV{'PATH'}>. + +=cut + +sub path { + my(@dirs,$dir,$i); + while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } + @dirs; +} + +=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'); + my($dir,$ext); + if ($file !~ m![/:>\]]!) { + for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) { + $dir = $ENV{"DCL\$PATH;$i"}; + $dir .= ':' unless $dir =~ m%[\]:]$%; + push(@dirs,$dir); + } + push(@dirs,'Sys$System:'); + foreach $dir (@dirs) { + my $sysfile = "$dir$file"; + foreach $ext (@exts) { + return $file if -x "$sysfile$ext" && ! -d _; + } + } + } + return 0; +} + +=item maybe_command_in_dirs (override) + +Uses DCL argument quoting on test command line. + +=cut + +sub maybe_command_in_dirs { # $ver is optional argument if looking for perl + my($self, $names, $dirs, $trace, $ver) = @_; + my($name, $dir); + foreach $dir (@$dirs){ + next unless defined $dir; # $self->{PERL_SRC} may be undefined + foreach $name (@$names){ + my($abs,$tryabs); + if ($self->file_name_is_absolute($name)) { + $abs = $name; + } else { + $abs = $self->catfile($dir, $name); + } + print "Checking $abs for $name\n" if ($trace >= 2); + next unless $tryabs = $self->maybe_command($abs); + print "Substituting $tryabs instead of $abs\n" + if ($trace >= 2 and $tryabs ne $abs); + $abs = $tryabs; + if (defined $ver) { + print "Executing $abs\n" if ($trace >= 2); + if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) { + print "Using $abs\n" if $trace; + return $abs; + } + } else { # Do not look for perl + return $abs; + } + } + } +} + +=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 file_name_is_absolute (override) + +Checks for VMS directory spec as well as Unix separators. + +=cut + +sub file_name_is_absolute { + my($self,$file) = @_; + # If it's a logical name, expand it. + $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file}; + $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/; +} + +=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_others (override) + +Provide VMS-specific forms of various utility commands, then hand +off to the default MM_Unix method. + +=cut + +sub init_others { + my($self) = @_; + + $self->{NOOP} = 'Continue'; + $self->{FIRST_MAKEFILE} ||= 'Descrip.MMS'; + $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS'; + $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE}; + $self->{NOECHO} ||= '@ '; + $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"'; + $self->{RM_RF} = '$(PERL) "-I$(PERL_LIB)" -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"'; + $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"'; + $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"'; # expect Unix syntax from MakeMaker + $self->{CP} = 'Copy/NoConfirm'; + $self->{MV} = 'Rename/NoConfirm'; + $self->{UMASK_NULL} = '! '; + &ExtUtils::MM_Unix::init_others; +} + +=item constants (override) + +Fixes up numerous file and directory macros to insure VMS syntax +regardless of input syntax. Also adds a few VMS-specific macros +and makes lists of files comma-separated. + +=cut + +sub constants { + my($self) = @_; + my(@m,$def,$macro); + + if ($self->{DEFINE} ne '') { + my(@defs) = split(/\s+/,$self->{DEFINE}); + foreach $def (@defs) { + next unless $def; + if ($def =~ s/^-D//) { # If it was a Unix-style definition + $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 = + } + } + $self->{DEFINE} = join ',',@defs; + } + + 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}))); + + + # Fix up directory specs + $self->{ROOTEXT} = $self->{ROOTEXT} ? $self->fixpath($self->{ROOTEXT},1) + : '[]'; + foreach $macro ( qw [ + INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB INST_EXE INSTALLPRIVLIB + INSTALLARCHLIB INSTALLSCRIPT INSTALLBIN PERL_LIB PERL_ARCHLIB + PERL_INC PERL_SRC FULLEXT INST_MAN1DIR INSTALLMAN1DIR + INST_MAN3DIR INSTALLMAN3DIR INSTALLSITELIB INSTALLSITEARCH + SITELIBEXP SITEARCHEXP ] ) { + next unless defined $self->{$macro}; + $self->{$macro} = $self->fixpath($self->{$macro},1); + } + $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC},q(VMS)) + if ($self->{PERL_SRC}); + + + + # Fix up file specs + foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) { + next unless defined $self->{$macro}; + $self->{$macro} = $self->fixpath($self->{$macro},0); + } + + foreach $macro (qw/ + AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM XS_VERSION + INST_BIN INST_EXE INST_LIB INST_ARCHLIB INST_SCRIPT PREFIX + INSTALLDIRS INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB + INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB + PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB + FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS + PERL_INC PERL FULLPERL + / ) { + next unless defined $self->{$macro}; + push @m, "$macro = $self->{$macro}\n"; + } + + + push @m, q[ +VERSION_MACRO = VERSION +DEFINE_VERSION = "$(VERSION_MACRO)=""$(VERSION)""" +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = "$(XS_VERSION_MACRO)=""$(XS_VERSION)""" + +MAKEMAKER = ],$self->catfile($self->{PERL_LIB},'ExtUtils','MakeMaker.pm'),qq[ +MM_VERSION = $ExtUtils::MakeMaker::VERSION +MM_REVISION = $ExtUtils::MakeMaker::Revision +MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision + +# FULLEXT = Pathname for extension directory (eg DBD/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +]; + + for $tmp (qw/ + FULLEXT VERSION_FROM OBJECT LDFROM + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = ",$self->fixpath($self->{$tmp},0),"\n"; + } + + for $tmp (qw/ + BASEEXT PARENT_NAME DLBASE INC DEFINE LINKTYPE + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + for $tmp (qw/ XS MAN1PODS MAN3PODS PM /) { + next unless defined $self->{$tmp}; + my(%tmp,$key); + for $key (keys %{$self->{$tmp}}) { + $tmp{$self->fixpath($key,0)} = $self->fixpath($self->{$tmp}{$key},0); + } + $self->{$tmp} = \%tmp; + } + + for $tmp (qw/ C O_FILES H /) { + next unless defined $self->{$tmp}; + my(@tmp,$val); + for $val (@{$self->{$tmp}}) { + push(@tmp,$self->fixpath($val,0)); + } + $self->{$tmp} = \@tmp; + } + + 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}}),' + +'; + + for $tmp (qw/ + INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT + /) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + +push @m," +.SUFFIXES : +.SUFFIXES : \$(OBJ_EXT) .c .cpp .cxx .xs + +# Here is the Config.pm that we are using/depend on +CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM) + +# Where to put things: +INST_LIBDIR = $self->{INST_LIBDIR} +INST_ARCHLIBDIR = $self->{INST_ARCHLIBDIR} + +INST_AUTODIR = $self->{INST_AUTODIR} +INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR} +"; + + if ($self->has_link_code()) { + push @m,' +INST_STATIC = $(INST_ARCHAUTODIR)$(BASEEXT)$(LIB_EXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT) +INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs +'; + } else { + my $shr = $Config{'dbgprefix'} . 'PERLSHR'; + push @m,' +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = +EXPORT_LIST = $(BASEEXT).opt +PERL_ARCHIVE = ',($ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"),' +'; + } + + $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ]; + $self->{PM_TO_BLIB} = [ %{$self->{PM}} ]; + push @m,' +TO_INST_PM = ',$self->wraplist(@{$self->{TO_INST_PM}}),' + +PM_TO_BLIB = ',$self->wraplist(@{$self->{PM_TO_BLIB}}),' +'; + + join('',@m); +} + +=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') { $flagincstr .= ',' . $self->fixpath($def,1); } + else { $undefstr .= qq["$def",]; } + } + } + if (length $quals and $quals !~ m!/!) { + warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n"; + $quals = ''; + } + 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} + if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) { + $quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') . + "\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3"; + } + else { + $quals .= '/Define=(' . ($self->{DEFINE} ? "$self->{DEFINE}," : '') . + '$(DEFINE_VERSION),$(XS_DEFINE_VERSION))'; + } + + $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb"; +# This whole section is commented out, since I don't think it's necessary (or applicable) +# if ($libperl =~ s/^$Config{'dbgprefix'}//) { $libperl =~ s/perl([^Dd]*)\./perld$1./; } +# if ($libperl =~ /libperl(\w+)\./i) { +# my($type) = uc $1; +# my(%map) = ( 'D' => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY', +# 'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY', +# 'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' ); +# my($add) = join(',', grep { $quals !~ /\b$_\b/ } split(/,/,$map{$type})); +# $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$add):i if $add; +# $self->{PERLTYPE} ||= $type; +# } + + # 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)"; + $self->{CCFLAGS} = $quals; + + $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'}; + if ($self->{OPTIMIZE} !~ m!/!) { + if ($self->{OPTIMIZE} =~ m!\b-g\b!) { $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} +SPLIT = +LARGE = +}; +} + +=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{'arch'} 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 pm_to_blib (override) + +DCL I<still> accepts a maximum of 255 characters on a command +line, so we write the (potentially) long list of file names +to a temp file, then persuade Perl to read it instead of the +command line to find args. + +=cut + +sub pm_to_blib { + my($self) = @_; + my($line,$from,$to,@m); + my($autodir) = $self->catdir('$(INST_LIB)','auto'); + my(@files) = @{$self->{PM_TO_BLIB}}; + + push @m, q{ + +# 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) + +# As always, keep under DCL's 255-char limit +pm_to_blib.ts : $(TO_INST_PM) + $(NOECHO) $(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp +}; + + $line = ''; # avoid uninitialized var warning + while ($from = shift(@files),$to = shift(@files)) { + $line .= " $from $to"; + if (length($line) > 128) { + push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n"); + $line = ''; + } + } + push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line; + + push(@m,q[ $(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[')" <.MM_tmp]); + push(@m,qq[ + \$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; + \$(NOECHO) \$(TOUCH) pm_to_blib.ts +]); + + join('',@m); +} + +=item tool_autosplit (override) + +Use VMS-style quoting on command line. + +=cut + +sub tool_autosplit{ + my($self, %attribs) = @_; + my($asl) = ""; + $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN}; + q{ +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use AutoSplit;}.$asl.q{ AutoSplit::autosplit($ARGV[0], $ARGV[1], 0, 1, 1) ;" +}; +} + +=item tool_sxubpp (override) + +Use VMS-style quoting on xsubpp command line. + +=cut + +sub tool_xsubpp { + my($self) = @_; + return '' unless $self->needs_linking; + my($xsdir) = $self->catdir($self->{PERL_LIB},'ExtUtils'); + # drop back to old location if xsubpp is not in new location yet + $xsdir = $self->catdir($self->{PERL_SRC},'ext') unless (-f $self->catfile($xsdir,'xsubpp')); + my(@tmdeps) = '$(XSUBPPDIR)typemap'; + if( $self->{TYPEMAPS} ){ + my $typemap; + foreach $typemap (@{$self->{TYPEMAPS}}){ + if( ! -f $typemap ){ + warn "Typemap $typemap not found.\n"; + } + else{ + push(@tmdeps, $self->fixpath($typemap,0)); + } + } + } + push(@tmdeps, "typemap") if -f "typemap"; + my(@tmargs) = map("-typemap $_", @tmdeps); + if( exists $self->{XSOPT} ){ + unshift( @tmargs, $self->{XSOPT} ); + } + + my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,'xsubpp')); + + # What are the correct thresholds for version 1 && 2 Paul? + if ( $xsubpp_version > 1.923 ){ + $self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG}; + } else { + if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) { + print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp. + Your version of xsubpp is $xsubpp_version and cannot handle this. + Please upgrade to a more recent version of xsubpp. +}; + } else { + $self->{XSPROTOARG} = ""; + } + } + + " +XSUBPPDIR = $xsdir +XSUBPP = \$(PERL) \"-I\$(PERL_ARCHLIB)\" \"-I\$(PERL_LIB)\" \$(XSUBPPDIR)xsubpp +XSPROTOARG = $self->{XSPROTOARG} +XSUBPPDEPS = @tmdeps +XSUBPPARGS = @tmargs +"; +} + +=item xsubpp_version (override) + +Test xsubpp exit status according to VMS rules ($sts & 1 ==E<gt> good) +rather than Unix rules ($sts == 0 ==E<gt> good). + +=cut + +sub xsubpp_version +{ + my($self,$xsubpp) = @_; + my ($version) ; + return '' unless $self->needs_linking; + + # try to figure out the version number of the xsubpp on the system + + # first try the -v flag, introduced in 1.921 & 2.000a2 + + my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v"; + print "Running: $command\n" if $Verbose; + $version = `$command` ; + if ($?) { + use vmsish 'status'; + warn "Running '$command' exits with status $?"; + } + chop $version ; + + return $1 if $version =~ /^xsubpp version (.*)/ ; + + # nope, then try something else + + my $counter = '000'; + my ($file) = 'temp' ; + $counter++ while -e "$file$counter"; # don't overwrite anything + $file .= $counter; + + local(*F); + open(F, ">$file") or die "Cannot open file '$file': $!\n" ; + print F <<EOM ; +MODULE = fred PACKAGE = fred + +int +fred(a) + int a; +EOM + + close F ; + + $command = "$self->{PERL} $xsubpp $file"; + print "Running: $command\n" if $Verbose; + my $text = `$command` ; + if ($?) { + use vmsish 'status'; + warn "Running '$command' exits with status $?"; + } + unlink $file ; + + # gets 1.2 -> 1.92 and 2.000a1 + return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/ ; + + # it is either 1.0 or 1.1 + return 1.1 if $text =~ /^Warning: ignored semicolon/ ; + + # none of the above, so 1.0 + return "1.0" ; +} + +=item tools_other (override) + +Adds a few MM[SK] macros, and shortens some the installatin commands, +in order to stay under DCL's 255-character limit. 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 tools_other { + my($self) = @_; + qq! +# Assumes \$(MMS) invokes MMS or MMK +# (It is assumed in some cases later that the default makefile name +# (Descrip.MMS for MM[SK]) is used.) +USEMAKEFILE = /Descrip= +USEMACROS = /Macro=( +MACROEND = ) +MAKEFILE = Descrip.MMS +SHELL = Posix +TOUCH = $self->{TOUCH} +CHMOD = $self->{CHMOD} +CP = $self->{CP} +MV = $self->{MV} +RM_F = $self->{RM_F} +RM_RF = $self->{RM_RF} +SAY = Write Sys\$Output +UMASK_NULL = $self->{UMASK_NULL} +NOOP = $self->{NOOP} +NOECHO = $self->{NOECHO} +MKPATH = Create/Directory +EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])" +!. ($self->{PARENT} ? '' : +qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}" +MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);" +DOC_INSTALL = \$(PERL) -e "\@ARGV=split(/\\|/,<STDIN>);print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]" +UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);" +!); +} + +=item dist (override) + +Provide VMSish defaults for some values, then hand off to +default MM_Unix method. + +=cut + +sub dist { + my($self, %attribs) = @_; + $attribs{VERSION} ||= $self->{VERSION_SYM}; + $attribs{NAME} ||= $self->{DISTNAME}; + $attribs{ZIPFLAGS} ||= '-Vu'; + $attribs{COMPRESS} ||= 'gzip'; + $attribs{SUFFIX} ||= '-gz'; + $attribs{SHAR} ||= 'vms_share'; + $attribs{DIST_DEFAULT} ||= 'zipdist'; + + # Sanitize these for use in $(DISTVNAME) filespec + $attribs{VERSION} =~ s/[^\w\$]/_/g; + $attribs{NAME} =~ s/[^\w\$]/_/g; + + return ExtUtils::MM_Unix::dist($self,%attribs); +} + +=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 : + $(XSUBPP) $(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) : + $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c +'; +} + +=item top_targets (override) + +Use VMS quoting on command line for Version_check. + +=cut + +sub top_targets { + my($self) = shift; + my(@m); + push @m, ' +all :: pure_all manifypods + $(NOECHO) $(NOOP) + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(MAKEFILE) $(INST_LIBDIR).exists + $(NOECHO) $(NOOP) + +config :: $(INST_ARCHAUTODIR).exists + $(NOECHO) $(NOOP) + +config :: $(INST_AUTODIR).exists + $(NOECHO) $(NOOP) +'; + + push @m, q{ +config :: Version_check + $(NOECHO) $(NOOP) + +} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; + + + push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); + if (%{$self->{MAN1PODS}}) { + push @m, q[ +config :: $(INST_MAN1DIR).exists + $(NOECHO) $(NOOP) +]; + push @m, $self->dir_target(qw[$(INST_MAN1DIR)]); + } + if (%{$self->{MAN3PODS}}) { + push @m, q[ +config :: $(INST_MAN3DIR).exists + $(NOECHO) $(NOOP) +]; + push @m, $self->dir_target(qw[$(INST_MAN3DIR)]); + } + + push @m, ' +$(O_FILES) : $(H_FILES) +' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; + + push @m, q{ +help : + perldoc ExtUtils::MakeMaker +}; + + push @m, q{ +Version_check : + $(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" - + "-MExtUtils::MakeMaker=Version_check" -e "&Version_check('$(MM_VERSION)')" +}; + + join('',@m); +} + +=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(@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 + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" - + ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ], + neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')" + $(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET) +'); + + if (length $self->{LDLOADLIBS}) { + my($lib); my($line) = ''; + foreach $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).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) 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 +'; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('',@m); +} + +=item dynamic_bs (override) + +Use VMS-style quoting on Mkbootstrap command line. + +=cut + +sub dynamic_bs { + my($self, %attribs) = @_; + return ' +BOOTSTRAP = +' unless $self->has_link_code(); + ' +BOOTSTRAP = '."$self->{BASEEXT}.bs".' + +# As MakeMaker 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) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists + $(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))" + $(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" - + -e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');" + $(NOECHO) $(TOUCH) $(MMS$TARGET) + +$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists + $(NOECHO) $(RM_RF) $(INST_BOOT) + - $(CP) $(BOOTSTRAP) $(INST_BOOT) +'; +} + +=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).exists + +$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) +'; + # If this extension has it's 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 "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n"); + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('',@m); +} + + +=item manifypods (override) + +Use VMS-style quoting on command line, and VMS logical name +to specify fallback location at build time if we can't find pod2man. + +=cut + + +sub manifypods { + my($self, %attribs) = @_; + return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}}; + my($dist); + my($pod2man_exe); + if (defined $self->{PERL_SRC}) { + $pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man'); + } else { + $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man'); + } + if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) { + # No pod2man but some MAN3PODS to be installed + print <<END; + +Warning: I could not locate your pod2man program. As a last choice, + I will look for the file to which the logical name POD2MAN + points when MMK is invoked. + +END + $pod2man_exe = "pod2man"; + } + my(@m); + push @m, +qq[POD2MAN_EXE = $pod2man_exe\n], +q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" - +-e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}" +]; + push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n"; + if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) { + my($pod); + foreach $pod (sort keys %{$self->{MAN1PODS}}) { + push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ]; + push @m, "$pod $self->{MAN1PODS}{$pod}\n"; + } + foreach $pod (sort keys %{$self->{MAN3PODS}}) { + push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ]; + push @m, "$pod $self->{MAN3PODS}{$pod}\n"; + } + } + join('', @m); +} + +=item processPL (override) + +Use VMS-style quoting on command line. + +=cut + +sub processPL { + my($self) = @_; + return "" unless $self->{PL_FILES}; + my(@m, $plfile); + foreach $plfile (sort keys %{$self->{PL_FILES}}) { + my $vmsplfile = vmsify($plfile); + my $vmsfile = vmsify($self->{PL_FILES}->{$plfile}); + push @m, " +all :: $vmsfile + \$(NOECHO) \$(NOOP) + +$vmsfile :: $vmsplfile +",' $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile +"; + } + join "", @m; +} + +=item installbin (override) + +Stay under DCL's 255 character command line limit once again by +splitting potentially long list of files across multiple lines +in C<realclean> target. + +=cut + +sub installbin { + my($self) = @_; + return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY"; + return '' unless @{$self->{EXE_FILES}}; + my(@m, $from, $to, %fromto, @to, $line); + my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}}; + for $from (@exefiles) { + my($path) = '$(INST_SCRIPT)' . basename($from); + local($_) = $path; # backward compatibility + $to = $self->libscan($path); + print "libscan($from) => '$to'\n" if ($Verbose >=2); + $fromto{$from} = vmsify($to); + } + @to = values %fromto; + push @m, " +EXE_FILES = @exefiles + +all :: @to + \$(NOECHO) \$(NOOP) + +realclean :: +"; + $line = ''; #avoid unitialized var warning + foreach $to (@to) { + if (length($line) + length($to) > 80) { + push @m, "\t\$(RM_F) $line\n"; + $line = $to; + } + else { $line .= " $to"; } + } + push @m, "\t\$(RM_F) $line\n\n" if $line; + + while (($from,$to) = each %fromto) { + last unless defined $from; + my $todir; + if ($to =~ m#[/>:\]]#) { $todir = dirname($to); } + else { ($todir = $to) =~ s/[^\)]+$//; } + $todir = $self->fixpath($todir,1); + push @m, " +$to : $from \$(MAKEFILE) ${todir}.exists + \$(CP) $from $to + +", $self->dir_target($todir); + } + join "", @m; +} + +=item subdir_x (override) + +Use VMS commands to change default directory. + +=cut + +sub subdir_x { + my($self, $subdir) = @_; + my(@m,$key); + $subdir = $self->fixpath($subdir,1); + push @m, ' + +subdirs :: + olddef = F$Environment("Default") + Set Default ',$subdir,' + - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND) + Set Default \'olddef\' +'; + join('',@m); +} + +=item clean (override) + +Split potentially long list of files across multiple commands (in +order to stay under the magic command line limit). Also use MM[SK] +commands for handling subdirectories. + +=cut + +sub clean { + my($self, %attribs) = @_; + my(@m,$dir); + push @m, ' +# Delete temporary files but do not touch installed files. We don\'t delete +# the Descrip.MMS here so that a later make realclean still has it to use. +clean :: +'; + foreach $dir (@{$self->{DIR}}) { # clean subdirectories first + my($vmsdir) = $self->fixpath($dir,1); + push( @m, ' If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t", + '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n"); + } + push @m, ' $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp +'; + + my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files + # Unlink realclean, $attribs{FILES} is a string here; it may contain + # a list or a macro that expands to a list. + if ($attribs{FILES}) { + my($word,$key,@filist); + if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; } + else { @filist = split /\s+/, $attribs{FILES}; } + foreach $word (@filist) { + if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') { + push(@otherfiles, @{$self->{$key}}); + } + else { push(@otherfiles, $word); } + } + } + push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]); + push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all')); + my($file,$line); + $line = ''; #avoid unitialized var warning + # Occasionally files are repeated several times from different sources + { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; } + + foreach $file (@otherfiles) { + $file = $self->fixpath($file); + if (length($line) + length($file) > 80) { + push @m, "\t\$(RM_RF) $line\n"; + $line = "$file"; + } + else { $line .= " $file"; } + } + push @m, "\t\$(RM_RF) $line\n" if $line; + push(@m, " $attribs{POSTOP}\n") if $attribs{POSTOP}; + join('', @m); +} + +=item realclean (override) + +Guess what we're working around? Also, use MM[SK] for subdirectories. + +=cut + +sub realclean { + my($self, %attribs) = @_; + my(@m); + push(@m,' +# Delete temporary files (via clean) and also delete installed files +realclean :: clean +'); + foreach(@{$self->{DIR}}){ + my($vmsdir) = $self->fixpath($_,1); + push(@m, ' If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t", + '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n"); + } + push @m,' $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR) +'; + # We can't expand several of the MMS macros here, since they don't have + # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a + # combination of macros). In order to stay below DCL's 255 char limit, + # we put only 2 on a line. + my($file,$line,$fcnt); + my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old }; + if ($self->has_link_code) { + push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) }); + } + push(@files, values %{$self->{PM}}); + $line = ''; #avoid unitialized var warning + # Occasionally files are repeated several times from different sources + { my(%f) = map { ($_,1) } @files; @files = keys %f; } + foreach $file (@files) { + $file = $self->fixpath($file); + if (length($line) + length($file) > 80 || ++$fcnt >= 2) { + push @m, "\t\$(RM_F) $line\n"; + $line = "$file"; + $fcnt = 0; + } + else { $line .= " $file"; } + } + push @m, "\t\$(RM_F) $line\n" if $line; + if ($attribs{FILES}) { + my($word,$key,@filist,@allfiles); + if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; } + else { @filist = split /\s+/, $attribs{FILES}; } + foreach $word (@filist) { + if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') { + push(@allfiles, @{$self->{$key}}); + } + else { push(@allfiles, $word); } + } + $line = ''; + # Occasionally files are repeated several times from different sources + { my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; } + foreach $file (@allfiles) { + $file = $self->fixpath($file); + if (length($line) + length($file) > 80) { + push @m, "\t\$(RM_RF) $line\n"; + $line = "$file"; + } + else { $line .= " $file"; } + } + push @m, "\t\$(RM_RF) $line\n" if $line; + } + push(@m, " $attribs{POSTOP}\n") if $attribs{POSTOP}; + join('', @m); +} + +=item dist_basics (override) + +Use VMS-style quoting on command line. + +=cut + +sub dist_basics { + my($self) = @_; +' +distclean :: realclean distcheck + $(NOECHO) $(NOOP) + +distcheck : + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()" + +skipcheck : + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()" + +manifest : + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()" +'; +} + +=item dist_core (override) + +Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>, +so C<shdist> target actions are VMS-specific. + +=cut + +sub dist_core { + my($self) = @_; +q[ +dist : $(DIST_DEFAULT) + $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')" + +zipdist : $(DISTVNAME).zip + $(NOECHO) $(NOOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*; + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)] + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +shdist : distdir + $(PREOP) + $(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share + $(RM_RF) $(DISTVNAME) + $(POSTOP) +]; +} + +=item dist_dir (override) + +Use VMS-style quoting on command line. + +=cut + +sub dist_dir { + my($self) = @_; +q{ +distdir : + $(RM_RF) $(DISTVNAME) + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\ + -e "manicopy(maniread(),'$(DISTVNAME)','$(DIST_CP)');" +}; +} + +=item dist_test (override) + +Use VMS commands to change default directory, and use VMS-style +quoting on command line. + +=cut + +sub dist_test { + my($self) = @_; +q{ +disttest : distdir + startdir = F$Environment("Default") + Set Default [.$(DISTVNAME)] + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL + $(MMS)$(MMSQUALIFIERS) + $(MMS)$(MMSQUALIFIERS) test + Set Default 'startdir' +}; +} + +# --- 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,@docfiles); + + if ($self->{EXE_FILES}) { + my($line,$file) = ('',''); + foreach $file (@{$self->{EXE_FILES}}) { + $line .= "$file "; + if (length($line) > 128) { + push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]); + $line = ''; + } + } + push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line; + } + + 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) + +install_ :: install_site + $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" + +pure_install :: pure_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +doc_install :: doc_$(INSTALLDIRS)_install + $(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod" + +pure__install : pure_site_install + $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" + +doc__install : doc_site_install + $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" + +# This hack brought to you by DCL's 255-character command line limit +pure_perl_install :: + $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp + $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp + $(MOD_INSTALL) <.MM_tmp + $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; + $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ + +# Likewise +pure_site_install :: + $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp + $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp + $(MOD_INSTALL) <.MM_tmp + $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; + $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ + +# Ditto +doc_perl_install :: + $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp + $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp +],@docfiles, +q% $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp + $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp + $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp + $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp + $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[ + $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp; + +# And again +doc_site_install :: + $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp + $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp +],@docfiles, +q% $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp + $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp + $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp + $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp + $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[ + $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp; + +]; + + push @m, q[ +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + $(NOECHO) $(NOOP) + +uninstall_from_perldirs :: + $(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ + $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes." + $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove" + $(NOECHO) $(SAY) "the appropriate files. Sorry for the inconvenience." + +uninstall_from_sitedirs :: + $(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",q[ + $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes." + $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove" + $(NOECHO) $(SAY) "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, $(PERL_INC)av.h +$(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h, $(PERL_INC)form.h +$(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h, $(PERL_INC)keywords.h +$(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h +$(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h +$(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h +$(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h +$(OBJECT) : $(PERL_INC)iperlsys.h + +' if $self->{OBJECT}; + + if ($self->{PERL_SRC}) { + my(@macros); + my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)'; + push(@macros,'__AXP__=1') if $Config{'arch'} 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 + +$(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 makefile (override) + +Use VMS commands and quoting. + +=cut + +sub makefile { + my($self) = @_; + my(@m,@cmd); + # 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. + push @m, q[ +$(OBJECT) : $(FIRST_MAKEFILE) +] if $self->{OBJECT}; + + push @m,q[ +# We take a very conservative approach here, but it\'s worth it. +# We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping. +$(MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)" + $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..." + - $(MV) $(MAKEFILE) $(MAKEFILE)_old + - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[ + $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt." + $(NOECHO) $(SAY) "Please run $(MMS) to build the extension." +]; + + join('',@m); +} + +=item test (override) + +Use VMS commands for handling subdirectories. + +=cut + +sub test { + my($self, %attribs) = @_; + my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : ''); + my(@m); + push @m," +TEST_VERBOSE = 0 +TEST_TYPE = test_\$(LINKTYPE) +TEST_FILE = test.pl +TESTDB_SW = -d + +test :: \$(TEST_TYPE) + \$(NOECHO) \$(NOOP) + +testdb :: testdb_\$(LINKTYPE) + \$(NOECHO) \$(NOOP) + +"; + foreach(@{$self->{DIR}}){ + my($vmsdir) = $self->fixpath($_,1); + push(@m, ' If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'", + '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n"); + } + push(@m, "\t\$(NOECHO) \$(SAY) \"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('$(FULLPERL)', $tests)) if $tests; + push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl"; + push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl"); + push(@m, "\n"); + + push(@m, "testdb_dynamic :: pure_all\n"); + push(@m, $self->test_via_script('$(FULLPERL) "$(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)', $tests)) if $tests; + push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) 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\t\$(NOECHO) \$(NOOP)\n\n"; + push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n"; + } + + join('',@m); +} + +=item test_via_harness (override) + +Use VMS-style quoting on command line. + +=cut + +sub test_via_harness { + my($self,$perl,$tests) = @_; + " $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\'."\n\t". + '-e "use Test::Harness qw(&runtests $verbose); $verbose=$(TEST_VERBOSE); runtests @ARGV;" \\'."\n\t$tests\n"; +} + +=item test_via_script (override) + +Use VMS-style quoting on command line. + +=cut + +sub test_via_script { + my($self,$perl,$script) = @_; + " $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.' +'; +} + +=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 + +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 +"; + return join '', @m if $self->{PARENT}; + + my($dir) = join ":", @{$self->{DIR}}; + + unless ($self->{MAKEAPERL}) { + push @m, q{ +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) + $(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)" + $(NOECHO) $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ + Makefile.PL DIR=}, $dir, q{ \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 + +$(MAP_TARGET) :: $(MAKE_APERL_FILE) + $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET) +}; + push @m, map( " \\\n\t\t$_", @ARGV ); + push @m, "\n"; + + return join '', @m; + } + + + my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir); + + # 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); + $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 $incl; + my $xx; + + ($xx = $File::Find::name) =~ s,.*?/auto/,,; + $xx =~ s,/?$_,,; + $xx =~ s,/,::,g; + + # Throw away anything not explicitly marked for inclusion. + # DynaLoader is implied. + foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){ + if( $xx eq $incl ){ + $found++; + last; + } + } + return unless $found; + } + elsif( exists $self->{EXCLUDE_EXT} ){ + my $excl; + my $xx; + + ($xx = $File::Find::name) =~ s,.*?/auto/,,; + $xx =~ s,/?$_,,; + $xx =~ s,/,::,g; + + # Throw away anything explicitly marked for exclusion + foreach $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 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/; + if (-f $extralibs ) { + open LIST,$extralibs or warn $!,next; + push @$extra, <LIST>; + close LIST; + } + if (-f $extopt) { + open OPT,$extopt or die $!; + while (<OPT>) { + next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/; + # ExtUtils::Miniperl expects Unix paths + (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g; + push @staticpkgs,$pkg; + } + push @staticopts, $extopt; + } + } + + $target = "Perl$Config{'exe_ext'}" unless $target; + ($shrtarget,$targdir) = fileparse($target); + $shrtarget =~ s/^([^.]*)/$1Shr/; + $shrtarget = $targdir . $shrtarget; + $target = "Perlshr.$Config{'dlext'}" unless $target; + $tmp = "[]" unless $tmp; + $tmp = $self->fixpath($tmp,1); + if (@$extra) { + $extralist = join(' ',@$extra); + $extralist =~ s/[,\s\n]+/, /g; + } + else { $extralist = ''; } + 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}) : '',' +# We use the linker options files created with each extension, rather than +#specifying the object files directly on the command line. +MAP_STATIC = ',@staticopts ? join(' ', @staticopts) : '',' +MAP_OPTS = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : ''," +MAP_EXTRA = $extralist +MAP_LIBPERL = ",$self->fixpath($libperl,0),' +'; + + + push @m,' +$(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",' + $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",' +$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",' + $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option + $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say" + $(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" + $(NOECHO) $(SAY) "To remove the intermediate files, say + $(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean" +'; + push @m,' +',"${tmp}perlmain.c",' : $(MAKEFILE) + $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET) +'; + + push @m, q[ +# More from the 255-char line length limit +doc_inst_perl : + $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp + $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp + $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp + $(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp + $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[ + $(NOECHO) Delete/NoLog/NoConfirm .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) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE) + \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET) +"; + + join '', @m; +} + +# --- Output postprocessing section --- + +=item nicetext (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 nicetext { + + my($self,$text) = @_; + $text =~ s/([^\s:])(:+\s)/$1 $2/gs; + $text; +} + +1; + +=back + +=cut + +__END__ + diff --git a/contrib/perl5/lib/ExtUtils/MM_Win32.pm b/contrib/perl5/lib/ExtUtils/MM_Win32.pm new file mode 100644 index 0000000..a1226b5 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/MM_Win32.pm @@ -0,0 +1,823 @@ +package ExtUtils::MM_Win32; + +=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. + +=over + +=cut + +use Config; +#use Cwd; +use File::Basename; +require Exporter; + +Exporter::import('ExtUtils::MakeMaker', + qw( $Verbose &neatvalue)); + +$ENV{EMXSHELL} = 'sh'; # to run `commands` +unshift @MM::ISA, 'ExtUtils::MM_Win32'; + +$BORLAND = 1 if $Config{'cc'} =~ /^bcc/i; +$GCC = 1 if $Config{'cc'} =~ /^gcc/i; +$DMAKE = 1 if $Config{'make'} =~ /^dmake/i; +$NMAKE = 1 if $Config{'make'} =~ /^nmake/i; +$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; + +sub dlsyms { + my($self,%attribs) = @_; + + my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; + my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + 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 +", + q! $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Mksymlists \\ + -e "Mksymlists('NAME' => '!, $self->{NAME}, + q!', 'DLBASE' => '!,$self->{DLBASE}, + q!', 'DL_FUNCS' => !,neatvalue($funcs), + q!, 'IMPORTS' => !,neatvalue($imports), + q!, 'DL_VARS' => !, neatvalue($vars), q!);" +!); + } + join('',@m); +} + +sub replace_manpage_separator { + my($self,$man) = @_; + $man =~ s,/+,.,g; + $man; +} + +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; +} + +sub file_name_is_absolute { + my($self,$file) = @_; + $file =~ m{^([a-z]:)?[\\/]}i ; +} + +sub find_perl { + my($self, $ver, $names, $dirs, $trace) = @_; + my($name, $dir); + if ($trace >= 2){ + print "Looking for perl $ver by these names: +@$names +in these dirs: +@$dirs +"; + } + foreach $dir (@$dirs){ + next unless defined $dir; # $self->{PERL_SRC} may be undefined + foreach $name (@$names){ + 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->canonpath($self->catfile($self->curdir, $name)); + } + print "Checking $abs\n" if ($trace >= 2); + next unless $self->maybe_command($abs); + print "Executing $abs\n" if ($trace >= 2); + $val = `$abs -e "require $ver;" 2>&1`; + if ($? == 0) { + print "Using PERL=$abs\n" if $trace; + return $abs; + } elsif ($trace >= 2) { + print "Result: `$val'\n"; + } + } + } + print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; + 0; # false and not empty +} + +sub catdir { + my $self = shift; + my @args = @_; + for (@args) { + # append a slash to each argument unless it has one there + $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\"; + } + my $result = $self->canonpath(join('', @args)); + $result; +} + +=item catfile + +Concatenate one or more directory names and a filename to form a +complete path ending with a filename + +=cut + +sub catfile { + my $self = shift @_; + my $file = pop @_; + return $file unless @_; + my $dir = $self->catdir(@_); + $dir =~ s/(\\\.)$//; + $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\"; + return $dir.$file; +} + +sub init_others +{ + my ($self) = @_; + &ExtUtils::MM_Unix::init_others; + $self->{'TOUCH'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e touch'; + $self->{'CHMOD'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e chmod'; + $self->{'CP'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e cp'; + $self->{'RM_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_f'; + $self->{'RM_RF'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_rf'; + $self->{'MV'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mv'; + $self->{'NOOP'} = 'rem'; + $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f'; + $self->{'LD'} = $Config{'ld'} || 'link'; + $self->{'AR'} = $Config{'ar'} || 'lib'; + $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"; + } + $self->{'DEV_NULL'} = '> NUL'; + # $self->{'NOECHO'} = ''; # till we have it working +} + + +=item constants (o) + +Initializes lots of constants and .SUFFIXES and .PHONY + +=cut + +sub constants { + my($self) = @_; + my(@m,$tmp); + + for $tmp (qw/ + + AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION + VERSION_SYM XS_VERSION INST_BIN INST_EXE INST_LIB + INST_ARCHLIB INST_SCRIPT PREFIX INSTALLDIRS + INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB + INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB + PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB + FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC + PERL_INC PERL FULLPERL + + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, qq{ +VERSION_MACRO = VERSION +DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\" +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\" +}; + + push @m, qq{ +MAKEMAKER = $INC{'ExtUtils\MakeMaker.pm'} +MM_VERSION = $ExtUtils::MakeMaker::VERSION +}; + + push @m, q{ +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!! +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +}; + + for $tmp (qw/ + FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT + LDFROM LINKTYPE + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, " +# Handy lists of source code files: +XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})." +C_FILES = ".join(" \\\n\t", @{$self->{C}})." +O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})." +H_FILES = ".join(" \\\n\t", @{$self->{H}})." +MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})." +MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})." +"; + + for $tmp (qw/ + INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT + /) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, qq{ +.USESHELL : +} if $DMAKE; + + push @m, q{ +.NO_CONFIG_REC: Makefile +} if $ENV{CLEARCASE_ROOT}; + + # why not q{} ? -- emacs + push @m, qq{ +# work around a famous dec-osf make(1) feature(?): +makemakerdflt: all + +.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT) + +# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that +# some make implementations will delete the Makefile when we rebuild it. Because +# we call false(1) when we rebuild it. So make(1) is not completely wrong when it +# does so. Our milage may vary. +# .PRECIOUS: Makefile # seems to be not necessary anymore + +.PHONY: all config static dynamic test linkext manifest + +# Where is the Config information that we are using/depend on +CONFIGDEP = \$(PERL_ARCHLIB)\\Config.pm \$(PERL_INC)\\config.h +}; + + my @parentdir = split(/::/, $self->{PARENT_NAME}); + push @m, q{ +# Where to put things: +INST_LIBDIR = }. $self->catdir('$(INST_LIB)',@parentdir) .q{ +INST_ARCHLIBDIR = }. $self->catdir('$(INST_ARCHLIB)',@parentdir) .q{ + +INST_AUTODIR = }. $self->catdir('$(INST_LIB)','auto','$(FULLEXT)') .q{ +INST_ARCHAUTODIR = }. $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)') .q{ +}; + + if ($self->has_link_code()) { + push @m, ' +INST_STATIC = $(INST_ARCHAUTODIR)\$(BASEEXT)$(LIB_EXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)\$(DLBASE).$(DLEXT) +INST_BOOT = $(INST_ARCHAUTODIR)\$(BASEEXT).bs +'; + } else { + push @m, ' +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = +'; + } + + $tmp = $self->export_list; + push @m, " +EXPORT_LIST = $tmp +"; + $tmp = $self->perl_archive; + push @m, " +PERL_ARCHIVE = $tmp +"; + +# push @m, q{ +#INST_PM = }.join(" \\\n\t", sort values %{$self->{PM}}).q{ +# +#PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ +#}; + + push @m, q{ +TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{ + +PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ +}; + + join('',@m); +} + + +sub path { + local $^W = 1; + my($self) = @_; + my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; + my @path = split(';',$path); + foreach(@path) { $_ = '.' if $_ eq '' } + @path; +} + +=item static_lib (o) + +Defines how to produce the *.a (or equivalent) files. + +=cut + +sub static_lib { + my($self) = @_; +# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC +# return '' unless $self->needs_linking(); #might be because of a subdir + + return '' unless $self->has_link_code; + + my(@m); + push(@m, <<'END'); +$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)\.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. + push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB}; + + push @m, +q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")' + : ($GCC ? '-ru $@ $(OBJECT)' + : '-out:$@ $(OBJECT)')).q{ + }.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld + $(CHMOD) 755 $@ +}; + +# Old mechanism - still available: + + push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs}."\n\n" + if $self->{PERL_SRC}; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('', "\n",@m); +} + +=item dynamic_bs (o) + +Defines targets for bootstrap files. + +=cut + +sub dynamic_bs { + my($self, %attribs) = @_; + return ' +BOOTSTRAP = +' unless $self->has_link_code(); + + return ' +BOOTSTRAP = '."$self->{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): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)\.exists + '.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" + '.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ + -MExtUtils::Mkbootstrap \ + -e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');" + '.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP) + $(CHMOD) 644 $@ + +$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists + '."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT) + -'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT) + $(CHMOD) 644 $@ +'; +} + +=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} || ($BORLAND ? 'c0d32.obj': ''); + my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; + my($ldfrom) = '$(LDFROM)'; + my(@m); + push(@m,' +# This section creates the dynamically loadable $(INST_DYNAMIC) +# from $(OBJECT) and possibly $(MYEXTLIB). +OTHERLDFLAGS = '.$otherldflags.' +INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' + +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) +'); + if ($GCC) { + push(@m, + q{ dlltool --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 --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp + $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp }); + } else { + push(@m, $BORLAND ? + q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,),$(RESFILES)} : + q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)} + ); + } + push @m, ' + $(CHMOD) 755 $@ +'; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('',@m); +} + +sub perl_archive +{ + my ($self) = @_; + if($OBJ) { + if ($self->{CAPI} eq 'TRUE') { + return '$(PERL_INC)\perlCAPI$(LIB_EXT)'; + } + } + return '$(PERL_INC)\\'.$Config{'libperl'}; +} + +sub export_list +{ + my ($self) = @_; + return "$self->{BASEEXT}.def"; +} + +=item canonpath + +No physical check on the filesystem, but a logical cleanup of a +path. On UNIX eliminated successive slashes and successive "/.". + +=cut + +sub canonpath { + my($self,$path) = @_; + $path =~ s/^([a-z]:)/\u$1/; + $path =~ s|/|\\|g; + $path =~ s|(.)\\+|$1\\|g ; # xx////xx -> xx/xx + $path =~ s|(\\\.)+\\|\\|g ; # xx/././xx -> xx/xx + $path =~ s|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx + $path =~ s|\\$|| + unless $path =~ m#^([a-z]:)?\\#; # xx/ -> xx + $path .= '.' if $path =~ m#\\$#; + $path; +} + +=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.pl" if -r "$file.pl" && -f _; + return; +} + +=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'); + return q{ +pm_to_blib: $(TO_INST_PM) + }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ + "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ + -e "pm_to_blib(qw[ }. + ($NMAKE ? '<<pmfiles.dat' + : '$(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n)'). + q{ ],'}.$autodir.q{')" + }. ($NMAKE ? q{ +$(PM_TO_BLIB) +<< + } : '') . $self->{NOECHO}.q{$(TOUCH) $@ +}; +} + +=item test_via_harness (o) + +Helper method to write the test targets + +=cut + +sub test_via_harness { + my($self, $perl, $tests) = @_; + "\t$perl".q! -Mblib -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e "use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;" !."$tests\n"; +} + + +=item tool_autosplit (override) + +Use Win32 quoting on command line. + +=cut + +sub tool_autosplit{ + my($self, %attribs) = @_; + my($asl) = ""; + $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN}; + q{ +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MAutoSplit }.$asl.q{ -e "autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);" +}; +} + +=item tools_other (o) + +Win32 overrides. + +Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in +the Makefile. Also defines the perl programs MKPATH, +WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL. + +=cut + +sub tools_other { + my($self) = shift; + my @m; + my $bin_sh = $Config{sh} || 'cmd /c'; + push @m, qq{ +SHELL = $bin_sh +} unless $DMAKE; # dmake determines its own shell + + for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) { + push @m, "$_ = $self->{$_}\n"; + } + + push @m, q{ +# The following is a portable way to say mkdir -p +# To see which directories are created, change the if 0 to if 1 +MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath + +# This helps us to minimize the effect of the .exists files A yet +# better solution would be to have a stable file in the perl +# distribution with a timestamp of zero. But this solution doesn't +# need any changes to the core distribution and works with older perls +EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime +}; + + + return join "", @m if $self->{PARENT}; + + push @m, q{ +# Here we warn users that an old packlist file was found somewhere, +# and that they should call some uninstall routine +WARN_IF_OLD_PACKLIST = $(PERL) -lwe "exit unless -f $$ARGV[0];" \\ +-e "print 'WARNING: I have found an old package in';" \\ +-e "print ' ', $$ARGV[0], '.';" \\ +-e "print 'Please make sure the two installations are not conflicting';" + +UNINST=0 +VERBINST=1 + +MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ +-e "install({ @ARGV },'$(VERBINST)',0,'$(UNINST)');" + +DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \ +-e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', shift, '>';" \ +-e "print '=over 4';" \ +-e "while (defined($$key = shift) and defined($$val = shift)) { print '=item *';print 'C<', \"$$key: $$val\", '>'; }" \ +-e "print '=back';" + +UNINSTALL = $(PERL) -MExtUtils::Install \ +-e "uninstall($$ARGV[0],1,1); print \"\nUninstall is deprecated. Please check the";" \ +-e "print \" packlist above carefully.\n There may be errors. Remove the\";" \ +-e "print \" appropriate files manually.\n Sorry for the inconveniences.\n\"" +}; + + return join "", @m; +} + +=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 '' +} + +=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, ' +#all :: config $(INST_PM) subdirs linkext manifypods +'; + + push @m, ' +all :: pure_all manifypods + '.$self->{NOECHO}.'$(NOOP) +' + unless $self->{SKIPHASH}{'all'}; + + push @m, ' +pure_all :: config pm_to_blib subdirs linkext + '.$self->{NOECHO}.'$(NOOP) + +subdirs :: $(MYEXTLIB) + '.$self->{NOECHO}.'$(NOOP) + +config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)\.exists + '.$self->{NOECHO}.'$(NOOP) + +config :: $(INST_ARCHAUTODIR)\.exists + '.$self->{NOECHO}.'$(NOOP) + +config :: $(INST_AUTODIR)\.exists + '.$self->{NOECHO}.'$(NOOP) +'; + + push @m, qq{ +config :: Version_check + $self->{NOECHO}\$(NOOP) + +} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; + + push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); + + if (%{$self->{MAN1PODS}}) { + push @m, qq[ +config :: \$(INST_MAN1DIR)\\.exists + $self->{NOECHO}\$(NOOP) + +]; + push @m, $self->dir_target(qw[$(INST_MAN1DIR)]); + } + if (%{$self->{MAN3PODS}}) { + push @m, qq[ +config :: \$(INST_MAN3DIR)\\.exists + $self->{NOECHO}\$(NOOP) + +]; + push @m, $self->dir_target(qw[$(INST_MAN3DIR)]); + } + + push @m, ' +$(O_FILES): $(H_FILES) +' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; + + push @m, q{ +help: + perldoc ExtUtils::MakeMaker +}; + + push @m, q{ +Version_check: + }.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + -MExtUtils::MakeMaker=Version_check \ + -e "Version_check('$(MM_VERSION)')" +}; + + join('',@m); +} + +=item manifypods (o) + +We don't want manpage process. XXX add pod2html support later. + +=cut + +sub manifypods { + my($self) = shift; + return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n"; +} + +=item dist_ci (o) + +Same as MM_Unix version (changes command-line quoting). + +=cut + +sub dist_ci { + my($self) = shift; + my @m; + push @m, q{ +ci : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\ + -e "@all = keys %{ maniread() };" \\ + -e "print(\"Executing $(CI) @all\n\"); system(\"$(CI) @all\");" \\ + -e "print(\"Executing $(RCS_LABEL) ...\n\"); system(\"$(RCS_LABEL) @all\");" +}; + join "", @m; +} + +=item dist_core (o) + +Same as MM_Unix version (changes command-line quoting). + +=cut + +sub dist_core { + my($self) = shift; + my @m; + push @m, q{ +dist : $(DIST_DEFAULT) + }.$self->{NOECHO}.q{$(PERL) -le "print \"Warning: Makefile possibly out of date with $$vf\" if " \ + -e "-e ($$vf=\"$(VERSION_FROM)\") and -M $$vf < -M \"}.$self->{MAKEFILE}.q{\";" + +tardist : $(DISTVNAME).tar$(SUFFIX) + +zipdist : $(DISTVNAME).zip + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) \\ + $(DISTVNAME).tar$(SUFFIX) > \\ + $(DISTVNAME).tar$(SUFFIX)_uu + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) +}; + join "", @m; +} + +=item pasthru (o) + +Defines the string that is passed to recursive make calls in +subdirectories. + +=cut + +sub pasthru { + my($self) = shift; + return "PASTHRU = " . ($NMAKE ? "-nologo" : ""); +} + + + +1; +__END__ + +=back + +=cut + + diff --git a/contrib/perl5/lib/ExtUtils/MakeMaker.pm b/contrib/perl5/lib/ExtUtils/MakeMaker.pm new file mode 100644 index 0000000..5b7bb0b --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/MakeMaker.pm @@ -0,0 +1,1933 @@ +BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatible with perl5.001m + +package ExtUtils::MakeMaker; + +$Version = $VERSION = "5.4301"; +$Version_OK = "5.17"; # Makefiles older than $Version_OK will die + # (Will be checked from MakeMaker version 4.13 onwards) +($Revision = substr(q$Revision: 1.222 $, 10)) =~ s/\s+$//; + + + +require Exporter; +use Config; +use Carp (); +#use FileHandle (); + +use vars qw( + + @ISA @EXPORT @EXPORT_OK $AUTOLOAD + $ISA_TTY $Is_Mac $Is_OS2 $Is_VMS $Revision $Setup_done + $VERSION $Verbose $Version_OK %Config %Keep_after_flush + %MM_Sections %Prepend_dot_dot %Recognized_Att_Keys + @Get_from_Config @MM_Sections @Overridable @Parent + + ); +# use strict; + +# &DynaLoader::mod2fname should be available to miniperl, thus +# should be a pseudo-builtin (cmp. os2.c). +#eval {require DynaLoader;}; + +# +# Set up the inheritance before we pull in the MM_* packages, because they +# import variables and functions from here +# +@ISA = qw(Exporter); +@EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt); +@EXPORT_OK = qw($VERSION &Version_check &neatvalue &mkbootstrap &mksymlists + $Version); + # $Version in mixed case will go away! + +# +# Dummy package MM inherits actual methods from OS-specific +# default packages. We use this intermediate package so +# MY::XYZ->func() can call MM->func() and get the proper +# default routine without having to know under what OS +# it's running. +# +@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::Liblist ExtUtils::MakeMaker]; + +# +# Setup dummy package: +# MY exists for overriding methods to be defined within +# +{ + package MY; + @MY::ISA = qw(MM); +### sub AUTOLOAD { use Devel::Symdump; print Devel::Symdump->rnew->as_string; Carp::confess "hey why? $AUTOLOAD" } + package MM; + sub DESTROY {} +} + +# "predeclare the package: we only load it via AUTOLOAD +# but we have already mentioned it in @ISA +package ExtUtils::Liblist; + +package ExtUtils::MakeMaker; +# +# Now we can pull in the friends +# +$Is_VMS = $^O eq 'VMS'; +$Is_OS2 = $^O eq 'os2'; +$Is_Mac = $^O eq 'MacOS'; +$Is_Win32 = $^O eq 'MSWin32'; + +# This is for module authors to query, so they can enable 'CAPI' => 'TRUE' +# in their Makefile.pl +$CAPI_support = 1; + +require ExtUtils::MM_Unix; + +if ($Is_VMS) { + require ExtUtils::MM_VMS; + require VMS::Filespec; # is a noop as long as we require it within MM_VMS +} +if ($Is_OS2) { + require ExtUtils::MM_OS2; +} +if ($Is_Mac) { + require ExtUtils::MM_Mac; +} +if ($Is_Win32) { + require ExtUtils::MM_Win32; +} + +# The SelfLoader would bring a lot of overhead for MakeMaker, because +# we know for sure we will use most of the autoloaded functions once +# we have to use one of them. So we write our own loader + +sub AUTOLOAD { + my $code; + if (defined fileno(DATA)) { + my $fh = select DATA; + my $o = $/; # For future reads from the file. + $/ = "\n__END__\n"; + $code = <DATA>; + $/ = $o; + select $fh; + close DATA; + eval $code; + if ($@) { + $@ =~ s/ at .*\n//; + Carp::croak $@; + } + } else { + warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; + } + defined(&$AUTOLOAD) or die "Myloader inconsistency error"; + goto &$AUTOLOAD; +} + +# The only subroutine we do not SelfLoad is Version_Check because it's +# called so often. Loading this minimum still requires 1.2 secs on my +# Indy :-( + +sub Version_check { + my($checkversion) = @_; + die "Your Makefile was built with ExtUtils::MakeMaker v $checkversion. +Current Version is $ExtUtils::MakeMaker::VERSION. There have been considerable +changes in the meantime. +Please rerun 'perl Makefile.PL' to regenerate the Makefile.\n" + if $checkversion < $Version_OK; + printf STDOUT "%s %s %s %s.\n", "Makefile built with ExtUtils::MakeMaker v", + $checkversion, "Current Version is", $VERSION + unless $checkversion == $VERSION; +} + +sub warnhandler { + $_[0] =~ /^Use of uninitialized value/ && return; + $_[0] =~ /used only once/ && return; + $_[0] =~ /^Subroutine\s+[\w:]+\s+redefined/ && return; + warn @_; +} + +sub ExtUtils::MakeMaker::eval_in_subdirs ; +sub ExtUtils::MakeMaker::eval_in_x ; +sub ExtUtils::MakeMaker::full_setup ; +sub ExtUtils::MakeMaker::writeMakefile ; +sub ExtUtils::MakeMaker::new ; +sub ExtUtils::MakeMaker::check_manifest ; +sub ExtUtils::MakeMaker::parse_args ; +sub ExtUtils::MakeMaker::check_hints ; +sub ExtUtils::MakeMaker::mv_all_methods ; +sub ExtUtils::MakeMaker::skipcheck ; +sub ExtUtils::MakeMaker::flush ; +sub ExtUtils::MakeMaker::mkbootstrap ; +sub ExtUtils::MakeMaker::mksymlists ; +sub ExtUtils::MakeMaker::neatvalue ; +sub ExtUtils::MakeMaker::selfdocument ; +sub ExtUtils::MakeMaker::WriteMakefile ; +sub ExtUtils::MakeMaker::prompt ($;$) ; + +1; + +__DATA__ + +package ExtUtils::MakeMaker; + +sub WriteMakefile { + Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; + local $SIG{__WARN__} = \&warnhandler; + + unless ($Setup_done++){ + full_setup(); + undef &ExtUtils::MakeMaker::full_setup; #safe memory + } + my %att = @_; + MM->new(\%att)->flush; +} + +sub prompt ($;$) { + my($mess,$def)=@_; + $ISA_TTY = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe? + Carp::confess("prompt function called without an argument") unless defined $mess; + my $dispdef = defined $def ? "[$def] " : " "; + $def = defined $def ? $def : ""; + my $ans; + local $|=1; + print "$mess $dispdef"; + if ($ISA_TTY) { + chomp($ans = <STDIN>); + } else { + print "$def\n"; + } + return $ans || $def; +} + +sub eval_in_subdirs { + my($self) = @_; + my($dir); + use Cwd 'cwd'; + my $pwd = cwd(); + + foreach $dir (@{$self->{DIR}}){ + my($abs) = $self->catdir($pwd,$dir); + $self->eval_in_x($abs); + } + chdir $pwd; +} + +sub eval_in_x { + my($self,$dir) = @_; + package main; + chdir $dir or Carp::carp("Couldn't change to directory $dir: $!"); +# use FileHandle (); +# my $fh = new FileHandle; +# $fh->open("Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir"); + local *FH; + open(FH,"Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir"); +# my $eval = join "", <$fh>; + my $eval = join "", <FH>; +# $fh->close; + close FH; + eval $eval; + if ($@) { +# if ($@ =~ /prerequisites/) { +# die "MakeMaker WARNING: $@"; +# } else { +# warn "WARNING from evaluation of $dir/Makefile.PL: $@"; +# } + warn "WARNING from evaluation of $dir/Makefile.PL: $@"; + } +} + +sub full_setup { + $Verbose ||= 0; + $^W=1; + + # package name for the classes into which the first object will be blessed + $PACKNAME = "PACK000"; + + @Attrib_help = qw/ + + AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION LICENSE_HREF CAPI + C CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS + EXE_FILES EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H + INC INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR + INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH + INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB + INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIB LIBS + LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB + NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC + PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX + PL_FILES PM PMLIBDIRS PREFIX + PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG + XS_VERSION clean depend dist dynamic_lib linkext macro realclean + tool_autosplit PPM_INSTALL_SCRIPT PPM_INSTALL_EXEC + + IMPORTS + + installpm + /; + + # IMPORTS is used under OS/2 + + # ^^^ installpm is deprecated, will go about Summer 96 + + # @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 tool_autosplit tool_xsubpp + tools_other dist macro depend cflags const_loadlibs const_cccmd + post_constants + + pasthru + + c_o xs_c xs_o top_targets linkext dlsyms dynamic dynamic_bs + dynamic_lib static static_lib manifypods processPL installbin subdirs + clean realclean dist_basics dist_core dist_dir dist_test dist_ci + install force perldepend makefile staticmake test ppd + + ); # loses section ordering + + @Overridable = @MM_Sections; + push @Overridable, qw[ + + dir_target libscan makeaperl needs_linking perm_rw perm_rwx + subdir_x test_via_harness test_via_script + + ]; + + 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 ld lddlflags ldflags libc + lib_ext obj_ext osname osvers ranlib sitelibexp sitearchexp so exe_ext + ); + + my $item; + foreach $item (@Attrib_help){ + $Recognized_Att_Keys{$item} = 1; + } + foreach $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_dot_dot = + qw( + + INST_BIN 1 INST_EXE 1 INST_LIB 1 INST_ARCHLIB 1 INST_SCRIPT + 1 MAP_TARGET 1 INST_MAN1DIR 1 INST_MAN3DIR 1 PERL_SRC 1 + PERL 1 FULLPERL 1 + + ); + + my @keep = qw/ + NEEDS_LINKING HAS_LINK_CODE + /; + @Keep_after_flush{@keep} = (1) x @keep; +} + +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 ExtUtils::MakeMaker::new { + my($class,$self) = @_; + my($key); + + print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose; + if (-f "MANIFEST" && ! -f "Makefile"){ + check_manifest(); + } + + $self = {} unless (defined $self); + + check_hints($self); + + my(%initial_att) = %$self; # record initial attributes + + my($prereq); + foreach $prereq (sort keys %{$self->{PREREQ_PM}}) { + my $eval = "use $prereq $self->{PREREQ_PM}->{$prereq}"; + eval $eval; + if ($@){ + warn "Warning: prerequisite $prereq $self->{PREREQ_PM}->{$prereq} not found"; +# Why is/was this 'delete' here? We need PREREQ_PM later to make PPDs. +# } else { +# delete $self->{PREREQ_PM}{$prereq}; + } + } +# if (@unsatisfied){ +# unless (defined $ExtUtils::MakeMaker::useCPAN) { +# print qq{MakeMaker WARNING: prerequisites not found (@unsatisfied) +# Please install these modules first and rerun 'perl Makefile.PL'.\n}; +# if ($ExtUtils::MakeMaker::hasCPAN) { +# $ExtUtils::MakeMaker::useCPAN = prompt(qq{Should I try to use the CPAN module to fetch them for you?},"yes"); +# } else { +# print qq{Hint: You may want to install the CPAN module to autofetch the needed modules\n}; +# $ExtUtils::MakeMaker::useCPAN=0; +# } +# } +# if ($ExtUtils::MakeMaker::useCPAN) { +# require CPAN; +# CPAN->import(@unsatisfied); +# } else { +# die qq{prerequisites not found (@unsatisfied)}; +# } +# warn qq{WARNING: prerequisites not found (@unsatisfied)}; +# } + + if (defined $self->{CONFIGURE}) { + if (ref $self->{CONFIGURE} eq 'CODE') { + $self = { %$self, %{&{$self->{CONFIGURE}}}}; + } 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; + { +# no strict; + print "Blessing Object into class [$newclass]\n" if $Verbose>=2; + mv_all_methods("MY",$newclass); + bless $self, $newclass; + push @Parent, $self; + @{"$newclass\:\:ISA"} = 'MM'; + } + + if (defined $Parent[-2]){ + $self->{PARENT} = $Parent[-2]; + my $key; + for $key (keys %Prepend_dot_dot) { + next unless defined $self->{PARENT}{$key}; + $self->{$key} = $self->{PARENT}{$key}; + # PERL and FULLPERL may be command verbs instead of full + # file specifications under VMS. If so, don't turn them + # into a filespec. + $self->{$key} = $self->catdir("..",$self->{$key}) + unless $self->file_name_is_absolute($self->{$key}) + || ($^O eq 'VMS' and ($key =~ /PERL$/ && $self->{$key} =~ /^[\w\-\$]+$/)); + } + $self->{PARENT}->{CHILDREN}->{$newclass} = $self if $self->{PARENT}; + } else { + parse_args($self,@ARGV); + } + + $self->{NAME} ||= $self->guess_name; + + ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g; + + $self->init_main(); + + if (! $self->{PERL_SRC} ) { + my($pthinks) = $self->canonpath($INC{'Config.pm'}); + my($cthinks) = $self->catfile($Config{'archlibexp'},'Config.pm'); + $pthinks = VMS::Filespec::vmsify($pthinks) if $Is_VMS; + if ($pthinks ne $cthinks && + !($Is_Win32 and lc($pthinks) eq lc($cthinks))) { + print "Have $pthinks expected $cthinks\n"; + if ($Is_Win32) { + $pthinks =~ s![/\\]Config\.pm$!!i; $pthinks =~ s!.*[/\\]!!; + } + else { + $pthinks =~ s!/Config\.pm$!!; $pthinks =~ s!.*/!!; + } + print STDOUT <<END; +Your perl and your Config.pm seem to have different ideas about the architecture +they are running on. +Perl thinks: [$pthinks] +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 + } + } + + $self->init_dirscan(); + $self->init_others(); + + 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 Parameters: +END + + foreach $key (sort keys %initial_att){ + my($v) = neatvalue($initial_att{$key}); + $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; + $v =~ tr/\n/ /s; + push @{$self->{RESULT}}, "# $key => $v"; + } + + # turn the SKIP array into a SKIPHASH hash + my (%skip,$skip); + for $skip (@{$self->{SKIP} || []}) { + $self->{SKIPHASH}{$skip} = 1; + } + delete $self->{SKIP}; # free memory + + if ($self->{PARENT}) { + for (qw/install dist dist_basics dist_core dist_dir 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}}; + } + + my $section; + foreach $section ( @MM_Sections ){ + 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->nicetext($self->$section( %a )); + } + } + + push @{$self->{RESULT}}, "\n# End."; + pop @Parent; + + $self; +} + +sub WriteEmptyMakefile { + if (-f 'Makefile.old') { + chmod 0666, 'Makefile.old'; + unlink 'Makefile.old' or warn "unlink Makefile.old: $!"; + } + rename 'Makefile', 'Makefile.old' or warn "rename Makefile Makefile.old: $!" + if -f 'Makefile'; + open MF, '> Makefile' or die "open Makefile for write: $!"; + print MF <<'EOP'; +all: + +clean: + +install: + +makemakerdflt: + +test: + +EOP + close MF or die "close Makefile for write: $!"; +} + +sub check_manifest { + print STDOUT "Checking if your kit is complete...\n"; + require ExtUtils::Manifest; + $ExtUtils::Manifest::Quiet=$ExtUtils::Manifest::Quiet=1; #avoid warning + 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/(.*?)=(.*)/){ + help(),exit 1 if m/^help$/; + ++$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; + } + $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}]; + } + my $mmkey; + foreach $mmkey (sort keys %$self){ + 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. + + return unless -d "hints"; + + # First we look for the best hintsfile we have + my(@goodhints); + 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 "hints/$hint.pl"; # found + } continue { + last unless $hint =~ s/_[^_]*$//; # nothing to cut off + } + return unless -f "hints/$hint.pl"; # really there + + # execute the hintsfile: +# use FileHandle (); +# my $fh = new FileHandle; +# $fh->open("hints/$hint.pl"); + local *FH; + open(FH,"hints/$hint.pl"); +# @goodhints = <$fh>; + @goodhints = <FH>; +# $fh->close; + close FH; + print STDOUT "Processing hints file hints/$hint.pl\n"; + eval join('',@goodhints); + print STDOUT $@ if $@; +} + +sub mv_all_methods { + my($from,$to) = @_; + my($method); + my($symtab) = \%{"${from}::"}; +# no strict; + + # 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. + + foreach $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"}; + + *{"${to}::$method"} = \&{"${from}::$method"}; + + # delete would do, if we were sure, nobody ever called + # MY->makeaperl directly + + # delete $symtab->{$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: + + eval "package MY; sub $method { shift->SUPER::$method(\@_); }"; + } + + # 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($chunk); +# use FileHandle (); +# my $fh = new FileHandle; + local *FH; + print STDOUT "Writing $self->{MAKEFILE} for $self->{NAME}\n"; + + unlink($self->{MAKEFILE}, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ''); +# $fh->open(">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!"; + open(FH,">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!"; + + for $chunk (@{$self->{RESULT}}) { +# print $fh "$chunk\n"; + print FH "$chunk\n"; + } + +# $fh->close; + close FH; + my($finalname) = $self->{MAKEFILE}; + rename("MakeMaker.tmp", $finalname); + chmod 0644, $finalname unless $Is_VMS; + + if ($self->{PARENT}) { + foreach (keys %$self) { # safe memory + delete $self->{$_} unless $Keep_after_flush{$_}; + } + } + + system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":"; +} + +# 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, $elem, @neat); + push @m, "["; + foreach $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 $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; +} + +package ExtUtils::MakeMaker; +1; + +__END__ + +=head1 NAME + +ExtUtils::MakeMaker - create an extension Makefile + +=head1 SYNOPSIS + +C<use ExtUtils::MakeMaker;> + +C<WriteMakefile( ATTRIBUTE =E<gt> VALUE [, ...] );> + +which is really + +C<MM-E<gt>new(\%att)-E<gt>flush;> + +=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 + +The short answer is: Don't. + + Always begin with h2xs. + Always begin with h2xs! + ALWAYS BEGIN WITH H2XS! + +even if you're not building around a header file, and even if you +don't have an XS component. + +Run h2xs(1) before you start thinking about writing a module. For so +called pm-only modules that consist of C<*.pm> files only, h2xs has +the C<-X> switch. This will generate dummy files of all kinds that are +useful for the module developer. + +The medium answer is: + + use ExtUtils::MakeMaker; + WriteMakefile( NAME => "Foo::Bar" ); + +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 PREFIX=/tmp/myperl5 + +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 adds commands to the test target +of the generated Makefile that will execute the script with the proper +set of perl C<-I> options. + +MakeMaker also checks for any files matching glob("t/*.t"). It will +add commands to the test target of the generated Makefile that execute +all matching files via the L<Test::Harness> module with the C<-I> +switches set correctly. + +=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 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 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 + + INST_ARCHLIB INSTALLARCHLIB INSTALLSITEARCH + INST_LIB INSTALLPRIVLIB INSTALLSITELIB + INST_BIN INSTALLBIN + INST_SCRIPT INSTALLSCRIPT + INST_MAN1DIR INSTALLMAN1DIR + INST_MAN3DIR INSTALLMAN3DIR + +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' + + +=head2 PREFIX and LIB attribute + +PREFIX and LIB can be used to set several INSTALL* attributes in one +go. The quickest way to install a module in a non-standard place might +be + + perl Makefile.PL LIB=~/lib + +This will install the module's architecture-independent files into +~/lib, the architecture-dependent files into ~/lib/$archname/auto. + +Another way to specify many INSTALL directories with a single +parameter is PREFIX. + + perl Makefile.PL PREFIX=~ + +This will replace the string specified by $Config{prefix} in all +$Config{install*} values. + +Note, that in both cases the tilde expansion is done by MakeMaker, not +by perl by default, nor by make. Conflicts between parmeters LIB, +PREFIX and the various INSTALL* arguments are resolved so that +XXX + +If the user has superuser privileges, and is not working on AFS +(Andrew File System) 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 can be specified as arguments to WriteMakefile() +or as NAME=VALUE pairs on the command line: + +=cut + +# The following "=item C" is used by the attrib_help routine +# likewise the "=back" below. So be careful when changing it! + +=over 2 + +=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 DEFINE + +Something like C<"-DHAVE_UNISTD_H"> + +=item DIR + +Ref to array of subdirectories containing Makefile.PLs e.g. [ 'sdbm' +] in ext/SDBM_File + +=item DISTNAME + +Your name for distributing the package (by tar file). This defaults to +NAME above. + +=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 +(export lists) and VMS (linker options) 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'] } + +=item DL_VARS + +Array of symbol names for variables to be made available as +universal symbols. Used only under AIX (export lists) and VMS +(linker options) 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 +commandline: 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. + +=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 FIRST_MAKEFILE + +The name of the Makefile to be produced. Defaults to the contents of +MAKEFILE, but can be overridden. This is used for the second Makefile +that will be produced for the MAP_TARGET. + +=item FULLPERL + +Perl binary able to run this extension. + +=item H + +Ref to array of *.h file names. Similar to C. + +=item IMPORTS + +IMPORTS is only used on OS/2. + +=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 +commandline: 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. + +=item INSTALLDIRS + +Determines which of the two sets of installation directories to +choose: installprivlib and installarchlib versus installsitelib and +installsitearch. The first pair is chosen with INSTALLDIRS=perl, the +second with INSTALLDIRS=site. Default is site. + +=item INSTALLMAN1DIR + +This directory gets the man pages at 'make install' time. Defaults to +$Config{installman1dir}. + +=item INSTALLMAN3DIR + +This directory gets the man pages at 'make install' time. Defaults to +$Config{installman3dir}. + +=item INSTALLPRIVLIB + +Used by 'make install', which copies files from INST_LIB to this +directory if INSTALLDIRS is set to perl. + +=item INSTALLSCRIPT + +Used by 'make install' which copies files from INST_SCRIPT to this +directory. + +=item INSTALLSITELIB + +Used by 'make install', which copies files from INST_LIB to this +directory if INSTALLDIRS is set to site (default). + +=item INSTALLSITEARCH + +Used by 'make install', which copies files from INST_ARCHLIB to this +directory if INSTALLDIRS is set to site (default). + +=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_EXE + +Old name for INST_SCRIPT. Deprecated. Please use INST_SCRIPT if you +need to use it. + +=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/bin", just to have a dummy location during +testing. make install will copy the files in INST_SCRIPT to +INSTALLSCRIPT. + +=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 LIBPERL_A + +The filename of the perllibrary that will be used together with this +extension. Defaults to libperl.a. + +=item LIB + +LIB can only be set at C<perl Makefile.PL> time. It has the effect of +setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any + +=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 LINKTYPE + +'static' or 'dynamic' (default unless usedl=undef in +config.sh). Should only be used to force static linking (also see +linkext below). + +=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 + +The name of the Makefile to be produced. + +=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. + +=item MAN3PODS + +Hashref of .pm and .pod files. MakeMaker will default this to all + .pod and any .pm files that include POD directives. The files listed +here will be converted to man pages and installed as was requested +at Configure time. + +=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 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 + +Defaults to C<@>. By setting it to an empty string you can generate a +Makefile that echos all commands. Mainly used in debugging MakeMaker +itself. + +=item NORECURS + +Boolean. Attribute to inhibit descending into subdirectories. + +=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" + +=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 PERLMAINCC + +The call to the program that is able to compile perlmain.c. Defaults +to $(CC). + +=item PERL_ARCHLIB + +Same as above for architecture dependent files + +=item PERL_LIB + +Directory containing the Perl library to use. + +=item PERL_SRC + +Directory containing the Perl source code (use of this should be +avoided, it may be undefined) + +=item PERM_RW + +Desired Permission for read/writable files. Defaults to C<644>. +See also L<MM_Unix/perm_rw>. + +=item PERM_RWX + +Desired permission for executable files. Defaults to C<755>. +See also L<MM_Unix/perm_rwx>. + +=item PL_FILES + +Ref to hash of files to be processed as perl programs. MakeMaker +will default to any found *.PL file (except Makefile.PL) being keys +and the basename of the file being the value. E.g. + + {'foobar.PL' => 'foobar'} + +The *.PL files are expected to produce output to the target files +themselves. + +=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. + +=item PREFIX + +Can be used to set the three INSTALL* attributes in one go (except for +probably INSTALLMAN1DIR, if it is not below PREFIX according to +%Config). They will have PREFIX as a common directory node and will +branch from that node into lib/, lib/ARCHNAME or whatever Configure +decided at the build time of your perl (unless you override one of +them, of course). + +=item PREREQ_PM + +Hashref: Names of modules that need to be available to run this +extension (e.g. Fcntl for SDBM_File) are the keys of the hash and the +desired version is the value. If the required version number is 0, we +only check if any version is installed already. + +=item SKIP + +Arryref. E.g. [qw(name1 name2)] skip (do not write) sections of the +Makefile. Caution! Do not use the SKIP attribute for the neglectible +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 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 the regular expression + + /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ + +will be evaluated with eval() and the value of the named variable +B<after> the eval() will be assigned to the VERSION attribute of the +MakeMaker object. The following lines will be parsed o.k.: + + $VERSION = '1.00'; + *VERSION = \'1.01'; + ( $VERSION ) = '$Revision: 1.222 $ ' =~ /\$Revision:\s+([^\s]+)/; + $FOO::VERSION = '1.10'; + *FOO::VERSION = \'1.11'; + +but these will fail: + + my $VERSION = '1.01'; + local $VERSION = '1.02'; + local $FOO::VERSION = '1.30'; + +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 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. + +=over 2 + +=item clean + + {FILES => "*.xyz foo"} + +=item depend + + {ANY_TARGET => ANY_DEPENDECY, ...} + +=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 installpm + +Deprecated as of MakeMaker 5.23. See L<ExtUtils::MM_Unix/pm_to_blib>. + +=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 realclean + + {FILES => '$(INST_ARCHAUTODIR)/*.xyz'} + +=item tool_autosplit + + {MAXLEN =E<gt> 8} + +=back + +=cut + +# bug in pod2html, so leave the =back + +# Don't delete this cut, MM depends on it! + +=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 subroutines 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: + + sub MY::c_o { + package MY; # so that "SUPER" works right + 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 +F<perl5-porters@perl.org> or F<comp.lang.perl.moderated> as appropriate. + +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 { + ' + $(MYEXTLIB): sdbm/Makefile + cd sdbm && $(MAKE) all + '; + } + + +=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. + +=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 $(TOUNIX), 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( 'dist' => { COMPRESS=>"bzip2", SUFFIX=>".bz2" }) + +=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 + + ExtUtils::MakeMaker::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). + +=head1 SEE ALSO + +ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib, +ExtUtils::Install, ExtUtils::Embed + +=head1 AUTHORS + +Andy Dougherty <F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig +<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>. +VMS support by Charles Bailey <F<bailey@genetics.upenn.edu>>. OS/2 +support by Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Contact the +makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if +you have any questions. + +=cut diff --git a/contrib/perl5/lib/ExtUtils/Manifest.pm b/contrib/perl5/lib/ExtUtils/Manifest.pm new file mode 100644 index 0000000..5557089 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Manifest.pm @@ -0,0 +1,408 @@ +package ExtUtils::Manifest; + +require Exporter; +use Config; +use File::Find; +use File::Copy 'copy'; +use Carp; +use strict; + +use vars qw($VERSION @ISA @EXPORT_OK + $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); + +$VERSION = substr(q$Revision: 1.33 $, 10); +@ISA=('Exporter'); +@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', + 'skipcheck', 'maniread', 'manicopy'); + +$Is_VMS = $^O eq 'VMS'; +if ($Is_VMS) { require File::Basename } + +$Debug = 0; +$Verbose = 1; +$Quiet = 0; +$MANIFEST = 'MANIFEST'; + +# Really cool fix from Ilya :) +unless (defined $Config{d_link}) { + *ln = \&cp; +} + +sub mkmanifest { + my $manimiss = 0; + my $read = maniread() or $manimiss++; + $read = {} if $manimiss; + local *M; + rename $MANIFEST, "$MANIFEST.bak" unless $manimiss; + open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!"; + my $matches = _maniskip(); + my $found = manifind(); + my($key,$val,$file,%all); + %all = (%$found, %$read); + $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files' + if $manimiss; # add new MANIFEST to known file list + foreach $file (sort keys %all) { + next if &$matches($file); + if ($Verbose){ + warn "Added to $MANIFEST: $file\n" unless exists $read->{$file}; + } + my $text = $all{$file}; + ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text; + my $tabs = (5 - (length($file)+1)/8); + $tabs = 1 if $tabs < 1; + $tabs = 0 unless $text; + print M $file, "\t" x $tabs, $text, "\n"; + } + close M; +} + +sub manifind { + local $found = {}; + find(sub {return if -d $_; + (my $name = $File::Find::name) =~ s|./||; + warn "Debug: diskfile $name\n" if $Debug; + $name =~ s#(.*)\.$#\L$1# if $Is_VMS; + $found->{$name} = "";}, "."); + $found; +} + +sub fullcheck { + _manicheck(3); +} + +sub manicheck { + return @{(_manicheck(1))[0]}; +} + +sub filecheck { + return @{(_manicheck(2))[1]}; +} + +sub skipcheck { + _manicheck(6); +} + +sub _manicheck { + my($arg) = @_; + my $read = maniread(); + my $found = manifind(); + my $file; + my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0); + my(@missfile,@missentry); + if ($arg & 1){ + foreach $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; + } + } + } + if ($arg & 2){ + $read ||= {}; + my $matches = _maniskip(); + my $skipwarn = $arg & 4; + foreach $file (sort keys %$found){ + if (&$matches($file)){ + warn "Skipping $file\n" if $skipwarn; + next; + } + warn "Debug: manicheck checking from disk $file\n" if $Debug; + unless ( exists $read->{$file} ) { + warn "Not in $MANIFEST: $file\n" unless $Quiet; + push @missentry, $file; + } + } + } + (\@missfile,\@missentry); +} + +sub maniread { + my ($mfile) = @_; + $mfile ||= $MANIFEST; + my $read = {}; + local *M; + unless (open M, $mfile){ + warn "$mfile: $!"; + return $read; + } + while (<M>){ + chomp; + next if /^#/; + if ($Is_VMS) { + my($file)= /^(\S+)/; + next unless $file; + my($base,$dir) = File::Basename::fileparse($file); + # Resolve illegal file specifications in the same way as tar + $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; + $read->{"\L$okfile"}=$_; + } + else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; } + } + close M; + $read; +} + +# returns an anonymous sub that decides if an argument matches +sub _maniskip { + my ($mfile) = @_; + my $matches = sub {0}; + my @skip ; + $mfile ||= "$MANIFEST.SKIP"; + local *M; + return $matches unless -f $mfile; + open M, $mfile or return $matches; + while (<M>){ + chomp; + next if /^#/; + next if /^\s*$/; + push @skip, $_; + } + close M; + my $opts = $Is_VMS ? 'oi ' : 'o '; + my $sub = "\$matches = " + . "sub { my(\$arg)=\@_; return 1 if " + . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0) + . " }"; + eval $sub; + print "Debug: $sub\n" if $Debug; + $matches; +} + +sub manicopy { + my($read,$target,$how)=@_; + croak "manicopy() called without target argument" unless defined $target; + $how ||= 'cp'; + require File::Path; + require File::Basename; + my(%dirs,$file); + $target = VMS::Filespec::unixify($target) if $Is_VMS; + umask 0 unless $Is_VMS; + File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755); + foreach $file (keys %$read){ + $file = VMS::Filespec::unixify($file) if $Is_VMS; + 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; + File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755); + } + cp_if_diff($file, "$target/$file", $how); + } +} + +sub cp_if_diff { + my($from, $to, $how)=@_; + -f $from or carp "$0: $from not found"; + my($diff) = 0; + local(*F,*T); + open(F,$from) or croak "Can't read $from: $!\n"; + if (open(T,$to)) { + 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 ($perm,$access,$mod) = (stat $srcFile)[2,8,9]; + copy($srcFile,$dstFile); + utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; + # chmod a+rX-w,go-w + chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ); +} + +sub ln { + my ($srcFile, $dstFile) = @_; + return &cp if $Is_VMS; + link($srcFile, $dstFile); + local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x) + my $mode= 0444 | (stat)[2] & 0700; + if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) { + unlink $dstFile; + return; + } + 1; +} + +sub best { + my ($srcFile, $dstFile) = @_; + if (-l $srcFile) { + cp($srcFile, $dstFile); + } else { + ln($srcFile, $dstFile) or cp($srcFile, $dstFile); + } +} + +1; + +__END__ + +=head1 NAME + +ExtUtils::Manifest - utilities to write and check a MANIFEST file + +=head1 SYNOPSIS + +C<require ExtUtils::Manifest;> + +C<ExtUtils::Manifest::mkmanifest;> + +C<ExtUtils::Manifest::manicheck;> + +C<ExtUtils::Manifest::filecheck;> + +C<ExtUtils::Manifest::fullcheck;> + +C<ExtUtils::Manifest::skipcheck;> + +C<ExtUtild::Manifest::manifind();> + +C<ExtUtils::Manifest::maniread($file);> + +C<ExtUtils::Manifest::manicopy($read,$target,$how);> + +=head1 DESCRIPTION + +Mkmanifest() writes all files in and below the current directory to a +file named in the global variable $ExtUtils::Manifest::MANIFEST (which +defaults to C<MANIFEST>) in the current directory. It works similar to + + find . -print + +but in doing so checks each line in an existing C<MANIFEST> file and +includes any comments that are found in the existing C<MANIFEST> file +in the new one. Anything between white space and an end of line within +a C<MANIFEST> file is considered to be a comment. Filenames and +comments are seperated by one or more TAB characters in the +output. All files that match any regular expression in a file +C<MANIFEST.SKIP> (if such a file exists) are ignored. + +Manicheck() checks if all the files within a C<MANIFEST> in the +current directory really do exist. It only reports discrepancies and +exits silently if MANIFEST and the tree below the current directory +are in sync. + +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. + +Fullcheck() does both a manicheck() and a filecheck(). + +Skipcheck() lists all the files that are skipped due to your +C<MANIFEST.SKIP> file. + +Manifind() retruns a hash reference. The keys of the hash are the +files found below the current directory. + +Maniread($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. + +I<Manicopy($read,$target,$how)> copies the files that are the keys in +the HASH I<%$read> to the named target directory. The HASH reference +I<$read> is typically returned by the maniread() function. This +function is useful for producing a directory tree identical to the +intended distribution tree. The third parameter $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. Best is the default. + +=head1 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 sharp character. A typical example: + + \bRCS\b + ^MANIFEST\. + ^Makefile$ + ~$ + \.html$ + \.old$ + ^blib/ + ^MakeMaker-\d + +=head1 EXPORT_OK + +C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>, +C<&maniread>, and C<&manicopy> are exportable. + +=head1 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. + +=head1 DIAGNOSTICS + +All diagnostic output is sent to C<STDERR>. + +=over + +=item C<Not in MANIFEST:> I<file> + +is reported if a file is found, that is missing in the C<MANIFEST> +file which is excluded by a regular expression in the file +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 SEE ALSO + +L<ExtUtils::MakeMaker> which has handy targets for most of the functionality. + +=head1 AUTHOR + +Andreas Koenig <F<koenig@franz.ww.TU-Berlin.DE>> + +=cut diff --git a/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm b/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm new file mode 100644 index 0000000..35d5236 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm @@ -0,0 +1,103 @@ +package ExtUtils::Mkbootstrap; + +$VERSION = substr q$Revision: 1.13 $, 10; +# $Date: 1996/09/03 17:04:43 $ + +use Config; +use Exporter; +@ISA=('Exporter'); +@EXPORT='&Mkbootstrap'; + +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 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 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/contrib/perl5/lib/ExtUtils/Mksymlists.pm b/contrib/perl5/lib/ExtUtils/Mksymlists.pm new file mode 100644 index 0000000..0b92ca0 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Mksymlists.pm @@ -0,0 +1,276 @@ +package ExtUtils::Mksymlists; +use strict qw[ subs refs ]; +# no strict 'vars'; # until filehandles are exempted + +use Carp; +use Exporter; +use vars qw( @ISA @EXPORT $VERSION ); +@ISA = 'Exporter'; +@EXPORT = '&Mksymlists'; +$VERSION = substr q$Revision: 1.17 $, 10; + +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{DL_FUNCS} = { $spec{NAME} => [] } + unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or + $spec{FUNCLIST}); + $spec{FUNCLIST} = [] unless $spec{FUNCLIST}; + if (defined $spec{DL_FUNCS}) { + my($package); + foreach $package (keys %{$spec{DL_FUNCS}}) { + my($packprefix,$sym,$bootseen); + ($packprefix = $package) =~ s/\W/_/g; + foreach $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 '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(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) . '_'; + } + rename "$data->{FILE}.def", "$data->{FILE}_def.old"; + + open(DEF,">$data->{FILE}.def") + or croak("Can't create $data->{FILE}.def: $!\n"); + print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n"; + print DEF "DESCRIPTION 'Perl (v$]$threaded) module $data->{NAME} v$data->{VERSION}'\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(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{'arch'} =~ /VAX/i; + my($set) = new ExtUtils::XSSymSet; + my($sym); + + rename "$data->{FILE}.opt", "$data->{FILE}.opt_old"; + + open(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 + + foreach $sym (@{$data->{FUNCLIST}}) { + my $safe = $set->addsym($sym); + if ($isvax) { print OPT "UNIVERSAL=$safe\n" } + else { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; } + } + foreach $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 + +=item NAME + +This gives the name of the extension (I<e.g.> Tk::Canvas) for which +the linker option file will be produced. + +=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 Tk::Canvas, FILE defaults to '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. + +=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. + +=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@genetics.upenn.eduE<gt>> + +=head1 REVISION + +Last revised 14-Feb-1996, for Perl 5.002. diff --git a/contrib/perl5/lib/ExtUtils/Packlist.pm b/contrib/perl5/lib/ExtUtils/Packlist.pm new file mode 100644 index 0000000..eeb0a5b --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/Packlist.pm @@ -0,0 +1,288 @@ +package ExtUtils::Packlist; +use strict; +use Carp qw(); +use vars qw($VERSION); +$VERSION = '0.03'; + +# Used for generating filehandle globs. IO::File might not be available! +my $fhname = "FH1"; + +sub mkfh() +{ +no strict; +my $fh = \*{$fhname++}; +use strict; +return($fh); +} + +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, @kvs) = split(' ', $line); + $key =~ s!/\./!/!g; # Some .packlists have spurious '/./' bits in the paths + if (! @kvs) + { + $self->{data}->{$key} = undef; + } + else + { + my ($data) = {}; + foreach my $kv (@kvs) + { + my ($k, $v) = split('=', $kv); + $data->{$k} = $v; + } + $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}}))) + { + print $fh ("$key"); + if (ref($self->{data}->{$key})) + { + my $data = $self->{data}->{$key}; + 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 + +=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/contrib/perl5/lib/ExtUtils/inst b/contrib/perl5/lib/ExtUtils/inst new file mode 100755 index 0000000..cbf2d01 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/inst @@ -0,0 +1,139 @@ +#!/usr/local/bin/perl -w + +use strict; +use IO::File; +use ExtUtils::Packlist; +use ExtUtils::Installed; + +use vars qw($Inst @Modules); + +################################################################################ + +sub do_module($) +{ +my ($module) = @_; +my $help = <<EOF; +Available commands are: + f [all|prog|doc] - List installed files of a given type + d [all|prog|doc] - List the directories used by a module + v - Validate the .packlist - check for missing files + t <tarfile> - Create a tar archive of the module + q - Quit the module +EOF +print($help); +while (1) + { + print("$module cmd? "); + my $reply = <STDIN>; chomp($reply); + CASE: + { + $reply =~ /^f\s*/ and do + { + my $class = (split(' ', $reply))[1]; + $class = 'all' if (! $class); + my @files; + if (eval { @files = $Inst->files($module, $class); }) + { + print("$class files in $module are:\n ", + join("\n ", @files), "\n"); + last CASE; + } + else + { print($@); } + }; + $reply =~ /^d\s*/ and do + { + my $class = (split(' ', $reply))[1]; + $class = 'all' if (! $class); + my @dirs; + if (eval { @dirs = $Inst->directories($module, $class); }) + { + print("$class directories in $module are:\n ", + join("\n ", @dirs), "\n"); + last CASE; + } + else + { print($@); } + }; + $reply =~ /^t\s*/ and do + { + my $file = (split(' ', $reply))[1]; + my $tmp = "/tmp/inst.$$"; + if (my $fh = IO::File->new($tmp, "w")) + { + $fh->print(join("\n", $Inst->files($module))); + $fh->close(); + system("tar cvf $file -I $tmp"); + unlink($tmp); + last CASE; + } + else { print("Can't open $file: $!\n"); } + last CASE; + }; + $reply eq 'v' and do + { + if (my @missing = $Inst->validate($module)) + { + print("Files missing from $module are:\n ", + join("\n ", @missing), "\n"); + } + else + { + print("$module has no missing files\n"); + } + last CASE; + }; + $reply eq 'q' and do + { + return; + }; + # Default + print($help); + } + } +} + +################################################################################ + +sub toplevel() +{ +my $help = <<EOF; +Available commands are: + l - List all installed modules + m <module> - Select a module + q - Quit the program +EOF +print($help); +while (1) + { + print("cmd? "); + my $reply = <STDIN>; chomp($reply); + CASE: + { + $reply eq 'l' and do + { + print("Installed modules are:\n ", join("\n ", @Modules), "\n"); + last CASE; + }; + $reply =~ /^m\s+/ and do + { + do_module((split(' ', $reply))[1]); + last CASE; + }; + $reply eq 'q' and do + { + exit(0); + }; + # Default + print($help); + } + } +} + +################################################################################ + +$Inst = ExtUtils::Installed->new(); +@Modules = $Inst->modules(); +toplevel(); + +################################################################################ diff --git a/contrib/perl5/lib/ExtUtils/testlib.pm b/contrib/perl5/lib/ExtUtils/testlib.pm new file mode 100644 index 0000000..d80f2a2 --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/testlib.pm @@ -0,0 +1,26 @@ +package ExtUtils::testlib; +$VERSION = substr q$Revision: 1.11 $, 10; +# $Id: testlib.pm,v 1.11 1996/05/31 08:27:07 k Exp $ + +use lib qw(blib/arch blib/lib); +1; +__END__ + +=head1 NAME + +ExtUtils::testlib - add blib/* directories to @INC + +=head1 SYNOPSIS + +C<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/contrib/perl5/lib/ExtUtils/typemap b/contrib/perl5/lib/ExtUtils/typemap new file mode 100644 index 0000000..28fd99c --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/typemap @@ -0,0 +1,289 @@ +# $Header$ +# basic C types +int T_IV +unsigned T_IV +unsigned int T_IV +long T_IV +unsigned long T_IV +short T_IV +unsigned short T_IV +char T_CHAR +unsigned char T_U_CHAR +char * T_PV +unsigned char * T_PV +caddr_t T_PV +wchar_t * T_PV +wchar_t T_IV +bool_t T_IV +size_t T_IV +ssize_t T_IV +time_t T_NV +unsigned long * T_OPAQUEPTR +char ** T_PACKED +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 +I32 T_IV +I16 T_IV +I8 T_IV +U32 T_U_LONG +U16 T_U_SHORT +U8 T_IV +Result T_U_CHAR +Boolean T_IV +double T_DOUBLE +SysRet T_SYSRET +SysRetLong T_SYSRET +FILE * T_IN +FileHandle T_PTROBJ +InputStream T_IN +InOutStream T_INOUT +OutputStream T_OUT +bool T_BOOL + +############################################################################# +INPUT +T_SV + $var = $arg +T_SVREF + if (sv_isa($arg, \"${ntype}\")) + $var = (SV*)SvRV($arg); + else + croak(\"$var is not of type ${ntype}\") +T_AVREF + if (sv_isa($arg, \"${ntype}\")) + $var = (AV*)SvRV($arg); + else + croak(\"$var is not of type ${ntype}\") +T_HVREF + if (sv_isa($arg, \"${ntype}\")) + $var = (HV*)SvRV($arg); + else + croak(\"$var is not of type ${ntype}\") +T_CVREF + if (sv_isa($arg, \"${ntype}\")) + $var = (CV*)SvRV($arg); + else + croak(\"$var is not of type ${ntype}\") +T_SYSRET + $var NOT IMPLEMENTED +T_IV + $var = ($type)SvIV($arg) +T_INT + $var = (int)SvIV($arg) +T_ENUM + $var = ($type)SvIV($arg) +T_BOOL + $var = (int)SvIV($arg) +T_U_INT + $var = (unsigned int)SvIV($arg) +T_SHORT + $var = (short)SvIV($arg) +T_U_SHORT + $var = (unsigned short)SvIV($arg) +T_LONG + $var = (long)SvIV($arg) +T_U_LONG + $var = (unsigned long)SvIV($arg) +T_CHAR + $var = (char)*SvPV($arg,PL_na) +T_U_CHAR + $var = (unsigned char)SvIV($arg) +T_FLOAT + $var = (float)SvNV($arg) +T_NV + $var = ($type)SvNV($arg) +T_DOUBLE + $var = (double)SvNV($arg) +T_PV + $var = ($type)SvPV($arg,PL_na) +T_PTR + $var = ($type)SvIV($arg) +T_PTRREF + if (SvROK($arg)) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not a reference\") +T_REF_IV_REF + if (sv_isa($arg, \"${type}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = *($type *) tmp; + } + else + croak(\"$var is not of type ${ntype}\") +T_REF_IV_PTR + if (sv_isa($arg, \"${type}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not of type ${ntype}\") +T_PTROBJ + if (sv_derived_from($arg, \"${ntype}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not of type ${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 + croak(\"$var is not of type ${ntype}\") +T_REFREF + if (SvROK($arg)) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = *($type) tmp; + } + else + croak(\"$var is not a reference\") +T_REFOBJ + if (sv_isa($arg, \"${ntype}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = *($type) tmp; + } + else + croak(\"$var is not of type ${ntype}\") +T_OPAQUE + $var NOT IMPLEMENTED +T_OPAQUEPTR + $var = ($type)SvPV($arg,PL_na) +T_PACKED + $var = XS_unpack_$ntype($arg) +T_PACKEDARRAY + $var = XS_unpack_$ntype($arg) +T_CALLBACK + $var = make_perl_cb_$type($arg) +T_ARRAY + $var = $ntype(items -= $argoff); + U32 ix_$var = $argoff; + while (items--) { + DO_ARRAY_ELEM; + } +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_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_setiv($arg, (IV)$var); +T_SHORT + sv_setiv($arg, (IV)$var); +T_U_SHORT + sv_setiv($arg, (IV)$var); +T_LONG + sv_setiv($arg, (IV)$var); +T_U_LONG + sv_setiv($arg, (IV)$var); +T_CHAR + sv_setpvn($arg, (char *)&$var, 1); +T_U_CHAR + sv_setiv($arg, (IV)$var); +T_FLOAT + sv_setnv($arg, (double)$var); +T_NV + sv_setnv($arg, (double)$var); +T_DOUBLE + sv_setnv($arg, (double)$var); +T_PV + sv_setpv((SV*)$arg, $var); +T_PTR + sv_setiv($arg, (IV)$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 + sv_setrefref($arg, \"${ntype}\", XS_service_$ntype, + ($var ? (void*)new $ntype($var) : 0)); +T_REFOBJ + NOT IMPLEMENTED +T_OPAQUE + sv_setpvn($arg, (char *)&$var, sizeof($var)); +T_OPAQUEPTR + sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$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 + ST_EXTEND($var.size); + for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) { + ST(ix_$var) = sv_newmortal(); + DO_ARRAY_ELEM + } + SP += $var.size - 1; +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/contrib/perl5/lib/ExtUtils/xsubpp b/contrib/perl5/lib/ExtUtils/xsubpp new file mode 100755 index 0000000..523dabc --- /dev/null +++ b/contrib/perl5/lib/ExtUtils/xsubpp @@ -0,0 +1,1512 @@ +#!./miniperl + +=head1 NAME + +xsubpp - compiler to convert Perl XS code into C code + +=head1 SYNOPSIS + +B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>] [B<-object_capi>]... file.xs + +=head1 DESCRIPTION + +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 + +=head1 OPTIONS + +=over 5 + +=item B<-C++> + +Adds ``extern "C"'' to the C code. + + +=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<-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<-object_capi> + +Compile code as C in a PERL_OBJECT environment. + +back + +=head1 ENVIRONMENT + +No environment variables are used. + +=head1 AUTHOR + +Larry Wall + +=head1 MODIFICATION HISTORY + +See the file F<changes.pod>. + +=head1 SEE ALSO + +perl(1), perlxs(1), perlxstut(1) + +=cut + +require 5.002; +use Cwd; +use vars '$cplusplus'; +use vars '%v'; + +use Config; + +sub Q ; + +# Global Constants + +$XSUBPP_version = "1.9507"; + +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; +} + +$FH = 'File0000' ; + +$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-s pattern] [-typemap typemap]... file.xs\n"; + +$proto_re = "[" . quotemeta('\$%&*@;') . "]" ; +# mjn +$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; + +$except = ""; +$WantPrototypes = -1 ; +$WantVersionChk = 1 ; +$ProtoUsed = 0 ; +$WantLineNumbers = 1 ; +SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) { + $flag = shift @ARGV; + $flag =~ s/^-// ; + $spat = quotemeta shift, next SWITCH if $flag eq 's'; + $cplusplus = 1, next SWITCH if $flag eq 'C++'; + $WantPrototypes = 0, next SWITCH if $flag eq 'noprototypes'; + $WantPrototypes = 1, next SWITCH if $flag eq 'prototypes'; + $WantVersionChk = 0, next SWITCH if $flag eq 'noversioncheck'; + $WantVersionChk = 1, next SWITCH if $flag eq 'versioncheck'; + $WantCAPI = 1, next SWITCH if $flag eq 'object_capi'; + $except = " TRY", next SWITCH if $flag eq 'except'; + push(@tm,shift), next SWITCH if $flag eq 'typemap'; + $WantLineNumbers = 0, next SWITCH if $flag eq 'nolinenumbers'; + $WantLineNumbers = 1, next SWITCH if $flag eq 'linenumbers'; + (print "xsubpp version $XSUBPP_version\n"), exit + if $flag eq 'v'; + die $usage; +} +if ($WantPrototypes == -1) + { $WantPrototypes = 0} +else + { $ProtoUsed = 1 } + + +@ARGV == 1 or die $usage; +($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)# + or ($dir, $filename) = $ARGV[0] =~ m#(.*)\\(.*)# + or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)# + or ($dir, $filename) = ('.', $ARGV[0]); +chdir($dir); +$pwd = cwd(); + +++ $IncludedFiles{$ARGV[0]} ; + +my(@XSStack) = ({type => 'none'}); # Stack of conditionals and INCLUDEs +my($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA"); + + +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($_) ; + + $_ ; +} + +$typemap = shift @ARGV; +foreach $typemap (@tm) { + die "Can't find $typemap in $pwd\n" unless -r $typemap; +} +unshift @tm, qw(../../../../lib/ExtUtils/typemap ../../../lib/ExtUtils/typemap + ../../lib/ExtUtils/typemap ../../../typemap ../../typemap + ../typemap typemap); +foreach $typemap (@tm) { + next unless -e $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; + $mode = 'Typemap'; + $junk = "" ; + $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 $key (keys %input_expr) { + $input_expr{$key} =~ s/\n+$//; +} + +$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 PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE + SCOPE INTERFACE INTERFACE_MACRO C_ARGS + )) . "|$END)\\s*:"; + +# 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; +} + + +if ($WantLineNumbers) { + { + package xsubpp::counter; + sub TIEHANDLE { + my ($class, $cfile) = @_; + my $buf = ""; + $SECTION_END_MARKER = "#line --- \"$cfile\""; + $line_no = 1; + bless \$buf; + } + + sub PRINT { + my $self = shift; + for (@_) { + $$self .= $_; + while ($$self =~ s/^([^\n]*\n)//) { + my $line = $1; + ++ $line_no; + $line =~ s|^\#line\s+---(?=\s)|#line $line_no|; + print STDOUT $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 STDOUT $$self; + } + } + + my $cfile = $filename; + $cfile =~ s/\.xs$/.c/i or $cfile .= ".c"; + tie(*PSEUDO_STDOUT, 'xsubpp::counter', $cfile); + select PSEUDO_STDOUT; +} + +sub print_section { + # the "do" is required for right semantics + do { $_ = shift(@line) } while !/\S/ && @line; + + print("#line ", $line_no[@line_no - @line -1], " \"$filename\"\n") + if $WantLineNumbers && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/; + for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { + print "$_\n"; + } + print "$xsubpp::counter::SECTION_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/ ; + + # 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) = /^(.*?[^& ]) *(\&?) *\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} ++ ; + + $thisdone |= $var_name eq "THIS"; + $retvaldone |= $var_name eq "RETVAL"; + $var_types{$var_name} = $var_type; + print "\t" . &map_type($var_type); + $var_num = $args_match{$var_name}; + + $proto_arg[$var_num] = ProtoString($var_type) + if $var_num ; + if ($var_addr) { + $var_addr{$var_name} = 1; + $func_args =~ s/\b($var_name)\b/&$1/; + } + if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/) { + print "\t$var_name;\n"; + } elsif ($var_init =~ /\S/) { + &output_init($var_type, $var_num, $var_name, $var_init); + } elsif ($var_num) { + # generate initialization code + &generate_init($var_type, $var_num, $var_name); + } 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); + } + } +} + +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) { + $Interfaces{$_} = $_; + } + 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 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 ALIAS_handler () +{ + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_) ; + GetAliases($_) if $_ ; + } +} + +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 $XSUBPP_version.") + unless $XSUBPP_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 ++ ; + + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_) ; + if ($_ =~ /^DISABLE/i) { + $ScopeThisXSUB = 0 + } + elsif ($_ =~ /^ENABLE/i) { + $ScopeThisXSUB = 1 + } + } + +} + +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, + Handle => $FH, + }) ; + + ++ $FH ; + + # open the new file + open ($FH, "$_") or death("Cannot open '$_': $!") ; + + print Q<<"EOF" ; +# +#/* INCLUDE: Including '$_' from '$filename' */ +# +EOF + + $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 = $data->{Filename} ; + $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; +} + +open($FH, $filename) or die "cannot open $filename: $!\n"; + +# Identify the version of xsubpp used +print <<EOM ; +/* + * This file was generated automatically by xsubpp version $XSUBPP_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 \"$filename\"\n") + if $WantLineNumbers; + +while (<$FH>) { + last if ($Module, $Package, $Prefix) = + /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; + + if ($OBJ) { + s/#if(?:def|\s+defined)\s+(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/; + } + print $_; +} +&Exit unless defined $_; + +print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers; + +$lastline = $_; +$lastline_no = $.; + +# 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(;;) { + 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; +} + +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 a statement on column one?)") + if $line[0] =~ /^\s/; + + # initialize info arrays + undef(%args_match); + undef(%var_types); + undef(%var_addr); + undef(%defaults); + undef($class); + undef($static); + undef($elipsis); + undef($wantRETVAL) ; + undef(%arg_list) ; + undef(@proto_arg) ; + undef($proto_in_this_xsub) ; + undef($scope_in_this_xsub) ; + undef($interface); + $interface_macro = 'XSINTERFACE_FUNC' ; + $interface_macro_set = 'XSINTERFACE_FUNC_SET' ; + $ProtoThisXSUB = $WantPrototypes ; + $ScopeThisXSUB = 0; + + $_ = shift(@line); + while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) { + &{"${kwd}_handler"}() ; + next PARAGRAPH unless @line ; + $_ = shift(@line); + } + + if (check_keyword("BOOT")) { + &check_cpp; + push (@BootCode, "#line $line_no[@line_no - @line] \"$filename\"") + if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/; + push (@BootCode, @line, "") ; + next PARAGRAPH ; + } + + + # extract return type, function name and arguments + ($ret_type) = TidyType($_); + + # a function definition needs at least 2 lines + blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH + unless @line ; + + $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; + + ($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 $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 = (); + $DoSetMagic = 1; + + @args = split(/\s*,\s*/, $orig_args); + if (defined($class)) { + my $arg0 = ((defined($static) or $func_name eq 'new') + ? "CLASS" : "THIS"); + unshift(@args, $arg0); + ($orig_args = "$arg0, $orig_args") =~ s/^$arg0, $/$arg0/; + } + $orig_args =~ s/"/\\"/g; + $min_args = $num_args = @args; + foreach $i (0..$num_args-1) { + if ($args[$i] =~ s/\.\.\.//) { + $elipsis = 1; + $min_args--; + if ($args[$i] eq '' && $i == $num_args - 1) { + pop(@args); + last; + } + } + if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) { + $min_args--; + $args[$i] = $1; + $defaults{$args[$i]} = $2; + $defaults{$args[$i]} =~ s/"/\\"/g; + } + $proto_arg[$i+1] = "\$" ; + } + if (defined($class)) { + $func_args = join(", ", @args[1..$#args]); + } else { + $func_args = join(", ", @args); + } + @args_match{@args} = 1..@args; + + $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); + + # print function header + print Q<<"EOF"; +#XS(XS_${Full_func_name}) +#[[ +# dXSARGS; +EOF + print Q<<"EOF" if $ALIAS ; +# dXSI32; +EOF + print Q<<"EOF" if $INTERFACE ; +# dXSFUNCTION($ret_type); +EOF + if ($elipsis) { + $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 ($ALIAS) + { print Q<<"EOF" if $cond } +# if ($cond) +# croak("Usage: %s($orig_args)", GvNAME(CvGV(cv))); +EOF + else + { print Q<<"EOF" if $cond } +# if ($cond) +# croak("Usage: $pname($orig_args)"); +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|PROTOTYPE|SCOPE") ; + + 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\tcroak(\"$pname: not implemented yet\");\n"; + $_ = '' ; + } else { + if ($ret_type ne "void") { + print "\t" . &map_type($ret_type) . "\tRETVAL;\n" + if !$retvaldone; + $args_match{"RETVAL"} = 0; + $var_types{"RETVAL"} = $ret_type; + } + + print $deferred; + + process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; + + 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/^($spat)// + if defined($spat); + $func_name = 'XSFUNCTION' if $interface; + print "$func_name($func_args);\n"; + } + } + + # do output variables + $gotRETVAL = 0; + undef $RETVAL_code ; + undef %outargs ; + process_keyword("OUTPUT|ALIAS|PROTOTYPE"); + + # all OUTPUT done, so now push the return value on the stack + if ($gotRETVAL && $RETVAL_code) { + print "\t$RETVAL_code\n"; + } elsif ($gotRETVAL || $wantRETVAL) { + # RETVAL almost never needs SvSETMAGIC() + &generate_output($ret_type, 0, 'RETVAL', 0); + } + + # do cleanup + process_keyword("CLEANUP|ALIAS|PROTOTYPE") ; + + 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]) +# croak(errbuf); +EOF + + if ($ret_type ne "void" or $EXPLICIT_RETURN) { + print Q<<EOF unless $PPCODE; +# XSRETURN(1); +EOF + } else { + print Q<<EOF unless $PPCODE; +# XSRETURN_EMPTY; +EOF + } + + print Q<<EOF; +#]] +# +EOF + + my $newXS = "newXS" ; + my $proto = "" ; + + # Build the prototype string for the xsub + if ($ProtoThisXSUB) { + $newXS = "newXSproto"; + + if ($ProtoThisXSUB eq 2) { + # User has specified empty prototype + $proto = ', ""' ; + } + elsif ($ProtoThisXSUB ne 1) { + # User has specified a prototype + $proto = ', "' . $ProtoThisXSUB . '"'; + } + else { + my $s = ';'; + if ($min_args < $num_args) { + $s = ''; + $proto_arg[$min_args] .= ";" ; + } + push @proto_arg, "$s\@" + if $elipsis ; + + $proto = ', "' . join ("", @proto_arg) . '"'; + } + } + + 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); +# XSANY.any_i32 = $value ; +EOF + push(@InitFileCode, Q<<"EOF") if $proto; +# sv_setpv((SV*)cv$proto) ; +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); +# $interface_macro_set(cv,$value) ; +EOF + push(@InitFileCode, Q<<"EOF") if $proto; +# sv_setpv((SV*)cv$proto) ; +EOF + } + } + else { + push(@InitFileCode, + " ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n"); + } +} + +# print initialization routine +if ($WantCAPI) { +print Q<<"EOF"; +# +##ifdef __cplusplus +#extern "C" +##endif +#XS(boot__CAPI_entry) +#[[ +# dXSARGS; +# char* file = __FILE__; +# +EOF +} else { +print Q<<"EOF"; +##ifdef __cplusplus +#extern "C" +##endif +#XS(boot_$Module_cname) +#[[ +# dXSARGS; +# char* file = __FILE__; +# +EOF +} + +print Q<<"EOF" if $WantVersionChk ; +# XS_VERSION_BOOTCHECK ; +# +EOF + +print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ; +# { +# CV * cv ; +# +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";; +# XSRETURN_YES; +#]] +# +EOF + +if ($WantCAPI) { +print Q<<"EOF"; +# +##define XSCAPI(name) void name(CV* cv, void* pPerl) +# +##ifdef __cplusplus +#extern "C" +##endif +#XSCAPI(boot_$Module_cname) +#[[ +# SetCPerlObj(pPerl); +# boot__CAPI_entry(cv); +#]] +# +EOF +} + +warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") + unless $ProtoUsed ; +&Exit; + +sub output_init { + local($type, $num, $var, $init) = @_; + local($arg) = "ST(" . ($num - 1) . ")"; + + if( $init =~ /^=/ ) { + eval qq/print "\\t$var $init\\n"/; + warn $@ if $@; + } else { + if( $init =~ s/^\+// && $num ) { + &generate_init($type, $num, $var); + } 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$/; + $type =~ tr/:/_/; + blurt("Error: No INPUT definition for type '$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' found"), return + unless defined $input_expr{$type_kind{$subtype}} ; + $subexpr = $input_expr{$type_kind{$subtype}}; + $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; + eval qq/print "\\t$var;\\n"/; + warn $@ if $@; + $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 !~ /^\t\$var =/) { + eval qq/print "\\t$var;\\n"/; + warn $@ if $@; + $deferred .= eval qq/"\\n$expr;\\n"/; + warn $@ if $@; + } else { + eval qq/print "$expr;\\n"/; + warn $@ if $@; + } +} + +sub generate_output { + local($type, $num, $var, $do_setmagic) = @_; + local($arg) = "ST(" . ($num - ($num != 0)) . ")"; + local($argoff) = $num - 1; + local($ntype); + + $type = TidyType($type) ; + if ($type =~ /^array\(([^,]*),(.*)\)/) { + print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\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' 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' 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(0));\n"; + print "\tSvSETMAGIC(ST(0));\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 ($arg =~ /^ST\(\d+\)$/) { + eval "print qq\a$expr\a"; + warn $@ if $@; + print "\tSvSETMAGIC($arg);\n" if $do_setmagic; + } + } +} + +sub map_type { + my($type) = @_; + + $type =~ tr/:/_/; + $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s; + $type; +} + + +sub Exit { +# If this is VMS, the exit status has meaning to the shell, so we +# use a predictable value (SS$_Normal or SS$_Abort) rather than an +# arbitrary number. +# exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ; + exit ($errors ? 1 : 0); +} |