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

$VERSION = 1.37_01;
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
	      'skipcheck', 'maniread', 'manicopy');

$Is_MacOS = $^O eq 'MacOS';
$Is_VMS = $^O eq 'VMS';
require VMS::Filespec if $Is_VMS;

$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
$Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
                   $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
$Quiet = 0;
$MANIFEST = 'MANIFEST';
$DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP";

# Really cool fix from Ilya :)
unless (defined $Config{d_link}) {
    no warnings;
    *ln = \&cp;
}

sub mkmanifest {
    my $manimiss = 0;
    my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
    $read = {} if $manimiss;
    local *M;
    rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
    open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
    my $skip = _maniskip();
    my $found = manifind();
    my($key,$val,$file,%all);
    %all = (%$found, %$read);
    $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
        if $manimiss; # add new MANIFEST to known file list
    foreach $file (sort keys %all) {
	if ($skip->($file)) {
	    # Policy: only remove files if they're listed in MANIFEST.SKIP.
	    # Don't remove files just because they don't exist.
	    warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
	    next;
	}
	if ($Verbose){
	    warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
	}
	my $text = $all{$file};
	($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
	$file = _unmacify($file);
	my $tabs = (5 - (length($file)+1)/8);
	$tabs = 1 if $tabs < 1;
	$tabs = 0 unless $text;
	print M $file, "\t" x $tabs, $text, "\n";
    }
    close M;
}

# Geez, shouldn't this use File::Spec or File::Basename or something?  
# Why so careful about dependencies?
sub clean_up_filename {
  my $filename = shift;
  $filename =~ s|^\./||;
  $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
  return $filename;
}

sub manifind {
    my $p = shift || {};
    my $found = {};

    my $wanted = sub {
	my $name = clean_up_filename($File::Find::name);
	warn "Debug: diskfile $name\n" if $Debug;
	return if -d $name;
	
        if( $Is_VMS ) {
            $name =~ s#(.*)\.$#\L$1#;
            $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
        }
	$found->{$name} = "";
    };

    # We have to use "$File::Find::dir/$_" in preprocess, because 
    # $File::Find::name is unavailable.
    # Also, it's okay to use / here, because MANIFEST files use Unix-style 
    # paths.
    find({wanted => $wanted,
	  no_chdir => 1,
	 },
	 $Is_MacOS ? ":" : ".");

    return $found;
}

sub fullcheck {
    return [_check_files()], [_check_manifest()];
}

sub manicheck {
    return _check_files();
}

sub filecheck {
    return _check_manifest();
}

sub skipcheck {
    my($p) = @_;
    my $found = manifind();
    my $matches = _maniskip();

    my @skipped = ();
    foreach my $file (sort keys %$found){
        if (&$matches($file)){
            warn "Skipping $file\n";
            push @skipped, $file;
            next;
        }
    }

    return @skipped;
}


sub _check_files {
    my $p = shift;
    my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
    my $read = maniread() || {};
    my $found = manifind($p);

    my(@missfile) = ();
    foreach my $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;
        }
    }

    return @missfile;
}


sub _check_manifest {
    my($p) = @_;
    my $read = maniread() || {};
    my $found = manifind($p);
    my $skip  = _maniskip();

    my @missentry = ();
    foreach my $file (sort keys %$found){
        next if $skip->($file);
        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;
        }
    }

    return @missentry;
}


sub maniread {
    my ($mfile) = @_;
    $mfile ||= $MANIFEST;
    my $read = {};
    local *M;
    unless (open M, $mfile){
	warn "$mfile: $!";
	return $read;
    }
    while (<M>){
	chomp;
	next if /^#/;

        my($file, $comment) = /^(\S+)\s*(.*)/;
        next unless $file;

	if ($Is_MacOS) {
	    $file = _macify($file);
	    $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
	}
	elsif ($Is_VMS) {
        require File::Basename;
	    my($base,$dir) = File::Basename::fileparse($file);
	    # Resolve illegal file specifications in the same way as tar
	    $dir =~ tr/./_/;
	    my(@pieces) = split(/\./,$base);
	    if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
	    my $okfile = "$dir$base";
	    warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
            $file = $okfile;
            $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
	}

        $read->{$file} = $comment;
    }
    close M;
    $read;
}

# returns an anonymous sub that decides if an argument matches
sub _maniskip {
    my @skip ;
    my $mfile = "$MANIFEST.SKIP";
    local *M;
    open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
    while (<M>){
	chomp;
	next if /^#/;
	next if /^\s*$/;
	push @skip, _macify($_);
    }
    close M;
    my $opts = $Is_VMS ? '(?i)' : '';

    # Make sure each entry is isolated in its own parentheses, in case
    # any of them contain alternations
    my $regex = join '|', map "(?:$_)", @skip;

    return sub { $_[0] =~ qr{$opts$regex} };
}

sub manicopy {
    my($read,$target,$how)=@_;
    croak "manicopy() called without target argument" unless defined $target;
    $how ||= 'cp';
    require File::Path;
    require File::Basename;
    my(%dirs,$file);
    $target = VMS::Filespec::unixify($target) if $Is_VMS;
    File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
    foreach $file (keys %$read){
    	if ($Is_MacOS) {
	    if ($file =~ m!:!) { 
	   	my $dir = _maccat($target, $file);
		$dir =~ s/[^:]+$//;
	    	File::Path::mkpath($dir,1,0755);
	    }
	    cp_if_diff($file, _maccat($target, $file), $how);
	} else {
	    $file = VMS::Filespec::unixify($file) if $Is_VMS;
	    if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
		my $dir = File::Basename::dirname($file);
		$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
		File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
	    }
	    cp_if_diff($file, "$target/$file", $how);
	}
    }
}

sub cp_if_diff {
    my($from, $to, $how)=@_;
    -f $from or carp "$0: $from not found";
    my($diff) = 0;
    local(*F,*T);
    open(F,"< $from\0") or croak "Can't read $from: $!\n";
    if (open(T,"< $to\0")) {
	while (<F>) { $diff++,last if $_ ne <T>; }
	$diff++ unless eof(T);
	close T;
    }
    else { $diff++; }
    close F;
    if ($diff) {
	if (-e $to) {
	    unlink($to) or confess "unlink $to: $!";
	}
      STRICT_SWITCH: {
	    best($from,$to), last STRICT_SWITCH if $how eq 'best';
	    cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
	    ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
	    croak("ExtUtils::Manifest::cp_if_diff " .
		  "called with illegal how argument [$how]. " .
		  "Legal values are 'best', 'cp', and 'ln'.");
	}
    }
}

sub cp {
    my ($srcFile, $dstFile) = @_;
    my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
    copy($srcFile,$dstFile);
    utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
    # chmod a+rX-w,go-w
    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile ) 
      unless ($^O eq 'MacOS');
}

sub ln {
    my ($srcFile, $dstFile) = @_;
    return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
    link($srcFile, $dstFile);
    local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
    my $mode= 0444 | (stat)[2] & 0700;
    if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
       unlink $dstFile;
       return;
    }
    1;
}

sub best {
    my ($srcFile, $dstFile) = @_;
    if (-l $srcFile) {
	cp($srcFile, $dstFile);
    } else {
	ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
    }
}

sub _macify {
    my($file) = @_;

    return $file unless $Is_MacOS;
    
    $file =~ s|^\./||;
    if ($file =~ m|/|) {
	$file =~ s|/+|:|g;
	$file = ":$file";
    }
    
    $file;
}

sub _maccat {
    my($f1, $f2) = @_;
    
    return "$f1/$f2" unless $Is_MacOS;
    
    $f1 .= ":$f2";
    $f1 =~ s/([^:]:):/$1/g;
    return $f1;
}

sub _unmacify {
    my($file) = @_;

    return $file unless $Is_MacOS;
    
    $file =~ s|^:||;
    $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
    $file =~ y|:|/|;
    
    $file;
}

1;

__END__

=head1 NAME

ExtUtils::Manifest - utilities to write and check a MANIFEST file

=head1 SYNOPSIS

    require ExtUtils::Manifest;

    ExtUtils::Manifest::mkmanifest;

    ExtUtils::Manifest::manicheck;

    ExtUtils::Manifest::filecheck;

    ExtUtils::Manifest::fullcheck;

    ExtUtils::Manifest::skipcheck;

    ExtUtils::Manifest::manifind();

    ExtUtils::Manifest::maniread($file);

    ExtUtils::Manifest::manicopy($read,$target,$how);

=head1 DESCRIPTION

mkmanifest() writes all files in and below the current directory to a
file named in the global variable $ExtUtils::Manifest::MANIFEST (which
defaults to C<MANIFEST>) in the current directory. It works similar to

    find . -print

but in doing so checks each line in an existing C<MANIFEST> file and
includes any comments that are found in the existing C<MANIFEST> file
in the new one. Anything between white space and an end of line within
a C<MANIFEST> file is considered to be a comment. Filenames and
comments are separated by one or more TAB characters in the
output. All files that match any regular expression in a file
C<MANIFEST.SKIP> (if such a file exists) are ignored.

manicheck() checks if all the files within a C<MANIFEST> in the current
directory really do exist. If C<MANIFEST> and the tree below the current
directory are in sync it exits silently, returning an empty list.  Otherwise
it returns a list of files which are listed in the C<MANIFEST> but missing
from the directory, and by default also outputs these names to STDERR.

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

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

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

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

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

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

=head1 MANIFEST.SKIP

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

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

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

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

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


=head1 EXPORT_OK

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

=head1 GLOBAL VARIABLES

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

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

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

=head1 DIAGNOSTICS

All diagnostic output is sent to C<STDERR>.

=over 4

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

is reported if a file is found which is not in C<MANIFEST>.

=item C<Skipping> I<file>

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