[perl5.git] / lib / ExtUtils / Manifest.pm

package ExtUtils::Manifest;

require Exporter;
use Config;
use File::Find;
use File::Copy 'copy';
use File::Spec;
use Carp;
use strict;

use vars qw($VERSION @ISA @EXPORT_OK 
          $Is_MacOS $Is_VMS 
          $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);

$VERSION = 1.38;
@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 = (File::Spec->splitpath($INC{"ExtUtils/Manifest.pm"}))[1].
                 "$MANIFEST.SKIP";

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

    $target = VMS::Filespec::unixify($target) if $Is_VMS;
    File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
    foreach my $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 die "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);

    # chmod a+r,go-w+X (except "X" only applies to u=x)
    local($_) = $dstFile;
    my $mode= 0444 | (stat)[2] & 0700;
    if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
        unlink $dstFile;
        return;
    }
    1;
}

unless (defined $Config{d_link}) {
    # Really cool fix from Ilya :)
    local $SIG{__WARN__} = sub { 
        warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
    };
    *ln = \&cp;
}


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