This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[REPATCH] Re: [PATCH lib/ExtUtils/Manifest.pm] Minor bug in comment logic in maniread...
[perl5.git] / lib / ExtUtils / Manifest.pm
index dc7d421..2d4d7e3 100644 (file)
@@ -4,33 +4,38 @@ require Exporter;
 use Config;
 use File::Find;
 use File::Copy 'copy';
 use Config;
 use File::Find;
 use File::Copy 'copy';
+use File::Spec::Functions qw(splitpath);
 use Carp;
 use strict;
 
 use Carp;
 use strict;
 
-use vars qw($VERSION @ISA @EXPORT_OK
-           $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
+our ($VERSION,@ISA,@EXPORT_OK,
+           $Is_MacOS,$Is_VMS,
+           $Debug,$Verbose,$Quiet,$MANIFEST,$found,$DEFAULT_MSKIP);
 
 
-$VERSION = '1.2801';
+$VERSION = substr(q$Revision: 1.35 $, 10);
 @ISA=('Exporter');
 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
              'skipcheck', 'maniread', 'manicopy');
 
 @ISA=('Exporter');
 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
              'skipcheck', 'maniread', 'manicopy');
 
+$Is_MacOS = $^O eq 'MacOS';
 $Is_VMS = $^O eq 'VMS';
 if ($Is_VMS) { require File::Basename }
 
 $Is_VMS = $^O eq 'VMS';
 if ($Is_VMS) { require File::Basename }
 
-$Debug = 0;
+$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
 $Verbose = 1;
 $Quiet = 0;
 $MANIFEST = '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}) {
 
 # Really cool fix from Ilya :)
 unless (defined $Config{d_link}) {
+    no warnings;
     *ln = \&cp;
 }
 
 sub mkmanifest {
     my $manimiss = 0;
     *ln = \&cp;
 }
 
 sub mkmanifest {
     my $manimiss = 0;
-    my $read = maniread() or $manimiss++;
+    my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
     $read = {} if $manimiss;
     local *M;
     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
     $read = {} if $manimiss;
     local *M;
     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
@@ -48,6 +53,7 @@ sub mkmanifest {
        }
        my $text = $all{$file};
        ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
        }
        my $text = $all{$file};
        ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
+       $file = _unmacify($file);
        my $tabs = (5 - (length($file)+1)/8);
        $tabs = 1 if $tabs < 1;
        $tabs = 0 unless $text;
        my $tabs = (5 - (length($file)+1)/8);
        $tabs = 1 if $tabs < 1;
        $tabs = 0 unless $text;
@@ -59,10 +65,11 @@ sub mkmanifest {
 sub manifind {
     local $found = {};
     find(sub {return if -d $_;
 sub manifind {
     local $found = {};
     find(sub {return if -d $_;
-             (my $name = $File::Find::name) =~ s|./||;
+             (my $name = $File::Find::name) =~ s|^\./||;
+             $name =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
              warn "Debug: diskfile $name\n" if $Debug;
              warn "Debug: diskfile $name\n" if $Debug;
-             $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
-             $found->{$name} = "";}, ".");
+             $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
+             $found->{$name} = "";}, $Is_MacOS ? ":" : ".");
     $found;
 }
 
     $found;
 }
 
@@ -85,12 +92,18 @@ sub skipcheck {
 sub _manicheck {
     my($arg) = @_;
     my $read = maniread();
 sub _manicheck {
     my($arg) = @_;
     my $read = maniread();
+    my $found = manifind();
     my $file;
     my $file;
+    my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
     my(@missfile,@missentry);
     if ($arg & 1){
     my(@missfile,@missentry);
     if ($arg & 1){
-       my $found = manifind();
        foreach $file (sort keys %$read){
            warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
        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;
            unless ( exists $found->{$file} ) {
                warn "No such file: $file\n" unless $Quiet;
                push @missfile, $file;
@@ -100,7 +113,6 @@ sub _manicheck {
     if ($arg & 2){
        $read ||= {};
        my $matches = _maniskip();
     if ($arg & 2){
        $read ||= {};
        my $matches = _maniskip();
-       my $found = manifind();
        my $skipwarn = $arg & 4;
        foreach $file (sort keys %$found){
            if (&$matches($file)){
        my $skipwarn = $arg & 4;
        foreach $file (sort keys %$found){
            if (&$matches($file)){
@@ -109,7 +121,8 @@ sub _manicheck {
            }
            warn "Debug: manicheck checking from disk $file\n" if $Debug;
            unless ( exists $read->{$file} ) {
            }
            warn "Debug: manicheck checking from disk $file\n" if $Debug;
            unless ( exists $read->{$file} ) {
-               warn "Not in $MANIFEST: $file\n" unless $Quiet;
+               my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
+               warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
                push @missentry, $file;
            }
        }
                push @missentry, $file;
            }
        }
@@ -119,7 +132,7 @@ sub _manicheck {
 
 sub maniread {
     my ($mfile) = @_;
 
 sub maniread {
     my ($mfile) = @_;
-    $mfile = $MANIFEST unless defined $mfile;
+    $mfile ||= $MANIFEST;
     my $read = {};
     local *M;
     unless (open M, $mfile){
     my $read = {};
     local *M;
     unless (open M, $mfile){
@@ -128,9 +141,16 @@ sub maniread {
     }
     while (<M>){
        chomp;
     }
     while (<M>){
        chomp;
-       if ($Is_VMS) {
-           my($file)= /^(\S+)/;
-           next unless $file;
+       next if /^#/;
+
+        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) {
            my($base,$dir) = File::Basename::fileparse($file);
            # Resolve illegal file specifications in the same way as tar
            $dir =~ tr/./_/;
            my($base,$dir) = File::Basename::fileparse($file);
            # Resolve illegal file specifications in the same way as tar
            $dir =~ tr/./_/;
@@ -138,9 +158,10 @@ sub maniread {
            if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
            my $okfile = "$dir$base";
            warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
            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"}=$_;
+            $file = "\L$okfile";
        }
        }
-       else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+
+        $read->{$file} = $comment;
     }
     close M;
     $read;
     }
     close M;
     $read;
@@ -151,14 +172,14 @@ sub _maniskip {
     my ($mfile) = @_;
     my $matches = sub {0};
     my @skip ;
     my ($mfile) = @_;
     my $matches = sub {0};
     my @skip ;
-    $mfile = "$MANIFEST.SKIP" unless defined $mfile;
+    $mfile ||= "$MANIFEST.SKIP";
     local *M;
     local *M;
-    return $matches unless -f $mfile;
-    open M, $mfile or return $matches;
+    open M, $mfile or open M, $DEFAULT_MSKIP or return $matches;
     while (<M>){
        chomp;
     while (<M>){
        chomp;
+       next if /^#/;
        next if /^\s*$/;
        next if /^\s*$/;
-       push @skip, $_;
+       push @skip, _macify($_);
     }
     close M;
     my $opts = $Is_VMS ? 'oi ' : 'o ';
     }
     close M;
     my $opts = $Is_VMS ? 'oi ' : 'o ';
@@ -174,31 +195,39 @@ sub _maniskip {
 sub manicopy {
     my($read,$target,$how)=@_;
     croak "manicopy() called without target argument" unless defined $target;
 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);
     $target = VMS::Filespec::unixify($target) if $Is_VMS;
     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);
+    File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
     foreach $file (keys %$read){
     foreach $file (keys %$read){
-       $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);
+       if ($Is_MacOS) {
+           if ($file =~ m!:!) { 
+               my $dir = _maccat($target, $file);
+               $dir =~ s/[^:]+$//;
+               File::Path::mkpath($dir,1,0755);
+           }
+           cp_if_diff($file, _maccat($target, $file), $how);
+       } else {
+           $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"],! $Quiet,$Is_VMS ? undef : 0755);
+           }
+           cp_if_diff($file, "$target/$file", $how);
        }
        }
-       cp_if_diff($file, "$target/$file", $how);
     }
 }
 
 sub cp_if_diff {
     my($from, $to, $how)=@_;
     }
 }
 
 sub cp_if_diff {
     my($from, $to, $how)=@_;
-    -f $from || carp "$0: $from not found";
+    -f $from or carp "$0: $from not found";
     my($diff) = 0;
     local(*F,*T);
     my($diff) = 0;
     local(*F,*T);
-    open(F,$from) or croak "Can't read $from: $!\n";
-    if (open(T,$to)) {
+    open(F,"< $from\0") or croak "Can't read $from: $!\n";
+    if (open(T,"< $to\0")) {
        while (<F>) { $diff++,last if $_ ne <T>; }
        $diff++ unless eof(T);
        close T;
        while (<F>) { $diff++,last if $_ ne <T>; }
        $diff++ unless eof(T);
        close T;
@@ -209,11 +238,14 @@ sub cp_if_diff {
        if (-e $to) {
            unlink($to) or confess "unlink $to: $!";
        }
        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';
-         }
+      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'.");
+       }
     }
 }
 
     }
 }
 
@@ -223,16 +255,20 @@ sub cp {
     copy($srcFile,$dstFile);
     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
     # chmod a+rX-w,go-w
     copy($srcFile,$dstFile);
     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
     # chmod a+rX-w,go-w
-    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
+    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile ) unless ($^O eq 'MacOS');
 }
 
 sub ln {
     my ($srcFile, $dstFile) = @_;
 }
 
 sub ln {
     my ($srcFile, $dstFile) = @_;
-    return &cp if $Is_VMS;
+    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)
     my $mode= 0444 | (stat)[2] & 0700;
     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 {
 }
 
 sub best {
@@ -244,6 +280,42 @@ sub best {
     }
 }
 
     }
 }
 
+sub _macify {
+    my($file) = @_;
+
+    return $file unless $Is_MacOS;
+    
+    $file =~ s|^\./||;
+    if ($file =~ m|/|) {
+       $file =~ s|/+|:|g;
+       $file = ":$file";
+    }
+    
+    $file;
+}
+
+sub _maccat {
+    my($f1, $f2) = @_;
+    
+    return "$f1/$f2" unless $Is_MacOS;
+    
+    $f1 .= ":$f2";
+    $f1 =~ s/([^:]:):/$1/g;
+    return $f1;
+}
+
+sub _unmacify {
+    my($file) = @_;
+
+    return $file unless $Is_MacOS;
+    
+    $file =~ s|^:||;
+    $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
+    $file =~ y|:|/|;
+    
+    $file;
+}
+
 1;
 
 __END__
 1;
 
 __END__
@@ -254,27 +326,27 @@ ExtUtils::Manifest - utilities to write and check a MANIFEST file
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
-C<require ExtUtils::Manifest;>
+    require ExtUtils::Manifest;
 
 
-C<ExtUtils::Manifest::mkmanifest;>
+    ExtUtils::Manifest::mkmanifest;
 
 
-C<ExtUtils::Manifest::manicheck;>
+    ExtUtils::Manifest::manicheck;
 
 
-C<ExtUtils::Manifest::filecheck;>
+    ExtUtils::Manifest::filecheck;
 
 
-C<ExtUtils::Manifest::fullcheck;>
+    ExtUtils::Manifest::fullcheck;
 
 
-C<ExtUtils::Manifest::skipcheck;>
+    ExtUtils::Manifest::skipcheck;
 
 
-C<ExtUtild::Manifest::manifind();>
+    ExtUtils::Manifest::manifind();
 
 
-C<ExtUtils::Manifest::maniread($file);>
+    ExtUtils::Manifest::maniread($file);
 
 
-C<ExtUtils::Manifest::manicopy($read,$target,$how);>
+    ExtUtils::Manifest::manicopy($read,$target,$how);
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 
-Mkmanifest() writes all files in and below the current directory to a
+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
 
 file named in the global variable $ExtUtils::Manifest::MANIFEST (which
 defaults to C<MANIFEST>) in the current directory. It works similar to
 
@@ -284,35 +356,37 @@ 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
 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.
 
 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
+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.
 
 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
+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.
 
 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().
+fullcheck() does both a manicheck() and a filecheck().
 
 
-Skipcheck() lists all the files that are skipped due to your
+skipcheck() lists all the files that are skipped due to your
 C<MANIFEST.SKIP> file.
 
 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.
 
 files found below the current directory.
 
-Maniread($file) reads a named C<MANIFEST> file (defaults to
+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.
 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
+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
 the HASH I<%$read> to the named target directory. The HASH reference
-I<$read> is typically returned by the maniread() function. This
+$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>,
 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>,
@@ -324,17 +398,32 @@ 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
 
 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:
 
 
+    # Version control files and dirs.
     \bRCS\b
     \bRCS\b
+    \bCVS\b
+    ,v$
+
+    # Makemaker generated files and dirs.
     ^MANIFEST\.
     ^Makefile$
     ^MANIFEST\.
     ^Makefile$
-    ~$
-    \.html$
-    \.old$
     ^blib/
     ^MakeMaker-\d
 
     ^blib/
     ^MakeMaker-\d
 
+    # Temp, old and emacs backup files.
+    ~$
+    \.old$
+    ^#.*#$
+    ^\.#
+
+If no MANIFEST.SKIP file is found, a default set of skips will be
+used, similar to the example above.  If you want nothing skipped,
+simply make an empty MANIFEST.SKIP file.
+
+
 =head1 EXPORT_OK
 
 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 =head1 EXPORT_OK
 
 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
@@ -351,11 +440,15 @@ and a developer version including RCS).
 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 all functions act silently.
 
 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 all functions act silently.
 
+C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
+or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
+produced.
+
 =head1 DIAGNOSTICS
 
 All diagnostic output is sent to C<STDERR>.
 
 =head1 DIAGNOSTICS
 
 All diagnostic output is sent to C<STDERR>.
 
-=over
+=over 4
 
 =item C<Not in MANIFEST:> I<file>
 
 
 =item C<Not in MANIFEST:> I<file>
 
@@ -379,12 +472,22 @@ to MANIFEST. $Verbose is set to 1 by default.
 
 =back
 
 
 =back
 
+=head1 ENVIRONMENT
+
+=over 4
+
+=item B<PERL_MM_MANIFEST_DEBUG>
+
+Turns on debugging
+
+=back
+
 =head1 SEE ALSO
 
 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 
 =head1 AUTHOR
 
 =head1 SEE ALSO
 
 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<andreas.koenig@anima.de>>
 
 =cut
 
 =cut