[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,$found,$DEFAULT_MSKIP);

$VERSION = substr(q$Revision: 1.35 $, 10);
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
	      'skipcheck', 'maniread', 'manicopy');

$Is_MacOS = $^O eq 'MacOS';
$Is_VMS = $^O eq 'VMS';
if ($Is_VMS) { require File::Basename }

$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 $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;
	$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;
}

sub manifind {
    local $found = {};
    find(sub {return if -d $_;
	      (my $name = $File::Find::name) =~ s|^\./||;
	      $name =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
	      warn "Debug: diskfile $name\n" if $Debug;
	      $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
	      $name = uc($name) if /^MANIFEST/i && $Is_VMS;
	      $found->{$name} = "";}, $Is_MacOS ? ":" : ".");
    $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} ) {
		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) {
	    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/i;
	}

        $read->{$file} = $comment;
    }
    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;
    open M, $mfile or open M, $DEFAULT_MSKIP or return $matches;
    while (<M>){
	chomp;
	next if /^#/;
	next if /^\s*$/;
	push @skip, _macify($_);
    }
    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;
    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. 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<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.

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