4 files changed, 560 insertions, 0 deletions
diff --git a/lib/ExtUtils/Helpers.pm b/lib/ExtUtils/Helpers.pm
new file mode 100644
index 0000000..bfa4dae
--- /dev/null
+++ b/lib/ExtUtils/Helpers.pm
@@ -0,0 +1,120 @@
+package ExtUtils::Helpers;
+$ExtUtils::Helpers::VERSION = '0.022';
+use strict;
+use warnings FATAL => 'all';
+use Exporter 5.57 'import';
+
+use Config;
+use File::Basename qw/basename/;
+use File::Spec::Functions qw/splitpath canonpath abs2rel splitdir/;
+use Module::Load;
+
+our @EXPORT_OK = qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;
+
+BEGIN {
+	my %impl_for = ( MSWin32 => 'Windows', VMS => 'VMS');
+	my $package = 'ExtUtils::Helpers::' . ($impl_for{$^O} || 'Unix');
+	load($package);
+	$package->import();
+}
+
+sub man1_pagename {
+	my $filename = shift;
+	return basename($filename).".$Config{man1ext}";
+}
+
+my %separator = (
+	MSWin32 => '.',
+	VMS => '__',
+	os2 => '.',
+	cygwin => '.',
+);
+my $separator = $separator{$^O} || '::';
+
+sub man3_pagename {
+	my ($filename, $base) = @_;
+	$base ||= 'lib';
+	my ($vols, $dirs, $file) = splitpath(canonpath(abs2rel($filename, $base)));
+	$file = basename($file, qw/.pm .pod/);
+	my @dirs = grep { length } splitdir($dirs);
+	return join $separator, @dirs, "$file.$Config{man3ext}";
+}
+
+1;
+
+# ABSTRACT: Various portability utilities for module builders
+
+__END__
+
+=pod
+
+=encoding utf-8
+
+=head1 NAME
+
+ExtUtils::Helpers - Various portability utilities for module builders
+
+=head1 VERSION
+
+version 0.022
+
+=head1 SYNOPSIS
+
+ use ExtUtils::Helpers qw/make_executable split_like_shell/;
+
+ unshift @ARGV, split_like_shell($ENV{PROGRAM_OPTS});
+ write_script_to('Build');
+ make_executable('Build');
+
+=head1 DESCRIPTION
+
+This module provides various portable helper functions for module building modules.
+
+=head1 FUNCTIONS
+
+=head2 make_executable($filename)
+
+This makes a perl script executable.
+
+=head2 split_like_shell($string)
+
+This function splits a string the same way as the local platform does.
+
+=head2 detildefy($path)
+
+This function substitutes a tilde at the start of a path with the users homedir in an appropriate manner.
+
+=head2 man1_pagename($filename)
+
+Returns the man page filename for a script.
+
+=head2 man3_pagename($filename, $basedir)
+
+Returns the man page filename for a Perl library.
+
+=head1 ACKNOWLEDGEMENTS
+
+Olivier Mengué and Christian Walde made C<make_executable> work on Windows.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Ken Williams <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
diff --git a/lib/ExtUtils/Helpers/Unix.pm b/lib/ExtUtils/Helpers/Unix.pm
new file mode 100644
index 0000000..06f3ea8
--- /dev/null
+++ b/lib/ExtUtils/Helpers/Unix.pm
@@ -0,0 +1,97 @@
+package ExtUtils::Helpers::Unix;
+$ExtUtils::Helpers::Unix::VERSION = '0.022';
+use strict;
+use warnings FATAL => 'all';
+
+use Exporter 5.57 'import';
+our @EXPORT = qw/make_executable split_like_shell detildefy/;
+
+use Carp qw/croak/;
+use Config;
+use Text::ParseWords 3.24 qw/shellwords/;
+
+my $layer = $] >= 5.008001 ? ":raw" : "";
+
+sub make_executable {
+	my $filename = shift;
+	my $current_mode = (stat $filename)[2] + 0;
+	if (-T $filename) {
+		open my $fh, "<$layer", $filename;
+		my @lines = <$fh>;
+		if (@lines and $lines[0] =~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms) {
+			open my $out, ">$layer", "$filename.new" or croak "Couldn't open $filename.new: $!";
+			print $out @lines;
+			close $out;
+			rename $filename, "$filename.bak" or croak "Couldn't rename $filename to $filename.bak";
+			rename "$filename.new", $filename or croak "Couldn't rename $filename.new to $filename";
+			unlink "$filename.bak";
+		}
+	}
+	chmod $current_mode | oct(111), $filename;
+	return;
+}
+
+sub split_like_shell {
+	my ($string) = @_;
+
+	return if not defined $string;
+	$string =~ s/^\s+|\s+$//g;
+	return if not length $string;
+
+	return shellwords($string);
+}
+
+sub detildefy {
+	my $value = shift;
+	# tilde with optional username
+	for ($value) {
+		s{ ^ ~ (?= /|$)}          [ $ENV{HOME} || (getpwuid $>)[7] ]ex or # tilde without user name
+		s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex;        # tilde with user name
+	}
+	return $value;
+}
+
+1;
+
+# ABSTRACT: Unix specific helper bits
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+ExtUtils::Helpers::Unix - Unix specific helper bits
+
+=head1 VERSION
+
+version 0.022
+
+=for Pod::Coverage make_executable
+split_like_shell
+detildefy
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Ken Williams <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
diff --git a/lib/ExtUtils/Helpers/VMS.pm b/lib/ExtUtils/Helpers/VMS.pm
new file mode 100644
index 0000000..8b51b83
--- /dev/null
+++ b/lib/ExtUtils/Helpers/VMS.pm
@@ -0,0 +1,129 @@
+package ExtUtils::Helpers::VMS;
+$ExtUtils::Helpers::VMS::VERSION = '0.022';
+use strict;
+use warnings FATAL => 'all';
+
+use Exporter 5.57 'import';
+our @EXPORT = qw/make_executable split_like_shell detildefy/;
+
+use ExtUtils::Helpers::Unix qw/split_like_shell/; # Probably very wrong, but whatever
+use File::Copy qw/copy/;
+
+sub make_executable {
+	my $filename = shift;
+	my $batchname = "$filename.com";
+	copy($filename, $batchname);
+	ExtUtils::Helpers::Unix::make_executable($batchname);
+	return;
+}
+
+sub detildefy {
+	my $arg = shift;
+
+	# 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;
+}
+
+# ABSTRACT: VMS specific helper bits
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+ExtUtils::Helpers::VMS - VMS specific helper bits
+
+=head1 VERSION
+
+version 0.022
+
+=for Pod::Coverage make_executable
+detildefy
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Ken Williams <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
diff --git a/lib/ExtUtils/Helpers/Windows.pm b/lib/ExtUtils/Helpers/Windows.pm
new file mode 100644
index 0000000..62d38d1
--- /dev/null
+++ b/lib/ExtUtils/Helpers/Windows.pm
@@ -0,0 +1,214 @@
+package ExtUtils::Helpers::Windows;
+$ExtUtils::Helpers::Windows::VERSION = '0.022';
+use strict;
+use warnings FATAL => 'all';
+
+use Exporter 5.57 'import';
+our @EXPORT = qw/make_executable split_like_shell detildefy/;
+
+use Config;
+use Carp qw/carp croak/;
+
+sub make_executable {
+	my $script = shift;
+	if (-T $script && $script !~ / \. (?:bat|cmd) $ /x) {
+		_pl2bat(in => $script, update => 1);
+	}
+	return;
+}
+
+# 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 %opts = @_;
+
+	# NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate
+	$opts{ntargs}    = '-x -S %0 %*';
+	$opts{otherargs} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9';
+
+	$opts{stripsuffix} = qr/\.plx?/ unless exists $opts{stripsuffix};
+
+	if (not exists $opts{out}) {
+		$opts{out} = $opts{in};
+		$opts{out} =~ s/$opts{stripsuffix}$//i;
+		$opts{out} .= '.bat' unless $opts{in} =~ /\.bat$/i or $opts{in} eq '-';
+	}
+
+	my $head = <<"EOT";
+	\@rem = '--*-Perl-*--
+	\@echo off
+	if "%OS%" == "Windows_NT" goto WinNT
+	perl $opts{otherargs}
+	\@set ErrorLevel=%ErrorLevel%
+	goto endofperl
+	:WinNT
+	perl $opts{ntargs}
+	\@set ErrorLevel=%ErrorLevel%
+	if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
+	if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+	goto endofperl
+	\@rem ';
+EOT
+
+	$head =~ s/^\s+//gm;
+	my $headlines = 2 + ($head =~ tr/\n/\n/);
+	my $tail = <<'EOT';
+	__END__
+	:endofperl
+	@"%COMSPEC%" /c exit /b %ErrorLevel%
+EOT
+	$tail =~ s/^\s+//gm;
+
+	my $linedone = 0;
+	my $taildone = 0;
+	my $linenum = 0;
+	my $skiplines = 0;
+
+	my $start = $Config{startperl};
+	$start = '#!perl' unless $start =~ /^#!.*perl/;
+
+	open my $in, '<', $opts{in} or croak "Can't open $opts{in}: $!";
+	my @file = <$in>;
+	close $in;
+
+	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 = '';
+		}
+	}
+
+	open my $out, '>', $opts{out} or croak "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;
+	close $out;
+
+	return $opts{out};
+}
+
+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.
+
+	local ($_) = @_;
+
+	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 =~ /\s/ && !$quote_mode ) {
+			push @argv, $arg if $arg;
+			$arg = '';
+			++$i while substr( $_, $i + 1, 1 ) =~ /\s/;
+		} else {
+			$arg .= $ch;
+		}
+
+		$i++;
+	}
+
+	push @argv, $arg if defined $arg && length $arg;
+	return @argv;
+}
+
+sub detildefy {
+	my $value = shift;
+	$value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if $ENV{USERPROFILE};
+	return $value;
+}
+
+1;
+
+# ABSTRACT: Windows specific helper bits
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+ExtUtils::Helpers::Windows - Windows specific helper bits
+
+=head1 VERSION
+
+version 0.022
+
+=for Pod::Coverage make_executable
+split_like_shell
+detildefy
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Ken Williams <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut