Bug #42146 for ExtUtils-Manifest: Add support for VMS in UNIX or extended characer set mode.

VMS has modes where it can be more like Unix, included more characters allowed in filenames, and returning file specificatiosn in UNIX format. This updates Extutils::Manifest.pm to support those modes.

--- /rsync_root/perl/lib/Extutils/Manifest.pm Sat Oct 25 10:27:47 2008 +++ lib/Extutils/Manifest.pm Sun Jan 4 11:13:29 2009 @@ -10,7 +10,7 @@ use strict; use vars qw($VERSION @ISA @EXPORT_OK - $Is_MacOS $Is_VMS + $Is_MacOS $Is_VMS $Is_VMS_mode $Is_VMS_lc $Is_VMS_nodot $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP); $VERSION = '1.55'; @@ -23,7 +23,35 @@ $Is_MacOS = $^O eq 'MacOS'; $Is_VMS = $^O eq 'VMS'; -require VMS::Filespec if $Is_VMS; +$Is_VMS_mode = 0; +$Is_VMS_lc = 0; +$Is_VMS_nodot = 0; # No dots in dir names or double dots in files + +if ($Is_VMS) { + require VMS::Filespec if $Is_VMS; + my $vms_unix_rpt; + my $vms_efs; + my $vms_case; + + $Is_VMS_mode = 1; + $Is_VMS_lc = 1; + $Is_VMS_nodot = 1; + if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { + $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); + $vms_efs = VMS::Feature::current("efs_charset"); + $vms_case = VMS::Feature::current("efs_case_preserve"); + } else { + my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; + my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; + my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; + $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; + $vms_efs = $efs_charset =~ /^[ET1]/i; + $vms_case = $efs_case =~ /^[ET1]/i; + } + $Is_VMS_lc = 0 if ($vms_case); + $Is_VMS_mode = 0 if ($vms_unix_rpt); + $Is_VMS_nodot = 0 if ($vms_efs); +} $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0; $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ? @@ -93,14 +121,15 @@ $read = {} if $manimiss; local *M; my $bakbase = $MANIFEST; - $bakbase =~ s/\./_/g if $Is_VMS; # avoid double dots + $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots rename $MANIFEST, "$bakbase.bak" unless $manimiss; open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!"; my $skip = maniskip(); my $found = manifind(); my($key,$val,$file,%all); %all = (%$found, %$read); - $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files' + $all{$MANIFEST} = ($Is_VMS_mode ? "$MANIFEST\t\t" : '') . + 'This list of files' if $manimiss; # add new MANIFEST to known file list foreach $file (_sort keys %all) { if ($skip->($file)) { @@ -153,8 +182,8 @@ my $name = clean_up_filename($File::Find::name); warn "Debug: diskfile $name\n" if $Debug; return if -d $_; - - if( $Is_VMS ) { + + if( $Is_VMS_lc ) { $name =~ s#(.*)\.$#\L$1#; $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i; } @@ -336,17 +365,21 @@ $file = _macify($file); $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge; } - elsif ($Is_VMS) { + elsif ($Is_VMS_mode) { require File::Basename; my($base,$dir) = File::Basename::fileparse($file); # Resolve illegal file specifications in the same way as tar - $dir =~ tr/./_/; - my(@pieces) = split(/\./,$base); - if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); } - my $okfile = "$dir$base"; - warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; - $file = $okfile; - $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/; + if ($Is_VMS_nodot) { + $dir =~ tr/./_/; + my(@pieces) = split(/\./,$base); + if (@pieces > 2) + { $base = shift(@pieces) . '.' . join('_',@pieces); } + my $okfile = "$dir$base"; + warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; + $file = $okfile; + } + $file = lc($file) + unless $Is_VMS_lc &&($file =~ /^MANIFEST(\.SKIP)?$/); } $read->{$file} = $comment; @@ -387,7 +420,7 @@ close M; return sub {0} unless (scalar @skip > 0); - my $opts = $Is_VMS ? '(?i)' : ''; + my $opts = $Is_VMS_mode ? '(?i)' : ''; # Make sure each entry is isolated in its own parentheses, in case # any of them contain alternations @@ -434,7 +467,7 @@ close M; return unless $flag; my $bakbase = $mfile; - $bakbase =~ s/\./_/g if $Is_VMS; # avoid double dots + $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots rename $mfile, "$bakbase.bak"; warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug; unless (open M, "> $mfile") { @@ -495,7 +528,7 @@ require File::Path; require File::Basename; - $target = VMS::Filespec::unixify($target) if $Is_VMS; + $target = VMS::Filespec::unixify($target) if $Is_VMS_mode; File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755); foreach my $file (keys %$read){ if ($Is_MacOS) { @@ -506,10 +539,10 @@ } cp_if_diff($file, _maccat($target, $file), $how); } else { - $file = VMS::Filespec::unixify($file) if $Is_VMS; + $file = VMS::Filespec::unixify($file) if $Is_VMS_mode; if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not? my $dir = File::Basename::dirname($file); - $dir = VMS::Filespec::unixify($dir) if $Is_VMS; + $dir = VMS::Filespec::unixify($dir) if $Is_VMS_mode; File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755); } cp_if_diff($file, "$target/$file", $how); @@ -561,6 +594,7 @@ sub ln { my ($srcFile, $dstFile) = @_; + # Fix-me - VMS can support links. return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95()); link($srcFile, $dstFile); --- /rsync_root/perl/lib/Extutils/t/Manifest.t Sat Oct 25 10:27:47 2008 +++ lib/Extutils/t/Manifest.t Fri Dec 26 16:09:17 2008 @@ -22,6 +22,18 @@ use Config; my $Is_VMS = $^O eq 'VMS'; +my $Is_VMS_noefs = $Is_VMS; +if ($Is_VMS) { + my $vms_efs = 0; + if (eval 'require VMS::Feature') { + $vms_efs = VMS::Feature::current("efs_charset"); + } else { + my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; + $vms_efs = $efs_charset =~ /^[ET1]/i; + } + $Is_VMS_noefs = 0 if $vms_efs; +} + # We're going to be chdir'ing and modules are sometimes loaded on the # fly in this test, so we need an absolute @INC. @@ -358,7 +370,7 @@ is( $skipchk->('mydefault.skip'), 1, 'mydefault.skip excluded via mydefault.skip' ); - my $extsep = $Is_VMS ? '_' : '.'; + my $extsep = $Is_VMS_noefs ? '_' : '.'; $Files{"$_.bak"}++ for ('MANIFEST', "MANIFEST${extsep}SKIP"); }