diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Module/Build/Platform')
14 files changed, 1471 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Amiga.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Amiga.pm new file mode 100755 index 00000000000..9356325c9f4 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Amiga.pm @@ -0,0 +1,34 @@ +package Module::Build::Platform::Amiga; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::Amiga - Builder class for Amiga platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base>. Please see the L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Default.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Default.pm new file mode 100755 index 00000000000..8d46fc47d56 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Default.pm @@ -0,0 +1,33 @@ +package Module::Build::Platform::Default; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::Default - Stub class for unknown platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base>. Please see the L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/EBCDIC.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/EBCDIC.pm new file mode 100755 index 00000000000..140e27872aa --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/EBCDIC.pm @@ -0,0 +1,34 @@ +package Module::Build::Platform::EBCDIC; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::EBCDIC - Builder class for EBCDIC platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base>. Please see the L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/MPEiX.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/MPEiX.pm new file mode 100755 index 00000000000..66bbdc95da6 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/MPEiX.pm @@ -0,0 +1,34 @@ +package Module::Build::Platform::MPEiX; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::MPEiX - Builder class for MPEiX platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base>. Please see the L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/MacOS.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/MacOS.pm new file mode 100755 index 00000000000..b80781bd955 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/MacOS.pm @@ -0,0 +1,152 @@ +package Module::Build::Platform::MacOS; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + +use ExtUtils::Install; + +sub have_forkpipe { 0 } + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + + # $Config{sitelib} and $Config{sitearch} are, unfortunately, missing. + foreach ('sitelib', 'sitearch') { + $self->config($_ => $self->config("install$_")) + unless $self->config($_); + } + + # For some reason $Config{startperl} is filled with a bunch of crap. + (my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//; + $self->config(startperl => $sp); + + return $self; +} + +sub make_executable { + my $self = shift; + require MacPerl; + foreach (@_) { + MacPerl::SetFileInfo('McPL', 'TEXT', $_); + } +} + +sub dispatch { + my $self = shift; + + if( !@_ and !@ARGV ) { + require MacPerl; + + # What comes first in the action list. + my @action_list = qw(build test install); + my %actions = map {+($_, 1)} $self->known_actions; + delete @actions{@action_list}; + push @action_list, sort { $a cmp $b } keys %actions; + + my %toolserver = map {+$_ => 1} qw(test disttest diff testdb); + foreach (@action_list) { + $_ .= ' *' if $toolserver{$_}; + } + + my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list); + return unless defined $cmd; + $cmd =~ s/ \*$//; + $ARGV[0] = ($cmd); + + my $args = MacPerl::Ask('Any extra arguments? (ie. verbose=1)', ''); + return unless defined $args; + push @ARGV, $self->split_like_shell($args); + } + + $self->SUPER::dispatch(@_); +} + +sub ACTION_realclean { + my $self = shift; + chmod 0666, $self->{properties}{build_script}; + $self->SUPER::ACTION_realclean; +} + +# ExtUtils::Install has a hard-coded '.' directory in versions less +# than 1.30. We use a sneaky trick to turn that into ':'. +# +# Note that we do it here in a cross-platform way, so this code could +# actually go in Module::Build::Base. But we put it here to be less +# intrusive for other platforms. + +sub ACTION_install { + my $self = shift; + + return $self->SUPER::ACTION_install(@_) + if eval {ExtUtils::Install->VERSION('1.30'); 1}; + + local $^W = 0; # Avoid a 'redefine' warning + local *ExtUtils::Install::find = sub { + my ($code, @dirs) = @_; + + @dirs = map { $_ eq '.' ? File::Spec->curdir : $_ } @dirs; + + return File::Find::find($code, @dirs); + }; + + return $self->SUPER::ACTION_install(@_); +} + +1; +__END__ + +=head1 NAME + +Module::Build::Platform::MacOS - Builder class for MacOS platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base> and override a few methods. Please see +L<Module::Build> for the docs. + +=head2 Overridden Methods + +=over 4 + +=item new() + +MacPerl doesn't define $Config{sitelib} or $Config{sitearch} for some +reason, but $Config{installsitelib} and $Config{installsitearch} are +there. So we copy the install variables to the other location + +=item make_executable() + +On MacOS we set the file type and creator to MacPerl so it will run +with a double-click. + +=item dispatch() + +Because there's no easy way to say "./Build test" on MacOS, if +dispatch is called with no arguments and no @ARGV a dialog box will +pop up asking what action to take and any extra arguments. + +Default action is "test". + +=item ACTION_realclean() + +Need to unlock the Build program before deleting. + +=back + +=head1 AUTHOR + +Michael G Schwern <schwern@pobox.com> + + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/RiscOS.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/RiscOS.pm new file mode 100755 index 00000000000..95e31515876 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/RiscOS.pm @@ -0,0 +1,34 @@ +package Module::Build::Platform::RiscOS; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::RiscOS - Builder class for RiscOS platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base>. Please see the L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Unix.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Unix.pm new file mode 100755 index 00000000000..0be5fc7df07 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Unix.pm @@ -0,0 +1,73 @@ +package Module::Build::Platform::Unix; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + +sub is_executable { + # We consider the owner bit to be authoritative on a file, because + # -x will always return true if the user is root and *any* + # executable bit is set. The -x test seems to try to answer the + # question "can I execute this file", but I think we want "is this + # file executable". + + my ($self, $file) = @_; + return +(stat $file)[2] & 0100; +} + +sub _startperl { "#! " . shift()->perl } + +sub _construct { + my $self = shift()->SUPER::_construct(@_); + + # perl 5.8.1-RC[1-3] had some broken %Config entries, and + # unfortunately Red Hat 9 shipped it like that. Fix 'em up here. + my $c = $self->{config}; + for (qw(siteman1 siteman3 vendorman1 vendorman3)) { + $c->{"install${_}dir"} ||= $c->{"install${_}"}; + } + + return $self; +} + +# Open group says username should be portable filename characters, +# but some Unix OS working with ActiveDirectory wind up with user-names +# with back-slashes in the name. The new code below is very liberal +# in what it accepts. +sub _detildefy { + my ($self, $value) = @_; + $value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username + [$1 ? + ((getpwnam $1)[7] || "~$1") : + ($ENV{HOME} || (getpwuid $>)[7]) + ]ex; + return $value; +} + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::Unix - Builder class for Unix platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base>. Please see the L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/VMS.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/VMS.pm new file mode 100755 index 00000000000..f406b7afb6f --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/VMS.pm @@ -0,0 +1,539 @@ +package Module::Build::Platform::VMS; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; +use Config; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + + + +=head1 NAME + +Module::Build::Platform::VMS - Builder class for VMS platforms + +=head1 DESCRIPTION + +This module inherits from C<Module::Build::Base> and alters a few +minor details of its functionality. Please see L<Module::Build> for +the general docs. + +=head2 Overridden Methods + +=over 4 + +=item _set_defaults + +Change $self->{build_script} to 'Build.com' so @Build works. + +=cut + +sub _set_defaults { + my $self = shift; + $self->SUPER::_set_defaults(@_); + + $self->{properties}{build_script} = 'Build.com'; +} + + +=item cull_args + +'@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing +people to write '@Build "foo"' we'll dispatch case-insensitively. + +=cut + +sub cull_args { + my $self = shift; + my($action, $args) = $self->SUPER::cull_args(@_); + my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions; + + die "Ambiguous action '$action'. Could be one of @possible_actions" + if @possible_actions > 1; + + return ($possible_actions[0], $args); +} + + +=item manpage_separator + +Use '__' instead of '::'. + +=cut + +sub manpage_separator { + return '__'; +} + + +=item prefixify + +Prefixify taking into account VMS' filepath syntax. + +=cut + +# Translated from ExtUtils::MM_VMS::prefixify() +sub _prefixify { + my($self, $path, $sprefix, $type) = @_; + my $rprefix = $self->prefix; + + $self->log_verbose(" prefixify $path from $sprefix to $rprefix\n"); + + # Translate $(PERLPREFIX) to a real path. + $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix; + $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix; + + $self->log_verbose(" rprefix translated to $rprefix\n". + " sprefix translated to $sprefix\n"); + + if( length $path == 0 ) { + $self->log_verbose(" no path to prefixify.\n") + } + elsif( !File::Spec->file_name_is_absolute($path) ) { + $self->log_verbose(" path is relative, not prefixifying.\n"); + } + elsif( $sprefix eq $rprefix ) { + $self->log_verbose(" no new prefix.\n"); + } + else { + my($path_vol, $path_dirs) = File::Spec->splitpath( $path ); + my $vms_prefix = $self->config('vms_prefix'); + if( $path_vol eq $vms_prefix.':' ) { + $self->log_verbose(" $vms_prefix: seen\n"); + + $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.}; + $path = $self->_catprefix($rprefix, $path_dirs); + } + else { + $self->log_verbose(" cannot prefixify.\n"); + return $self->prefix_relpaths($self->installdirs, $type); + } + } + + $self->log_verbose(" now $path\n"); + + return $path; +} + +=item _quote_args + +Command-line arguments (but not the command itself) must be quoted +to ensure case preservation. + +=cut + +sub _quote_args { + # Returns a string that can become [part of] a command line with + # proper quoting so that the subprocess sees this same list of args, + # or if we get a single arg that is an array reference, quote the + # elements of it and return the reference. + my ($self, @args) = @_; + my $got_arrayref = (scalar(@args) == 1 + && UNIVERSAL::isa($args[0], 'ARRAY')) + ? 1 + : 0; + + # Do not quote qualifiers that begin with '/'. + map { if (!/^\//) { + $_ =~ s/\"/""/g; # escape C<"> by doubling + $_ = q(").$_.q("); + } + } + ($got_arrayref ? @{$args[0]} + : @args + ); + + return $got_arrayref ? $args[0] + : join(' ', @args); +} + +=item have_forkpipe + +There is no native fork(), so some constructs depending on it are not +available. + +=cut + +sub have_forkpipe { 0 } + +=item _backticks + +Override to ensure that we quote the arguments but not the command. + +=cut + +sub _backticks { + # The command must not be quoted but the arguments to it must be. + my ($self, @cmd) = @_; + my $cmd = shift @cmd; + my $args = $self->_quote_args(@cmd); + return `$cmd $args`; +} + +=item find_command + +Local an executable program + +=cut + +sub find_command { + my ($self, $command) = @_; + + # a lot of VMS executables have a symbol defined + # check those first + if ( $^O eq 'VMS' ) { + require VMS::DCLsym; + my $syms = VMS::DCLsym->new; + return $command if scalar $syms->getsym( uc $command ); + } + + $self->SUPER::find_command($command); +} + +# _maybe_command copied from ExtUtils::MM_VMS::maybe_command + +=item _maybe_command (override) + +Follows VMS naming conventions for executable files. +If the name passed in doesn't exactly match an executable file, +appends F<.Exe> (or equivalent) to check for executable image, and F<.Com> +to check for DCL procedure. If this fails, checks directories in DCL$PATH +and finally F<Sys$System:> for an executable file having the name specified, +with or without the F<.Exe>-equivalent suffix. + +=cut + +sub _maybe_command { + my($self,$file) = @_; + return $file if -x $file && ! -d _; + my(@dirs) = (''); + my(@exts) = ('',$Config{'exe_ext'},'.exe','.com'); + + if ($file !~ m![/:>\]]!) { + for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) { + my $dir = $ENV{"DCL\$PATH;$i"}; + $dir .= ':' unless $dir =~ m%[\]:]$%; + push(@dirs,$dir); + } + push(@dirs,'Sys$System:'); + foreach my $dir (@dirs) { + my $sysfile = "$dir$file"; + foreach my $ext (@exts) { + return $file if -x "$sysfile$ext" && ! -d _; + } + } + } + return; +} + +=item do_system + +Override to ensure that we quote the arguments but not the command. + +=cut + +sub do_system { + # The command must not be quoted but the arguments to it must be. + my ($self, @cmd) = @_; + $self->log_verbose("@cmd\n"); + my $cmd = shift @cmd; + my $args = $self->_quote_args(@cmd); + return !system("$cmd $args"); +} + +=item oneliner + +Override to ensure that we do not quote the command. + +=cut + +sub oneliner { + my $self = shift; + my $oneliner = $self->SUPER::oneliner(@_); + + $oneliner =~ s/^\"\S+\"//; + + return "MCR $^X $oneliner"; +} + +=item _infer_xs_spec + +Inherit the standard version but tweak the library file name to be +something Dynaloader can find. + +=cut + +sub _infer_xs_spec { + my $self = shift; + my $file = shift; + + my $spec = $self->SUPER::_infer_xs_spec($file); + + # Need to create with the same name as DynaLoader will load with. + if (defined &DynaLoader::mod2fname) { + my $file = $$spec{module_name} . '.' . $self->{config}->get('dlext'); + $file =~ tr/:/_/; + $file = DynaLoader::mod2fname([$file]); + $$spec{lib_file} = File::Spec->catfile($$spec{archdir}, $file); + } + + return $spec; +} + +=item rscan_dir + +Inherit the standard version but remove dots at end of name. +If the extended character set is in effect, do not remove dots from filenames +with Unix path delimiters. + +=cut + +sub rscan_dir { + my ($self, $dir, $pattern) = @_; + + my $result = $self->SUPER::rscan_dir( $dir, $pattern ); + + for my $file (@$result) { + if (!_efs() && ($file =~ m#/#)) { + $file =~ s/\.$//; + } + } + return $result; +} + +=item dist_dir + +Inherit the standard version but replace embedded dots with underscores because +a dot is the directory delimiter on VMS. + +=cut + +sub dist_dir { + my $self = shift; + + my $dist_dir = $self->SUPER::dist_dir; + $dist_dir =~ s/\./_/g unless _efs(); + return $dist_dir; +} + +=item man3page_name + +Inherit the standard version but chop the extra manpage delimiter off the front if +there is one. The VMS version of splitdir('[.foo]') returns '', 'foo'. + +=cut + +sub man3page_name { + my $self = shift; + + my $mpname = $self->SUPER::man3page_name( shift ); + my $sep = $self->manpage_separator; + $mpname =~ s/^$sep//; + return $mpname; +} + +=item expand_test_dir + +Inherit the standard version but relativize the paths as the native glob() doesn't +do that for us. + +=cut + +sub expand_test_dir { + my ($self, $dir) = @_; + + my @reldirs = $self->SUPER::expand_test_dir( $dir ); + + for my $eachdir (@reldirs) { + my ($v,$d,$f) = File::Spec->splitpath( $eachdir ); + my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) ); + $eachdir = File::Spec->catfile( $reldir, $f ); + } + return @reldirs; +} + +=item _detildefy + +The home-grown glob() does not currently handle tildes, so provide limited support +here. Expect only UNIX format file specifications for now. + +=cut + +sub _detildefy { + my ($self, $arg) = @_; + + # Apparently double ~ are not translated. + return $arg if ($arg =~ /^~~/); + + # Apparently ~ followed by whitespace are not translated. + return $arg if ($arg =~ /^~ /); + + if ($arg =~ /^~/) { + my $spec = $arg; + + # Remove the tilde + $spec =~ s/^~//; + + # Remove any slash following the tilde if present. + $spec =~ s#^/##; + + # break up the paths for the merge + my $home = VMS::Filespec::unixify($ENV{HOME}); + + # In the default VMS mode, the trailing slash is present. + # In Unix report mode it is not. The parsing logic assumes that + # it is present. + $home .= '/' unless $home =~ m#/$#; + + # Trivial case of just ~ by it self + if ($spec eq '') { + $home =~ s#/$##; + return $home; + } + + my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home); + if ($hdir eq '') { + # Someone has tampered with $ENV{HOME} + # So hfile is probably the directory since this should be + # a path. + $hdir = $hfile; + } + + my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec); + + my @hdirs = File::Spec::Unix->splitdir($hdir); + my @dirs = File::Spec::Unix->splitdir($dir); + + my $newdirs; + + # Two cases of tilde handling + if ($arg =~ m#^~/#) { + + # Simple case, just merge together + $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs); + + } else { + + # Complex case, need to add an updir - No delimiters + my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir); + + $newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs); + + } + + # Now put the two cases back together + $arg = File::Spec::Unix->catpath($hvol, $newdirs, $file); + + } + return $arg; + +} + +=item find_perl_interpreter + +On VMS, $^X returns the fully qualified absolute path including version +number. It's logically impossible to improve on it for getting the perl +we're currently running, and attempting to manipulate it is usually +lossy. + +=cut + +sub find_perl_interpreter { + return VMS::Filespec::vmsify($^X); +} + +=item localize_file_path + +Convert the file path to the local syntax + +=cut + +sub localize_file_path { + my ($self, $path) = @_; + $path = VMS::Filespec::vmsify($path); + $path =~ s/\.\z//; + return $path; +} + +=item localize_dir_path + +Convert the directory path to the local syntax + +=cut + +sub localize_dir_path { + my ($self, $path) = @_; + return VMS::Filespec::vmspath($path); +} + +=item ACTION_clean + +The home-grown glob() expands a bit too aggressively when given a bare name, +so default in a zero-length extension. + +=cut + +sub ACTION_clean { + my ($self) = @_; + foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) { + $self->delete_filetree($item); + } +} + + +# Need to look up the feature settings. The preferred way is to use the +# VMS::Feature module, but that may not be available to dual life modules. + +my $use_feature; +BEGIN { + if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { + $use_feature = 1; + } +} + +# Need to look up the UNIX report mode. This may become a dynamic mode +# in the future. +sub _unix_rpt { + my $unix_rpt; + if ($use_feature) { + $unix_rpt = VMS::Feature::current("filename_unix_report"); + } else { + my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; + $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; + } + return $unix_rpt; +} + +# Need to look up the EFS character set mode. This may become a dynamic +# mode in the future. +sub _efs { + my $efs; + if ($use_feature) { + $efs = VMS::Feature::current("efs_charset"); + } else { + my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; + $efs = $env_efs =~ /^[ET1]/i; + } + return $efs; +} + +=back + +=head1 AUTHOR + +Michael G Schwern <schwern@pobox.com> +Ken Williams <kwilliams@cpan.org> +Craig A. Berry <craigberry@mac.com> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut + +1; +__END__ diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/VOS.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/VOS.pm new file mode 100755 index 00000000000..001a9507d44 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/VOS.pm @@ -0,0 +1,34 @@ +package Module::Build::Platform::VOS; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::VOS - Builder class for VOS platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base>. Please see the L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Windows.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Windows.pm new file mode 100755 index 00000000000..1e248a75c5f --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/Windows.pm @@ -0,0 +1,320 @@ +package Module::Build::Platform::Windows; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; + +use Config; +use File::Basename; +use File::Spec; +use IO::File; + +use Module::Build::Base; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); + + +sub manpage_separator { + return '.'; +} + +sub have_forkpipe { 0 } + +sub _detildefy { + my ($self, $value) = @_; + $value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x + if $ENV{HOME}; + return $value; +} + +sub ACTION_realclean { + my ($self) = @_; + + $self->SUPER::ACTION_realclean(); + + my $basename = basename($0); + $basename =~ s/(?:\.bat)?$//i; + + if ( lc $basename eq lc $self->build_script ) { + if ( $self->build_bat ) { + $self->log_verbose("Deleting $basename.bat\n"); + my $full_progname = $0; + $full_progname =~ s/(?:\.bat)?$/.bat/i; + + # Voodoo required to have a batch file delete itself without error; + # Syntax differs between 9x & NT: the later requires a null arg (???) + require Win32; + my $null_arg = (Win32::IsWinNT()) ? '""' : ''; + my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname"); + + my $fh = IO::File->new(">> $basename.bat") + or die "Can't create $basename.bat: $!"; + print $fh $cmd; + close $fh ; + } else { + $self->delete_filetree($self->build_script . '.bat'); + } + } +} + +sub make_executable { + my $self = shift; + + $self->SUPER::make_executable(@_); + + foreach my $script (@_) { + + # Native batch script + if ( $script =~ /\.(bat|cmd)$/ ) { + $self->SUPER::make_executable($script); + next; + + # Perl script that needs to be wrapped in a batch script + } else { + my %opts = (); + if ( $script eq $self->build_script ) { + $opts{ntargs} = q(-x -S %0 --build_bat %*); + $opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9); + } + + my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)}; + if ( $@ ) { + $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@"); + } else { + $self->SUPER::make_executable($out); + } + } + } +} + +# This routine was copied almost verbatim from the 'pl2bat' utility +# distributed with perl. It requires too much voodoo with shell quoting +# differences and shortcomings between the various flavors of Windows +# to reliably shell out +sub pl2bat { + my $self = shift; + my %opts = @_; + + # NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate + $opts{ntargs} = '-x -S %0 %*' unless exists $opts{ntargs}; + $opts{otherargs} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $opts{otherargs}; + + $opts{stripsuffix} = '/\\.plx?/' unless exists $opts{stripsuffix}; + $opts{stripsuffix} = ($opts{stripsuffix} =~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E"); + + unless (exists $opts{out}) { + $opts{out} = $opts{in}; + $opts{out} =~ s/$opts{stripsuffix}$//oi; + $opts{out} .= '.bat' unless $opts{in} =~ /\.bat$/i or $opts{in} =~ /^-$/; + } + + my $head = <<EOT; + \@rem = '--*-Perl-*-- + \@echo off + if "%OS%" == "Windows_NT" goto WinNT + perl $opts{otherargs} + goto endofperl + :WinNT + perl $opts{ntargs} + if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl + if %errorlevel% == 9009 echo You do not have Perl in your PATH. + if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul + goto endofperl + \@rem '; +EOT + + $head =~ s/^\s+//gm; + my $headlines = 2 + ($head =~ tr/\n/\n/); + my $tail = "\n__END__\n:endofperl\n"; + + my $linedone = 0; + my $taildone = 0; + my $linenum = 0; + my $skiplines = 0; + + my $start = $Config{startperl}; + $start = "#!perl" unless $start =~ /^#!.*perl/; + + my $in = IO::File->new("< $opts{in}") or die "Can't open $opts{in}: $!"; + my @file = <$in>; + $in->close; + + foreach my $line ( @file ) { + $linenum++; + if ( $line =~ /^:endofperl\b/ ) { + if (!exists $opts{update}) { + warn "$opts{in} has already been converted to a batch file!\n"; + return; + } + $taildone++; + } + if ( not $linedone and $line =~ /^#!.*perl/ ) { + if (exists $opts{update}) { + $skiplines = $linenum - 1; + $line .= "#line ".(1+$headlines)."\n"; + } else { + $line .= "#line ".($linenum+$headlines)."\n"; + } + $linedone++; + } + if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) { + $line = ""; + } + } + + my $out = IO::File->new("> $opts{out}") or die "Can't open $opts{out}: $!"; + print $out $head; + print $out $start, ( $opts{usewarnings} ? " -w" : "" ), + "\n#line ", ($headlines+1), "\n" unless $linedone; + print $out @file[$skiplines..$#file]; + print $out $tail unless $taildone; + $out->close; + + return $opts{out}; +} + + +sub _quote_args { + # Returns a string that can become [part of] a command line with + # proper quoting so that the subprocess sees this same list of args. + my ($self, @args) = @_; + + my @quoted; + + for (@args) { + if ( /^[^\s*?!\$<>;|'"\[\]\{\}]+$/ ) { + # Looks pretty safe + push @quoted, $_; + } else { + # XXX this will obviously have to improve - is there already a + # core module lying around that does proper quoting? + s/"/\\"/g; + push @quoted, qq("$_"); + } + } + + return join " ", @quoted; +} + + +sub split_like_shell { + # As it turns out, Windows command-parsing is very different from + # Unix command-parsing. Double-quotes mean different things, + # backslashes don't necessarily mean escapes, and so on. So we + # can't use Text::ParseWords::shellwords() to break a command string + # into words. The algorithm below was bashed out by Randy and Ken + # (mostly Randy), and there are a lot of regression tests, so we + # should feel free to adjust if desired. + + (my $self, local $_) = @_; + + return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY'); + + my @argv; + return @argv unless defined() && length(); + + my $arg = ''; + my( $i, $quote_mode ) = ( 0, 0 ); + + while ( $i < length() ) { + + my $ch = substr( $_, $i , 1 ); + my $next_ch = substr( $_, $i+1, 1 ); + + if ( $ch eq '\\' && $next_ch eq '"' ) { + $arg .= '"'; + $i++; + } elsif ( $ch eq '\\' && $next_ch eq '\\' ) { + $arg .= '\\'; + $i++; + } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) { + $quote_mode = !$quote_mode; + $arg .= '"'; + $i++; + } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode && + ( $i + 2 == length() || + substr( $_, $i + 2, 1 ) eq ' ' ) + ) { # for cases like: a"" => [ 'a' ] + push( @argv, $arg ); + $arg = ''; + $i += 2; + } elsif ( $ch eq '"' ) { + $quote_mode = !$quote_mode; + } elsif ( $ch eq ' ' && !$quote_mode ) { + push( @argv, $arg ) if $arg; + $arg = ''; + ++$i while substr( $_, $i + 1, 1 ) eq ' '; + } else { + $arg .= $ch; + } + + $i++; + } + + push( @argv, $arg ) if defined( $arg ) && length( $arg ); + return @argv; +} + + +# system(@cmd) does not like having double-quotes in it on Windows. +# So we quote them and run it as a single command. +sub do_system { + my ($self, @cmd) = @_; + + my $cmd = $self->_quote_args(@cmd); + my $status = system($cmd); + if ($status and $! =~ /Argument list too long/i) { + my $env_entries = ''; + foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " } + warn "'Argument list' was 'too long', env lengths are $env_entries"; + } + return !$status; +} + +# Copied from ExtUtils::MM_Win32 +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; +} + + +1; + +__END__ + +=head1 NAME + +Module::Build::Platform::Windows - Builder class for Windows platforms + +=head1 DESCRIPTION + +The sole purpose of this module is to inherit from +C<Module::Build::Base> and override a few methods. Please see +L<Module::Build> for the docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/aix.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/aix.pm new file mode 100755 index 00000000000..dab064805d3 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/aix.pm @@ -0,0 +1,40 @@ +package Module::Build::Platform::aix; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Platform::Unix; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Platform::Unix); + +# This class isn't necessary anymore, but we can't delete it, because +# some people might still have the old copy in their @INC, containing +# code we don't want to execute, so we have to make sure an upgrade +# will replace it with this empty subclass. + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::aix - Builder class for AIX platform + +=head1 DESCRIPTION + +This module provides some routines very specific to the AIX +platform. + +Please see the L<Module::Build> for the general docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/cygwin.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/cygwin.pm new file mode 100755 index 00000000000..37c59ad0ce2 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/cygwin.pm @@ -0,0 +1,55 @@ +package Module::Build::Platform::cygwin; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Platform::Unix; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Platform::Unix); + +sub manpage_separator { + '.' +} + +# Copied from ExtUtils::MM_Cygwin::maybe_command() +# If our path begins with F</cygdrive/> then we use C<ExtUtils::MM_Win32> +# to determine if it may be a command. Otherwise we use the tests +# from C<ExtUtils::MM_Unix>. + +sub _maybe_command { + my ($self, $file) = @_; + + if ($file =~ m{^/cygdrive/}i) { + require Module::Build::Platform::Win32; + return Module::Build::Platform::Win32->_maybe_command($file); + } + + return $self->SUPER::_maybe_command($file); +} + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::cygwin - Builder class for Cygwin platform + +=head1 DESCRIPTION + +This module provides some routines very specific to the cygwin +platform. + +Please see the L<Module::Build> for the general docs. + +=head1 AUTHOR + +Initial stub by Yitzchak Scott-Thoennes <sthoenna@efn.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/darwin.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/darwin.pm new file mode 100755 index 00000000000..c2f3126c440 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/darwin.pm @@ -0,0 +1,40 @@ +package Module::Build::Platform::darwin; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Platform::Unix; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Platform::Unix); + +# This class isn't necessary anymore, but we can't delete it, because +# some people might still have the old copy in their @INC, containing +# code we don't want to execute, so we have to make sure an upgrade +# will replace it with this empty subclass. + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::darwin - Builder class for Mac OS X platform + +=head1 DESCRIPTION + +This module provides some routines very specific to the Mac OS X +platform. + +Please see the L<Module::Build> for the general docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/os2.pm b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/os2.pm new file mode 100755 index 00000000000..be164ae980b --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Module/Build/Platform/os2.pm @@ -0,0 +1,49 @@ +package Module::Build::Platform::os2; + +use strict; +use vars qw($VERSION); +$VERSION = '0.3603'; +$VERSION = eval $VERSION; +use Module::Build::Platform::Unix; + +use vars qw(@ISA); +@ISA = qw(Module::Build::Platform::Unix); + +sub manpage_separator { '.' } + +sub have_forkpipe { 0 } + +# Copied from ExtUtils::MM_OS2::maybe_command +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; +} + +1; +__END__ + + +=head1 NAME + +Module::Build::Platform::os2 - Builder class for OS/2 platform + +=head1 DESCRIPTION + +This module provides some routines very specific to the OS/2 +platform. + +Please see the L<Module::Build> for the general docs. + +=head1 AUTHOR + +Ken Williams <kwilliams@cpan.org> + +=head1 SEE ALSO + +perl(1), Module::Build(3), ExtUtils::MakeMaker(3) + +=cut |