Re: [blead 2009-05-29.22:08:17] vms.c EFS logical name fix.
"John E. Malmberg" <[email protected]>
| Newsgroups | gmane.comp.lang.perl.ports.vms |
|---|---|
| Message-ID | <[email protected]> |
John E. Malmberg wrote: > Craig A. Berry wrote: >> >> >> I went back to my original test case (not the narrower one you ended >> up fixing) and it looks like we are half-way there. If both >> DECC$EFS_CHARSET and DECC$FILENAME_UNIX_REPORT are defined, this works: >> >> $ perl -"MFile::Spec::Functions" -e "print >> catfile(File::Spec->tmpdir(), 'bar');" >> /sys$scratch/bar >> >> but if only DECC$EFS_CHARSET is defined, it doesn't: >> >> $ perl -"MFile::Spec::Functions" -e "print >> catfile(File::Spec->tmpdir(), 'bar');" >> [.sys$scratch:]bar > > The attached patch has not been run through a full test run yet. > > The problem was that catfile was expecting that the path components were > either contained VMS directory delimiters or were bare words. > > The earlier part of the code detected the trailing ":" so knew to treat > the path a VMS. > > This patch allows a path ending with a ":" to be treated as a VMS > directory path. This patch is better, but still not fully tested. I did not run a comprehensive test of EFS mode with out Unix report also on before, and this is exposing some dragons that are going to take some time to slay. There are a number of tests and modules that will need to be adjusted to handle VMS EFS charsets that I have found. testp2pt.pl needs a patch as it is trying to do catfile() on directories. cwd.t is creating an illegal symbolic link unless it is in UNIX mode, so it does not get resolved. ext/File-Glob/t/Basic.t is trying to compare the results of a directory in UNIX syntax with one in VMS syntax. With EFS on, VMS names with out extensions have the trailing periods present. There are a few other failures that I do not understand yet. Regards, -John [email protected] Personal Opinion Only
file_spec_vms_pm.gdiff
(text/plain, 6.9 KB)
--- /rsync_root/perl/lib/File/Spec/VMS.pm Sun May 10 04:02:09 2009
+++ lib/File/Spec/VMS.pm Mon Jun 8 01:19:01 2009
@@ -195,6 +195,32 @@
if ($efs) {
# Extended character set in use, go into DWIM mode.
+ if ($path =~ /:$/) {
+ # We have a problem. If we do a syntax only conversion
+ # we can break existing code that does not understand how
+ # logical names and directories can be combined.
+ my $test_path = $path;
+ my $i = 0;
+ while ($i < 10) {
+ # We need to do a logical name check, but we do not have
+ # logical name services in perl. So we need to $ENV until
+ # that can be remedied.
+ $test_path =~ s/:$//;
+ my $test_trnlnm = $ENV{$test_path};
+ last unless defined $test_trnlnm;
+ if ($test_trnlnm =~ /\.[\]>]$/) {
+ # A rooted logical name, same as device so use as is.
+ last;
+ }
+ if ($test_trnlnm =~ /[\]>]$/) {
+ # Found a directory, use this instead of the path
+ $path = $test_trnlnm;
+ last;
+ }
+ $test_path = $test_trnlnm;
+ $i++;
+ };
+ }
# Now we need to identify what the directory is in
# of the specification in order to merge them.
@@ -204,6 +230,7 @@
my $path_vms = 0;
$path_vms = 1 if ($path =~ m#[\[<\]]#);
$path_vms = 1 if ($path =~ /^--?$/);
+ $path_vms = 1 if ($path =~ /:$/);
my $dir_unix = 0;
$dir_unix = 1 if ($dir =~ m#/#);
$dir_unix = 1 if ($dir =~ /^\.\.?$/);
@@ -237,8 +264,10 @@
#with <> posible instead of [.
# Normalize the brackets
# Fixme - need to not switch when preceded by ^.
- $path =~ s/</\[/g;
- $path =~ s/>/\]/g;
+ if ($path !~ /:$/) {
+ $path =~ s/</\[/g;
+ $path =~ s/>/\]/g;
+ }
$dir =~ s/</\[/g;
$dir =~ s/>/\]/g;
@@ -251,6 +280,7 @@
#If path is foo, it needs to be converted to [.foo]
# Fix up a bare path name.
+ my $is_abs_path = 0;
unless ($path_vms) {
$path =~ s/\.dir\Z(?!\n)//i;
if (($path ne '') && ($path !~ /^-/)) {
@@ -258,6 +288,7 @@
$path = '[.' . $path;
} else {
# Just start a directory.
+ $is_abs_path = 1 if $path eq '';
$path = '[' . $path;
}
} else {
@@ -276,16 +307,25 @@
$dir =~ s/\]$//;
}
- #strip off the leading dot if present.
- $dir =~ s/^\.//;
-
# Now put the specifications together.
if ($dir ne '') {
- # Add a separator unless this is an absolute path
- $path .= '.' if ($path ne '[');
- $rslt = $path . $dir . ']';
+ if ($path =~ /:$/) {
+ $rslt = $path . '[' . $dir . ']';
+ } else {
+
+ #strip off the leading dot if present.
+ $dir =~ s/^\.//;
+
+ # Add a separator unless this is an absolute path
+ $path .= '.' unless $is_abs_path;
+ $rslt = $path . $dir . ']';
+ }
} else {
- $rslt = $path . ']';
+ if ($path =~ /:$/) {
+ $rslt = $path;
+ } else {
+ $rslt = $path . ']';
+ }
}
}
@@ -429,6 +469,7 @@
my $spath_vms = 0;
$spath_vms = 1 if ($spath =~ m#[\[<\]]#);
$spath_vms = 1 if ($spath =~ /^--?$/);
+ $spath_vms = 1 if ($spath =~ /:$/);
# Assume VMS mode
if (($spath_unix == $spath_vms) &&
@@ -439,13 +480,19 @@
$unix_mode = 1
if (($spath_unix || $file_unix) && $unix_rpt);
}
-
if (!$unix_mode) {
if ($spath_vms) {
- $spath = '[' . $spath . ']' if $spath =~ /^-/;
- $rslt = vmspath($spath);
+ if ($spath =~ /^-/) {
+ $rslt = '[' . $spath . ']';
+ } else {
+ $rslt = $spath;
+ }
} else {
- $rslt = '[.' . $spath . ']';
+ if ($spath_unix) {
+ $rslt = vmspath($spath);
+ } else {
+ $rslt = '[.' . $spath . ']';
+ }
}
$file = vmsify($file) if ($file_unix);
} else {
@@ -459,7 +506,7 @@
}
$rslt .= $file;
- $rslt =~ s/\]\[//;
+ $rslt =~ s/\]\[// if !$unix_mode;
} else {
# Traditional VMS Perl mode expects that this is done.
@@ -640,6 +687,7 @@
my $path_vms = 0;
$path_vms = 1 if ($path =~ m#[\[<\]]#);
$path_vms = 1 if ($path =~ /^--?$/);
+ $path_vms = 1 if ($path =~ /:$/);
if (!$path_vms) {
return $self->SUPER::splitpath($path, $nofile);
}
@@ -789,6 +837,7 @@
my $path_vms = 0;
$path_vms = 1 if ($path =~ m#[\[<\]]#);
$path_vms = 1 if ($path =~ /^--?$/);
+ $path_vms = 1 if ($path =~ /:$/);
my $unix_mode = 0;
if ($path_vms == $path_unix) {
@@ -805,6 +854,7 @@
$base_unix = 1 if ($base =~ /^\.\.?$/);
$base_vms = 1 if ($base =~ m#[\[<\]]#);
$base_vms = 1 if ($base =~ /^--?$/);
+ $base_vms = 1 if ($base =~ /:$/);
if ($path_vms == $path_unix) {
if ($base_vms == $base_unix) {
@@ -925,6 +975,7 @@
my $path_vms = 0;
$path_vms = 1 if ($path =~ m#[\[<\]]#);
$path_vms = 1 if ($path =~ /^--?$/);
+ $path_vms = 1 if ($path =~ /:$/);
my $unix_mode = 0;
if ($path_vms == $path_unix) {
@@ -941,6 +992,7 @@
$base_unix = 1 if ($base =~ /^\.\.?$/);
$base_vms = 1 if ($base =~ m#[\[<\]]#);
$base_vms = 1 if ($base =~ /^--?$/);
+ $base_vms = 1 if ($base =~ /:$/);
# If we could not determine the path mode, see if we can find out
# from the base.