1use strict; 2use warnings; 3 4BEGIN { 5 if( $ENV{PERL_CORE} ) { 6 chdir 't' if -d 't'; 7 unshift @INC, '../lib'; 8 } 9 else { 10 unshift @INC, 't/lib'; 11 } 12 $ENV{PERL_MM_MANIFEST_VERBOSE}=1; 13} 14chdir 't'; 15 16use Test::More tests => 101; 17use Cwd; 18 19use File::Spec; 20use File::Path; 21use File::Find; 22use Config; 23 24my $Is_VMS = $^O eq 'VMS'; 25my $Is_VMS_noefs = $Is_VMS; 26if ($Is_VMS) { 27 my $vms_efs = 0; 28 if (eval 'require VMS::Feature') { 29 $vms_efs = VMS::Feature::current("efs_charset"); 30 } else { 31 my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; 32 $vms_efs = $efs_charset =~ /^[ET1]/i; 33 } 34 $Is_VMS_noefs = 0 if $vms_efs; 35} 36 37# We're going to be chdir'ing and modules are sometimes loaded on the 38# fly in this test, so we need an absolute @INC. 39@INC = map File::Spec->rel2abs($_), @INC; 40 41# keep track of everything added so it can all be deleted 42my %Files; 43sub add_file { 44 my ($file, $data) = @_; 45 $data ||= 'foo'; 46 $file =~ s/ /^_/g if $Is_VMS_noefs; # escape spaces 47 1 while unlink $file; # or else we'll get multiple versions on VMS 48 open( T, '> '.$file) or return; 49 binmode T, ':raw'; # no CRLFs please 50 print T $data; 51 close T; 52 return 0 unless -e $file; # exists under the name we gave it ? 53 ++$Files{$file}; 54} 55 56sub read_manifest { 57 open( M, 'MANIFEST' ) or return; 58 chomp( my @files = <M> ); 59 close M; 60 return @files; 61} 62 63sub catch_warning { 64 my $warn = ''; 65 local $SIG{__WARN__} = sub { $warn .= $_[0] }; 66 return join('', $_[0]->() ), $warn; 67} 68 69sub remove_dir { 70 ok( rmdir( $_ ), "remove $_ directory" ) for @_; 71} 72 73# use module, import functions 74BEGIN { 75 use_ok( 'ExtUtils::Manifest', 76 qw( mkmanifest manicheck filecheck fullcheck 77 maniread manicopy skipcheck maniadd maniskip) ); 78} 79 80my $cwd = Cwd::getcwd(); 81 82# Just in case any old files were lying around. 83rmtree('mantest'); 84 85ok( mkdir( 'mantest', 0777 ), 'make mantest directory' ); 86ok( chdir( 'mantest' ), 'chdir() to mantest' ); 87ok( add_file('foo'), 'add a temporary file' ); 88 89# This ensures the -x check for manicopy means something 90# Some platforms don't have chmod or an executable bit, in which case 91# this call will do nothing or fail, but on the platforms where chmod() 92# works, we test the executable bit is copied 93chmod( 0744, 'foo') if $Config{'chmod'}; 94 95# there shouldn't be a MANIFEST there 96my ($res, $warn) = catch_warning( \&mkmanifest ); 97# Canonize the order. 98$warn = join("", map "$_|", 99 sort { lc($a) cmp lc($b) } split /\r?\n/, $warn); 100is( $warn, "Added to MANIFEST: foo|Added to MANIFEST: MANIFEST|", 101 "mkmanifest() displayed its additions" ); 102 103# and now you see it 104ok( -e 'MANIFEST', 'create MANIFEST file' ); 105 106my @list = read_manifest(); 107is( @list, 2, 'check files in MANIFEST' ); 108ok( ! ExtUtils::Manifest::filecheck(), 'no additional files in directory' ); 109 110# after adding bar, the MANIFEST is out of date 111ok( add_file( 'bar' ), 'add another file' ); 112ok( ! manicheck(), 'MANIFEST now out of sync' ); 113 114# it reports that bar has been added and throws a warning 115($res, $warn) = catch_warning( \&filecheck ); 116 117like( $warn, qr/^Not in MANIFEST: bar/, 'warning that bar has been added' ); 118is( $res, 'bar', 'bar reported as new' ); 119 120# now quiet the warning that bar was added and test again 121($res, $warn) = do { local $ExtUtils::Manifest::Quiet = 1; 122 catch_warning( \&skipcheck ) 123 }; 124is( $warn, '', 'disabled warnings' ); 125 126# add a skip file with a rule to skip itself (and the nonexistent glob '*baz*') 127add_file( 'MANIFEST.SKIP', "baz\n.SKIP" ); 128 129# this'll skip the new file 130($res, $warn) = catch_warning( \&skipcheck ); 131like( $warn, qr/^Skipping MANIFEST\.SKIP/i, 'got skipping warning' ); 132 133my @skipped; 134catch_warning( sub { 135 @skipped = skipcheck() 136}); 137 138is( join( ' ', @skipped ), 'MANIFEST.SKIP', 'listed skipped files' ); 139 140{ 141 local $ExtUtils::Manifest::Quiet = 1; 142 is( join(' ', filecheck() ), 'bar', 'listing skipped with filecheck()' ); 143} 144 145# add a subdirectory and a file there that should be found 146ok( mkdir( 'moretest', 0777 ), 'created moretest directory' ); 147add_file( File::Spec->catfile('moretest', 'quux'), 'quux' ); 148ok( exists( ExtUtils::Manifest::manifind()->{'moretest/quux'} ), 149 "manifind found moretest/quux" ); 150 151# only MANIFEST and foo are in the manifest 152$_ = 'foo'; 153my $files = maniread(); 154is( keys %$files, 2, 'two files found' ); 155is( join(' ', sort { lc($a) cmp lc($b) } keys %$files), 'foo MANIFEST', 156 'both files found' ); 157is( $_, 'foo', q{maniread() doesn't clobber $_} ); 158 159ok( mkdir( 'copy', 0777 ), 'made copy directory' ); 160 161# Check that manicopy copies files. 162manicopy( $files, 'copy', 'cp' ); 163my @copies = (); 164find( sub { push @copies, $_ if -f }, 'copy' ); 165@copies = map { s/\.$//; $_ } @copies if $Is_VMS; # VMS likes to put dots on 166 # the end of files. 167# Have to compare insensitively for non-case preserving VMS 168is_deeply( [sort map lc, @copies], [sort map lc, keys %$files] ); 169 170# cp would leave files readonly, so check permissions. 171foreach my $orig (@copies) { 172 my $copy = "copy/$orig"; 173 ok( -r $copy, "$copy: must be readable" ); 174 is( -w $copy, -w $orig, " writable if original was" ); 175 is( -x $copy, -x $orig, " executable if original was" ); 176} 177rmtree('copy'); 178 179 180# poison the manifest, and add a comment that should be reported 181add_file( 'MANIFEST', 'none #none' ); 182is( ExtUtils::Manifest::maniread()->{none}, '#none', 183 'maniread found comment' ); 184 185ok( mkdir( 'copy', 0777 ), 'made copy directory' ); 186$files = maniread(); 187eval { (undef, $warn) = catch_warning( sub { 188 manicopy( $files, 'copy', 'cp' ) }) 189}; 190 191# a newline comes through, so get rid of it 192chomp($warn); 193# the copy should have given a warning 194like($warn, qr/^none not found/, 'carped about none' ); 195($res, $warn) = catch_warning( \&skipcheck ); 196like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' ); 197 198# tell ExtUtils::Manifest to use a different file 199{ 200 local $ExtUtils::Manifest::MANIFEST = 'albatross'; 201 ($res, $warn) = catch_warning( \&mkmanifest ); 202 like( $warn, qr/Added to albatross: /, 'using a new manifest file' ); 203 204 # add the new file to the list of files to be deleted 205 $Files{'albatross'}++; 206} 207 208 209# Make sure MANIFEST.SKIP is using complete relative paths 210add_file( 'MANIFEST.SKIP' => "^moretest/q\n" ); 211 212# This'll skip moretest/quux 213($res, $warn) = catch_warning( \&skipcheck ); 214like( $warn, qr{^Skipping moretest/quux$}i, 'got skipping warning again' ); 215 216 217# There was a bug where entries in MANIFEST would be blotted out 218# by MANIFEST.SKIP rules. 219add_file( 'MANIFEST.SKIP' => 'foo' ); 220add_file( 'MANIFEST' => "foobar\n" ); 221add_file( 'foobar' => '123' ); 222($res, $warn) = catch_warning( \&manicheck ); 223is( $res, '', 'MANIFEST overrides MANIFEST.SKIP' ); 224is( $warn, '', 'MANIFEST overrides MANIFEST.SKIP, no warnings' ); 225 226$files = maniread; 227ok( !$files->{wibble}, 'MANIFEST in good state' ); 228maniadd({ wibble => undef }); 229maniadd({ yarrow => "hock" }); 230$files = maniread; 231is( $files->{wibble}, '', 'maniadd() with undef comment' ); 232is( $files->{yarrow}, 'hock',' with comment' ); 233is( $files->{foobar}, '', ' preserved old entries' ); 234 235my $manicontents = do { 236 local $/; 237 open my $fh, "MANIFEST" or die; 238 binmode $fh, ':raw'; 239 <$fh> 240}; 241is index($manicontents, "\015\012"), -1, 'MANIFEST no CRLF'; 242 243{ 244 # EOL normalization in maniadd() 245 246 # move manifest away: 247 rename "MANIFEST", "MANIFEST.bak" or die "Could not rename MANIFEST to MANIFEST.bak: $!"; 248 my $prev_maniaddresult; 249 my @eol = ("\012","\015","\015\012"); 250 # for all line-endings: 251 for my $i (0..$#eol) { 252 my $eol = $eol[$i]; 253 # cp the backup of the manifest to MANIFEST, line-endings adjusted 254 my $content = do { local $/; open my $fh, "MANIFEST.bak" or die; <$fh> }; 255 SPLITTER: for my $eol2 (@eol) { 256 if ( index($content, $eol2) > -1 ) { 257 my @lines = split /$eol2/, $content; 258 pop @lines while $lines[-1] eq ""; 259 open my $fh, ">", "MANIFEST" or die "Could not open >MANIFEST: $!"; 260 print $fh map "$_$eol", @lines; 261 close $fh or die "Could not close: $!"; 262 last SPLITTER; 263 } 264 } 265 # try maniadd 266 maniadd({eoltest => "end of line normalization test"}); 267 # slurp result and compare to previous result 268 my $maniaddresult = do { local $/; open my $fh, "MANIFEST" or die; <$fh> }; 269 if ($prev_maniaddresult) { 270 if ( $maniaddresult eq $prev_maniaddresult ) { 271 pass "normalization success with i=$i"; 272 } else { 273 require Data::Dumper; 274 no warnings "once"; 275 local $Data::Dumper::Useqq = 1; 276 local $Data::Dumper::Terse = 1; 277 is Data::Dumper::Dumper($maniaddresult), Data::Dumper::Dumper($prev_maniaddresult), "eol normalization failed with i=$i"; 278 } 279 } 280 $prev_maniaddresult = $maniaddresult; 281 } 282 # move backup over MANIFEST 283 rename "MANIFEST.bak", "MANIFEST" or die "Could not rename MANIFEST.bak to MANIFEST: $!"; 284} 285 286my %funky_files; 287# test including a filename with a space 288SKIP: { 289 add_file( 'foo bar' => "space" ) 290 or skip "couldn't create spaced test file", 2; 291 local $ExtUtils::Manifest::MANIFEST = "albatross"; 292 maniadd({ 'foo bar' => "contains space"}); 293 is( maniread()->{'foo bar'}, "contains space", 294 'spaced manifest filename' ); 295 add_file( 'albatross.bak', '' ); 296 ($res, $warn) = catch_warning( \&mkmanifest ); 297 like( $warn, qr/\A(Added to.*\n)+\z/m, 298 'no warnings about funky filename' ); 299 $funky_files{'space'} = 'foo bar'; 300} 301 302# test including a filename with a space and a quote 303SKIP: { 304 add_file( 'foo\' baz\'quux' => "quote" ) 305 or skip "couldn't create quoted test file", 1; 306 local $ExtUtils::Manifest::MANIFEST = "albatross"; 307 maniadd({ 'foo\' baz\'quux' => "contains quote"}); 308 is( maniread()->{'foo\' baz\'quux'}, "contains quote", 309 'quoted manifest filename' ); 310 $funky_files{'space_quote'} = 'foo\' baz\'quux'; 311} 312 313# test including a filename with a space and a backslash 314SKIP: { 315 add_file( 'foo bar\\baz' => "backslash" ) 316 or skip "couldn't create backslash test file", 1; 317 local $ExtUtils::Manifest::MANIFEST = "albatross"; 318 maniadd({ 'foo bar\\baz' => "contains backslash"}); 319 is( maniread()->{'foo bar\\baz'}, "contains backslash", 320 'backslashed manifest filename' ); 321 $funky_files{'space_backslash'} = 'foo bar\\baz'; 322} 323 324# test including a filename with a space, quote, and a backslash 325SKIP: { 326 add_file( 'foo bar\\baz\'quux' => "backslash/quote" ) 327 or skip "couldn't create backslash/quote test file", 1; 328 local $ExtUtils::Manifest::MANIFEST = "albatross"; 329 maniadd({ 'foo bar\\baz\'quux' => "backslash and quote"}); 330 is( maniread()->{'foo bar\\baz\'quux'}, "backslash and quote", 331 'backslashed and quoted manifest filename' ); 332 $funky_files{'space_quote_backslash'} = 'foo bar\\baz\'quux'; 333} 334 335# test including a filename which is itself a quoted string 336# https://rt.perl.org/Ticket/Display.html?id=122415 337SKIP: { 338 my $quoted_filename = q{'quoted name.txt'}; 339 my $description = "quoted string"; 340 add_file( $quoted_filename => $description ) 341 or skip "couldn't create $description test file", 1; 342 local $ExtUtils::Manifest::MANIFEST = "albatross"; 343 maniadd({ $quoted_filename => $description }); 344 is( maniread()->{$quoted_filename}, $description, 345 'file whose name starts and ends with quotes' ); 346 $funky_files{$description} = $quoted_filename; 347} 348 349my @funky_keys = qw(space space_quote space_backslash space_quote_backslash); 350# test including an external manifest.skip file in MANIFEST.SKIP 351{ 352 local $ENV{HOME} = File::Spec->catdir($cwd, qw(mantest)); 353 354 maniadd({ foo => undef, orange => undef, albatross => undef, 355 'mymanifest.skip' => undef, 'mydefault.skip' => undef}); 356 for (@funky_keys) { 357 maniadd( {$funky_files{$_} => $_} ) if defined $funky_files{$_}; 358 } 359 360 add_file('mymanifest.skip' => "^foo\n"); 361 add_file('mydefault.skip' => "^my\n"); 362 local $ExtUtils::Manifest::DEFAULT_MSKIP = 363 File::Spec->catfile($cwd, qw(mantest mydefault.skip)); 364 my $skip = File::Spec->catfile($cwd, qw(mantest mymanifest.skip)); 365 add_file('global.skip' => "^orange\n"); 366 add_file('MANIFEST.SKIP' => 367 "albatross\n#!include $skip\n#!include_default\n#!include ~/global.skip"); 368 my ($res, $warn) = catch_warning( \&skipcheck ); 369 for (qw(albatross foo foobar mymanifest.skip mydefault.skip)) { 370 like( $warn, qr/Skipping \b$_\b/, 371 "Skipping $_" ); 372 } 373 for my $funky_key (@funky_keys) { 374 SKIP: { 375 my $funky_file = $funky_files{$funky_key}; 376 skip "'$funky_key' not created", 1 unless $funky_file; 377 like( $warn, qr/Skipping \b\Q$funky_file\E\b/, 378 "Skipping $funky_file"); 379 } 380 } 381 ($res, $warn) = catch_warning( \&mkmanifest ); 382 for (qw(albatross foo foobar mymanifest.skip mydefault.skip orange)) { 383 like( $warn, qr/Removed from MANIFEST: \b$_\b/, 384 "Removed $_ from MANIFEST" ); 385 } 386 for my $funky_key (@funky_keys) { 387 SKIP: { 388 my $funky_file = $funky_files{$funky_key}; 389 skip "'$funky_key' not created", 1 unless $funky_file; 390 like( $warn, qr/Removed from MANIFEST: \b\Q$funky_file\E\b/, 391 "Removed $funky_file from MANIFEST"); 392 } 393 } 394 my $files = maniread; 395 ok( ! exists $files->{albatross}, 'albatross excluded via MANIFEST.SKIP' ); 396 ok( exists $files->{yarrow}, 'yarrow included in MANIFEST' ); 397 ok( exists $files->{bar}, 'bar included in MANIFEST' ); 398 ok( ! exists $files->{foobar}, 'foobar excluded via mymanifest.skip' ); 399 ok( ! exists $files->{foo}, 'foo excluded via mymanifest.skip' ); 400 ok( ! exists $files->{orange}, 'orange excluded via global.skip' ); 401 ok( ! exists $files->{'mymanifest.skip'}, 402 'mymanifest.skip excluded via mydefault.skip' ); 403 ok( ! exists $files->{'mydefault.skip'}, 404 'mydefault.skip excluded via mydefault.skip' ); 405 406 # test exclusion of funky files 407 for my $funky_key (@funky_keys) { 408 SKIP: { 409 my $funky_file = $funky_files{$funky_key}; 410 skip "'$funky_key' not created", 1 unless $funky_file; 411 ok( ! exists $files->{$funky_file}, 412 "'$funky_file' excluded via mymanifest.skip" ); 413 } 414 } 415 416 # tests for maniskip 417 my $skipchk = maniskip(); 418 is ( $skipchk->('albatross'), 1, 419 'albatross excluded via MANIFEST.SKIP' ); 420 is( $skipchk->('yarrow'), '', 421 'yarrow included in MANIFEST' ); 422 is( $skipchk->('bar'), '', 423 'bar included in MANIFEST' ); 424 $skipchk = maniskip('mymanifest.skip'); 425 is( $skipchk->('foobar'), 1, 426 'foobar excluded via mymanifest.skip' ); 427 is( $skipchk->('foo'), 1, 428 'foo excluded via mymanifest.skip' ); 429 is( $skipchk->('mymanifest.skip'), '', 430 'mymanifest.skip included via mydefault.skip' ); 431 is( $skipchk->('mydefault.skip'), '', 432 'mydefault.skip included via mydefault.skip' ); 433 $skipchk = maniskip('mydefault.skip'); 434 is( $skipchk->('foobar'), '', 435 'foobar included via mydefault.skip' ); 436 is( $skipchk->('foo'), '', 437 'foo included via mydefault.skip' ); 438 is( $skipchk->('mymanifest.skip'), 1, 439 'mymanifest.skip excluded via mydefault.skip' ); 440 is( $skipchk->('mydefault.skip'), 1, 441 'mydefault.skip excluded via mydefault.skip' ); 442 443 my $extsep = $Is_VMS_noefs ? '_' : '.'; 444 $Files{"$_.bak"}++ for ('MANIFEST', "MANIFEST${extsep}SKIP"); 445 446 my $mskip_contents = do { 447 local $/; 448 open my $fh, '<', "MANIFEST${extsep}SKIP" or return; 449 <$fh>; 450 }; 451 unlike $mskip_contents, qr{^\Q^my\E}m, 'include_default memory-only'; 452} 453 454add_file('MANIFEST' => 'Makefile.PL'); 455maniadd({ foo => 'bar' }); 456$files = maniread; 457# VMS downcases the MANIFEST. We normalize it here to match. 458%$files = map +(lc $_ => $files->{$_}), keys %$files; 459my %expect = ( 'makefile.pl' => '', 460 'foo' => 'bar' 461 ); 462is_deeply( $files, \%expect, 'maniadd() vs MANIFEST without trailing newline'); 463 464#add_file('MANIFEST' => 'Makefile.PL'); 465#maniadd({ foo => 'bar' }); 466 467SKIP: { 468 chmod( 0400, 'MANIFEST' ); 469 skip "Can't make MANIFEST read-only", 2 if -w 'MANIFEST' or $Config{osname} eq 'cygwin'; 470 471 eval { 472 maniadd({ 'foo' => 'bar' }); 473 }; 474 is( $@, '', "maniadd() won't open MANIFEST if it doesn't need to" ); 475 476 eval { 477 maniadd({ 'grrrwoof' => 'yippie' }); 478 }; 479 like( $@, qr/^\Qmaniadd() could not open MANIFEST:\E/, 480 "maniadd() dies if it can't open the MANIFEST" ); 481 482 chmod( 0600, 'MANIFEST' ); 483} 484 485 486END { 487 is( unlink( keys %Files ), keys %Files, 'remove all added files' ); 488 for my $file ( keys %Files ) { 1 while unlink $file; } # all versions 489 remove_dir( 'moretest', 'copy' ); 490 491 # now get rid of the parent directory 492 ok( chdir( $cwd ), 'return to parent directory' ); 493 remove_dir( 'mantest' ); 494} 495