Author: kwilliams
Date: Sun Sep 10 06:11:50 2006
New Revision: 7821
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/lib/Module/Build/Platform/VMS.pm
Log:
Get do_system() and friends working better on VMS.
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Sun Sep 10 06:11:50 2006
@@ -1,5 +1,10 @@
Revision history for Perl extension Module::Build.
+0.2806
+
+ - Changes to do_system() & friends on VMS to get system calls working
+ much better there. [Craig Berry]
+
0.2805_01 Thu Sep 7 21:57:29 CDT 2006
- Because of a weird behavior of YAML::Node, any distribution that
Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm Sun Sep 10 06:11:50 2006
@@ -3880,7 +3880,6 @@
# 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
Modified: Module-Build/trunk/lib/Module/Build/Platform/VMS.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Platform/VMS.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Platform/VMS.pm Sun Sep 10 06:11:50 2006
@@ -118,21 +118,93 @@
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.
+ # 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;
+
+ map { $_ = q(").$_.q(") if !/^\"/ && length($_) > 0 }
+ ($got_arrayref ? @{$args[0]}
+ : @args
+ );
- my $return_args = '';
- for (@args) {
- $return_args .= q( ").$_.q(") if !/^\"/ && length($_) > 0;
- }
- return $return_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 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_info("@cmd\n");
+ my $cmd = shift @cmd;
+ my $args = $self->_quote_args(@cmd);
+ return !system("$cmd $args");
+}
+
+=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 = DynaLoader::mod2fname([$$spec{base_name}]);
+ $$spec{lib_file} = File::Spec->catfile($$spec{archdir},
"$file.$self->{config}->{dlext}");
+ }
+
+ return $spec;
+}
+
=back
=head1 AUTHOR
