c6573a1aadd76aa41aa9dc0a75725118e9c3513c
[perl.git] / ext / ExtUtils-MakeMaker / t / lib / MakeMaker / Test / Setup / Problem.pm
1 package MakeMaker::Test::Setup::Problem;
2
3 @ISA = qw(Exporter);
4 require Exporter;
5 @EXPORT = qw(setup_recurs teardown_recurs);
6
7 use strict;
8 use File::Path;
9 use File::Basename;
10 use MakeMaker::Test::Utils;
11
12 my %Files = (
13              'Problem-Module/Makefile.PL'   => <<'END',
14 use ExtUtils::MakeMaker;
15
16 WriteMakefile(
17     NAME    => 'Problem::Module',
18 );
19 END
20
21              'Problem-Module/subdir/Makefile.PL'    => <<'END',
22 printf "\@INC %s .\n", (grep { $_ eq '.' } @INC) ? "has" : "doesn't have";
23
24 warn "I think I'm going to be sick\n";
25 die "YYYAaaaakkk\n";
26 END
27
28 );
29
30
31 sub setup_recurs {
32     while(my($file, $text) = each %Files) {
33         # Convert to a relative, native file path.
34         $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file);
35
36         my $dir = dirname($file);
37         mkpath $dir;
38         open(FILE, ">$file") || die "Can't create $file: $!";
39         print FILE $text;
40         close FILE;
41
42         # ensure file at least 1 second old for makes that assume
43         # files with the same time are out of date.
44         my $time = calibrate_mtime();
45         utime $time, $time - 1, $file;
46     }
47
48     return 1;
49 }
50
51 sub teardown_recurs { 
52     foreach my $file (keys %Files) {
53         my $dir = dirname($file);
54         if( -e $dir ) {
55             rmtree($dir) || return;
56         }
57     }
58     return 1;
59 }
60
61
62 1;