X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FManifest.pm;h=1a6dde7a024bc0eca7e7815b584002028e416c17;hb=562a7b0c67b6218259506760bd4728f2f0c6093b;hp=14d0f6e1bed672d8934b45f4e6c8f7cd0b53f4d0;hpb=f1387719c66d49522b38f85cae0c68334115d46b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index 14d0f6e..1a6dde7 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -1,24 +1,26 @@ package ExtUtils::Manifest; - require Exporter; -@ISA=('Exporter'); -@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', - 'skipcheck', 'maniread', 'manicopy'); - use Config; use File::Find; use File::Copy 'copy'; use Carp; +use strict; -$Debug = 0; -$Verbose = 1; -$Is_VMS = $^O eq 'VMS'; +use vars qw($VERSION @ISA @EXPORT_OK + $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); -$VERSION = $VERSION = substr(q$Revision: 1.24 $,10,4); +$VERSION = substr(q$Revision: 1.33 $, 10); +@ISA=('Exporter'); +@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', + 'skipcheck', 'maniread', 'manicopy'); -$Quiet = 0; +$Is_VMS = $^O eq 'VMS'; +if ($Is_VMS) { require File::Basename } +$Debug = 0; +$Verbose = 1; +$Quiet = 0; $MANIFEST = 'MANIFEST'; # Really cool fix from Ilya :) @@ -83,12 +85,18 @@ sub skipcheck { 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; + 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; @@ -98,7 +106,6 @@ sub _manicheck { if ($arg & 2){ $read ||= {}; my $matches = _maniskip(); - my $found = manifind(); my $skipwarn = $arg & 4; foreach $file (sort keys %$found){ if (&$matches($file)){ @@ -117,7 +124,7 @@ sub _manicheck { sub maniread { my ($mfile) = @_; - $mfile = $MANIFEST unless defined $mfile; + $mfile ||= $MANIFEST; my $read = {}; local *M; unless (open M, $mfile){ @@ -126,8 +133,20 @@ sub maniread { } while (){ chomp; - if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; } - else { /^(\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; @@ -138,12 +157,13 @@ sub _maniskip { my ($mfile) = @_; my $matches = sub {0}; my @skip ; - $mfile = "$MANIFEST.SKIP" unless defined $mfile; + $mfile ||= "$MANIFEST.SKIP"; local *M; return $matches unless -f $mfile; open M, $mfile or return $matches; while (){ chomp; + next if /^#/; next if /^\s*$/; push @skip, $_; } @@ -161,7 +181,7 @@ sub _maniskip { 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); @@ -175,14 +195,13 @@ sub manicopy { $dir = VMS::Filespec::unixify($dir) if $Is_VMS; File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755); } - if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); } - else { cp_if_diff($file, "$target/$file", $how); } + cp_if_diff($file, "$target/$file", $how); } } sub cp_if_diff { - my($from,$to, $how)=@_; - -f $from || carp "$0: $from not found"; + 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"; @@ -197,26 +216,14 @@ sub cp_if_diff { if (-e $to) { unlink($to) or confess "unlink $to: $!"; } - &$how($from, $to); - } -} - -# Do the comparisons here rather than spawning off another process -sub vms_cp_if_diff { - my($from,$to) = @_; - my($diff) = 0; - local(*F,*T); - open(F,$from) or croak "Can't read $from: $!\n"; - if (open(T,$to)) { - while () { $diff++,last if $_ ne ; } - $diff++ unless eof(T); - close T; - } - else { $diff++; } - close F; - if ($diff) { - system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1 - or confess "Copy failed: $!"; + 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'."); + } } } @@ -224,17 +231,22 @@ sub cp { my ($srcFile, $dstFile) = @_; my ($perm,$access,$mod) = (stat $srcFile)[2,8,9]; copy($srcFile,$dstFile); - utime $access, $mod, $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; - chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ ); + if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) { + unlink $dstFile; + return; + } + 1; } sub best { @@ -242,7 +254,7 @@ sub best { if (-l $srcFile) { cp($srcFile, $dstFile); } else { - ln($srcFile, $dstFile); + ln($srcFile, $dstFile) or cp($srcFile, $dstFile); } } @@ -286,7 +298,7 @@ but in doing so checks each line in an existing C file and includes any comments that are found in the existing C file in the new one. Anything between white space and an end of line within a C 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 (if such a file exists) are ignored. @@ -305,12 +317,14 @@ Fullcheck() does both a manicheck() and a filecheck(). Skipcheck() lists all the files that are skipped due to your C 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. Maniread($file) reads a named C file (defaults to C 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 file +are discarded. I copies the files that are the keys in the HASH I<%$read> to the named target directory. The HASH reference @@ -326,7 +340,9 @@ 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 -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: \bRCS\b ^MANIFEST\. @@ -350,7 +366,7 @@ C file. This is useful if you want to maintain different distributions for different audiences (say a user version and a developer version including RCS). -<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value, +C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value, all functions act silently. =head1 DIAGNOSTICS @@ -387,6 +403,6 @@ L which has handy targets for most of the functionality. =head1 AUTHOR -Andreas Koenig Fkoenig@franz.ww.TU-Berlin.DEE> +Andreas Koenig > =cut