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