package ExtUtils::Manifest; require Exporter; use Config; use File::Find; use File::Copy 'copy'; use Carp; use strict; use vars qw($VERSION @ISA @EXPORT_OK $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); $VERSION = substr(q$Revision: 1.33 $, 10); @ISA=('Exporter'); @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 'skipcheck', 'maniread', 'manicopy'); $Is_VMS = $^O eq 'VMS'; if ($Is_VMS) { require File::Basename } $Debug = 0; $Verbose = 1; $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: $!"; my $matches = _maniskip(); my $found = manifind(); my($key,$val,$file,%all); %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}; } my $text = $all{$file}; ($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; print M $file, "\t" x $tabs, $text, "\n"; } close M; } sub manifind { local $found = {}; find(sub {return if -d $_; (my $name = $File::Find::name) =~ s|./||; warn "Debug: diskfile $name\n" if $Debug; $name =~ s#(.*)\.$#\L$1# if $Is_VMS; $found->{$name} = "";}, "."); $found; } sub fullcheck { _manicheck(3); } sub manicheck { return @{(_manicheck(1))[0]}; } sub filecheck { return @{(_manicheck(2))[1]}; } sub skipcheck { _manicheck(6); } 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){ 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; } } } if ($arg & 2){ $read ||= {}; my $matches = _maniskip(); my $skipwarn = $arg & 4; foreach $file (sort keys %$found){ if (&$matches($file)){ warn "Skipping $file\n" if $skipwarn; next; } warn "Debug: manicheck checking from disk $file\n" if $Debug; unless ( exists $read->{$file} ) { warn "Not in $MANIFEST: $file\n" unless $Quiet; push @missentry, $file; } } } (\@missfile,\@missentry); } sub maniread { my ($mfile) = @_; $mfile ||= $MANIFEST; my $read = {}; local *M; unless (open M, $mfile){ warn "$mfile: $!"; return $read; } while (){ chomp; 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; } # returns an anonymous sub that decides if an argument matches sub _maniskip { my ($mfile) = @_; my $matches = sub {0}; my @skip ; $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, $_; } close M; my $opts = $Is_VMS ? 'oi ' : 'o '; my $sub = "\$matches = " . "sub { my(\$arg)=\@_; return 1 if " . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0) . " }"; eval $sub; print "Debug: $sub\n" if $Debug; $matches; } sub manicopy { my($read,$target,$how)=@_; croak "manicopy() called without target argument" unless defined $target; $how ||= 'cp'; 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); 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); } cp_if_diff($file, "$target/$file", $how); } } sub cp_if_diff { 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"; if (open(T,$to)) { while () { $diff++,last if $_ ne ; } $diff++ unless eof(T); close T; } else { $diff++; } close F; if ($diff) { 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'; 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 ($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; if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) { unlink $dstFile; return; } 1; } sub best { my ($srcFile, $dstFile) = @_; if (-l $srcFile) { cp($srcFile, $dstFile); } else { 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 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. 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() 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. 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