h2xs.t change is that when the CRTL features DECC$READDIR_DROPDOTNOTYPE
and DECC$UNIX_FILENAME_REPORT is in effect, there will not be a trailing
dot on UNIX names returned by readdir().
cwd.pm changes are more interesting.
With OpenVMS future that supports symbolic links, there will be a
realpath() routine.
It runs significantly faster than the one that is coded in perl in this
module. I have set a logical name to optionally enable the use of the
Perl script with out it.
Interestingly, the Perl configure step does not generate anything in the
.H file if it detects that a platform has realpath, so I am keying off
symbolic links being available instead.
This change should be dormant in the Perl code until a binary is there
to support it.
Another interesting side effect showed up in testing. OpenVMS can
always be made to return an untainted absolute path in UNIX or VMS syntax.
The perl tests scripts do not know that, and will fail if VMS does, so
instead of using an easy way of returning the current working directory
in Posix mode, I have to translate the tainted environment variable so
that I return a tainted current working directory.
Someone better at Perl scripts than me can probably clean this one up a bit.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- lib/h2xs.t_5_8_4 Thu Apr 21 17:32:20 2005
+++ lib/h2xs.t Tue May 3 12:22:14 2005
@@ -32,6 +32,55 @@
my $extracted_program = '../utils/h2xs'; # unix, nt, ...
if ($^O eq 'VMS') { $extracted_program = '[-.utils]h2xs.com'; }
+
+# VMS can pretend it is UNIX.
+
+my $IsVMS = $^O eq 'VMS';
+my $posix_compliant;
+my $unix_report;
+my $unix_only;
+my $case_preserved = 1;
+my $vms_drop_dot;
+my $vms_format = 0;
+if ($IsVMS) {
+ $vms_format = 1;
+ $posix_compliant = $ENV{'DECC$POSIX_COMPLIANT_PATHNAMES'};
+ if (defined $posix_compliant) {
+ if (($posix_compliant lt '1') && ($posix_compliant ne 'ENABLE')) {
+ $posix_compliant = undef;
+ }
+ }
+ $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'};
+ if (defined $unix_report) {
+ if (($unix_report lt '1') && ($unix_report ne 'ENABLE')) {
+ $unix_report = undef;
+ }
+ }
+ $unix_only = $ENV{'DECC$FILENAME_UNIX_ONLY'};
+ if (defined $unix_only) {
+ if (($unix_only lt '1') && ($unix_only ne 'ENABLE')) {
+ $unix_only = undef;
+ }
+ }
+ $unix_report = 1 if (defined $unix_only);
+
+ $case_preserved = $ENV{'DECC$EFS_CASE_PRESERVE'};
+ if (defined $case_preserved) {
+ if (($case_preserved lt '1') && ($case_preserved ne 'ENABLE')) {
+ $case_preserved = undef;
+ }
+ }
+ $vms_drop_dot = $ENV{'DECC$READDIR_DROPDOTNOTYPE'};
+ if (defined $vms_drop_dot) {
+ if (($vms_drop_dot lt '1') && ($vms_drop_dot ne 'ENABLE')) {
+ $vms_drop_dot = undef;
+ }
+ }
+ if ((defined $unix_report) && (defined $vms_drop_dot)) {
+ $vms_format = 0
+ }
+}
+
if ($^O eq 'MacOS') { $extracted_program = '::utils:h2xs'; }
if (!(-e $extracted_program)) {
print "1..0 # Skip: $extracted_program was not built\n";
@@ -183,7 +231,9 @@
$_ =~ s/$name:t:1.t/$name:t\/1.t/; # is this an h2xs bug?
}
if ($^O eq 'VMS') {
- $_ .= '.' unless $_ =~ m/\./;
+ if (!(defined $vms_drop_dot)) {
+ $_ .= '.' unless ($_ =~ m/\./);
+ }
$_ = lc($_) unless exists $got{$_};
}
ok (-e $_, "check for $_") and delete $got{$_};
--- lib/Cwd.pm_5_8_7 Wed Jul 13 11:46:01 2005
+++ lib/Cwd.pm Wed Jul 13 11:57:30 2005
@@ -168,6 +168,7 @@
use strict;
use Exporter;
+use Config;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
$VERSION = '3.05';
@@ -445,10 +446,34 @@
}
return 0 unless CORE::chdir $newdir;
-
if ($^O eq 'VMS') {
+ my $unix_report;
+ my $unix_only = $ENV{'DECC$FILENAME_UNIX_ONLY'};
+ if (defined $unix_only) {
+ if (($unix_only ne '1') && ($unix_only ne 'ENABLE')) {
+ $unix_only = undef;
+ }
+ }
+ if (defined $unix_only) {
+ $unix_report = 1;
+ } else {
+ $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'};
+ if (defined $unix_report) {
+ if (($unix_report ne '1') && ($unix_report ne 'ENABLE')) {
+ $unix_report = undef;
+ }
+ }
+ }
+
+
+ if (defined $unix_report) {
+ my $tmpcwd = _vms_abs_path(".");
+ $tmpcwd =~ s|\/\Z(?!\n)||;
+ return $ENV{'PWD'} = $tmpcwd;
+ } else {
return $ENV{'PWD'} = $ENV{'DEFAULT'}
}
+ }
elsif ($^O eq 'MacOS') {
return $ENV{'PWD'} = cwd();
}
@@ -488,7 +513,6 @@
unless (-d _) {
# Make sure we can be invoked on plain files, not just directories.
# NOTE that this routine assumes that '/' is the only directory
separator.
-
my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
or return cwd() . '/' . $start;
@@ -539,7 +565,7 @@
closedir(PARENT);
return '';
}
- $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
+ $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"));
}
while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
$tst[1] != $pst[1]);
@@ -617,10 +643,131 @@
# the CRTL chdir() function persist only until Perl exits.
sub _vms_cwd {
- return $ENV{'DEFAULT'};
+ my $posix_compliant = $ENV{'DECC$POSIX_COMPLIANT_PATHNAMES'};
+ if (defined $posix_compliant) {
+ if (($posix_compliant lt '1') && ($posix_compliant ne 'ENABLE')) {
+ $posix_compliant = undef;
+ }
+ }
+
+ my $unix_report;
+ my $unix_only = $ENV{'DECC$FILENAME_UNIX_ONLY'};
+ if (defined $unix_only) {
+ if (($unix_only ne '1') && ($unix_only ne 'ENABLE')) {
+ $unix_only = undef;
+ }
+ }
+
+ if (defined $unix_only) {
+ $unix_report = 1;
+ } else {
+ $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'};
+ if (defined $unix_report) {
+ if (($unix_report ne '1') && ($unix_report ne 'ENABLE')) {
+ $unix_report = undef;
+ }
+ }
+ }
+
+# cwd is stored in $ENV{'DEFAULT'}, which could be tainted.
+# PCP mode abs_path is never tainted, so can not use it if cwd is tainted.
+# Or taint.t will fail.
+
+ my $default = $ENV{'DEFAULT'};
+
+ if ((defined $unix_only) || (defined $posix_compliant)) {
+ my $default_untaint = $default =~ /^(.*)\z/s;
+ my $cwd_tainted = ($default ne $default_untaint);
+ if ($cwd_tainted) {
+ $default = VMS::Filespec::unixify($default);
+ }
+ else {
+ $default = _vms_abs_path(".");
+ }
+ } else {
+ $default = VMS::Filespec::unixify($default) if (defined $unix_report);
+ }
+ return $default;
}
+
sub _vms_abs_path {
+
+ my $slow_realpath = $ENV{'DECC_DISABLE_CRTL_REALPATH'};
+ if (defined $slow_realpath) {
+ if (($slow_realpath ne '1') && ($slow_realpath ne 'ENABLE')) {
+ $slow_realpath = undef;
+ }
+ }
+
+ my $posix_compliant = $ENV{'DECC$POSIX_COMPLIANT_PATHNAMES'};
+ if (defined $posix_compliant) {
+ if (($posix_compliant lt '1') && ($posix_compliant ne 'ENABLE')) {
+ $posix_compliant = undef;
+ }
+ }
+
+ if ($Config{d_symlink} and (defined $posix_compliant)) {
+#
+# With symbolic links implemented, the UNIX perl code needs to be
+# used to get the correct result.
+
+ my $unix_report;
+ my $unix_only = $ENV{'DECC$FILENAME_UNIX_ONLY'};
+ if (defined $unix_only) {
+ if (($unix_only ne '1') && ($unix_only ne 'ENABLE')) {
+ $unix_only = undef;
+ }
+ }
+
+ if (defined $unix_only) {
+ $unix_report = 1;
+ } else {
+ $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'};
+ if (defined $unix_report) {
+ if (($unix_report ne '1') && ($unix_report ne 'ENABLE')) {
+ $unix_report = undef;
+ }
+ }
+ }
+
+ my $path;
+
+ if (@_) {
+ $path = $_[0];
+ }
+ else {
+#
+# Must use $ENV{'DEFAULT'} instead of '.' to preserve any
+# tainting that may be in effect.
+ $path = $ENV{'DEFAULT'};
+ }
+
+ if (!defined $unix_only) {
+ $path = VMS::Filespec::unixify($path);
+ if (defined $slow_realpath) {
+ $path = _perl_abs_path($path);
+ }
+ else {
+ $path = VMS::Filespec::vms_realpath($path);
+ }
+ } else {
+ if (defined $slow_realpath) {
+ $path = _perl_abs_path($path);
+ }
+ else {
+ $path = VMS::Filespec::vms_realpath($path);
+ }
+ }
+
+ if (defined $unix_report) {
+ return $path
+ } else {
+ return VMS::Filespec::vmsify($path);
+ }
+
+ } else {
+
return $ENV{'DEFAULT'} unless @_;
# may need to turn foo.dir into [.foo]
@@ -628,6 +775,7 @@
$path = $_[0] unless defined $path;
return VMS::Filespec::rmsexpand($path);
+ }
}
sub _os2_cwd {
