[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;
	      $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 = "\L$okfile";
	}

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