summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm91
1 files changed, 76 insertions, 15 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm
index d6b63eba63f..c204abcb2d1 100644
--- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm
@@ -15,7 +15,7 @@ BEGIN {
use File::Basename;
-our $VERSION = '6.57_05';
+our $VERSION = '6.63_02';
require ExtUtils::MM_Any;
require ExtUtils::MM_Unix;
@@ -447,21 +447,20 @@ sub init_main {
}
}
-=item init_others (override)
+=item init_tools (override)
-Provide VMS-specific forms of various utility commands, then hand
-off to the default MM_Unix method.
+Provide VMS-specific forms of various utility commands.
-DEV_NULL should probably be overriden with something.
+Sets DEV_NULL to nothing because I don't know how to do it on VMS.
-Also changes EQUALIZE_TIMESTAMP to set revision date of target file to
+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 init_others {
+sub init_tools {
my($self) = @_;
$self->{NOOP} = 'Continue';
@@ -493,17 +492,34 @@ sub init_others {
install([ from_to => {split(' ', <STDIN>)}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]);
CODE
- $self->SUPER::init_others;
+ $self->{UMASK_NULL} = '! ';
- $self->{SHELL} ||= 'Posix';
+ $self->SUPER::init_tools;
- $self->{UMASK_NULL} = '! ';
+ # Use the default shell
+ $self->{SHELL} ||= 'Posix';
# Redirection on VMS goes before the command, not after as on Unix.
# $(DEV_NULL) is used once and its not worth going nuts over making
# it work. However, Unix's DEV_NULL is quite wrong for VMS.
$self->{DEV_NULL} = '';
+ return;
+}
+
+
+=item init_others (override)
+
+Provide VMS-specific forms of various compile and link commands
+
+=cut
+
+sub init_others {
+ my $self = shift;
+
+ # Must come first as we're modifying and deriving from the defaults.
+ $self->SUPER::init_others;
+
if ($self->{OBJECT} =~ /\s/) {
$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
$self->{OBJECT} = $self->wraplist(
@@ -514,6 +530,8 @@ CODE
$self->{LDFROM} = $self->wraplist(
map $self->fixpath($_,0), split /,?\s+/, $self->{LDFROM}
);
+
+ return;
}
@@ -1753,13 +1771,21 @@ native Write command instead. Besides, its faster.
=cut
sub echo {
- my($self, $text, $file, $appending) = @_;
- $appending ||= 0;
+ my($self, $text, $file, $opts) = @_;
+
+ # Compatibility with old options
+ if( !ref $opts ) {
+ my $append = $opts;
+ $opts = { append => $append || 0 };
+ }
+ my $opencmd = $opts->{append} ? 'Open/Append' : 'Open/Write';
+
+ $opts->{allow_variables} = 0 unless defined $opts->{allow_variables};
- my $opencmd = $appending ? 'Open/Append' : 'Open/Write';
+ my $ql_opts = { allow_variables => $opts->{allow_variables} };
my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
- push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) }
+ push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_, $ql_opts) }
split /\n/, $text;
push @cmds, '$(NOECHO) Close MMECHOFILE';
return @cmds;
@@ -1771,14 +1797,49 @@ sub echo {
=cut
sub quote_literal {
- my($self, $text) = @_;
+ my($self, $text, $opts) = @_;
+ $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
# I believe this is all we should need.
$text =~ s{"}{""}g;
+ $text = $opts->{allow_variables}
+ ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
+
return qq{"$text"};
}
+=item escape_dollarsigns
+
+Quote, don't escape.
+
+=cut
+
+sub escape_dollarsigns {
+ my($self, $text) = @_;
+
+ # Quote dollar signs which are not starting a variable
+ $text =~ s{\$ (?!\() }{"\$"}gx;
+
+ return $text;
+}
+
+
+=item escape_all_dollarsigns
+
+Quote, don't escape.
+
+=cut
+
+sub escape_all_dollarsigns {
+ my($self, $text) = @_;
+
+ # Quote dollar signs
+ $text =~ s{\$}{"\$\"}gx;
+
+ return $text;
+}
+
=item escape_newlines
=cut