Re: maint @ 20617 [PATCH]

[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Manifest.pm

diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm
index df4cb9e..9965e5d 100644 (file)
--- a/lib/ExtUtils/Manifest.pm
+++ b/lib/ExtUtils/Manifest.pm
@@ -12,7 +12,7 @@ use vars qw($VERSION @ISA @EXPORT_OK
           $Is_MacOS $Is_VMS 
           $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
 
-$VERSION = 1.38;
+$VERSION = 1.39;
 @ISA=('Exporter');
 @EXPORT_OK = qw(mkmanifest
                 manicheck  filecheck  fullcheck  skipcheck
@@ -29,9 +29,8 @@ $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
 $Quiet = 0;
 $MANIFEST = 'MANIFEST';
 
-my $manifest_mod = $INC{"ExtUtils/Manifest.pm"} ||
-                   ($Is_VMS ? $INC{'extutils/manifest.pm'} : '');
-$DEFAULT_MSKIP = (File::Spec->splitpath($manifest_mod))[1].
+my $Filename = __FILE__;
+$DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
                  "$MANIFEST.SKIP";
 
 
@@ -86,6 +85,10 @@ 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 {
     my $manimiss = 0;
     my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
@@ -99,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.
@@ -231,7 +234,7 @@ sub skipcheck {
     my $matches = _maniskip();
 
     my @skipped = ();
-    foreach my $file (sort keys %$found){
+    foreach my $file (_sort keys %$found){
         if (&$matches($file)){
             warn "Skipping $file\n";
             push @skipped, $file;
@@ -250,7 +253,7 @@ sub _check_files {
     my $found = manifind($p);
 
     my(@missfile) = ();
-    foreach my $file (sort keys %$read){
+    foreach my $file (_sort keys %$read){
         warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
         if ($dosnames){
             $file = lc $file;
@@ -274,7 +277,7 @@ sub _check_manifest {
     my $skip  = _maniskip();
 
     my @missentry = ();
-    foreach my $file (sort keys %$found){
+    foreach my $file (_sort keys %$found){
         next if $skip->($file);
         warn "Debug: manicheck checking from disk $file\n" if $Debug;
         unless ( exists $read->{$file} ) {
@@ -306,32 +309,33 @@ sub maniread {
     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;
     }
@@ -343,7 +347,7 @@ sub maniread {
 sub _maniskip {
     my @skip ;
     my $mfile = "$MANIFEST.SKIP";
-    local *M;
+    local(*M,$_);
     open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
     while (<M>){
        chomp;
@@ -414,6 +418,7 @@ sub cp_if_diff {
     local(*F,*T);
     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;
@@ -521,7 +526,7 @@ sub _unmacify {
 
   maniadd({ $file => $comment, ...});
 
-Adds an entry to an existing F<MANIFEST>.
+Adds an entry to an existing F<MANIFEST> unless its already there.
 
 $file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
 
@@ -531,17 +536,39 @@ sub maniadd {
     my($additions) = shift;
 
     _normalize($additions);
+    _fix_manifest($MANIFEST);
 
     my $manifest = maniread();
     open(MANIFEST, ">>$MANIFEST") or die "Could not open $MANIFEST: $!";
-    while( my($file, $comment) = each %$additions ) {
-        $comment ||= '';
-        printf MANIFEST "%-40s%s\n", $file, $comment unless
-          exists $manifest->{$file};
+    foreach my $file (_sort keys %$additions) {
+        next if exists $manifest->{$file};
+
+        my $comment = $additions->{$file} || '';
+        printf MANIFEST "%-40s%s\n", $file, $comment;
     }
     close MANIFEST;
 }
 
+
+# Sometimes MANIFESTs are missing a trailing newline.  Fix this.
+sub _fix_manifest {
+    my $manifest_file = shift;
+
+    open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
+
+    # Yes, we should be using seek(), but I'd like to avoid loading POSIX
+    # to get SEEK_*
+    my @manifest = <MANIFEST>;
+    close MANIFEST;
+
+    unless( $manifest[-1] =~ /\n\z/ ) {
+        open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
+        print MANIFEST "\n";
+        close MANIFEST;
+    }
+}
+        
+
 # UNIMPLEMENTED
 sub _normalize {
     return;