Re: maint @ 20617 [PATCH]
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Manifest.pm
index fa5a0b4..9965e5d 100644 (file)
@@ -4,34 +4,89 @@ require Exporter;
 use Config;
 use File::Find;
 use File::Copy 'copy';
-use File::Spec::Functions qw(splitpath);
+use File::Spec;
 use Carp;
 use strict;
 
-our ($VERSION,@ISA,@EXPORT_OK,
-           $Is_MacOS,$Is_VMS,
-           $Debug,$Verbose,$Quiet,$MANIFEST,$DEFAULT_MSKIP);
+use vars qw($VERSION @ISA @EXPORT_OK 
+          $Is_MacOS $Is_VMS 
+          $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
 
-$VERSION = 1.37_01;
+$VERSION = 1.39;
 @ISA=('Exporter');
-@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
-             'skipcheck', 'maniread', 'manicopy');
+@EXPORT_OK = qw(mkmanifest
+                manicheck  filecheck  fullcheck  skipcheck
+                manifind   maniread   manicopy   maniadd
+               );
 
 $Is_MacOS = $^O eq 'MacOS';
-$Is_VMS = $^O eq 'VMS';
+$Is_VMS   = $^O eq 'VMS';
 require VMS::Filespec if $Is_VMS;
 
-$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
+$Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
 $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
                    $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
 $Quiet = 0;
 $MANIFEST = 'MANIFEST';
-$DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP";
 
-# Really cool fix from Ilya :)
-unless (defined $Config{d_link}) {
-    no warnings;
-    *ln = \&cp;
+my $Filename = __FILE__;
+$DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
+                 "$MANIFEST.SKIP";
+
+
+=head1 NAME
+
+ExtUtils::Manifest - utilities to write and check a MANIFEST file
+
+=head1 SYNOPSIS
+
+    use ExtUtils::Manifest qw(...funcs to import...);
+
+    mkmanifest();
+
+    my @missing_files    = manicheck;
+    my @skipped          = skipcheck;
+    my @extra_files      = filecheck;
+    my($missing, $extra) = fullcheck;
+
+    my $found    = manifind();
+
+    my $manifest = maniread();
+
+    manicopy($read,$target);
+
+    maniadd({$file => $comment, ...});
+
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+ExtUtils::Manifest exports no functions by default.  The following are
+exported on request
+
+=over 4
+
+=item mkmanifest
+
+    mkmanifest();
+
+Writes all files in and below the current directory to your F<MANIFEST>.
+It works similar to
+
+    find . > MANIFEST
+
+All files that match any regular expression in a file F<MANIFEST.SKIP>
+(if it exists) are ignored.
+
+Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.  Lines
+from the old F<MANIFEST> file is preserved, including any comments
+that are found in the existing F<MANIFEST> file in the new one.
+
+=cut
+
+sub _sort {
+    return sort { lc $a cmp lc $b } @_;
 }
 
 sub mkmanifest {
@@ -47,7 +102,7 @@ sub mkmanifest {
     %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) {
+    foreach $file (_sort keys %all) {
        if ($skip->($file)) {
            # Policy: only remove files if they're listed in MANIFEST.SKIP.
            # Don't remove files just because they don't exist.
@@ -77,15 +132,24 @@ sub clean_up_filename {
   return $filename;
 }
 
+
+=item manifind
+
+    my $found = manifind();
+
+returns a hash reference. The keys of the hash are the files found
+below the current directory.
+
+=cut
+
 sub manifind {
     my $p = shift || {};
-    my $skip = _maniskip(warn => $p->{warn_on_skip});
     my $found = {};
 
     my $wanted = sub {
        my $name = clean_up_filename($File::Find::name);
        warn "Debug: diskfile $name\n" if $Debug;
-       return if $skip->($name) or -d $name;
+       return if -d $_;
        
         if( $Is_VMS ) {
             $name =~ s#(.*)\.$#\L$1#;
@@ -98,105 +162,180 @@ sub manifind {
     # $File::Find::name is unavailable.
     # Also, it's okay to use / here, because MANIFEST files use Unix-style 
     # paths.
-    find({wanted => $wanted,
-         preprocess => 
-          sub {grep {!$skip->( clean_up_filename("$File::Find::dir/$_") )} @_},
-         no_chdir => 1,
-        },
+    find({wanted => $wanted},
         $Is_MacOS ? ":" : ".");
 
     return $found;
 }
 
-sub fullcheck {
-    _manicheck({check_files => 1, check_MANIFEST => 1});
-}
+
+=item manicheck
+
+    my @missing_files = manicheck();
+
+checks if all the files within a C<MANIFEST> in the current directory
+really do exist. If C<MANIFEST> and the tree below the current
+directory are in sync it exits silently, returning an empty list.
+Otherwise it returns a list of files which are listed in the
+C<MANIFEST> but missing from the directory, and by default also
+outputs these names to STDERR.
+
+=cut
 
 sub manicheck {
-    return @{(_manicheck({check_files => 1}))[0]};
+    return _check_files();
 }
 
+
+=item filecheck
+
+    my @extra_files = 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. The list of any
+extraneous files found is returned, and by default also reported to
+STDERR.
+
+=cut
+
 sub filecheck {
-    return @{(_manicheck({check_MANIFEST => 1}))[1]};
+    return _check_manifest();
 }
 
-sub skipcheck {
-    _manicheck({check_MANIFEST => 1, warn_on_skip => 1});
+
+=item fullcheck
+
+    my($missing, $extra) = fullcheck();
+
+does both a manicheck() and a filecheck(), returning then as two array
+refs.
+
+=cut
+
+sub fullcheck {
+    return [_check_files()], [_check_manifest()];
 }
 
-sub _manicheck {
+
+=item skipcheck
+
+    my @skipped = skipcheck();
+
+lists all the files that are skipped due to your C<MANIFEST.SKIP>
+file.
+
+=cut
+
+sub skipcheck {
     my($p) = @_;
-    my $read = maniread();
-    my $found = manifind($p);
+    my $found = manifind();
+    my $matches = _maniskip();
+
+    my @skipped = ();
+    foreach my $file (_sort keys %$found){
+        if (&$matches($file)){
+            warn "Skipping $file\n";
+            push @skipped, $file;
+            next;
+        }
+    }
+
+    return @skipped;
+}
 
-    my $file;
+
+sub _check_files {
+    my $p = shift;
     my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
-    my(@missfile,@missentry);
-    if ($p->{check_files}){
-       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;
-           }
-       }
+    my $read = maniread() || {};
+    my $found = manifind($p);
+
+    my(@missfile) = ();
+    foreach my $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;
+        }
     }
-    if ($p->{check_MANIFEST}){
-       $read ||= {};
-       my $matches = _maniskip();
-       foreach $file (sort keys %$found){
-           if (&$matches($file)){
-               warn "Skipping $file\n" if $p->{warn_on_skip};
-               next;
-           }
-           warn "Debug: manicheck checking from disk $file\n" if $Debug;
-           unless ( exists $read->{$file} ) {
-               my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
-               warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
-               push @missentry, $file;
-           }
-       }
+
+    return @missfile;
+}
+
+
+sub _check_manifest {
+    my($p) = @_;
+    my $read = maniread() || {};
+    my $found = manifind($p);
+    my $skip  = _maniskip();
+
+    my @missentry = ();
+    foreach my $file (_sort keys %$found){
+        next if $skip->($file);
+        warn "Debug: manicheck checking from disk $file\n" if $Debug;
+        unless ( exists $read->{$file} ) {
+            my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
+            warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
+            push @missentry, $file;
+        }
     }
-    (\@missfile,\@missentry);
+
+    return @missentry;
 }
 
+
+=item maniread
+
+    my $manifest = maniread();
+    my $manifest = maniread($manifest_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.
+
+=cut
+
 sub maniread {
     my ($mfile) = @_;
     $mfile ||= $MANIFEST;
     my $read = {};
     local *M;
     unless (open M, $mfile){
-       warn "$mfile: $!";
-       return $read;
+        warn "$mfile: $!";
+        return $read;
     }
+    local $_;
     while (<M>){
-       chomp;
-       next if /^#/;
+        chomp;
+        next if /^\s*#/;
 
         my($file, $comment) = /^(\S+)\s*(.*)/;
         next unless $file;
 
-       if ($Is_MacOS) {
-           $file = _macify($file);
-           $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
-       }
-       elsif ($Is_VMS) {
-        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;
+        if ($Is_MacOS) {
+            $file = _macify($file);
+            $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
+        }
+        elsif ($Is_VMS) {
+            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)?$/;
-       }
+        }
 
         $read->{$file} = $comment;
     }
@@ -206,11 +345,9 @@ sub maniread {
 
 # returns an anonymous sub that decides if an argument matches
 sub _maniskip {
-    my (%args) = @_;
-
     my @skip ;
-    my $mfile ||= "$MANIFEST.SKIP";
-    local *M;
+    my $mfile = "$MANIFEST.SKIP";
+    local(*M,$_);
     open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
     while (<M>){
        chomp;
@@ -225,22 +362,36 @@ sub _maniskip {
     # any of them contain alternations
     my $regex = join '|', map "(?:$_)", @skip;
 
-    return ($args{warn}
-           ? sub { $_[0] =~ qr{$opts$regex} && warn "Skipping $_[0]\n" }
-           : sub { $_[0] =~ qr{$opts$regex} }
-          );
+    return sub { $_[0] =~ qr{$opts$regex} };
 }
 
+=item manicopy
+
+    manicopy($src, $dest_dir);
+    manicopy($src, $dest_dir, $how);
+
+copies the files that are the keys in the HASH I<%$src> to the
+$dest_dir. The HASH reference $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.
+
+=cut
+
 sub manicopy {
     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;
     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
-    foreach $file (keys %$read){
+    foreach my $file (keys %$read){
        if ($Is_MacOS) {
            if ($file =~ m!:!) { 
                my $dir = _maccat($target, $file);
@@ -265,8 +416,9 @@ sub cp_if_diff {
     -f $from or carp "$0: $from not found";
     my($diff) = 0;
     local(*F,*T);
-    open(F,"< $from\0") or croak "Can't read $from: $!\n";
+    open(F,"< $from\0") or die "Can't read $from: $!\n";
     if (open(T,"< $to\0")) {
+        local $_;
        while (<F>) { $diff++,last if $_ ne <T>; }
        $diff++ unless eof(T);
        close T;
@@ -294,22 +446,36 @@ sub cp {
     copy($srcFile,$dstFile);
     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
     # chmod a+rX-w,go-w
-    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile ) unless ($^O eq 'MacOS');
+    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile ) 
+      unless ($^O eq 'MacOS');
 }
 
 sub ln {
     my ($srcFile, $dstFile) = @_;
     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
     link($srcFile, $dstFile);
-    local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
+
+    # chmod a+r,go-w+X (except "X" only applies to u=x)
+    local($_) = $dstFile;
     my $mode= 0444 | (stat)[2] & 0700;
     if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
-       unlink $dstFile;
-       return;
+        unlink $dstFile;
+        return;
     }
     1;
 }
 
+unless (defined $Config{d_link}) {
+    # Really cool fix from Ilya :)
+    local $SIG{__WARN__} = sub { 
+        warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
+    };
+    *ln = \&cp;
+}
+
+
+
+
 sub best {
     my ($srcFile, $dstFile) = @_;
     if (-l $srcFile) {
@@ -355,90 +521,70 @@ sub _unmacify {
     $file;
 }
 
-1;
 
-__END__
+=item maniadd
 
-=head1 NAME
+  maniadd({ $file => $comment, ...});
 
-ExtUtils::Manifest - utilities to write and check a MANIFEST file
+Adds an entry to an existing F<MANIFEST> unless its already there.
 
-=head1 SYNOPSIS
+$file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
 
-    require ExtUtils::Manifest;
+=cut
 
-    ExtUtils::Manifest::mkmanifest;
+sub maniadd {
+    my($additions) = shift;
 
-    ExtUtils::Manifest::manicheck;
+    _normalize($additions);
+    _fix_manifest($MANIFEST);
 
-    ExtUtils::Manifest::filecheck;
+    my $manifest = maniread();
+    open(MANIFEST, ">>$MANIFEST") or die "Could not open $MANIFEST: $!";
+    foreach my $file (_sort keys %$additions) {
+        next if exists $manifest->{$file};
 
-    ExtUtils::Manifest::fullcheck;
+        my $comment = $additions->{$file} || '';
+        printf MANIFEST "%-40s%s\n", $file, $comment;
+    }
+    close MANIFEST;
+}
 
-    ExtUtils::Manifest::skipcheck;
 
-    ExtUtils::Manifest::manifind();
+# Sometimes MANIFESTs are missing a trailing newline.  Fix this.
+sub _fix_manifest {
+    my $manifest_file = shift;
 
-    ExtUtils::Manifest::maniread($file);
+    open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
 
-    ExtUtils::Manifest::manicopy($read,$target,$how);
+    # Yes, we should be using seek(), but I'd like to avoid loading POSIX
+    # to get SEEK_*
+    my @manifest = <MANIFEST>;
+    close MANIFEST;
 
-=head1 DESCRIPTION
+    unless( $manifest[-1] =~ /\n\z/ ) {
+        open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
+        print MANIFEST "\n";
+        close MANIFEST;
+    }
+}
+        
 
-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 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.
-
-manicheck() checks if all the files within a C<MANIFEST> in the current
-directory really do exist. If C<MANIFEST> and the tree below the current
-directory are in sync it exits silently, returning an empty list.  Otherwise
-it returns a list of files which are listed in the C<MANIFEST> but missing
-from the directory, and by default also outputs these names to STDERR.
-
-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. The list of
-any extraneous files found is returned, and by default also reported to
-STDERR.
+# UNIMPLEMENTED
+sub _normalize {
+    return;
+}
 
-fullcheck() does both a manicheck() and a filecheck(), returning references
-to two arrays, the first for files manicheck() found to be missing, the
-seond for unexpeced files found by filecheck().
 
-skipcheck() lists all the files that are skipped due to your
-C<MANIFEST.SKIP> file.
+=back
 
-manifind() returns a hash reference. The keys of the hash are the
-files found below the current directory.
+=head2 MANIFEST
 
-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.
+Anything between white space and an end of line within a C<MANIFEST>
+file is considered to be a comment.  Filenames and comments are
+separated by one or more TAB characters in the output. 
 
-C<manicopy($read,$target,$how)> copies the files that are the keys in
-the HASH I<%$read> to the named target directory. The HASH reference
-$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
+=head2 MANIFEST.SKIP
 
 The file MANIFEST.SKIP may contain regular expressions of files that
 should be ignored by mkmanifest() and filecheck(). The regular
@@ -450,6 +596,7 @@ expression to start with a sharp character. A typical example:
     \bRCS\b
     \bCVS\b
     ,v$
+    \B\.svn\b
 
     # Makemaker generated files and dirs.
     ^MANIFEST\.
@@ -468,12 +615,12 @@ used, similar to the example above.  If you want nothing skipped,
 simply make an empty MANIFEST.SKIP file.
 
 
-=head1 EXPORT_OK
+=head2 EXPORT_OK
 
 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 C<&maniread>, and C<&manicopy> are exportable.
 
-=head1 GLOBAL VARIABLES
+=head2 GLOBAL VARIABLES
 
 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 results in both a different C<MANIFEST> and a different
@@ -496,9 +643,11 @@ All diagnostic output is sent to C<STDERR>.
 
 =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>.
+is reported if a file is found which is not in C<MANIFEST>.
+
+=item C<Skipping> I<file>
+
+is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
 
 =item C<No such file:> I<file>
 
@@ -535,3 +684,5 @@ L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 Andreas Koenig <F<andreas.koenig@anima.de>>
 
 =cut
+
+1;