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

package ExtUtils::Manifest;

require Exporter;
use Config;
use File::Find;
use File::Copy 'copy';
use File::Spec::Functions qw(splitpath);
use Carp;
use strict;

our ($VERSION,@ISA,@EXPORT_OK,
	    $Is_MacOS,$Is_VMS,
	    $Debug,$Verbose,$Quiet,$MANIFEST,$DEFAULT_MSKIP);

$VERSION = 1.37_01;
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
	      'skipcheck', 'maniread', 'manicopy');

$Is_MacOS = $^O eq 'MacOS';
$Is_VMS = $^O eq 'VMS';
require VMS::Filespec if $Is_VMS;

$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
$Verbose = 1;
$Quiet = 0;
$MANIFEST = 'MANIFEST';
$DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP";

# Really cool fix from Ilya :)
unless (defined $Config{d_link}) {
    no warnings;
    *ln = \&cp;
}

sub mkmanifest {
    my $manimiss = 0;
    my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
    $read = {} if $manimiss;
    local *M;
    rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
    open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
    my $skip = _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) {
	if ($skip->($file)) {
	    # Policy: only remove files if they're listed in MANIFEST.SKIP.
	    # Don't remove files just because they don't exist.
	    warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
	    next;
	}
	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;
	$file = _unmacify($file);
	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;
}

# 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;
  return $filename;
}

sub manifind {
    my $p = shift || {};
    my $skip = _maniskip(warn => $p->{warn_on_skip});
    my $found = {};

    my $wanted = sub {
	my $name = clean_up_filename($File::Find::name);
	warn "Debug: diskfile $name\n" if $Debug;
	return if $skip->($name) or -d $name;
	
        if( $Is_VMS ) {
            $name =~ s#(.*)\.$#\L$1#;
            $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
        }
	$found->{$name} = "";
    };

    # 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 
    # paths.
    find({wanted => $wanted,
	  preprocess => 
          sub {grep {!$skip->( clean_up_filename("$File::Find::dir/$_") )} @_},
	  no_chdir => 1,
	 },
	 $Is_MacOS ? ":" : ".");

    return $found;
}

sub fullcheck {
    _manicheck({check_files => 1, check_MANIFEST => 1});
}

sub manicheck {
    return @{(_manicheck({check_files => 1}))[0]};
}

sub filecheck {
    return @{(_manicheck({check_MANIFEST => 1}))[1]};
}

sub skipcheck {
    _manicheck({check_MANIFEST => 1, warn_on_skip => 1});
}

sub _manicheck {
    my($p) = @_;
    my $read = maniread();
    my $found = manifind($p);

    my $file;
    my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
    my(@missfile,@missentry);
    if ($p->{check_files}){
	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 ($p->{check_MANIFEST}){
	$read ||= {};
	my $matches = _maniskip();
	foreach $file (sort keys %$found){
	    if (&$matches($file)){
		warn "Skipping $file\n" if $p->{warn_on_skip};
		next;
	    }
	    warn "Debug: manicheck checking from disk $file\n" if $Debug;
	    unless ( exists $read->{$file} ) {
		my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
		warn "Not in $MANIFEST: $file$canon\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 (<M>){
	chomp;
	next if /^#/;

        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;
            $file = $okfile;
            $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
	}

        $read->{$file} = $comment;
    }
    close M;
    $read;
}

# returns an anonymous sub that decides if an argument matches
sub _maniskip {
    my (%args) = @_;

    my @skip ;
    my $mfile ||= "$MANIFEST.SKIP";
    local *M;
    open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
    while (<M>){
	chomp;
	next if /^#/;
	next if /^\s*$/;
	push @skip, _macify($_);
    }
    close M;
    my $opts = $Is_VMS ? '(?i)' : '';

    # Make sure each entry is isolated in its own parentheses, in case
    # any of them contain alternations
    my $regex = join '|', map "(?:$_)", @skip;

    return ($args{warn}
	    ? sub { $_[0] =~ qr{$opts$regex} && warn "Skipping $_[0]\n" }
	    : sub { $_[0] =~ qr{$opts$regex} }
	   );
}

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;
    File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
    foreach $file (keys %$read){
    	if ($Is_MacOS) {
	    if ($file =~ m!:!) { 
	   	my $dir = _maccat($target, $file);
		$dir =~ s/[^:]+$//;
	    	File::Path::mkpath($dir,1,0755);
	    }
	    cp_if_diff($file, _maccat($target, $file), $how);
	} else {
	    $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"],! $Quiet,$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\0") or croak "Can't read $from: $!\n";
    if (open(T,"< $to\0")) {
	while (<F>) { $diff++,last if $_ ne <T>; }
	$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 ) unless ($^O eq 'MacOS');
}

sub ln {
    my ($srcFile, $dstFile) = @_;
    return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
    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);
    }
}

sub _macify {
    my($file) = @_;

    return $file unless $Is_MacOS;
    
    $file =~ s|^\./||;
    if ($file =~ m|/|) {
	$file =~ s|/+|:|g;
	$file = ":$file";
    }
    
    $file;
}

sub _maccat {
    my($f1, $f2) = @_;
    
    return "$f1/$f2" unless $Is_MacOS;
    
    $f1 .= ":$f2";
    $f1 =~ s/([^:]:):/$1/g;
    return $f1;
}

sub _unmacify {
    my($file) = @_;

    return $file unless $Is_MacOS;
    
    $file =~ s|^:||;
    $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
    $file =~ y|:|/|;
    
    $file;
}

1;

__END__

=head1 NAME

ExtUtils::Manifest - utilities to write and check a MANIFEST file

=head1 SYNOPSIS

    require ExtUtils::Manifest;

    ExtUtils::Manifest::mkmanifest;

    ExtUtils::Manifest::manicheck;

    ExtUtils::Manifest::filecheck;

    ExtUtils::Manifest::fullcheck;

    ExtUtils::Manifest::skipcheck;

    ExtUtils::Manifest::manifind();

    ExtUtils::Manifest::maniread($file);

    ExtUtils::Manifest::manicopy($read,$target,$how);

=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<MANIFEST>) in the current directory. It works similar to

    find . -print

but in doing so checks each line in an existing C<MANIFEST> file and
includes any comments that are found in the existing C<MANIFEST> file
in the new one. Anything between white space and an end of line within
a C<MANIFEST> 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<MANIFEST.SKIP> (if such a file exists) are ignored.

manicheck() checks if all the files within a C<MANIFEST> in the current
directory really do exist. If C<MANIFEST> and the tree below the current
directory are in sync it exits silently, returning an empty list.  Otherwise
it returns a list of files which are listed in the C<MANIFEST> but missing
from the directory, and by default also outputs these names to STDERR.

filecheck() finds files below the current directory that are not
mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
will be consulted. Any file matching a regular expression in such a
file will not be reported as missing in the C<MANIFEST> file. The list of
any extraneous files found is returned, and by default also reported to
STDERR.

fullcheck() does both a manicheck() and a filecheck(), returning references
to two arrays, the first for files manicheck() found to be missing, the
seond for unexpeced files found by filecheck().

skipcheck() lists all the files that are skipped due to your
C<MANIFEST.SKIP> 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<MANIFEST> file (defaults to
C<MANIFEST> 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<MANIFEST> file
are discarded.

C<manicopy($read,$target,$how)> copies the files that are the keys in
the HASH I<%$read> to the named target directory. The HASH reference
$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<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. 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:

    # Version control files and dirs.
    \bRCS\b
    \bCVS\b
    ,v$

    # Makemaker generated files and dirs.
    ^MANIFEST\.
    ^Makefile$
    ^blib/
    ^MakeMaker-\d

    # Temp, old and emacs backup files.
    ~$
    \.old$
    ^#.*#$
    ^\.#

If no MANIFEST.SKIP file is found, a default set of skips will be
used, similar to the example above.  If you want nothing skipped,
simply make an empty MANIFEST.SKIP file.


=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<MANIFEST>. Changing it
results in both a different C<MANIFEST> and a different
C<MANIFEST.SKIP> 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.

C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
produced.

=head1 DIAGNOSTICS

All diagnostic output is sent to C<STDERR>.

=over 4

=item C<Not in MANIFEST:> I<file>

is reported if a file is found, that is missing in the C<MANIFEST>
file which is excluded by a regular expression in the file
C<MANIFEST.SKIP>.

=item C<No such file:> I<file>

is reported if a file mentioned in a C<MANIFEST> file does not
exist.

=item C<MANIFEST:> I<$!>

is reported if C<MANIFEST> could not be opened.

=item C<Added to MANIFEST:> I<file>

is reported by mkmanifest() if $Verbose is set and a file is added
to MANIFEST. $Verbose is set to 1 by default.

=back

=head1 ENVIRONMENT

=over 4

=item B<PERL_MM_MANIFEST_DEBUG>

Turns on debugging

=back

=head1 SEE ALSO

L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.

=head1 AUTHOR

Andreas Koenig <F<andreas.koenig@anima.de>>

=cut
Commit	Line	Data
005c1a0e	1	package ExtUtils::Manifest;
005c1a0e	2
005c1a0e	3	require Exporter;
8e07c86e	4	use Config;
005c1a0e	5	use File::Find;
79dd614e	6	use File::Copy 'copy';
0b9c804f	7	use File::Spec::Functions qw(splitpath);
005c1a0e	8	use Carp;
8a1da95f	9	use strict;
8a1da95f	10
f168a5e7	11	our ($VERSION,@ISA,@EXPORT_OK,
5d31cce8	12	$Is_MacOS,$Is_VMS,
f6d6199c	13	$Debug,$Verbose,$Quiet,$MANIFEST,$DEFAULT_MSKIP);
8a1da95f	14
f6d6199c	15	$VERSION = 1.37_01;
8a1da95f	16	@ISA=('Exporter');
	17	@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
	18	'skipcheck', 'maniread', 'manicopy');
005c1a0e	19
db5fd395	20	$Is_MacOS = $^O eq 'MacOS';
79dd614e	21	$Is_VMS = $^O eq 'VMS';
f6d6199c	22	require VMS::Filespec if $Is_VMS;
005c1a0e	23
0b9c804f	24	$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} \|\| 0;
9607fc9c	25	$Verbose = 1;
005c1a0e	26	$Quiet = 0;
cb1a09d0	27	$MANIFEST = 'MANIFEST';
0b9c804f	28	$DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP";
cb1a09d0	29
4e68a208	30	# Really cool fix from Ilya :)
4e68a208	31	unless (defined $Config{d_link}) {
db376a24	32	no warnings;
4e68a208	33	*ln = \&cp;
	34	}
	35
005c1a0e	36	sub mkmanifest {
005c1a0e	37	my $manimiss = 0;
0300da75	38	my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
005c1a0e	39	$read = {} if $manimiss;
864a5fa8	40	local *M;
cb1a09d0	41	rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
cb1a09d0	42	open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
f6d6199c	43	my $skip = _maniskip();
005c1a0e	44	my $found = manifind();
005c1a0e	45	my($key,$val,$file,%all);
f1387719	46	%all = (%$found, %$read);
84876ac5	47	$all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
84876ac5	48	if $manimiss; # add new MANIFEST to known file list
005c1a0e	49	foreach $file (sort keys %all) {
f6d6199c	50	if ($skip->($file)) {
	51	# Policy: only remove files if they're listed in MANIFEST.SKIP.
	52	# Don't remove files just because they don't exist.
	53	warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
	54	next;
	55	}
005c1a0e	56	if ($Verbose){
cb1a09d0	57	warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
005c1a0e	58	}
8e07c86e	59	my $text = $all{$file};
84876ac5	60	($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
db5fd395	61	$file = _unmacify($file);
005c1a0e	62	my $tabs = (5 - (length($file)+1)/8);
005c1a0e	63	$tabs = 1 if $tabs < 1;
8e07c86e	64	$tabs = 0 unless $text;
8e07c86e	65	print M $file, "\t" x $tabs, $text, "\n";
005c1a0e	66	}
	67	close M;
	68	}
	69
f6d6199c	70	# Geez, shouldn't this use File::Spec or File::Basename or something?
	71	# Why so careful about dependencies?
	72	sub clean_up_filename {
	73	my $filename = shift;
	74	$filename =~ s\|^\./\|\|;
	75	$filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
	76	return $filename;
	77	}
	78
005c1a0e	79	sub manifind {
f6d6199c	80	my $p = shift \|\| {};
	81	my $skip = _maniskip(warn => $p->{warn_on_skip});
	82	my $found = {};
	83
	84	my $wanted = sub {
	85	my $name = clean_up_filename($File::Find::name);
	86	warn "Debug: diskfile $name\n" if $Debug;
	87	return if $skip->($name) or -d $name;
	88
	89	if( $Is_VMS ) {
	90	$name =~ s#(.*)\.$#\L$1#;
	91	$name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
	92	}
	93	$found->{$name} = "";
	94	};
	95
	96	# We have to use "$File::Find::dir/$_" in preprocess, because
	97	# $File::Find::name is unavailable.
	98	# Also, it's okay to use / here, because MANIFEST files use Unix-style
	99	# paths.
	100	find({wanted => $wanted,
	101	preprocess =>
	102	sub {grep {!$skip->( clean_up_filename("$File::Find::dir/$_") )} @_},
	103	no_chdir => 1,
	104	},
	105	$Is_MacOS ? ":" : ".");
	106
	107	return $found;
005c1a0e	108	}
	109
	110	sub fullcheck {
6aa71d6e	111	_manicheck({check_files => 1, check_MANIFEST => 1});
005c1a0e	112	}
	113
	114	sub manicheck {
6aa71d6e	115	return @{(_manicheck({check_files => 1}))[0]};
005c1a0e	116	}
	117
	118	sub filecheck {
6aa71d6e	119	return @{(_manicheck({check_MANIFEST => 1}))[1]};
005c1a0e	120	}
005c1a0e	121
8e07c86e	122	sub skipcheck {
6aa71d6e	123	_manicheck({check_MANIFEST => 1, warn_on_skip => 1});
8e07c86e	124	}
8e07c86e	125
005c1a0e	126	sub _manicheck {
6aa71d6e	127	my($p) = @_;
005c1a0e	128	my $read = maniread();
f6d6199c	129	my $found = manifind($p);
f6d6199c	130
005c1a0e	131	my $file;
39e571d4	132	my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
005c1a0e	133	my(@missfile,@missentry);
6aa71d6e	134	if ($p->{check_files}){
005c1a0e	135	foreach $file (sort keys %$read){
cb1a09d0	136	warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
39e571d4	137	if ($dosnames){
	138	$file = lc $file;
	139	$file =~ s=(\.(\w\|-)+)=substr ($1,0,4)=ge;
	140	$file =~ s=((\w\|-)+)=substr ($1,0,8)=ge;
	141	}
005c1a0e	142	unless ( exists $found->{$file} ) {
8e07c86e	143	warn "No such file: $file\n" unless $Quiet;
8e07c86e	144	push @missfile, $file;
005c1a0e	145	}
	146	}
	147	}
6aa71d6e	148	if ($p->{check_MANIFEST}){
005c1a0e	149	$read \|\|= {};
005c1a0e	150	my $matches = _maniskip();
005c1a0e	151	foreach $file (sort keys %$found){
8e07c86e	152	if (&$matches($file)){
6aa71d6e	153	warn "Skipping $file\n" if $p->{warn_on_skip};
8e07c86e	154	next;
8e07c86e	155	}
005c1a0e	156	warn "Debug: manicheck checking from disk $file\n" if $Debug;
005c1a0e	157	unless ( exists $read->{$file} ) {
c4968b8c	158	my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
db5fd395	159	warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
8e07c86e	160	push @missentry, $file;
005c1a0e	161	}
	162	}
	163	}
	164	(\@missfile,\@missentry);
	165	}
	166
	167	sub maniread {
	168	my ($mfile) = @_;
15a074ca	169	$mfile \|\|= $MANIFEST;
005c1a0e	170	my $read = {};
	171	local *M;
	172	unless (open M, $mfile){
	173	warn "$mfile: $!";
	174	return $read;
	175	}
	176	while (<M>){
	177	chomp;
15a074ca	178	next if /^#/;
0e3309e2	179
	180	my($file, $comment) = /^(\S+)\s(.)/;
	181	next unless $file;
	182
db5fd395	183	if ($Is_MacOS) {
0e3309e2	184	$file = _macify($file);
0e3309e2	185	$file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
db5fd395	186	}
db5fd395	187	elsif ($Is_VMS) {
f6d6199c	188	require File::Basename;
9607fc9c	189	my($base,$dir) = File::Basename::fileparse($file);
	190	# Resolve illegal file specifications in the same way as tar
	191	$dir =~ tr/./_/;
	192	my(@pieces) = split(/\./,$base);
	193	if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
	194	my $okfile = "$dir$base";
	195	warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
349e1be1	196	$file = $okfile;
f6d6199c	197	$file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
9607fc9c	198	}
0e3309e2	199
0e3309e2	200	$read->{$file} = $comment;
005c1a0e	201	}
	202	close M;
	203	$read;
	204	}
	205
	206	# returns an anonymous sub that decides if an argument matches
	207	sub _maniskip {
f6d6199c	208	my (%args) = @_;
f6d6199c	209
005c1a0e	210	my @skip ;
f6d6199c	211	my $mfile \|\|= "$MANIFEST.SKIP";
005c1a0e	212	local *M;
f6d6199c	213	open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
005c1a0e	214	while (<M>){
005c1a0e	215	chomp;
15a074ca	216	next if /^#/;
005c1a0e	217	next if /^\s*$/;
db5fd395	218	push @skip, _macify($_);
005c1a0e	219	}
005c1a0e	220	close M;
f6d6199c	221	my $opts = $Is_VMS ? '(?i)' : '';
	222
	223	# Make sure each entry is isolated in its own parentheses, in case
	224	# any of them contain alternations
	225	my $regex = join '\|', map "(?:$_)", @skip;
	226
	227	return ($args{warn}
	228	? sub { $_[0] =~ qr{$opts$regex} && warn "Skipping $_[0]\n" }
	229	: sub { $_[0] =~ qr{$opts$regex} }
	230	);
005c1a0e	231	}
	232
	233	sub manicopy {
8e07c86e	234	my($read,$target,$how)=@_;
005c1a0e	235	croak "manicopy() called without target argument" unless defined $target;
15a074ca	236	$how \|\|= 'cp';
005c1a0e	237	require File::Path;
	238	require File::Basename;
	239	my(%dirs,$file);
8e07c86e	240	$target = VMS::Filespec::unixify($target) if $Is_VMS;
553c0e07	241	File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
005c1a0e	242	foreach $file (keys %$read){
db5fd395	243	if ($Is_MacOS) {
	244	if ($file =~ m!:!) {
	245	my $dir = _maccat($target, $file);
	246	$dir =~ s/[^:]+$//;
	247	File::Path::mkpath($dir,1,0755);
	248	}
	249	cp_if_diff($file, _maccat($target, $file), $how);
	250	} else {
	251	$file = VMS::Filespec::unixify($file) if $Is_VMS;
	252	if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
	253	my $dir = File::Basename::dirname($file);
	254	$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
	255	File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
	256	}
	257	cp_if_diff($file, "$target/$file", $how);
84876ac5	258	}
005c1a0e	259	}
	260	}
	261
	262	sub cp_if_diff {
8a1da95f	263	my($from, $to, $how)=@_;
15a074ca	264	-f $from or carp "$0: $from not found";
8e07c86e	265	my($diff) = 0;
8e07c86e	266	local(F,T);
db5fd395	267	open(F,"< $from\0") or croak "Can't read $from: $!\n";
db5fd395	268	if (open(T,"< $to\0")) {
8e07c86e	269	while (<F>) { $diff++,last if $_ ne <T>; }
	270	$diff++ unless eof(T);
	271	close T;
	272	}
	273	else { $diff++; }
	274	close F;
	275	if ($diff) {
	276	if (-e $to) {
	277	unlink($to) or confess "unlink $to: $!";
	278	}
15a074ca	279	STRICT_SWITCH: {
	280	best($from,$to), last STRICT_SWITCH if $how eq 'best';
	281	cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
	282	ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
	283	croak("ExtUtils::Manifest::cp_if_diff " .
	284	"called with illegal how argument [$how]. " .
	285	"Legal values are 'best', 'cp', and 'ln'.");
	286	}
8e07c86e	287	}
	288	}
	289
8e07c86e	290	sub cp {
8e07c86e	291	my ($srcFile, $dstFile) = @_;
79dd614e	292	my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
79dd614e	293	copy($srcFile,$dstFile);
9607fc9c	294	utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
8e07c86e	295	# chmod a+rX-w,go-w
db5fd395	296	chmod( 0444 \| ( $perm & 0111 ? 0111 : 0 ), $dstFile ) unless ($^O eq 'MacOS');
8e07c86e	297	}
	298
	299	sub ln {
	300	my ($srcFile, $dstFile) = @_;
f0f13d0e	301	return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
8e07c86e	302	link($srcFile, $dstFile);
	303	local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
	304	my $mode= 0444 \| (stat)[2] & 0700;
4e6ea2c3	305	if (! chmod( $mode \| ( $mode & 0100 ? 0111 : 0 ), $_ )) {
	306	unlink $dstFile;
	307	return;
	308	}
	309	1;
8e07c86e	310	}
8e07c86e	311
4633a7c4	312	sub best {
	313	my ($srcFile, $dstFile) = @_;
	314	if (-l $srcFile) {
	315	cp($srcFile, $dstFile);
	316	} else {
3dee4013	317	ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
4633a7c4	318	}
	319	}
	320
db5fd395	321	sub _macify {
	322	my($file) = @_;
	323
	324	return $file unless $Is_MacOS;
	325
	326	$file =~ s\|^\./\|\|;
	327	if ($file =~ m\|/\|) {
	328	$file =~ s\|/+\|:\|g;
	329	$file = ":$file";
	330	}
	331
	332	$file;
	333	}
	334
	335	sub _maccat {
	336	my($f1, $f2) = @_;
	337
	338	return "$f1/$f2" unless $Is_MacOS;
	339
	340	$f1 .= ":$f2";
	341	$f1 =~ s/([^:]:):/$1/g;
	342	return $f1;
	343	}
	344
	345	sub _unmacify {
	346	my($file) = @_;
	347
	348	return $file unless $Is_MacOS;
	349
	350	$file =~ s\|^:\|\|;
	351	$file =~ s\|([/ \n])\|sprintf("\\%03o", unpack("c", $1))\|ge;
	352	$file =~ y\|:\|/\|;
	353
	354	$file;
	355	}
	356
005c1a0e	357	1;
79dd614e	358
	359	__END__
	360
	361	=head1 NAME
	362
	363	ExtUtils::Manifest - utilities to write and check a MANIFEST file
	364
	365	=head1 SYNOPSIS
	366
d962e1c0	367	require ExtUtils::Manifest;
79dd614e	368
d962e1c0	369	ExtUtils::Manifest::mkmanifest;
79dd614e	370
d962e1c0	371	ExtUtils::Manifest::manicheck;
79dd614e	372
d962e1c0	373	ExtUtils::Manifest::filecheck;
79dd614e	374
d962e1c0	375	ExtUtils::Manifest::fullcheck;
79dd614e	376
d962e1c0	377	ExtUtils::Manifest::skipcheck;
79dd614e	378
d962e1c0	379	ExtUtils::Manifest::manifind();
79dd614e	380
d962e1c0	381	ExtUtils::Manifest::maniread($file);
79dd614e	382
d962e1c0	383	ExtUtils::Manifest::manicopy($read,$target,$how);
79dd614e	384
	385	=head1 DESCRIPTION
	386
d962e1c0	387	mkmanifest() writes all files in and below the current directory to a
79dd614e	388	file named in the global variable $ExtUtils::Manifest::MANIFEST (which
	389	defaults to C<MANIFEST>) in the current directory. It works similar to
	390
	391	find . -print
	392
	393	but in doing so checks each line in an existing C<MANIFEST> file and
	394	includes any comments that are found in the existing C<MANIFEST> file
	395	in the new one. Anything between white space and an end of line within
	396	a C<MANIFEST> file is considered to be a comment. Filenames and
de592821	397	comments are separated by one or more TAB characters in the
79dd614e	398	output. All files that match any regular expression in a file
	399	C<MANIFEST.SKIP> (if such a file exists) are ignored.
	400
e258e381	401	manicheck() checks if all the files within a C<MANIFEST> in the current
	402	directory really do exist. If C<MANIFEST> and the tree below the current
	403	directory are in sync it exits silently, returning an empty list. Otherwise
	404	it returns a list of files which are listed in the C<MANIFEST> but missing
	405	from the directory, and by default also outputs these names to STDERR.
79dd614e	406
d962e1c0	407	filecheck() finds files below the current directory that are not
79dd614e	408	mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
79dd614e	409	will be consulted. Any file matching a regular expression in such a
e258e381	410	file will not be reported as missing in the C<MANIFEST> file. The list of
	411	any extraneous files found is returned, and by default also reported to
	412	STDERR.
79dd614e	413
e258e381	414	fullcheck() does both a manicheck() and a filecheck(), returning references
	415	to two arrays, the first for files manicheck() found to be missing, the
	416	seond for unexpeced files found by filecheck().
79dd614e	417
d962e1c0	418	skipcheck() lists all the files that are skipped due to your
79dd614e	419	C<MANIFEST.SKIP> file.
79dd614e	420
d962e1c0	421	manifind() returns a hash reference. The keys of the hash are the
79dd614e	422	files found below the current directory.
79dd614e	423
d962e1c0	424	maniread($file) reads a named C<MANIFEST> file (defaults to
79dd614e	425	C<MANIFEST> in the current directory) and returns a HASH reference
79dd614e	426	with files being the keys and comments being the values of the HASH.
15a074ca	427	Blank lines and lines which start with C<#> in the C<MANIFEST> file
15a074ca	428	are discarded.
79dd614e	429
d962e1c0	430	C<manicopy($read,$target,$how)> copies the files that are the keys in
79dd614e	431	the HASH I<%$read> to the named target directory. The HASH reference
d962e1c0	432	$read is typically returned by the maniread() function. This
79dd614e	433	function is useful for producing a directory tree identical to the
	434	intended distribution tree. The third parameter $how can be used to
	435	specify a different methods of "copying". Valid values are C<cp>,
	436	which actually copies the files, C<ln> which creates hard links, and
	437	C<best> which mostly links the files but copies any symbolic link to
	438	make a tree without any symbolic link. Best is the default.
	439
	440	=head1 MANIFEST.SKIP
	441
	442	The file MANIFEST.SKIP may contain regular expressions of files that
	443	should be ignored by mkmanifest() and filecheck(). The regular
15a074ca	444	expressions should appear one on each line. Blank lines and lines
	445	which start with C<#> are skipped. Use C<\#> if you need a regular
	446	expression to start with a sharp character. A typical example:
79dd614e	447
0b9c804f	448	# Version control files and dirs.
79dd614e	449	\bRCS\b
0b9c804f	450	\bCVS\b
	451	,v$
	452
	453	# Makemaker generated files and dirs.
79dd614e	454	^MANIFEST\.
79dd614e	455	^Makefile$
79dd614e	456	^blib/
	457	^MakeMaker-\d
	458
0b9c804f	459	# Temp, old and emacs backup files.
	460	~$
	461	\.old$
	462	^#.*#$
cfcce72b	463	^\.#
0b9c804f	464
	465	If no MANIFEST.SKIP file is found, a default set of skips will be
	466	used, similar to the example above. If you want nothing skipped,
	467	simply make an empty MANIFEST.SKIP file.
	468
	469
79dd614e	470	=head1 EXPORT_OK
	471
	472	C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
	473	C<&maniread>, and C<&manicopy> are exportable.
	474
	475	=head1 GLOBAL VARIABLES
	476
	477	C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
	478	results in both a different C<MANIFEST> and a different
	479	C<MANIFEST.SKIP> file. This is useful if you want to maintain
	480	different distributions for different audiences (say a user version
	481	and a developer version including RCS).
	482
81ff29e3	483	C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
79dd614e	484	all functions act silently.
79dd614e	485
0b9c804f	486	C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value,
	487	or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
	488	produced.
	489
79dd614e	490	=head1 DIAGNOSTICS
	491
	492	All diagnostic output is sent to C<STDERR>.
	493
bbc7dcd2	494	=over 4
79dd614e	495
	496	=item C<Not in MANIFEST:> I<file>
	497
	498	is reported if a file is found, that is missing in the C<MANIFEST>
	499	file which is excluded by a regular expression in the file
	500	C<MANIFEST.SKIP>.
	501
	502	=item C<No such file:> I<file>
	503
	504	is reported if a file mentioned in a C<MANIFEST> file does not
	505	exist.
	506
	507	=item C<MANIFEST:> I<$!>
	508
	509	is reported if C<MANIFEST> could not be opened.
	510
	511	=item C<Added to MANIFEST:> I<file>
	512
	513	is reported by mkmanifest() if $Verbose is set and a file is added
	514	to MANIFEST. $Verbose is set to 1 by default.
	515
	516	=back
	517
0b9c804f	518	=head1 ENVIRONMENT
	519
	520	=over 4
	521
	522	=item B<PERL_MM_MANIFEST_DEBUG>
	523
	524	Turns on debugging
	525
	526	=back
	527
79dd614e	528	=head1 SEE ALSO
	529
	530	L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
	531
	532	=head1 AUTHOR
	533
e309c560	534	Andreas Koenig <F<andreas.koenig@anima.de>>
79dd614e	535
79dd614e	536	=cut