This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move ExtUtils-Manifest to cpan/
[perl5.git] / cpan / ExtUtils-Manifest / lib / ExtUtils / Manifest.pm
index df621d5..165a15c 100644 (file)
@@ -8,24 +8,22 @@ use File::Find;
 use File::Spec;
 use Carp;
 use strict;
+use warnings;
 
-use vars qw($VERSION @ISA @EXPORT_OK 
-          $Is_MacOS $Is_VMS $Is_VMS_mode $Is_VMS_lc $Is_VMS_nodot
-          $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
+use Exporter 5.57 'import';
 
-$VERSION = '1.57';
-@ISA=('Exporter');
-@EXPORT_OK = qw(mkmanifest
+our $VERSION = '1.64';
+our @EXPORT_OK = qw(mkmanifest
                 manicheck  filecheck  fullcheck  skipcheck
                 manifind   maniread   manicopy   maniadd
                 maniskip
                );
 
-$Is_MacOS = $^O eq 'MacOS';
-$Is_VMS   = $^O eq 'VMS';
-$Is_VMS_mode = 0;
-$Is_VMS_lc = 0;
-$Is_VMS_nodot = 0;  # No dots in dir names or double dots in files
+our $Is_MacOS = $^O eq 'MacOS';
+our $Is_VMS   = $^O eq 'VMS';
+our $Is_VMS_mode = 0;
+our $Is_VMS_lc = 0;
+our $Is_VMS_nodot = 0;  # No dots in dir names or double dots in files
 
 if ($Is_VMS) {
     require VMS::Filespec if $Is_VMS;
@@ -44,7 +42,7 @@ if ($Is_VMS) {
         my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
         my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
         my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
-        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 
+        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
         $vms_efs = $efs_charset =~ /^[ET1]/i;
         $vms_case = $efs_case =~ /^[ET1]/i;
     }
@@ -53,13 +51,13 @@ if ($Is_VMS) {
     $Is_VMS_nodot = 0 if ($vms_efs);
 }
 
-$Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
-$Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
+our $Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
+our $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
                    $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
-$Quiet = 0;
-$MANIFEST = 'MANIFEST';
+our $Quiet = 0;
+our $MANIFEST = 'MANIFEST';
 
-$DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" );
+our $DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" );
 
 
 =head1 NAME
@@ -155,12 +153,20 @@ sub mkmanifest {
     close M;
 }
 
-# Geez, shouldn't this use File::Spec or File::Basename or something?  
+# Geez, shouldn't this use File::Spec or File::Basename or something?
 # Why so careful about dependencies?
 sub clean_up_filename {
   my $filename = shift;
   $filename =~ s|^\./||;
   $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
+  if ( $Is_VMS ) {
+      $filename =~ s/\.$//;                           # trim trailing dot
+      $filename = VMS::Filespec::unixify($filename);  # unescape spaces, etc.
+      if( $Is_VMS_lc ) {
+          $filename = lc($filename);
+          $filename = uc($filename) if $filename =~ /^MANIFEST(\.SKIP)?$/i;
+      }
+  }
   return $filename;
 }
 
@@ -182,17 +188,12 @@ sub manifind {
        my $name = clean_up_filename($File::Find::name);
        warn "Debug: diskfile $name\n" if $Debug;
        return if -d $_;
-
-        if( $Is_VMS_lc ) {
-            $name =~ s#(.*)\.$#\L$1#;
-            $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
-        }
        $found->{$name} = "";
     };
 
-    # We have to use "$File::Find::dir/$_" in preprocess, because 
+    # We have to use "$File::Find::dir/$_" in preprocess, because
     # $File::Find::name is unavailable.
-    # Also, it's okay to use / here, because MANIFEST files use Unix-style 
+    # Also, it's okay to use / here, because MANIFEST files use Unix-style
     # paths.
     find({wanted => $wanted},
         $Is_MacOS ? ":" : ".");
@@ -377,9 +378,11 @@ sub maniread {
                 my $okfile = "$dir$base";
                 warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
                 $file = $okfile;
-            } 
-            $file = lc($file)
-                unless $Is_VMS_lc &&($file =~ /^MANIFEST(\.SKIP)?$/);
+            }
+            if( $Is_VMS_lc ) {
+                $file = lc($file);
+                $file = uc($file) if $file =~ /^MANIFEST(\.SKIP)?$/i;
+            }
         }
 
         $read->{$file} = $comment;
@@ -414,8 +417,8 @@ sub maniskip {
       $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$};
       #my $comment = $3;
       my $filename = $2;
-      if ( defined($1) ) { 
-        $filename = $1; 
+      if ( defined($1) ) {
+        $filename = $1;
         $filename =~ s/\\(['\\])/$1/g;
       }
       next if (not defined($filename) or not $filename);
@@ -514,13 +517,13 @@ typically returned by the maniread() function.
 
     manicopy( maniread(), $dest_dir );
 
-This function is useful for producing a directory tree identical to the 
-intended distribution tree. 
+This function is useful for producing a directory tree identical to the
+intended distribution tree.
 
 $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.  C<cp> is the 
+symbolic link to make a tree without any symbolic link.  C<cp> is the
 default.
 
 =cut
@@ -535,11 +538,11 @@ sub manicopy {
     $target = VMS::Filespec::unixify($target) if $Is_VMS_mode;
     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
     foreach my $file (keys %$read){
-       if ($Is_MacOS) {
-           if ($file =~ m!:!) { 
-               my $dir = _maccat($target, $file);
+       if ($Is_MacOS) {
+           if ($file =~ m!:!) {
+               my $dir = _maccat($target, $file);
                $dir =~ s/[^:]+$//;
-               File::Path::mkpath($dir,1,0755);
+               File::Path::mkpath($dir,1,0755);
            }
            cp_if_diff($file, _maccat($target, $file), $how);
        } else {
@@ -689,7 +692,7 @@ sub maniadd {
     my @needed = grep { !exists $manifest->{$_} } keys %$additions;
     return 1 unless @needed;
 
-    open(MANIFEST, ">>$MANIFEST") or 
+    open(MANIFEST, ">>$MANIFEST") or
       die "maniadd() could not open $MANIFEST: $!";
 
     foreach my $file (_sort @needed) {
@@ -706,21 +709,36 @@ sub maniadd {
 }
 
 
-# Sometimes MANIFESTs are missing a trailing newline.  Fix this.
+# Make sure this MANIFEST is consistently written with native
+# newlines and has a terminal newline.
 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>;
+    local $/;
+    my @manifest = split /(\015\012|\012|\015)/, <MANIFEST>, -1;
     close MANIFEST;
+    my $must_rewrite = "";
+    if ($manifest[-1] eq ""){
+        # sane case: last line had a terminal newline
+        pop @manifest;
+        for (my $i=1; $i<=$#manifest; $i+=2) {
+            unless ($manifest[$i] eq "\n") {
+                $must_rewrite = "not a newline at pos $i";
+                last;
+            }
+        }
+    } else {
+        $must_rewrite = "last line without newline";
+    }
 
-    unless( $manifest[-1] =~ /\n\z/ ) {
-        open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
-        print MANIFEST "\n";
-        close MANIFEST;
+    if ( $must_rewrite ) {
+        1 while unlink $MANIFEST; # avoid multiple versions on VMS
+        open MANIFEST, ">", $MANIFEST or die "(must_rewrite=$must_rewrite) Could not open >$MANIFEST: $!";
+        for (my $i=0; $i<=$#manifest; $i+=2) {
+            print MANIFEST "$manifest[$i]\n";
+        }
+        close MANIFEST or die "could not write $MANIFEST: $!";
     }
 }