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';
+$VERSION = '1.56';
@ISA=('Exporter');
@EXPORT_OK = qw(mkmanifest
manicheck filecheck fullcheck skipcheck
$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} ?
$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)) {
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;
}
$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;
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
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") {
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) {
}
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);
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);