[win32] reverse integrate asperl branch contents (phew!)
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Manifest.pm
index a76006e..5557089 100644 (file)
 package ExtUtils::Manifest;
 
-=head1 NAME
-
-ExtUtils::Manifest - utilities to write and check a MANIFEST file
-
-=head1 SYNOPSIS
-
-C<require ExtUtils::Manifest;>
-
-C<ExtUtils::Manifest::mkmanifest;>
-
-C<ExtUtils::Manifest::manicheck;>
-
-C<ExtUtils::Manifest::filecheck;>
-
-C<ExtUtils::Manifest::fullcheck;>
-
-C<ExtUtils::Manifest::maniread($file);>
-
-C<ExtUtils::Manifest::manicopy($read,$target);>
-
-=head1 DESCRIPTION
-
-Mkmanifest() writes all files in and below the current directory to a
-file named C<MANIFEST> in the current directory. It works similar to
-
-    find . -print
-
-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
-output. All files that match any regular expression in a file
-C<MANIFEST.SKIP> (if such a file exists) are ignored.
-
-Manicheck() checks if all the files within a C<MANIFEST> in the current
-directory really do exist.
-
-Filecheck() finds files below the current directory that are not
-mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
-will be consulted. Any file matching a regular expression in such a
-file will not be reported as missing in the C<MANIFEST> file.
-
-Fullcheck() does both a manicheck() and a filecheck().
-
-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.
-
-I<Manicopy($read,$target)> copies the files that are the keys in the
-HASH I<%$read> to the named target directory. The HASH reference
-I<$read> is typically returned by the maniread() function. This
-function is useful for producing a directory tree identical to the
-intended distribution tree.
-
-=head1 MANIFEST.SKIP
-
-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:
-
-    \bRCS\b
-    ^MANIFEST\.
-    ^Makefile$
-    ~$
-    \.html$
-    \.old$
-    ^blib/
-    ^MakeMaker-\d
-
-=head1 EXPORT_OK
-
-C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
-C<&maniread>, and C<&manicopy> are exportable.
-
-=head1 DIAGNOSTICS
-
-All diagnostic output is sent to C<STDERR>.
-
-=over
-    
-=item C<Not in MANIFEST:> I<file>
-is reported if a file is found, that is missing in the C<MANIFEST>
-file which is excluded by a regular expression in the file
-C<MANIFEST.SKIP>.
-
-=item C<No such file:> I<file>
-is reported if a file mentioned in a C<MANIFEST> file does not
-exist.
-
-=item C<MANIFEST:> I<$!>
-is reported if C<MANIFEST> could not be opened.
-
-=item C<Added to MANIFEST:> I<file>
-is reported by mkmanifest() if $Verbose is set and a file is added
-to MANIFEST. $Verbose is set to 1 by default.
-
-=back
-
-=head1 AUTHOR
+require Exporter;
+use Config;
+use File::Find;
+use File::Copy 'copy';
+use Carp;
+use strict;
 
-Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
+use vars qw($VERSION @ISA @EXPORT_OK
+           $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
 
-=cut
-
-require Exporter;
+$VERSION = substr(q$Revision: 1.33 $, 10);
 @ISA=('Exporter');
 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
-             'maniread', 'manicopy');
+             'skipcheck', 'maniread', 'manicopy');
 
-use File::Find;
-use Carp;
+$Is_VMS = $^O eq 'VMS';
+if ($Is_VMS) { require File::Basename }
 
 $Debug = 0;
 $Verbose = 1;
-
-($Version) = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
-$Version = $Version; #avoid warning
-
 $Quiet = 0;
+$MANIFEST = 'MANIFEST';
+
+# Really cool fix from Ilya :)
+unless (defined $Config{d_link}) {
+    *ln = \&cp;
+}
 
 sub mkmanifest {
     my $manimiss = 0;
     my $read = maniread() or $manimiss++;
     $read = {} if $manimiss;
+    local *M;
+    rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
+    open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
     my $matches = _maniskip();
     my $found = manifind();
     my($key,$val,$file,%all);
-    my %all = (%$found, %$read);
-    local *M;
-    rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
-    open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
+    %all = (%$found, %$read);
+    $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
+        if $manimiss; # add new MANIFEST to known file list
     foreach $file (sort keys %all) {
        next if &$matches($file);
        if ($Verbose){
-           warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
+           warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
        }
+       my $text = $all{$file};
+       ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
        my $tabs = (5 - (length($file)+1)/8);
        $tabs = 1 if $tabs < 1;
-       $tabs = 0 unless $all{$file};
-       print M $file, "\t" x $tabs, $all{$file}, "\n";
+       $tabs = 0 unless $text;
+       print M $file, "\t" x $tabs, $text, "\n";
     }
     close M;
 }
@@ -150,6 +61,7 @@ sub manifind {
     find(sub {return if -d $_;
              (my $name = $File::Find::name) =~ s|./||;
              warn "Debug: diskfile $name\n" if $Debug;
+             $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
              $found->{$name} = "";}, ".");
     $found;
 }
@@ -166,31 +78,44 @@ sub filecheck {
     return @{(_manicheck(2))[1]};
 }
 
+sub skipcheck {
+    _manicheck(6);
+}
+
 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;
+           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;
+               warn "No such file: $file\n" unless $Quiet;
+               push @missfile, $file;
            }
        }
     }
     if ($arg & 2){
        $read ||= {};
        my $matches = _maniskip();
-       my $found = manifind();
+       my $skipwarn = $arg & 4;
        foreach $file (sort keys %$found){
-           next if &$matches($file);
+           if (&$matches($file)){
+               warn "Skipping $file\n" if $skipwarn;
+               next;
+           }
            warn "Debug: manicheck checking from disk $file\n" if $Debug;
            unless ( exists $read->{$file} ) {
-             warn "Not in MANIFEST: $file\n" unless $Quiet;
-             push @missentry, $file;
+               warn "Not in $MANIFEST: $file\n" unless $Quiet;
+               push @missentry, $file;
            }
        }
     }
@@ -199,7 +124,7 @@ sub _manicheck {
 
 sub maniread {
     my ($mfile) = @_;
-    $mfile = "MANIFEST" unless defined $mfile;
+    $mfile ||= $MANIFEST;
     my $read = {};
     local *M;
     unless (open M, $mfile){
@@ -208,7 +133,20 @@ sub maniread {
     }
     while (<M>){
        chomp;
-       /^(\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;
@@ -219,19 +157,21 @@ sub _maniskip {
     my ($mfile) = @_;
     my $matches = sub {0};
     my @skip ;
-    my $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, $_;
     }
     close M;
+    my $opts = $Is_VMS ? 'oi ' : 'o ';
     my $sub = "\$matches = "
        . "sub { my(\$arg)=\@_; return 1 if "
-       . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/o "} @skip), 0)
+       . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
        . " }";
     eval $sub;
     print "Debug: $sub\n" if $Debug;
@@ -239,26 +179,230 @@ sub _maniskip {
 }
 
 sub manicopy {
-    my($read,$target)=@_;
+    my($read,$target,$how)=@_;
     croak "manicopy() called without target argument" unless defined $target;
+    $how ||= 'cp';
     require File::Path;
     require File::Basename;
     my(%dirs,$file);
+    $target = VMS::Filespec::unixify($target) if $Is_VMS;
+    umask 0 unless $Is_VMS;
+    File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
     foreach $file (keys %$read){
-       my $dir = File::Basename::dirname($file);
-       File::Path::mkpath("$target/$dir");
-       cp_if_diff($file, "$target/$file");
+       $file = VMS::Filespec::unixify($file) if $Is_VMS;
+       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;
+           File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
+       }
+       cp_if_diff($file, "$target/$file", $how);
     }
 }
 
 sub cp_if_diff {
-    my($from,$to)=@_;
-    -f $from || carp "$0: $from not found";
-    system "cmp", "-s", $from, $to;
-    if ($?) {
-       unlink($to);   # In case we don't have write permissions.
-       (system 'cp', $from, $to) == 0 or confess "system 'cp': $!";
+    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";
+    if (open(T,$to)) {
+       while (<F>) { $diff++,last if $_ ne <T>; }
+       $diff++ unless eof(T);
+       close T;
+    }
+    else { $diff++; }
+    close F;
+    if ($diff) {
+       if (-e $to) {
+           unlink($to) or confess "unlink $to: $!";
+       }
+      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'.");
+       }
+    }
+}
+
+sub cp {
+    my ($srcFile, $dstFile) = @_;
+    my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
+    copy($srcFile,$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;
+    if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
+       unlink $dstFile;
+       return;
+    }
+    1;
+}
+
+sub best {
+    my ($srcFile, $dstFile) = @_;
+    if (-l $srcFile) {
+       cp($srcFile, $dstFile);
+    } else {
+       ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
     }
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Manifest - utilities to write and check a MANIFEST file
+
+=head1 SYNOPSIS
+
+C<require ExtUtils::Manifest;>
+
+C<ExtUtils::Manifest::mkmanifest;>
+
+C<ExtUtils::Manifest::manicheck;>
+
+C<ExtUtils::Manifest::filecheck;>
+
+C<ExtUtils::Manifest::fullcheck;>
+
+C<ExtUtils::Manifest::skipcheck;>
+
+C<ExtUtild::Manifest::manifind();>
+
+C<ExtUtils::Manifest::maniread($file);>
+
+C<ExtUtils::Manifest::manicopy($read,$target,$how);>
+
+=head1 DESCRIPTION
+
+Mkmanifest() writes all files in and below the current directory to a
+file named in the global variable $ExtUtils::Manifest::MANIFEST (which
+defaults to C<MANIFEST>) in the current directory. It works similar to
+
+    find . -print
+
+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
+output. All files that match any regular expression in a file
+C<MANIFEST.SKIP> (if such a file exists) are ignored.
+
+Manicheck() checks if all the files within a C<MANIFEST> in the
+current directory really do exist. It only reports discrepancies and
+exits silently if MANIFEST and the tree below the current directory
+are in sync.
+
+Filecheck() finds files below the current directory that are not
+mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
+will be consulted. Any file matching a regular expression in such a
+file will not be reported as missing in the C<MANIFEST> file.
+
+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
+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
+I<$read> is typically returned by the maniread() function. This
+function is useful for producing a directory tree identical to the
+intended distribution tree. The third parameter $how can be used to
+specify a different methods of "copying". Valid values are C<cp>,
+which actually copies the files, C<ln> which creates hard links, and
+C<best> which mostly links the files but copies any symbolic link to
+make a tree without any symbolic link. Best is the default.
+
+=head1 MANIFEST.SKIP
+
+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. 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\.
+    ^Makefile$
+    ~$
+    \.html$
+    \.old$
+    ^blib/
+    ^MakeMaker-\d
+
+=head1 EXPORT_OK
+
+C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
+C<&maniread>, and C<&manicopy> are exportable.
+
+=head1 GLOBAL VARIABLES
+
+C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
+results in both a different C<MANIFEST> and a different
+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).
+
+C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
+all functions act silently.
+
+=head1 DIAGNOSTICS
+
+All diagnostic output is sent to C<STDERR>.
+
+=over
+
+=item C<Not in MANIFEST:> I<file>
+
+is reported if a file is found, that is missing in the C<MANIFEST>
+file which is excluded by a regular expression in the file
+C<MANIFEST.SKIP>.
+
+=item C<No such file:> I<file>
+
+is reported if a file mentioned in a C<MANIFEST> file does not
+exist.
+
+=item C<MANIFEST:> I<$!>
+
+is reported if C<MANIFEST> could not be opened.
+
+=item C<Added to MANIFEST:> I<file>
+
+is reported by mkmanifest() if $Verbose is set and a file is added
+to MANIFEST. $Verbose is set to 1 by default.
+
+=back
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
+
+=head1 AUTHOR
+
+Andreas Koenig <F<koenig@franz.ww.TU-Berlin.DE>>
+
+=cut