1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
package Test::Module::Build::Pluggable;
use strict;
use warnings;
use utf8;
use File::Temp qw/tempdir/;
use Cwd;
use Test::SharedFork;
use File::Basename ();
use File::Path ();
sub new {
my $class = shift;
my %args = @_==1 ? %{$_[0]} : @_;
my $self = bless {
files => [],
cleanup => 1,
%args
}, $class;
$self->{origcwd} = Cwd::getcwd();
$self->{dir} = tempdir(CLEANUP => $self->{cleanup});
$self->{libdir} = tempdir(CLEANUP => $self->{cleanup});
unshift @INC, $self->{libdir};
chdir $self->{dir};
return $self;
}
sub DESTROY {
my $self = shift;
chdir($self->{origcwd});
}
sub write_plugin {
my ($self, $package, $content) = @_;
my $ofile = do {
my $path = $package;
$path =~ s!::!/!g;
$path .= ".pm";
File::Spec->catfile($self->{libdir}, $path);
};
File::Path::mkpath(File::Basename::dirname($ofile));
open my $fh, '>', $ofile or die "Cannot open $ofile, $!";
print {$fh} $content;
close $fh;
push @{$self->{files}}, $ofile;
}
sub write_file {
my ($self, $fname, $content) = @_;
if (my $dir = File::Basename::dirname($fname)) {
File::Path::mkpath($dir);
}
open my $fh, '>', $fname or die "Cannot open $fname: $!";
print $fh $content;
close $fh;
push @{$self->{files}}, $fname;
}
sub write_manifest {
my $self = shift;
open my $fh, '>', 'MANIFEST' or die "Cannot open MANIFEST: $!";
for (@{$self->{files}}) {
print $fh $_ . "\n";
}
close $fh;
}
sub read_file {
my ($self, $fname) = @_;
open my $fh, '<', $fname or die "Cannot open $fname in @{[ Cwd::getcwd() ]}: $!";
local $/;
scalar(<$fh>);
}
sub run_build_script {
my ($self, @args) = @_;
my $pid = fork();
die "fork failed: $!" unless defined $pid;
if ($pid) { # parent
waitpid $pid, 0;
} else { # child
local @ARGV = (@args);
do 'Build';
::ok(!$@) or ::diag $@;
exit 0;
}
}
sub run_build_pl {
my ($self, @args) = @_;
my $pid = fork();
die "fork failed: $!" unless defined $pid;
if ($pid) { # parent
waitpid $pid, 0;
} else { # child
local @ARGV = @args;
do 'Build.PL';
::ok(-f 'Build', 'Created Build file') or ::diag $@;
exit 0;
}
}
1;
__END__
=head1 NAME
Test::Module::Build::Pluggable - Test your plugin
=head1 SYNOPSIS
my $test = Test::Module::Build::Pluggable->new();
$test->write_file('Build.PL', <<'...');
...
$test->run_build_pl();
$test->run_build_script();
# test...
=head1 METHODS
=over 4
=item C<< my $test = Test::Module::Build::Pluggable->new() >>
=item C<< $test->write_file($filename, $src); >>
=item C<< $test->write_plugin($package, $src); >>
=item C<< $test->write_manifest(); >>
Write manifest from file list. The file list means list of file name added by C<< $test->write_file >> and C<< $test->write_plugin >>
=item C<< $test->run_build_pl(); >>
=item C<< $test->run_build_script(); >>
=back
|
