1*3d61058aSafresh1package ExtUtils::Manifest; # git description: 1.74-10-g1bddbb0 2b8851fccSafresh1 3b8851fccSafresh1require Exporter; 4b8851fccSafresh1use Config; 5b8851fccSafresh1use File::Basename; 6b8851fccSafresh1use File::Copy 'copy'; 7b8851fccSafresh1use File::Find; 8b8851fccSafresh1use File::Spec 0.8; 9b8851fccSafresh1use Carp; 10b8851fccSafresh1use strict; 11b8851fccSafresh1use warnings; 12b8851fccSafresh1 13*3d61058aSafresh1our $VERSION = '1.75'; 14b8851fccSafresh1our @ISA = ('Exporter'); 15b8851fccSafresh1our @EXPORT_OK = qw(mkmanifest 16b8851fccSafresh1 manicheck filecheck fullcheck skipcheck 17b8851fccSafresh1 manifind maniread manicopy maniadd 18b8851fccSafresh1 maniskip 19b8851fccSafresh1 ); 20b8851fccSafresh1 21b8851fccSafresh1our $Is_VMS = $^O eq 'VMS'; 22b8851fccSafresh1our $Is_VMS_mode = 0; 23b8851fccSafresh1our $Is_VMS_lc = 0; 24b8851fccSafresh1our $Is_VMS_nodot = 0; # No dots in dir names or double dots in files 25b8851fccSafresh1 26b8851fccSafresh1if ($Is_VMS) { 27b8851fccSafresh1 require VMS::Filespec if $Is_VMS; 28b8851fccSafresh1 my $vms_unix_rpt; 29b8851fccSafresh1 my $vms_efs; 30b8851fccSafresh1 my $vms_case; 31b8851fccSafresh1 32b8851fccSafresh1 $Is_VMS_mode = 1; 33b8851fccSafresh1 $Is_VMS_lc = 1; 34b8851fccSafresh1 $Is_VMS_nodot = 1; 35b8851fccSafresh1 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { 36b8851fccSafresh1 $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); 37b8851fccSafresh1 $vms_efs = VMS::Feature::current("efs_charset"); 38b8851fccSafresh1 $vms_case = VMS::Feature::current("efs_case_preserve"); 39b8851fccSafresh1 } else { 40b8851fccSafresh1 my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; 41b8851fccSafresh1 my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; 42b8851fccSafresh1 my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; 43b8851fccSafresh1 $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 44b8851fccSafresh1 $vms_efs = $efs_charset =~ /^[ET1]/i; 45b8851fccSafresh1 $vms_case = $efs_case =~ /^[ET1]/i; 46b8851fccSafresh1 } 47b8851fccSafresh1 $Is_VMS_lc = 0 if ($vms_case); 48b8851fccSafresh1 $Is_VMS_mode = 0 if ($vms_unix_rpt); 49b8851fccSafresh1 $Is_VMS_nodot = 0 if ($vms_efs); 50b8851fccSafresh1} 51b8851fccSafresh1 52b8851fccSafresh1our $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0; 53b8851fccSafresh1our $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ? 54b8851fccSafresh1 $ENV{PERL_MM_MANIFEST_VERBOSE} : 1; 55b8851fccSafresh1our $Quiet = 0; 56b8851fccSafresh1our $MANIFEST = 'MANIFEST'; 57b8851fccSafresh1 58eac174f2Safresh1our $DEFAULT_MSKIP = File::Spec->rel2abs(File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" )); 59b8851fccSafresh1 60b8851fccSafresh1 61b8851fccSafresh1=head1 NAME 62b8851fccSafresh1 63b46d8ef2Safresh1ExtUtils::Manifest - Utilities to write and check a MANIFEST file 64b8851fccSafresh1 65b8851fccSafresh1=head1 VERSION 66b8851fccSafresh1 67*3d61058aSafresh1version 1.75 68b8851fccSafresh1 69b8851fccSafresh1=head1 SYNOPSIS 70b8851fccSafresh1 71b8851fccSafresh1 use ExtUtils::Manifest qw(...funcs to import...); 72b8851fccSafresh1 73b8851fccSafresh1 mkmanifest(); 74b8851fccSafresh1 75b8851fccSafresh1 my @missing_files = manicheck; 76b8851fccSafresh1 my @skipped = skipcheck; 77b8851fccSafresh1 my @extra_files = filecheck; 78b8851fccSafresh1 my($missing, $extra) = fullcheck; 79b8851fccSafresh1 80b8851fccSafresh1 my $found = manifind(); 81b8851fccSafresh1 82b8851fccSafresh1 my $manifest = maniread(); 83b8851fccSafresh1 84b8851fccSafresh1 manicopy($read,$target); 85b8851fccSafresh1 86b8851fccSafresh1 maniadd({$file => $comment, ...}); 87b8851fccSafresh1 88b8851fccSafresh1 89b8851fccSafresh1=head1 DESCRIPTION 90b8851fccSafresh1 91b46d8ef2Safresh1... 92b46d8ef2Safresh1 93b46d8ef2Safresh1=head1 FUNCTIONS 94b8851fccSafresh1 95b8851fccSafresh1ExtUtils::Manifest exports no functions by default. The following are 96b46d8ef2Safresh1exported on request: 97b8851fccSafresh1 98b46d8ef2Safresh1=head2 mkmanifest 99b8851fccSafresh1 100b8851fccSafresh1 mkmanifest(); 101b8851fccSafresh1 102b8851fccSafresh1Writes all files in and below the current directory to your F<MANIFEST>. 103b8851fccSafresh1It works similar to the result of the Unix command 104b8851fccSafresh1 105b8851fccSafresh1 find . > MANIFEST 106b8851fccSafresh1 107b8851fccSafresh1All files that match any regular expression in a file F<MANIFEST.SKIP> 108b8851fccSafresh1(if it exists) are ignored. 109b8851fccSafresh1 110b8851fccSafresh1Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>. 111b8851fccSafresh1 112b8851fccSafresh1=cut 113b8851fccSafresh1 114b8851fccSafresh1sub _sort { 115b8851fccSafresh1 return sort { lc $a cmp lc $b } @_; 116b8851fccSafresh1} 117b8851fccSafresh1 118b8851fccSafresh1sub mkmanifest { 119b8851fccSafresh1 my $manimiss = 0; 120b8851fccSafresh1 my $read = (-r 'MANIFEST' && maniread()) or $manimiss++; 121b8851fccSafresh1 $read = {} if $manimiss; 122b8851fccSafresh1 my $bakbase = $MANIFEST; 123b8851fccSafresh1 $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots 124b8851fccSafresh1 rename $MANIFEST, "$bakbase.bak" unless $manimiss; 125*3d61058aSafresh1 open my $fh, '>', $MANIFEST or die "Could not open $MANIFEST: $!"; 126*3d61058aSafresh1 binmode $fh, ':raw'; 127b8851fccSafresh1 my $skip = maniskip(); 128b8851fccSafresh1 my $found = manifind(); 129b8851fccSafresh1 my($key,$val,$file,%all); 130b8851fccSafresh1 %all = (%$found, %$read); 131b8851fccSafresh1 $all{$MANIFEST} = ($Is_VMS_mode ? "$MANIFEST\t\t" : '') . 132b8851fccSafresh1 'This list of files' 133b8851fccSafresh1 if $manimiss; # add new MANIFEST to known file list 134b8851fccSafresh1 foreach $file (_sort keys %all) { 135b8851fccSafresh1 if ($skip->($file)) { 136b8851fccSafresh1 # Policy: only remove files if they're listed in MANIFEST.SKIP. 137b8851fccSafresh1 # Don't remove files just because they don't exist. 138b8851fccSafresh1 warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file}; 139b8851fccSafresh1 next; 140b8851fccSafresh1 } 141b8851fccSafresh1 if ($Verbose){ 142b8851fccSafresh1 warn "Added to $MANIFEST: $file\n" unless exists $read->{$file}; 143b8851fccSafresh1 } 144b8851fccSafresh1 my $text = $all{$file}; 145b8851fccSafresh1 my $tabs = (5 - (length($file)+1)/8); 146b8851fccSafresh1 $tabs = 1 if $tabs < 1; 147b8851fccSafresh1 $tabs = 0 unless $text; 148b8851fccSafresh1 if ($file =~ /\s/) { 149b8851fccSafresh1 $file =~ s/([\\'])/\\$1/g; 150b8851fccSafresh1 $file = "'$file'"; 151b8851fccSafresh1 } 152*3d61058aSafresh1 print $fh $file, "\t" x $tabs, $text, "\n"; 153b8851fccSafresh1 } 154b8851fccSafresh1} 155b8851fccSafresh1 156b8851fccSafresh1# Geez, shouldn't this use File::Spec or File::Basename or something? 157b8851fccSafresh1# Why so careful about dependencies? 158b8851fccSafresh1sub clean_up_filename { 159b8851fccSafresh1 my $filename = shift; 160b8851fccSafresh1 $filename =~ s|^\./||; 161b8851fccSafresh1 if ( $Is_VMS ) { 162b8851fccSafresh1 $filename =~ s/\.$//; # trim trailing dot 163b8851fccSafresh1 $filename = VMS::Filespec::unixify($filename); # unescape spaces, etc. 164b8851fccSafresh1 if( $Is_VMS_lc ) { 165b8851fccSafresh1 $filename = lc($filename); 166b8851fccSafresh1 $filename = uc($filename) if $filename =~ /^MANIFEST(\.SKIP)?$/i; 167b8851fccSafresh1 } 168b8851fccSafresh1 } 169b8851fccSafresh1 return $filename; 170b8851fccSafresh1} 171b8851fccSafresh1 172b8851fccSafresh1 173b46d8ef2Safresh1=head2 manifind 174b8851fccSafresh1 175b8851fccSafresh1 my $found = manifind(); 176b8851fccSafresh1 177b8851fccSafresh1returns a hash reference. The keys of the hash are the files found 178b8851fccSafresh1below the current directory. 179b8851fccSafresh1 180b8851fccSafresh1=cut 181b8851fccSafresh1 182b8851fccSafresh1sub manifind { 183b8851fccSafresh1 my $p = shift || {}; 184b8851fccSafresh1 my $found = {}; 185b8851fccSafresh1 186b8851fccSafresh1 my $wanted = sub { 187b8851fccSafresh1 my $name = clean_up_filename($File::Find::name); 188b8851fccSafresh1 warn "Debug: diskfile $name\n" if $Debug; 189b8851fccSafresh1 return if -d $_; 190b8851fccSafresh1 $found->{$name} = ""; 191b8851fccSafresh1 }; 192b8851fccSafresh1 193b8851fccSafresh1 # We have to use "$File::Find::dir/$_" in preprocess, because 194b8851fccSafresh1 # $File::Find::name is unavailable. 195b8851fccSafresh1 # Also, it's okay to use / here, because MANIFEST files use Unix-style 196b8851fccSafresh1 # paths. 197*3d61058aSafresh1 find({wanted => $wanted, follow_fast => 1}, "."); 198b8851fccSafresh1 199b8851fccSafresh1 return $found; 200b8851fccSafresh1} 201b8851fccSafresh1 202b8851fccSafresh1 203b46d8ef2Safresh1=head2 manicheck 204b8851fccSafresh1 205b8851fccSafresh1 my @missing_files = manicheck(); 206b8851fccSafresh1 207b8851fccSafresh1checks if all the files within a C<MANIFEST> in the current directory 208b8851fccSafresh1really do exist. If C<MANIFEST> and the tree below the current 209b8851fccSafresh1directory are in sync it silently returns an empty list. 210b8851fccSafresh1Otherwise it returns a list of files which are listed in the 211b8851fccSafresh1C<MANIFEST> but missing from the directory, and by default also 212b8851fccSafresh1outputs these names to STDERR. 213b8851fccSafresh1 214b8851fccSafresh1=cut 215b8851fccSafresh1 216b8851fccSafresh1sub manicheck { 217b8851fccSafresh1 return _check_files(); 218b8851fccSafresh1} 219b8851fccSafresh1 220b8851fccSafresh1 221b46d8ef2Safresh1=head2 filecheck 222b8851fccSafresh1 223b8851fccSafresh1 my @extra_files = filecheck(); 224b8851fccSafresh1 225b8851fccSafresh1finds files below the current directory that are not mentioned in the 226b8851fccSafresh1C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be 227b8851fccSafresh1consulted. Any file matching a regular expression in such a file will 228b8851fccSafresh1not be reported as missing in the C<MANIFEST> file. The list of any 229b8851fccSafresh1extraneous files found is returned, and by default also reported to 230b8851fccSafresh1STDERR. 231b8851fccSafresh1 232b8851fccSafresh1=cut 233b8851fccSafresh1 234b8851fccSafresh1sub filecheck { 235b8851fccSafresh1 return _check_manifest(); 236b8851fccSafresh1} 237b8851fccSafresh1 238b8851fccSafresh1 239b46d8ef2Safresh1=head2 fullcheck 240b8851fccSafresh1 241b8851fccSafresh1 my($missing, $extra) = fullcheck(); 242b8851fccSafresh1 243b8851fccSafresh1does both a manicheck() and a filecheck(), returning then as two array 244b8851fccSafresh1refs. 245b8851fccSafresh1 246b8851fccSafresh1=cut 247b8851fccSafresh1 248b8851fccSafresh1sub fullcheck { 249b8851fccSafresh1 return [_check_files()], [_check_manifest()]; 250b8851fccSafresh1} 251b8851fccSafresh1 252b8851fccSafresh1 253b46d8ef2Safresh1=head2 skipcheck 254b8851fccSafresh1 255b8851fccSafresh1 my @skipped = skipcheck(); 256b8851fccSafresh1 257b8851fccSafresh1lists all the files that are skipped due to your C<MANIFEST.SKIP> 258b8851fccSafresh1file. 259b8851fccSafresh1 260b8851fccSafresh1=cut 261b8851fccSafresh1 262b8851fccSafresh1sub skipcheck { 263b8851fccSafresh1 my($p) = @_; 264b8851fccSafresh1 my $found = manifind(); 265b8851fccSafresh1 my $matches = maniskip(); 266b8851fccSafresh1 267b8851fccSafresh1 my @skipped = (); 268b8851fccSafresh1 foreach my $file (_sort keys %$found){ 269b8851fccSafresh1 if (&$matches($file)){ 270b8851fccSafresh1 warn "Skipping $file\n" unless $Quiet; 271b8851fccSafresh1 push @skipped, $file; 272b8851fccSafresh1 next; 273b8851fccSafresh1 } 274b8851fccSafresh1 } 275b8851fccSafresh1 276b8851fccSafresh1 return @skipped; 277b8851fccSafresh1} 278b8851fccSafresh1 279b8851fccSafresh1 280b8851fccSafresh1sub _check_files { 281b8851fccSafresh1 my $p = shift; 282b8851fccSafresh1 my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0); 283b8851fccSafresh1 my $read = maniread() || {}; 284b8851fccSafresh1 my $found = manifind($p); 285b8851fccSafresh1 286b8851fccSafresh1 my(@missfile) = (); 287b8851fccSafresh1 foreach my $file (_sort keys %$read){ 288b8851fccSafresh1 warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; 289b8851fccSafresh1 if ($dosnames){ 290b8851fccSafresh1 $file = lc $file; 291b8851fccSafresh1 $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge; 292b8851fccSafresh1 $file =~ s=((\w|-)+)=substr ($1,0,8)=ge; 293b8851fccSafresh1 } 294b8851fccSafresh1 unless ( exists $found->{$file} ) { 295b8851fccSafresh1 warn "No such file: $file\n" unless $Quiet; 296b8851fccSafresh1 push @missfile, $file; 297b8851fccSafresh1 } 298b8851fccSafresh1 } 299b8851fccSafresh1 300b8851fccSafresh1 return @missfile; 301b8851fccSafresh1} 302b8851fccSafresh1 303b8851fccSafresh1 304b8851fccSafresh1sub _check_manifest { 305b8851fccSafresh1 my($p) = @_; 306b8851fccSafresh1 my $read = maniread() || {}; 307b8851fccSafresh1 my $found = manifind($p); 308b8851fccSafresh1 my $skip = maniskip(); 309b8851fccSafresh1 310b8851fccSafresh1 my @missentry = (); 311b8851fccSafresh1 foreach my $file (_sort keys %$found){ 312b8851fccSafresh1 next if $skip->($file); 313b8851fccSafresh1 warn "Debug: manicheck checking from disk $file\n" if $Debug; 314b8851fccSafresh1 unless ( exists $read->{$file} ) { 315*3d61058aSafresh1 warn "Not in $MANIFEST: $file\n" unless $Quiet; 316b8851fccSafresh1 push @missentry, $file; 317b8851fccSafresh1 } 318b8851fccSafresh1 } 319b8851fccSafresh1 320b8851fccSafresh1 return @missentry; 321b8851fccSafresh1} 322b8851fccSafresh1 323b8851fccSafresh1 324b46d8ef2Safresh1=head2 maniread 325b8851fccSafresh1 326b8851fccSafresh1 my $manifest = maniread(); 327b8851fccSafresh1 my $manifest = maniread($manifest_file); 328b8851fccSafresh1 329b8851fccSafresh1reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current 330b8851fccSafresh1directory) and returns a HASH reference with files being the keys and 331b8851fccSafresh1comments being the values of the HASH. Blank lines and lines which 332b8851fccSafresh1start with C<#> in the C<MANIFEST> file are discarded. 333b8851fccSafresh1 334b8851fccSafresh1=cut 335b8851fccSafresh1 336b8851fccSafresh1sub maniread { 337b8851fccSafresh1 my ($mfile) = @_; 338b8851fccSafresh1 $mfile ||= $MANIFEST; 339b8851fccSafresh1 my $read = {}; 340*3d61058aSafresh1 my $fh; 341*3d61058aSafresh1 unless (open $fh, '<', $mfile){ 342b8851fccSafresh1 warn "Problem opening $mfile: $!"; 343b8851fccSafresh1 return $read; 344b8851fccSafresh1 } 345b8851fccSafresh1 local $_; 346*3d61058aSafresh1 while (<$fh>){ 347b8851fccSafresh1 chomp; 348b8851fccSafresh1 next if /^\s*#/; 349b8851fccSafresh1 350b8851fccSafresh1 my($file, $comment); 351b8851fccSafresh1 352b8851fccSafresh1 # filename may contain spaces if enclosed in '' 353b8851fccSafresh1 # (in which case, \\ and \' are escapes) 354b8851fccSafresh1 if (($file, $comment) = /^'((?:\\[\\']|.+)+)'\s*(.*)/) { 355b8851fccSafresh1 $file =~ s/\\([\\'])/$1/g; 356b8851fccSafresh1 } 357b8851fccSafresh1 else { 358b8851fccSafresh1 ($file, $comment) = /^(\S+)\s*(.*)/; 359b8851fccSafresh1 } 360b8851fccSafresh1 next unless $file; 361b8851fccSafresh1 362*3d61058aSafresh1 if ($Is_VMS_mode) { 363b8851fccSafresh1 require File::Basename; 364b8851fccSafresh1 my($base,$dir) = File::Basename::fileparse($file); 365b8851fccSafresh1 # Resolve illegal file specifications in the same way as tar 366b8851fccSafresh1 if ($Is_VMS_nodot) { 367b8851fccSafresh1 $dir =~ tr/./_/; 368b8851fccSafresh1 my(@pieces) = split(/\./,$base); 369b8851fccSafresh1 if (@pieces > 2) 370b8851fccSafresh1 { $base = shift(@pieces) . '.' . join('_',@pieces); } 371b8851fccSafresh1 my $okfile = "$dir$base"; 372b8851fccSafresh1 warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; 373b8851fccSafresh1 $file = $okfile; 374b8851fccSafresh1 } 375b8851fccSafresh1 if( $Is_VMS_lc ) { 376b8851fccSafresh1 $file = lc($file); 377b8851fccSafresh1 $file = uc($file) if $file =~ /^MANIFEST(\.SKIP)?$/i; 378b8851fccSafresh1 } 379b8851fccSafresh1 } 380b8851fccSafresh1 381b8851fccSafresh1 $read->{$file} = $comment; 382b8851fccSafresh1 } 383b8851fccSafresh1 $read; 384b8851fccSafresh1} 385b8851fccSafresh1 386b46d8ef2Safresh1=head2 maniskip 387b8851fccSafresh1 388b8851fccSafresh1 my $skipchk = maniskip(); 389b8851fccSafresh1 my $skipchk = maniskip($manifest_skip_file); 390b8851fccSafresh1 391b8851fccSafresh1 if ($skipchk->($file)) { .. } 392b8851fccSafresh1 393b8851fccSafresh1reads a named C<MANIFEST.SKIP> file (defaults to C<MANIFEST.SKIP> in 394b8851fccSafresh1the current directory) and returns a CODE reference that tests whether 395b8851fccSafresh1a given filename should be skipped. 396b8851fccSafresh1 397b8851fccSafresh1=cut 398b8851fccSafresh1 399*3d61058aSafresh1sub _process_skipline { 400*3d61058aSafresh1 local $_ = shift; 401b8851fccSafresh1 chomp; 402b8851fccSafresh1 s/\r//; 403b8851fccSafresh1 $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$}; 404b8851fccSafresh1 #my $comment = $3; 405b8851fccSafresh1 my $filename = $2; 406b8851fccSafresh1 if ( defined($1) ) { 407b8851fccSafresh1 $filename = $1; 408b8851fccSafresh1 $filename =~ s/\\(['\\])/$1/g; 409b8851fccSafresh1 } 410*3d61058aSafresh1 $filename; 411b8851fccSafresh1} 412*3d61058aSafresh1 413*3d61058aSafresh1# returns an anonymous sub that decides if an argument matches 414*3d61058aSafresh1sub maniskip { 415*3d61058aSafresh1 my @skip ; 416*3d61058aSafresh1 my $mfile = shift || "$MANIFEST.SKIP"; 417*3d61058aSafresh1 _check_mskip_directives($mfile) if -f $mfile; 418*3d61058aSafresh1 local $_; 419*3d61058aSafresh1 my $fh; 420*3d61058aSafresh1 open $fh, '<', $mfile or open $fh, '<', $DEFAULT_MSKIP or return sub {0}; 421*3d61058aSafresh1 while (<$fh>){ 422*3d61058aSafresh1 if (/^#!include_default\s*$/) { 423*3d61058aSafresh1 if (my @default = _include_mskip_file()) { 424*3d61058aSafresh1 warn "Debug: Including default MANIFEST.SKIP\n" if $Debug; 425*3d61058aSafresh1 push @skip, grep $_, map _process_skipline($_), @default; 426*3d61058aSafresh1 } 427*3d61058aSafresh1 next; 428*3d61058aSafresh1 } 429*3d61058aSafresh1 next unless my $filename = _process_skipline($_); 430*3d61058aSafresh1 push @skip, $filename; 431*3d61058aSafresh1 } 432b8851fccSafresh1 return sub {0} unless (scalar @skip > 0); 433b8851fccSafresh1 434b8851fccSafresh1 my $opts = $Is_VMS_mode ? '(?i)' : ''; 435b8851fccSafresh1 436b8851fccSafresh1 # Make sure each entry is isolated in its own parentheses, in case 437b8851fccSafresh1 # any of them contain alternations 438b8851fccSafresh1 my $regex = join '|', map "(?:$_)", @skip; 439b8851fccSafresh1 440b8851fccSafresh1 return sub { $_[0] =~ qr{$opts$regex} }; 441b8851fccSafresh1} 442b8851fccSafresh1 443*3d61058aSafresh1sub _get_homedir { 444*3d61058aSafresh1 $^O eq 'MSWin32' && "$]" < 5.016 ? $ENV{HOME} || $ENV{USERPROFILE} : (glob('~'))[0]; 445*3d61058aSafresh1} 446*3d61058aSafresh1 447b8851fccSafresh1# checks for the special directives 448b8851fccSafresh1# #!include_default 449b8851fccSafresh1# #!include /path/to/some/manifest.skip 450b8851fccSafresh1# in a custom MANIFEST.SKIP for, for including 451b8851fccSafresh1# the content of, respectively, the default MANIFEST.SKIP 452b8851fccSafresh1# and an external manifest.skip file 453b8851fccSafresh1sub _check_mskip_directives { 454b8851fccSafresh1 my $mfile = shift; 455*3d61058aSafresh1 local $_; 456*3d61058aSafresh1 my $fh; 457b8851fccSafresh1 my @lines = (); 458b8851fccSafresh1 my $flag = 0; 459*3d61058aSafresh1 unless (open $fh, '<', $mfile) { 460b8851fccSafresh1 warn "Problem opening $mfile: $!"; 461b8851fccSafresh1 return; 462b8851fccSafresh1 } 463*3d61058aSafresh1 while (<$fh>) { 464b8851fccSafresh1 if (/^#!include\s+(.*)\s*$/) { 465b8851fccSafresh1 my $external_file = $1; 466*3d61058aSafresh1 $external_file =~ s{^~/}{_get_homedir().'/'}e; 467b8851fccSafresh1 if (my @external = _include_mskip_file($external_file)) { 468b8851fccSafresh1 push @lines, @external; 469b8851fccSafresh1 warn "Debug: Including external $external_file\n" if $Debug; 470b8851fccSafresh1 $flag++; 471b8851fccSafresh1 } 472b8851fccSafresh1 next; 473b8851fccSafresh1 } 474b8851fccSafresh1 push @lines, $_; 475b8851fccSafresh1 } 476*3d61058aSafresh1 close $fh; 477b8851fccSafresh1 return unless $flag; 478b8851fccSafresh1 my $bakbase = $mfile; 479b8851fccSafresh1 $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots 480b8851fccSafresh1 rename $mfile, "$bakbase.bak"; 481b8851fccSafresh1 warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug; 482*3d61058aSafresh1 unless (open $fh, '>', $mfile) { 483b8851fccSafresh1 warn "Problem opening $mfile: $!"; 484b8851fccSafresh1 return; 485b8851fccSafresh1 } 486*3d61058aSafresh1 binmode $fh, ':raw'; 487*3d61058aSafresh1 print $fh $_ for (@lines); 488b8851fccSafresh1 return; 489b8851fccSafresh1} 490b8851fccSafresh1 491b8851fccSafresh1# returns an array containing the lines of an external 492b8851fccSafresh1# manifest.skip file, if given, or $DEFAULT_MSKIP 493b8851fccSafresh1sub _include_mskip_file { 494b8851fccSafresh1 my $mskip = shift || $DEFAULT_MSKIP; 495b8851fccSafresh1 unless (-f $mskip) { 496b8851fccSafresh1 warn qq{Included file "$mskip" not found - skipping}; 497b8851fccSafresh1 return; 498b8851fccSafresh1 } 499*3d61058aSafresh1 local $_; 500*3d61058aSafresh1 my $fh; 501*3d61058aSafresh1 unless (open $fh, '<', $mskip) { 502b8851fccSafresh1 warn "Problem opening $mskip: $!"; 503b8851fccSafresh1 return; 504b8851fccSafresh1 } 505b8851fccSafresh1 my @lines = (); 506b8851fccSafresh1 push @lines, "\n#!start included $mskip\n"; 507*3d61058aSafresh1 push @lines, $_ while <$fh>; 508b8851fccSafresh1 push @lines, "#!end included $mskip\n\n"; 509b8851fccSafresh1 return @lines; 510b8851fccSafresh1} 511b8851fccSafresh1 512b46d8ef2Safresh1=head2 manicopy 513b8851fccSafresh1 514b8851fccSafresh1 manicopy(\%src, $dest_dir); 515b8851fccSafresh1 manicopy(\%src, $dest_dir, $how); 516b8851fccSafresh1 517b8851fccSafresh1Copies the files that are the keys in %src to the $dest_dir. %src is 518b8851fccSafresh1typically returned by the maniread() function. 519b8851fccSafresh1 520b8851fccSafresh1 manicopy( maniread(), $dest_dir ); 521b8851fccSafresh1 522b8851fccSafresh1This function is useful for producing a directory tree identical to the 523b8851fccSafresh1intended distribution tree. 524b8851fccSafresh1 525b8851fccSafresh1$how can be used to specify a different methods of "copying". Valid 526b8851fccSafresh1values are C<cp>, which actually copies the files, C<ln> which creates 527b8851fccSafresh1hard links, and C<best> which mostly links the files but copies any 528b8851fccSafresh1symbolic link to make a tree without any symbolic link. C<cp> is the 529b8851fccSafresh1default. 530b8851fccSafresh1 531b8851fccSafresh1=cut 532b8851fccSafresh1 533b8851fccSafresh1sub manicopy { 534b8851fccSafresh1 my($read,$target,$how)=@_; 535b8851fccSafresh1 croak "manicopy() called without target argument" unless defined $target; 536b8851fccSafresh1 $how ||= 'cp'; 537b8851fccSafresh1 require File::Path; 538b8851fccSafresh1 require File::Basename; 539b8851fccSafresh1 540b8851fccSafresh1 $target = VMS::Filespec::unixify($target) if $Is_VMS_mode; 541b8851fccSafresh1 File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755); 542b8851fccSafresh1 foreach my $file (keys %$read){ 543b8851fccSafresh1 $file = VMS::Filespec::unixify($file) if $Is_VMS_mode; 544b8851fccSafresh1 if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not? 545b8851fccSafresh1 my $dir = File::Basename::dirname($file); 546b8851fccSafresh1 $dir = VMS::Filespec::unixify($dir) if $Is_VMS_mode; 547b8851fccSafresh1 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755); 548b8851fccSafresh1 } 549b8851fccSafresh1 cp_if_diff($file, "$target/$file", $how); 550b8851fccSafresh1 } 551b8851fccSafresh1} 552b8851fccSafresh1 553b8851fccSafresh1sub cp_if_diff { 554b8851fccSafresh1 my($from, $to, $how)=@_; 555b8851fccSafresh1 if (! -f $from) { 556b8851fccSafresh1 carp "$from not found"; 557b8851fccSafresh1 return; 558b8851fccSafresh1 } 559b8851fccSafresh1 my($diff) = 0; 560*3d61058aSafresh1 my ($fromfh, $tofh); 561*3d61058aSafresh1 open($fromfh, '<', $from) or die "Can't read $from: $!\n"; 562*3d61058aSafresh1 if (open($tofh, '<', $to)) { 563b8851fccSafresh1 local $_; 564*3d61058aSafresh1 while (<$fromfh>) { $diff++,last if $_ ne <$tofh>; } 565*3d61058aSafresh1 $diff++ unless eof($tofh); 566*3d61058aSafresh1 close $tofh; 567b8851fccSafresh1 } 568b8851fccSafresh1 else { $diff++; } 569*3d61058aSafresh1 close $fromfh; 570b8851fccSafresh1 if ($diff) { 571b8851fccSafresh1 if (-e $to) { 572b8851fccSafresh1 unlink($to) or confess "unlink $to: $!"; 573b8851fccSafresh1 } 574b8851fccSafresh1 STRICT_SWITCH: { 575b8851fccSafresh1 best($from,$to), last STRICT_SWITCH if $how eq 'best'; 576b8851fccSafresh1 cp($from,$to), last STRICT_SWITCH if $how eq 'cp'; 577b8851fccSafresh1 ln($from,$to), last STRICT_SWITCH if $how eq 'ln'; 578b8851fccSafresh1 croak("ExtUtils::Manifest::cp_if_diff " . 579b8851fccSafresh1 "called with illegal how argument [$how]. " . 580b8851fccSafresh1 "Legal values are 'best', 'cp', and 'ln'."); 581b8851fccSafresh1 } 582b8851fccSafresh1 } 583b8851fccSafresh1} 584b8851fccSafresh1 585b8851fccSafresh1sub cp { 586b8851fccSafresh1 my ($srcFile, $dstFile) = @_; 587b8851fccSafresh1 my ($access,$mod) = (stat $srcFile)[8,9]; 588b8851fccSafresh1 589b8851fccSafresh1 copy($srcFile,$dstFile); 590b8851fccSafresh1 utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; 591b8851fccSafresh1 _manicopy_chmod($srcFile, $dstFile); 592b8851fccSafresh1} 593b8851fccSafresh1 594b8851fccSafresh1 595b8851fccSafresh1sub ln { 596b8851fccSafresh1 my ($srcFile, $dstFile) = @_; 597b8851fccSafresh1 # Fix-me - VMS can support links. 598b8851fccSafresh1 return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95()); 599b8851fccSafresh1 link($srcFile, $dstFile); 600b8851fccSafresh1 601b8851fccSafresh1 unless( _manicopy_chmod($srcFile, $dstFile) ) { 602b8851fccSafresh1 unlink $dstFile; 603b8851fccSafresh1 return; 604b8851fccSafresh1 } 605b8851fccSafresh1 1; 606b8851fccSafresh1} 607b8851fccSafresh1 608b8851fccSafresh1# 1) Strip off all group and world permissions. 609b8851fccSafresh1# 2) Let everyone read it. 610b8851fccSafresh1# 3) If the owner can execute it, everyone can. 611b8851fccSafresh1sub _manicopy_chmod { 612b8851fccSafresh1 my($srcFile, $dstFile) = @_; 613b8851fccSafresh1 614b8851fccSafresh1 my $perm = 0444 | (stat $srcFile)[2] & 0700; 615b8851fccSafresh1 chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $dstFile ); 616b8851fccSafresh1} 617b8851fccSafresh1 618b8851fccSafresh1# Files that are often modified in the distdir. Don't hard link them. 619b8851fccSafresh1my @Exceptions = qw(MANIFEST META.yml SIGNATURE); 620b8851fccSafresh1sub best { 621b8851fccSafresh1 my ($srcFile, $dstFile) = @_; 622b8851fccSafresh1 623b8851fccSafresh1 my $is_exception = grep $srcFile =~ /$_/, @Exceptions; 624b8851fccSafresh1 if ($is_exception or !$Config{d_link} or -l $srcFile) { 625b8851fccSafresh1 cp($srcFile, $dstFile); 626b8851fccSafresh1 } else { 627b8851fccSafresh1 ln($srcFile, $dstFile) or cp($srcFile, $dstFile); 628b8851fccSafresh1 } 629b8851fccSafresh1} 630b8851fccSafresh1 631b46d8ef2Safresh1=head2 maniadd 632b8851fccSafresh1 633b8851fccSafresh1 maniadd({ $file => $comment, ...}); 634b8851fccSafresh1 635b8851fccSafresh1Adds an entry to an existing F<MANIFEST> unless its already there. 636b8851fccSafresh1 637b8851fccSafresh1$file will be normalized (ie. Unixified). B<UNIMPLEMENTED> 638b8851fccSafresh1 639b8851fccSafresh1=cut 640b8851fccSafresh1 641b8851fccSafresh1sub maniadd { 642b8851fccSafresh1 my($additions) = shift; 643b8851fccSafresh1 644b8851fccSafresh1 _normalize($additions); 645b8851fccSafresh1 _fix_manifest($MANIFEST); 646b8851fccSafresh1 647b8851fccSafresh1 my $manifest = maniread(); 648b46d8ef2Safresh1 my @needed = grep !exists $manifest->{$_}, keys %$additions; 649b8851fccSafresh1 return 1 unless @needed; 650b8851fccSafresh1 651*3d61058aSafresh1 open(my $fh, '>>', $MANIFEST) or 652b8851fccSafresh1 die "maniadd() could not open $MANIFEST: $!"; 653*3d61058aSafresh1 binmode $fh, ':raw'; 654b8851fccSafresh1 655b8851fccSafresh1 foreach my $file (_sort @needed) { 656b8851fccSafresh1 my $comment = $additions->{$file} || ''; 657b8851fccSafresh1 if ($file =~ /\s/) { 658b8851fccSafresh1 $file =~ s/([\\'])/\\$1/g; 659b8851fccSafresh1 $file = "'$file'"; 660b8851fccSafresh1 } 661*3d61058aSafresh1 printf $fh "%-40s %s\n", $file, $comment; 662b8851fccSafresh1 } 663*3d61058aSafresh1 close $fh or die "Error closing $MANIFEST: $!"; 664b8851fccSafresh1 665b8851fccSafresh1 return 1; 666b8851fccSafresh1} 667b8851fccSafresh1 668b8851fccSafresh1 669b8851fccSafresh1# Make sure this MANIFEST is consistently written with native 670b8851fccSafresh1# newlines and has a terminal newline. 671b8851fccSafresh1sub _fix_manifest { 672b8851fccSafresh1 my $manifest_file = shift; 673b8851fccSafresh1 674*3d61058aSafresh1 open my $fh, '<', $MANIFEST or die "Could not open $MANIFEST: $!"; 675b8851fccSafresh1 local $/; 676*3d61058aSafresh1 my @manifest = split /(\015\012|\012|\015)/, <$fh>, -1; 677*3d61058aSafresh1 close $fh; 678b8851fccSafresh1 my $must_rewrite = ""; 679b8851fccSafresh1 if ($manifest[-1] eq ""){ 680b8851fccSafresh1 # sane case: last line had a terminal newline 681b8851fccSafresh1 pop @manifest; 682b8851fccSafresh1 for (my $i=1; $i<=$#manifest; $i+=2) { 683b8851fccSafresh1 unless ($manifest[$i] eq "\n") { 684b8851fccSafresh1 $must_rewrite = "not a newline at pos $i"; 685b8851fccSafresh1 last; 686b8851fccSafresh1 } 687b8851fccSafresh1 } 688b8851fccSafresh1 } else { 689b8851fccSafresh1 $must_rewrite = "last line without newline"; 690b8851fccSafresh1 } 691b8851fccSafresh1 692b8851fccSafresh1 if ( $must_rewrite ) { 693b8851fccSafresh1 1 while unlink $MANIFEST; # avoid multiple versions on VMS 694*3d61058aSafresh1 open $fh, ">", $MANIFEST or die "(must_rewrite=$must_rewrite) Could not open >$MANIFEST: $!"; 695*3d61058aSafresh1 binmode $fh, ':raw'; 696b8851fccSafresh1 for (my $i=0; $i<=$#manifest; $i+=2) { 697*3d61058aSafresh1 print $fh "$manifest[$i]\n"; 698b8851fccSafresh1 } 699*3d61058aSafresh1 close $fh or die "could not write $MANIFEST: $!"; 700b8851fccSafresh1 } 701b8851fccSafresh1} 702b8851fccSafresh1 703b8851fccSafresh1 704b8851fccSafresh1# UNIMPLEMENTED 705b8851fccSafresh1sub _normalize { 706b8851fccSafresh1 return; 707b8851fccSafresh1} 708b8851fccSafresh1 709b8851fccSafresh1=head2 MANIFEST 710b8851fccSafresh1 711b8851fccSafresh1A list of files in the distribution, one file per line. The MANIFEST 712b8851fccSafresh1always uses Unix filepath conventions even if you're not on Unix. This 713b8851fccSafresh1means F<foo/bar> style not F<foo\bar>. 714b8851fccSafresh1 715b8851fccSafresh1Anything between white space and an end of line within a C<MANIFEST> 716b8851fccSafresh1file is considered to be a comment. Any line beginning with # is also 717b8851fccSafresh1a comment. Beginning with ExtUtils::Manifest 1.52, a filename may 718b8851fccSafresh1contain whitespace characters if it is enclosed in single quotes; single 719b8851fccSafresh1quotes or backslashes in that filename must be backslash-escaped. 720b8851fccSafresh1 721b8851fccSafresh1 # this a comment 722b8851fccSafresh1 some/file 723b8851fccSafresh1 some/other/file comment about some/file 724b8851fccSafresh1 'some/third file' comment 725b8851fccSafresh1 726b8851fccSafresh1 727b8851fccSafresh1=head2 MANIFEST.SKIP 728b8851fccSafresh1 729b8851fccSafresh1The file MANIFEST.SKIP may contain regular expressions of files that 730b8851fccSafresh1should be ignored by mkmanifest() and filecheck(). The regular 731b8851fccSafresh1expressions should appear one on each line. Blank lines and lines 732b8851fccSafresh1which start with C<#> are skipped. Use C<\#> if you need a regular 733b8851fccSafresh1expression to start with a C<#>. 734b8851fccSafresh1 735b8851fccSafresh1For example: 736b8851fccSafresh1 737b8851fccSafresh1 # Version control files and dirs. 738b8851fccSafresh1 \bRCS\b 739b8851fccSafresh1 \bCVS\b 740b8851fccSafresh1 ,v$ 741b8851fccSafresh1 \B\.svn\b 742b8851fccSafresh1 743b8851fccSafresh1 # Makemaker generated files and dirs. 744b8851fccSafresh1 ^MANIFEST\. 745b8851fccSafresh1 ^Makefile$ 746b8851fccSafresh1 ^blib/ 747b8851fccSafresh1 ^MakeMaker-\d 748b8851fccSafresh1 749b8851fccSafresh1 # Temp, old and emacs backup files. 750b8851fccSafresh1 ~$ 751b8851fccSafresh1 \.old$ 752b8851fccSafresh1 ^#.*#$ 753b8851fccSafresh1 ^\.# 754b8851fccSafresh1 755b8851fccSafresh1If no MANIFEST.SKIP file is found, a default set of skips will be 756b8851fccSafresh1used, similar to the example above. If you want nothing skipped, 757b8851fccSafresh1simply make an empty MANIFEST.SKIP file. 758b8851fccSafresh1 759b8851fccSafresh1In one's own MANIFEST.SKIP file, certain directives 760b8851fccSafresh1can be used to include the contents of other MANIFEST.SKIP 761b8851fccSafresh1files. At present two such directives are recognized. 762b8851fccSafresh1 763b8851fccSafresh1=over 4 764b8851fccSafresh1 765b8851fccSafresh1=item #!include_default 766b8851fccSafresh1 767*3d61058aSafresh1This tells ExtUtils::Manifest to read the default F<MANIFEST.SKIP> 768*3d61058aSafresh1file and skip files accordingly, but I<not> to include it in the local 769*3d61058aSafresh1F<MANIFEST.SKIP>. This is intended to skip files according to a system 770*3d61058aSafresh1default, which can change over time without requiring further changes 771*3d61058aSafresh1to the distribution's F<MANIFEST.SKIP>. 772b8851fccSafresh1 773b8851fccSafresh1=item #!include /Path/to/another/manifest.skip 774b8851fccSafresh1 775*3d61058aSafresh1This inserts the contents of the specified external file in the local 776*3d61058aSafresh1F<MANIFEST.SKIP>. This is intended for authors to have a central 777*3d61058aSafresh1F<MANIFEST.SKIP> file, and to include it with their various distributions. 778b8851fccSafresh1 779b8851fccSafresh1=back 780b8851fccSafresh1 781b8851fccSafresh1The included contents will be inserted into the MANIFEST.SKIP 782b8851fccSafresh1file in between I<#!start included /path/to/manifest.skip> 783b8851fccSafresh1and I<#!end included /path/to/manifest.skip> markers. 784b8851fccSafresh1The original MANIFEST.SKIP is saved as MANIFEST.SKIP.bak. 785b8851fccSafresh1 786b8851fccSafresh1=head2 EXPORT_OK 787b8851fccSafresh1 788b8851fccSafresh1C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>, 789b8851fccSafresh1C<&maniread>, and C<&manicopy> are exportable. 790b8851fccSafresh1 791b8851fccSafresh1=head2 GLOBAL VARIABLES 792b8851fccSafresh1 793b8851fccSafresh1C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it 794b8851fccSafresh1results in both a different C<MANIFEST> and a different 795b8851fccSafresh1C<MANIFEST.SKIP> file. This is useful if you want to maintain 796b8851fccSafresh1different distributions for different audiences (say a user version 797b8851fccSafresh1and a developer version including RCS). 798b8851fccSafresh1 799b8851fccSafresh1C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value, 800b8851fccSafresh1all functions act silently. 801b8851fccSafresh1 802b8851fccSafresh1C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value, 803b8851fccSafresh1or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be 804b8851fccSafresh1produced. 805b8851fccSafresh1 806b8851fccSafresh1=head1 DIAGNOSTICS 807b8851fccSafresh1 808b8851fccSafresh1All diagnostic output is sent to C<STDERR>. 809b8851fccSafresh1 810b8851fccSafresh1=over 4 811b8851fccSafresh1 812b8851fccSafresh1=item C<Not in MANIFEST:> I<file> 813b8851fccSafresh1 814b8851fccSafresh1is reported if a file is found which is not in C<MANIFEST>. 815b8851fccSafresh1 816b8851fccSafresh1=item C<Skipping> I<file> 817b8851fccSafresh1 818b8851fccSafresh1is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>. 819b8851fccSafresh1 820b8851fccSafresh1=item C<No such file:> I<file> 821b8851fccSafresh1 822b8851fccSafresh1is reported if a file mentioned in a C<MANIFEST> file does not 823b8851fccSafresh1exist. 824b8851fccSafresh1 825b8851fccSafresh1=item C<MANIFEST:> I<$!> 826b8851fccSafresh1 827b8851fccSafresh1is reported if C<MANIFEST> could not be opened. 828b8851fccSafresh1 829b8851fccSafresh1=item C<Added to MANIFEST:> I<file> 830b8851fccSafresh1 831b8851fccSafresh1is reported by mkmanifest() if $Verbose is set and a file is added 832b8851fccSafresh1to MANIFEST. $Verbose is set to 1 by default. 833b8851fccSafresh1 834b8851fccSafresh1=back 835b8851fccSafresh1 836b8851fccSafresh1=head1 ENVIRONMENT 837b8851fccSafresh1 838b8851fccSafresh1=over 4 839b8851fccSafresh1 840b8851fccSafresh1=item B<PERL_MM_MANIFEST_DEBUG> 841b8851fccSafresh1 842b8851fccSafresh1Turns on debugging 843b8851fccSafresh1 844b8851fccSafresh1=back 845b8851fccSafresh1 846b8851fccSafresh1=head1 SEE ALSO 847b8851fccSafresh1 848b8851fccSafresh1L<ExtUtils::MakeMaker> which has handy targets for most of the functionality. 849b8851fccSafresh1 850b8851fccSafresh1=head1 AUTHOR 851b8851fccSafresh1 852b8851fccSafresh1Andreas Koenig C<andreas.koenig@anima.de> 853b8851fccSafresh1 854b8851fccSafresh1Currently maintained by the Perl Toolchain Gang. 855b8851fccSafresh1 856b8851fccSafresh1=head1 COPYRIGHT AND LICENSE 857b8851fccSafresh1 858b8851fccSafresh1This software is copyright (c) 1996- by Andreas Koenig. 859b8851fccSafresh1 860b8851fccSafresh1This is free software; you can redistribute it and/or modify it under 861b8851fccSafresh1the same terms as the Perl 5 programming language system itself. 862b8851fccSafresh1 863b8851fccSafresh1=cut 864b8851fccSafresh1 865b8851fccSafresh11; 866