Author: kwilliams
Date: Sun Sep 30 13:33:38 2007
New Revision: 10028
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/Platform/VMS.pm
Log:
Fix _detildefy() on VMS
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Sun Sep 30 13:33:38 2007
@@ -5,6 +5,9 @@
illegal characters in VMS file specs. [John E. Malmberg and Craig
A. Berry]
+ - Fixed the _detildefy() method on VMS. [John E. Malmberg and Craig
+ A. Berry]
+
- We now use a much more reliable method when Data::Dumper-ing saved
state data to the _build/ directory. [Yves]
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 30 13:33:38 2007
@@ -271,6 +271,78 @@
return @reldirs;
}
+=item _detildefy
+
+The home-grown glob() does not currently handle tildes, so provide limited
support
+here. Expect only UNIX format file specifications for now.
+
+=cut
+
+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
