Update of /cvsroot/module-build/Module-Build/lib/Module/Build
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27541/lib/Module/Build
Modified Files:
Base.pm
Log Message:
Fix some VMS quoting issues and add _backticks() and _quote_args() methods
Index: Base.pm
===================================================================
RCS file: /cvsroot/module-build/Module-Build/lib/Module/Build/Base.pm,v
retrieving revision 1.564
retrieving revision 1.565
diff -u -d -r1.564 -r1.565
--- Base.pm 21 Mar 2006 05:03:52 -0000 1.564
+++ Base.pm 24 Mar 2006 23:26:41 -0000 1.565
@@ -314,23 +314,64 @@
return Cwd::cwd();
}
+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 $return_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 _backticks {
+ # Tries to avoid using true backticks, when possible, so that we
+ # don't have to worry about shell args.
+
+ my ($self, @cmd) = @_;
+ if ($] >= 5.008) {
+ local *FH;
+ open FH, "-|", @cmd or die "Can't run @cmd: $!";
+ return wantarray ? <FH> : join '', <FH>;
+ } else {
+ my $cmd = $self->_quote_args(@cmd);
+ return `$cmd`;
+ }
+}
+
+
# Determine whether a given binary is the same as the perl
# (configuration) that started this process.
sub _perl_is_same {
my ($self, $perl) = @_;
+ my @cmd = ($perl);
+
# When run from the perl core, @INC will include the directories
# where perl is yet to be installed. We need to reference the
# absolute path within the source distribution where it can find
# it's Config.pm This also prevents us from picking up a Config.pm
# from a different configuration that happens to be already
# installed in @INC.
- my $INC = '';
if ($ENV{PERL_CORE}) {
- $INC = '-I' . File::Spec->catdir(File::Basename::dirname($perl), 'lib');
+ push @cmd, '-I' . File::Spec->catdir(File::Basename::dirname($perl), 'lib');
}
- return `$perl $INC -MConfig=myconfig -e print -e myconfig` eq Config->myconfig;
+ push @cmd, qw(-MConfig=myconfig -e print -e myconfig);
+ return $self->_backticks(@cmd) eq Config->myconfig;
}
# Returns the absolute path of the perl interperter used to invoke
@@ -2080,7 +2121,7 @@
foreach my $file (keys %$files) {
my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
- $self->fix_shebang_line($result);
+ $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
$self->make_executable($result);
}
}
@@ -2167,6 +2208,7 @@
sub localize_file_path {
my ($self, $path) = @_;
+ $path =~ s/\.\z// if $self->os_type eq 'VMS';
return File::Spec->catfile( split m{/}, $path );
}
@@ -3669,6 +3711,7 @@
# this before documenting.
my ($self, $args) = @_;
$args = [ $self->split_like_shell($args) ] unless ref($args);
+ $args = [ split(/\s+/, $self->_quote_args($args)) ] if $self->os_type eq 'VMS';
my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter;
# Make sure our local additions to @INC are propagated to the subprocess
|
