[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 = 1.35_00;
@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({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();
    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) {
	    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. If C<MANIFEST> and the tree below the current
directory are in sync it exits silently, returning an empty list.  Otherwise
it returns a list of files which are listed in the C<MANIFEST> but missing
from the directory, and by default also outputs these names to STDERR.

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

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

skipcheck() lists all the files that are skipped due to your
C<MANIFEST.SKIP> file.

manifind() returns a hash reference. The keys of the hash are the
files found below the current directory.

maniread($file) reads a named C<MANIFEST> file (defaults to
C<MANIFEST> in the current directory) and returns a HASH reference
with files being the keys and comments being the values of the HASH.
Blank lines and lines which start with C<#> in the C<MANIFEST> file
are discarded.

C<manicopy($read,$target,$how)> copies the files that are the keys in
the HASH I<%$read> to the named target directory. The HASH reference
$read is typically returned by the maniread() function. This
function is useful for producing a directory tree identical to the
intended distribution tree. The third parameter $how can be used to
specify a different methods of "copying". Valid values are C<cp>,
which actually copies the files, C<ln> which creates hard links, and
C<best> which mostly links the files but copies any symbolic link to
make a tree without any symbolic link. Best is the default.

=head1 MANIFEST.SKIP

The file MANIFEST.SKIP may contain regular expressions of files that
should be ignored by mkmanifest() and filecheck(). The regular
expressions should appear one on each line. Blank lines and lines
which start with C<#> are skipped.  Use C<\#> if you need a regular
expression to start with a sharp character. A typical example:

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

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

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

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


=head1 EXPORT_OK

C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
C<&maniread>, and C<&manicopy> are exportable.

=head1 GLOBAL VARIABLES

C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
results in both a different C<MANIFEST> and a different
C<MANIFEST.SKIP> file. This is useful if you want to maintain
different distributions for different audiences (say a user version
and a developer version including RCS).

C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
all functions act silently.

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

=head1 DIAGNOSTICS

All diagnostic output is sent to C<STDERR>.

=over 4

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

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

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

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

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

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

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

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

=back

=head1 ENVIRONMENT

=over 4

=item B<PERL_MM_MANIFEST_DEBUG>

Turns on debugging

=back

=head1 SEE ALSO

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

=head1 AUTHOR

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

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