applied suggested patch, modulo superseded parts
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Manifest.pm
index 14d0f6e..1a6dde7 100644 (file)
@@ -1,24 +1,26 @@
 package ExtUtils::Manifest;
 
-
 require Exporter;
-@ISA=('Exporter');
-@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
-             'skipcheck', 'maniread', 'manicopy');
-
 use Config;
 use File::Find;
 use File::Copy 'copy';
 use Carp;
+use strict;
 
-$Debug = 0;
-$Verbose = 1;
-$Is_VMS = $^O eq 'VMS';
+use vars qw($VERSION @ISA @EXPORT_OK
+           $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
 
-$VERSION = $VERSION = substr(q$Revision: 1.24 $,10,4);
+$VERSION = substr(q$Revision: 1.33 $, 10);
+@ISA=('Exporter');
+@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
+             'skipcheck', 'maniread', 'manicopy');
 
-$Quiet = 0;
+$Is_VMS = $^O eq 'VMS';
+if ($Is_VMS) { require File::Basename }
 
+$Debug = 0;
+$Verbose = 1;
+$Quiet = 0;
 $MANIFEST = 'MANIFEST';
 
 # Really cool fix from Ilya :)
@@ -83,12 +85,18 @@ sub skipcheck {
 sub _manicheck {
     my($arg) = @_;
     my $read = maniread();
+    my $found = manifind();
     my $file;
+    my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
     my(@missfile,@missentry);
     if ($arg & 1){
-       my $found = manifind();
        foreach $file (sort keys %$read){
            warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
+            if ($dosnames){
+                $file = lc $file;
+                $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
+                $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
+            }
            unless ( exists $found->{$file} ) {
                warn "No such file: $file\n" unless $Quiet;
                push @missfile, $file;
@@ -98,7 +106,6 @@ sub _manicheck {
     if ($arg & 2){
        $read ||= {};
        my $matches = _maniskip();
-       my $found = manifind();
        my $skipwarn = $arg & 4;
        foreach $file (sort keys %$found){
            if (&$matches($file)){
@@ -117,7 +124,7 @@ sub _manicheck {
 
 sub maniread {
     my ($mfile) = @_;
-    $mfile = $MANIFEST unless defined $mfile;
+    $mfile ||= $MANIFEST;
     my $read = {};
     local *M;
     unless (open M, $mfile){
@@ -126,8 +133,20 @@ sub maniread {
     }
     while (<M>){
        chomp;
-       if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
-       else         { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+       next if /^#/;
+       if ($Is_VMS) {
+           my($file)= /^(\S+)/;
+           next unless $file;
+           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;
+           $read->{"\L$okfile"}=$_;
+       }
+       else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
     }
     close M;
     $read;
@@ -138,12 +157,13 @@ sub _maniskip {
     my ($mfile) = @_;
     my $matches = sub {0};
     my @skip ;
-    $mfile = "$MANIFEST.SKIP" unless defined $mfile;
+    $mfile ||= "$MANIFEST.SKIP";
     local *M;
     return $matches unless -f $mfile;
     open M, $mfile or return $matches;
     while (<M>){
        chomp;
+       next if /^#/;
        next if /^\s*$/;
        push @skip, $_;
     }
@@ -161,7 +181,7 @@ sub _maniskip {
 sub manicopy {
     my($read,$target,$how)=@_;
     croak "manicopy() called without target argument" unless defined $target;
-    $how = 'cp' unless defined $how && $how;
+    $how ||= 'cp';
     require File::Path;
     require File::Basename;
     my(%dirs,$file);
@@ -175,14 +195,13 @@ sub manicopy {
            $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
            File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
        }
-       if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
-       else         { cp_if_diff($file, "$target/$file", $how); }
+       cp_if_diff($file, "$target/$file", $how);
     }
 }
 
 sub cp_if_diff {
-    my($from,$to, $how)=@_;
-    -f $from || carp "$0: $from not found";
+    my($from, $to, $how)=@_;
+    -f $from or carp "$0: $from not found";
     my($diff) = 0;
     local(*F,*T);
     open(F,$from) or croak "Can't read $from: $!\n";
@@ -197,26 +216,14 @@ sub cp_if_diff {
        if (-e $to) {
            unlink($to) or confess "unlink $to: $!";
        }
-       &$how($from, $to);
-    }
-}
-
-# Do the comparisons here rather than spawning off another process
-sub vms_cp_if_diff {
-    my($from,$to) = @_;
-    my($diff) = 0;
-    local(*F,*T);
-    open(F,$from) or croak "Can't read $from: $!\n";
-    if (open(T,$to)) {
-       while (<F>) { $diff++,last if $_ ne <T>; }
-       $diff++ unless eof(T);
-       close T;
-    }
-    else { $diff++; }
-    close F;
-    if ($diff) {
-       system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1
-           or confess "Copy failed: $!";
+      STRICT_SWITCH: {
+           best($from,$to), last STRICT_SWITCH if $how eq 'best';
+           cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
+           ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
+           croak("ExtUtils::Manifest::cp_if_diff " .
+                 "called with illegal how argument [$how]. " .
+                 "Legal values are 'best', 'cp', and 'ln'.");
+       }
     }
 }
 
@@ -224,17 +231,22 @@ sub cp {
     my ($srcFile, $dstFile) = @_;
     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
     copy($srcFile,$dstFile);
-    utime $access, $mod, $dstFile;
+    utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
     # chmod a+rX-w,go-w
     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
 }
 
 sub ln {
     my ($srcFile, $dstFile) = @_;
+    return &cp if $Is_VMS;
     link($srcFile, $dstFile);
     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
     my $mode= 0444 | (stat)[2] & 0700;
-    chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
+    if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
+       unlink $dstFile;
+       return;
+    }
+    1;
 }
 
 sub best {
@@ -242,7 +254,7 @@ sub best {
     if (-l $srcFile) {
        cp($srcFile, $dstFile);
     } else {
-       ln($srcFile, $dstFile);
+       ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
     }
 }
 
@@ -286,7 +298,7 @@ but in doing so checks each line in an existing C<MANIFEST> file and
 includes any comments that are found in the existing C<MANIFEST> file
 in the new one. Anything between white space and an end of line within
 a C<MANIFEST> file is considered to be a comment. Filenames and
-comments are seperated by one or more TAB characters in the
+comments are separated by one or more TAB characters in the
 output. All files that match any regular expression in a file
 C<MANIFEST.SKIP> (if such a file exists) are ignored.
 
@@ -305,12 +317,14 @@ Fullcheck() does both a manicheck() and a filecheck().
 Skipcheck() lists all the files that are skipped due to your
 C<MANIFEST.SKIP> file.
 
-Manifind() retruns a hash reference. The keys of the hash are the
+Manifind() returns a hash reference. The keys of the hash are the
 files found below the current directory.
 
 Maniread($file) reads a named C<MANIFEST> file (defaults to
 C<MANIFEST> in the current directory) and returns a HASH reference
 with files being the keys and comments being the values of the HASH.
+Blank lines and lines which start with C<#> in the C<MANIFEST> file
+are discarded.
 
 I<Manicopy($read,$target,$how)> copies the files that are the keys in
 the HASH I<%$read> to the named target directory. The HASH reference
@@ -326,7 +340,9 @@ make a tree without any symbolic link. Best is the default.
 
 The file MANIFEST.SKIP may contain regular expressions of files that
 should be ignored by mkmanifest() and filecheck(). The regular
-expressions should appear one on each line. A typical example:
+expressions should appear one on each line. Blank lines and lines
+which start with C<#> are skipped.  Use C<\#> if you need a regular
+expression to start with a sharp character. A typical example:
 
     \bRCS\b
     ^MANIFEST\.
@@ -350,7 +366,7 @@ C<MANIFEST.SKIP> file. This is useful if you want to maintain
 different distributions for different audiences (say a user version
 and a developer version including RCS).
 
-<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
+C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 all functions act silently.
 
 =head1 DIAGNOSTICS
@@ -387,6 +403,6 @@ L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 
 =head1 AUTHOR
 
-Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
+Andreas Koenig <F<koenig@franz.ww.TU-Berlin.DE>>
 
 =cut