X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FManifest.pm;h=1a6dde7a024bc0eca7e7815b584002028e416c17;hb=562a7b0c67b6218259506760bd4728f2f0c6093b;hp=d2da929d84e526600608d1d12c2fbb3967c551e8;hpb=864a5fa82f3880839549be048858ea56b16abc8d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index d2da929..1a6dde7 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -1,163 +1,53 @@ package ExtUtils::Manifest; -=head1 NAME - -ExtUtils::Manifest - utilities to write and check a MANIFEST file - -=head1 SYNOPSIS - -C - -C - -C - -C - -C - -C - -C - -C - -C - -=head1 DESCRIPTION - -Mkmanifest() writes all files in and below the current directory to a -file named C in the current directory. It works similar to - - find . -print - -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 -output. All files that match any regular expression in a file -C (if such a file exists) are ignored. - -Manicheck() checks if all the files within a C in the current -directory really do exist. - -Filecheck() finds files below the current directory that are not -mentioned in the C file. An optional file C -will be consulted. Any file matching a regular expression in such a -file will not be reported as missing in the C file. - -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 -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. - -I copies the files that are the keys in -the HASH I<%$read> to the named target directory. The HASH reference -I<$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, -which actually copies the files, C which creates hard links, and -C 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 - -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: - - \bRCS\b - ^MANIFEST\. - ^Makefile$ - ~$ - \.html$ - \.old$ - ^blib/ - ^MakeMaker-\d - -=head1 EXPORT_OK - -C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>, -C<&maniread>, and C<&manicopy> are exportable. - -=head1 DIAGNOSTICS - -All diagnostic output is sent to C. - -=over - -=item C I - -is reported if a file is found, that is missing in the C -file which is excluded by a regular expression in the file -C. - -=item C I - -is reported if a file mentioned in a C file does not -exist. - -=item C I<$!> - -is reported if C could not be opened. - -=item C I - -is reported by mkmanifest() if $Verbose is set and a file is added -to MANIFEST. $Verbose is set to 1 by default. - -=back - -=head1 AUTHOR - -Andreas Koenig Fkoenig@franz.ww.TU-Berlin.DEE> +require Exporter; +use Config; +use File::Find; +use File::Copy 'copy'; +use Carp; +use strict; -=cut +use vars qw($VERSION @ISA @EXPORT_OK + $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); -require Exporter; +$VERSION = substr(q$Revision: 1.33 $, 10); @ISA=('Exporter'); @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 'skipcheck', 'maniread', 'manicopy'); -use Config; -use File::Find; -use Carp; +$Is_VMS = $^O eq 'VMS'; +if ($Is_VMS) { require File::Basename } $Debug = 0; $Verbose = 1; -$Is_VMS = $Config{'osname'} eq 'VMS'; - -$VERSION = $VERSION = substr(q$Revision: 1.16 $,10,4); - $Quiet = 0; +$MANIFEST = 'MANIFEST'; + +# Really cool fix from Ilya :) +unless (defined $Config{d_link}) { + *ln = \&cp; +} sub mkmanifest { my $manimiss = 0; my $read = maniread() or $manimiss++; $read = {} if $manimiss; local *M; - rename "MANIFEST", "MANIFEST.bak" unless $manimiss; - open M, ">MANIFEST" or die "Could not open MANIFEST: $!"; + rename $MANIFEST, "$MANIFEST.bak" unless $manimiss; + open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!"; my $matches = _maniskip(); my $found = manifind(); my($key,$val,$file,%all); - my %all = (%$found, %$read); + %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) { next if &$matches($file); if ($Verbose){ - warn "Added to MANIFEST: $file\n" unless exists $read->{$file}; + warn "Added to $MANIFEST: $file\n" unless exists $read->{$file}; } my $text = $all{$file}; - ($file,$text) = split(/\s+/,$text,2) if $Is_VMS; + ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text; my $tabs = (5 - (length($file)+1)/8); $tabs = 1 if $tabs < 1; $tabs = 0 unless $text; @@ -195,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; + 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; @@ -210,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)){ @@ -219,7 +114,7 @@ sub _manicheck { } warn "Debug: manicheck checking from disk $file\n" if $Debug; unless ( exists $read->{$file} ) { - warn "Not in MANIFEST: $file\n" unless $Quiet; + warn "Not in $MANIFEST: $file\n" unless $Quiet; push @missentry, $file; } } @@ -229,7 +124,7 @@ sub _manicheck { sub maniread { my ($mfile) = @_; - $mfile = "MANIFEST" unless defined $mfile; + $mfile ||= $MANIFEST; my $read = {}; local *M; unless (open M, $mfile){ @@ -238,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; @@ -250,12 +157,13 @@ sub _maniskip { my ($mfile) = @_; my $matches = sub {0}; my @skip ; - my $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, $_; } @@ -273,24 +181,27 @@ 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); $target = VMS::Filespec::unixify($target) if $Is_VMS; - umask 0; + umask 0 unless $Is_VMS; + File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755); foreach $file (keys %$read){ $file = VMS::Filespec::unixify($file) if $Is_VMS; - my $dir = File::Basename::dirname($file); - File::Path::mkpath(["$target/$dir"],1,0755); - if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); } - else { cp_if_diff($file, "$target/$file", $how); } + 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); + } + 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"; @@ -305,49 +216,37 @@ 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',vmsify($from),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'."); + } } } sub cp { my ($srcFile, $dstFile) = @_; - my $buf; - open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n"; - open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n"; - my ($perm,$access,$mod) = (stat IN)[2,8,9]; - syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192); - close IN; - close OUT; - utime $access, $mod, $dstFile; + my ($perm,$access,$mod) = (stat $srcFile)[2,8,9]; + copy($srcFile,$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 { @@ -355,8 +254,155 @@ sub best { if (-l $srcFile) { cp($srcFile, $dstFile); } else { - ln($srcFile, $dstFile); + ln($srcFile, $dstFile) or cp($srcFile, $dstFile); } } 1; + +__END__ + +=head1 NAME + +ExtUtils::Manifest - utilities to write and check a MANIFEST file + +=head1 SYNOPSIS + +C + +C + +C + +C + +C + +C + +C + +C + +C + +=head1 DESCRIPTION + +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) in the current directory. It works similar to + + find . -print + +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 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. + +Manicheck() checks if all the files within a C 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. + +Filecheck() finds files below the current directory that are not +mentioned in the C file. An optional file C +will be consulted. Any file matching a regular expression in such a +file will not be reported as missing in the C file. + +Fullcheck() does both a manicheck() and a filecheck(). + +Skipcheck() lists all the files that are skipped due to your +C file. + +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 +I<$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, +which actually copies the files, C which creates hard links, and +C 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 + +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. 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\. + ^Makefile$ + ~$ + \.html$ + \.old$ + ^blib/ + ^MakeMaker-\d + +=head1 EXPORT_OK + +C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>, +C<&maniread>, and C<&manicopy> are exportable. + +=head1 GLOBAL VARIABLES + +C<$ExtUtils::Manifest::MANIFEST> defaults to C. Changing it +results in both a different C and a different +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). + +C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value, +all functions act silently. + +=head1 DIAGNOSTICS + +All diagnostic output is sent to C. + +=over + +=item C I + +is reported if a file is found, that is missing in the C +file which is excluded by a regular expression in the file +C. + +=item C I + +is reported if a file mentioned in a C file does not +exist. + +=item C I<$!> + +is reported if C could not be opened. + +=item C I + +is reported by mkmanifest() if $Verbose is set and a file is added +to MANIFEST. $Verbose is set to 1 by default. + +=back + +=head1 SEE ALSO + +L which has handy targets for most of the functionality. + +=head1 AUTHOR + +Andreas Koenig > + +=cut