[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_VMS,$Debug,$Verbose,$Quiet,$MANIFEST,$found,$DEFAULT_MSKIP);

$VERSION = substr(q$Revision: 1.33 $, 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 = 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;
	      $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 = "\t" . _unmacify($file) if $Is_MacOS;
		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 /^#/;
	if ($Is_MacOS) {
	    my($item,$text) = /^(\S+)\s*(.*)/;
	    $item = _macify($item);
	    $item =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
	    $read->{$item}=$text;
	}
	elsif ($Is_VMS) {
	    my($file)= /^(\S+)/;
	    next unless $file;
	    my($base,$dir) = File::Basename::fileparse($file);
	    # Resolve illegal file specifications in the same way as tar
	    $dir =~ tr/./_/;
	    my(@pieces) = split(/\./,$base);
	    if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
	    my $okfile = "$dir$base";
	    warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
	    $read->{"\L$okfile"}=$_;
	}
	else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
    }
    close M;
    $read;
}

# returns an anonymous sub that decides if an argument matches
sub _maniskip {
    my ($mfile) = @_;
    my $matches = sub {0};
    my @skip ;
    $mfile ||= "$MANIFEST.SKIP";
    local *M;
    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

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