Per Craig Berry's suggestion:
Change _detildefy into a method and then provide a VMS override to it.
Presence of file specification starting with a C<~> will cause it to be
treated as a UNIX file specification, as it will not happen in a VMS
format specification.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/Module/Build/Base.pm Fri Sep 28 23:43:35 2007
+++ lib/Module/Build/Base.pm Sat Sep 29 22:33:21 2007
@@ -1651,7 +1651,7 @@
# De-tilde-ify any path parameters
for my $key (qw(prefix install_base destdir)) {
next if !defined $args{$key};
- $args{$key} = _detildefy($args{$key});
+ $args{$key} = $self->_detildefy($args{$key});
}
for my $key (qw(install_path)) {
@@ -1659,7 +1659,7 @@
for my $subkey (keys %{$args{$key}}) {
next if !defined $args{$key}{$subkey};
- my $subkey_ext = _detildefy($args{$key}{$subkey});
+ my $subkey_ext = $self->_detildefy($args{$key}{$subkey});
if ( $subkey eq 'html' ) { # translate for compatability
$args{$key}{binhtml} = $subkey_ext;
$args{$key}{libhtml} = $subkey_ext;
@@ -1681,7 +1681,8 @@
# (bash shell won't expand tildes mid-word: "--foo=~/thing")
# TODO: handle ~user/foo
sub _detildefy {
- my $arg = shift;
+ my ($self, $arg) = @_;
+# my $arg = shift;
return $arg =~ /^~/ ? (glob $arg)[0] : $arg;
}
@@ -2247,7 +2248,7 @@
push @{$p->{include_dirs}}, $p->{c_source};
- my $files = $self->rscan_dir($p->{c_source}, qr('\.c(pp)?$'));
+ my $files = $self->rscan_dir($p->{c_source}, file_qr('\.c(pp)?$'));
foreach my $file (@$files) {
push @{$p->{objects}}, $self->compile_c($file);
}
--- /rsync_root/perl/lib/Module/Build/Platform/VMS.pm Fri Sep 28 23:43:35 2007
+++ lib/Module/Build/Platform/VMS.pm Sun Sep 30 08:52:41 2007
@@ -271,6 +271,73 @@
return @reldirs;
}
+# VMS will not deal with tildes at all.
+# Expect them to only show up in UNIX format file specifications for now.
+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 folloing the tilde if present.
+ $spec =~ s#^/##;
+
+ # break up the paths for the merge
+ my $home = VMS::Filespec::unixify($ENV{HOME});
+
+ # Trivial case of just ~ by it self
+ if ($spec eq '') {
+ 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);
+
+ } else {
+ return $arg;
+ }
+
+}
+
=back
=head1 AUTHOR
