1package MakeMaker::Test::Setup::BFD; 2 3@ISA = qw(Exporter); 4require Exporter; 5@EXPORT = qw(setup_recurs teardown_recurs); 6 7use strict; 8use warnings; 9use File::Path; 10use File::Basename; 11use MakeMaker::Test::Utils; 12 13my $Is_VMS = $^O eq 'VMS'; 14 15my %Files = ( 16 'Big-Dummy/lib/Big/Dummy.pm' => <<'END', 17package Big::Dummy; 18 19$VERSION = 0.01; 20 21=head1 NAME 22 23Big::Dummy - Try "our" hot dog's, $andwiche$ and $(ub)$! 24 25=cut 26 271; 28END 29 30 'Big-Dummy/Makefile.PL' => <<'END', 31use ExtUtils::MakeMaker; 32 33# This will interfere with the PREREQ_PRINT tests. 34printf "Current package is: %s\n", __PACKAGE__ unless "@ARGV" =~ /PREREQ/; 35 36WriteMakefile( 37 NAME => 'Big::Dummy', 38 VERSION_FROM => 'lib/Big/Dummy.pm', 39 EXE_FILES => [qw(bin/program)], 40 PREREQ_PM => { strict => 0 }, 41 BUILD_REQUIRES => { warnings => 0 }, 42 ABSTRACT_FROM => 'lib/Big/Dummy.pm', 43 AUTHOR => 'Michael G Schwern <schwern@pobox.com>', 44); 45END 46 47 'Big-Dummy/bin/program' => <<'END', 48#!/usr/bin/perl -w 49 50=head1 NAME 51 52program - this is a program 53 54=cut 55 561; 57END 58 'Big-Dummy/usrbin/interp' => <<'END', 59This is a dummy interpreter 60END 61 62 'Big-Dummy/test.pl' => <<'END', 63print "1..1\n"; 64print "ok 1 - testing test.pl\n"; 65END 66 67 'Big-Dummy/t/compile.t' => <<'END', 68print "1..3\n"; 69print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; 70print "ok 2 - TEST_VERBOSE\n"; 71print "ok 3 - testing t/*.t\n"; 72END 73 74 'Big-Dummy/Liar/t/sanity.t' => <<'END', 75print "1..3\n"; 76print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; 77print eval "use Big::Liar; 1;" ? "ok 2\n" : "not ok 2\n"; 78print "ok 3 - TEST_VERBOSE\n"; 79END 80 81 'Big-Dummy/Liar/lib/Big/Liar.pm' => <<'END', 82package Big::Liar; 83 84$VERSION = 0.01; 85 861; 87END 88 89 'Big-Dummy/Liar/Makefile.PL' => <<'END', 90use ExtUtils::MakeMaker; 91 92my $mm = WriteMakefile( 93 NAME => 'Big::Liar', 94 VERSION_FROM => 'lib/Big/Liar.pm', 95 _KEEP_AFTER_FLUSH => 1 96 ); 97 98print "Big::Liar's vars\n"; 99foreach my $key (qw(INST_LIB INST_ARCHLIB)) { 100 print "$key = $mm->{$key}\n"; 101} 102END 103 104 ); 105 106my $tmpdir; 107 108# if given args, those are inserted as components in resulting path, eg: 109# setup_recurs('dir') means instead of creating Big-Dummy/*, dir/Big-Dummy/* 110sub setup_recurs { 111 my @chrs = ( "A" .. "Z", 0 .. 9 ); 112 # annoyingly we cant use File::Temp here as it drags in XS code 113 # and we run under blocks to prevent XS code loads. This is a minimal 114 # patch to fix the issue. 115 $tmpdir = join "", "./temp-$$-", map { $chrs[rand(@chrs)] } 1..8; 116 mkdir($tmpdir) or die "Failed to create '$tmpdir': $!"; 117 chdir($tmpdir) or die "Failed to chdir '$tmpdir': $!"; 118 foreach my $file (sort keys %Files) { 119 my $text = $Files{$file}; 120 # Convert to a relative, native file path. 121 $file = File::Spec->catfile(File::Spec->curdir, @_, split m{\/}, $file); 122 $file = File::Spec->rel2abs($file); 123 124 my $dir = dirname($file); 125 mkpath $dir; 126 open(FILE, ">$file") || die "Can't create $file: $!"; 127 print FILE $text; 128 close FILE; 129 130 # ensure file at least 1 second old for makes that assume 131 # files with the same time are out of date. 132 my $time = calibrate_mtime(); 133 utime $time, $time - 1, $file; 134 } 135 136 return 1; 137} 138 139sub teardown_recurs { 140 foreach my $file (keys %Files) { 141 my $dir = dirname($file); 142 if( -e $dir ) { 143 rmtree($dir) or next; 144 } 145 } 146 chdir(".."); 147 rmtree($tmpdir); 148 return 1; 149} 150 151 1521; 153