line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package ExtUtils::ModuleMaker::Auxiliary; |
2
|
85
|
|
|
85
|
|
92704
|
use strict; |
|
85
|
|
|
|
|
115
|
|
|
85
|
|
|
|
|
2042
|
|
3
|
|
|
|
|
|
|
# Contains test subroutines for distribution with ExtUtils::ModuleMaker |
4
|
85
|
|
|
85
|
|
268
|
use warnings; |
|
85
|
|
|
|
|
97
|
|
|
85
|
|
|
|
|
2083
|
|
5
|
85
|
|
|
85
|
|
258
|
use vars qw( $VERSION @ISA @EXPORT_OK ); |
|
85
|
|
|
|
|
111
|
|
|
85
|
|
|
|
|
6326
|
|
6
|
|
|
|
|
|
|
$VERSION = 0.56; |
7
|
|
|
|
|
|
|
require Exporter; |
8
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
9
|
|
|
|
|
|
|
@EXPORT_OK = qw( |
10
|
|
|
|
|
|
|
read_file_string |
11
|
|
|
|
|
|
|
read_file_array |
12
|
|
|
|
|
|
|
six_file_tests |
13
|
|
|
|
|
|
|
check_MakefilePL |
14
|
|
|
|
|
|
|
check_pm_file |
15
|
|
|
|
|
|
|
make_compact |
16
|
|
|
|
|
|
|
failsafe |
17
|
|
|
|
|
|
|
licensetest |
18
|
|
|
|
|
|
|
_process_personal_defaults_file |
19
|
|
|
|
|
|
|
_reprocess_personal_defaults_file |
20
|
|
|
|
|
|
|
_get_els |
21
|
|
|
|
|
|
|
_subclass_preparatory_tests |
22
|
|
|
|
|
|
|
_subclass_cleanup_tests |
23
|
|
|
|
|
|
|
_save_pretesting_status |
24
|
|
|
|
|
|
|
_restore_pretesting_status |
25
|
|
|
|
|
|
|
); |
26
|
85
|
|
|
85
|
|
298
|
use Carp; |
|
85
|
|
|
|
|
100
|
|
|
85
|
|
|
|
|
3895
|
|
27
|
85
|
|
|
85
|
|
306
|
use Cwd; |
|
85
|
|
|
|
|
101
|
|
|
85
|
|
|
|
|
3520
|
|
28
|
85
|
|
|
85
|
|
38641
|
use File::Copy; |
|
85
|
|
|
|
|
138098
|
|
|
85
|
|
|
|
|
4201
|
|
29
|
85
|
|
|
85
|
|
373
|
use File::Path; |
|
85
|
|
|
|
|
105
|
|
|
85
|
|
|
|
|
2955
|
|
30
|
85
|
|
|
85
|
|
295
|
use File::Spec; |
|
85
|
|
|
|
|
99
|
|
|
85
|
|
|
|
|
1337
|
|
31
|
85
|
|
|
85
|
|
235
|
use File::Temp qw| tempdir |; |
|
85
|
|
|
|
|
99
|
|
|
85
|
|
|
|
|
4995
|
|
32
|
|
|
|
|
|
|
*ok = *Test::More::ok; |
33
|
|
|
|
|
|
|
*is = *Test::More::is; |
34
|
|
|
|
|
|
|
*like = *Test::More::like; |
35
|
|
|
|
|
|
|
*copy = *File::Copy::copy; |
36
|
|
|
|
|
|
|
*move = *File::Copy::move; |
37
|
85
|
|
|
|
|
163827
|
use File::Save::Home qw( |
38
|
|
|
|
|
|
|
get_subhome_directory_status |
39
|
|
|
|
|
|
|
make_subhome_directory |
40
|
|
|
|
|
|
|
restore_subhome_directory_status |
41
|
85
|
|
|
85
|
|
308
|
); |
|
85
|
|
|
|
|
93
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 NAME |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
ExtUtils::ModuleMaker::Auxiliary - Subroutines for testing ExtUtils::ModuleMaker |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 DESCRIPTION |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
This package contains subroutines used in one or more F files in |
50
|
|
|
|
|
|
|
ExtUtils::ModuleMaker's test suite. They may prove useful in writing test |
51
|
|
|
|
|
|
|
suites for distributions which subclass ExtUtils::ModuleMaker. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head1 SUBROUTINES |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head2 C |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Function: Read the contents of a file into a string. |
58
|
|
|
|
|
|
|
Argument: String holding name of a file created by complete_build(). |
59
|
|
|
|
|
|
|
Returns: String holding text of the file read. |
60
|
|
|
|
|
|
|
Used: To see whether text of files such as README, Makefile.PL, |
61
|
|
|
|
|
|
|
etc. was created correctly by returning a string against which |
62
|
|
|
|
|
|
|
a pattern can be matched. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=cut |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub read_file_string { |
67
|
80
|
|
|
80
|
1
|
62889
|
my $file = shift; |
68
|
80
|
50
|
|
|
|
2063
|
open my $fh, $file or die "Unable to open filehandle: $!"; |
69
|
80
|
|
|
|
|
133
|
my $filetext = do { local $/; <$fh> }; |
|
80
|
|
|
|
|
230
|
|
|
80
|
|
|
|
|
1833
|
|
70
|
80
|
50
|
|
|
|
590
|
close $fh or die "Unable to close filehandle: $!"; |
71
|
80
|
|
|
|
|
338
|
return $filetext; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head2 C |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Function: Read a file line-by-line into an array. |
77
|
|
|
|
|
|
|
Argument: String holding name of a file created by complete_build(). |
78
|
|
|
|
|
|
|
Returns: Array holding the lines of the file read. |
79
|
|
|
|
|
|
|
Used: To see whether text of files such as README, Makefile.PL, |
80
|
|
|
|
|
|
|
etc. was created correctly by returning an array against whose |
81
|
|
|
|
|
|
|
elements patterns can be matched. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub read_file_array { |
86
|
10
|
|
|
10
|
1
|
17
|
my $file = shift; |
87
|
10
|
50
|
|
|
|
256
|
open my $fh, $file or die "Unable to open filehandle: $!"; |
88
|
10
|
|
|
|
|
241
|
my @filetext = <$fh>; |
89
|
10
|
50
|
|
|
|
74
|
close $fh or die "Unable to close filehandle: $!"; |
90
|
10
|
|
|
|
|
111
|
return @filetext; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head2 C |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Function: Verify that content of MANIFEST and lib/*.pm were created |
96
|
|
|
|
|
|
|
correctly. |
97
|
|
|
|
|
|
|
Argument: Two arguments: |
98
|
|
|
|
|
|
|
1. A number predicting the number of entries in the MANIFEST. |
99
|
|
|
|
|
|
|
2. The stem of the lib/*.pm file, i.e., what immediately |
100
|
|
|
|
|
|
|
precedes the .pm. |
101
|
|
|
|
|
|
|
Returns: n/a. |
102
|
|
|
|
|
|
|
Used: To see whether MANIFEST and lib/*.pm have correct text. |
103
|
|
|
|
|
|
|
Runs 6 Test::More tests: |
104
|
|
|
|
|
|
|
1. Number of entries in MANIFEST. |
105
|
|
|
|
|
|
|
2. Change to directory under lib. |
106
|
|
|
|
|
|
|
3. Applies read_file_string to the stem.pm file. |
107
|
|
|
|
|
|
|
4. Determine whether stem.pm's POD contains module name and |
108
|
|
|
|
|
|
|
abstract. |
109
|
|
|
|
|
|
|
5. Determine whether POD contains a HISTORY head. |
110
|
|
|
|
|
|
|
6. Determine whether POD contains correct author information. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub six_file_tests { |
115
|
4
|
|
|
4
|
1
|
10
|
my ($manifest_entries, $testmod) = @_; |
116
|
4
|
|
|
|
|
14
|
my @filetext = read_file_array('MANIFEST'); |
117
|
4
|
|
|
|
|
16
|
is(scalar(@filetext), $manifest_entries, |
118
|
|
|
|
|
|
|
'Correct number of entries in MANIFEST'); |
119
|
|
|
|
|
|
|
|
120
|
4
|
|
|
|
|
770
|
my $str; |
121
|
4
|
|
|
|
|
39
|
ok(chdir 'lib/Alpha', 'Directory is now lib/Alpha'); |
122
|
4
|
|
|
|
|
838
|
ok($str = read_file_string("$testmod.pm"), |
123
|
|
|
|
|
|
|
"Able to read $testmod.pm"); |
124
|
4
|
|
|
|
|
888
|
ok($str =~ m|Alpha::$testmod\s-\sTest\sof\sthe\scapacities\sof\sEU::MM|, |
125
|
|
|
|
|
|
|
'POD contains module name and abstract'); |
126
|
4
|
|
|
|
|
813
|
ok($str =~ m|=head1\sHISTORY|, |
127
|
|
|
|
|
|
|
'POD contains history head'); |
128
|
4
|
|
|
|
|
806
|
ok($str =~ m| |
129
|
|
|
|
|
|
|
Phineas\sT\.\sBluster\n |
130
|
|
|
|
|
|
|
\s+CPAN\sID:\s+PTBLUSTER\n |
131
|
|
|
|
|
|
|
\s+Peanut\sGallery\n |
132
|
|
|
|
|
|
|
\s+phineas\@anonymous\.com\n |
133
|
|
|
|
|
|
|
\s+http:\/\/www\.anonymous\.com\/~phineas |
134
|
|
|
|
|
|
|
|xs, |
135
|
|
|
|
|
|
|
'POD contains correct author info'); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head2 C |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Function: Verify that content of Makefile.PL was created correctly. |
141
|
|
|
|
|
|
|
Argument: Two arguments: |
142
|
|
|
|
|
|
|
1. A string holding the directory in which the Makefile.PL |
143
|
|
|
|
|
|
|
should have been created. |
144
|
|
|
|
|
|
|
2. A reference to an array holding strings each of which is a |
145
|
|
|
|
|
|
|
prediction as to content of particular lines in Makefile.PL. |
146
|
|
|
|
|
|
|
Returns: n/a. |
147
|
|
|
|
|
|
|
Used: To see whether Makefile.PL created by complete_build() has |
148
|
|
|
|
|
|
|
correct entries. Runs 1 Test::More test which checks NAME, |
149
|
|
|
|
|
|
|
VERSION_FROM, AUTHOR and ABSTRACT. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=cut |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub check_MakefilePL { |
154
|
4
|
|
|
4
|
1
|
9580
|
my ($topdir, $predictref) = @_; |
155
|
4
|
|
|
|
|
10
|
my @pred = @$predictref; |
156
|
|
|
|
|
|
|
|
157
|
4
|
|
|
|
|
57
|
my $mkfl = File::Spec->catfile( $topdir, q{Makefile.PL} ); |
158
|
4
|
|
|
|
|
20
|
local *MAK; |
159
|
4
|
50
|
|
|
|
116
|
open MAK, $mkfl or die "Unable to open Makefile.PL: $!"; |
160
|
4
|
|
|
|
|
14
|
my $bigstr = read_file_string($mkfl); |
161
|
4
|
|
|
|
|
180
|
like($bigstr, qr/ |
162
|
|
|
|
|
|
|
NAME.+($pred[0]).+ |
163
|
|
|
|
|
|
|
VERSION_FROM.+($pred[1]).+ |
164
|
|
|
|
|
|
|
AUTHOR.+($pred[2]).+ |
165
|
|
|
|
|
|
|
($pred[3]).+ |
166
|
|
|
|
|
|
|
ABSTRACT.+($pred[4]).+ |
167
|
|
|
|
|
|
|
/sx, "Makefile.PL has predicted values"); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub check_pm_file { |
171
|
0
|
|
|
0
|
0
|
0
|
my ($pmfile, $predictref) = @_; |
172
|
0
|
|
|
|
|
0
|
my %pred = %$predictref; |
173
|
0
|
|
|
|
|
0
|
my @pmlines; |
174
|
0
|
|
|
|
|
0
|
@pmlines = read_file_array($pmfile); |
175
|
0
|
|
|
|
|
0
|
ok( scalar(@pmlines), ".pm file has content"); |
176
|
0
|
0
|
|
|
|
0
|
if (defined $pred{'pod_present'}) { |
177
|
0
|
|
|
|
|
0
|
pod_present(\@pmlines, \%pred); |
178
|
|
|
|
|
|
|
} |
179
|
0
|
0
|
|
|
|
0
|
if (defined $pred{'constructor_present'}) { |
180
|
0
|
|
|
|
|
0
|
constructor_present(\@pmlines, \%pred); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub make_compact { |
185
|
0
|
|
|
0
|
0
|
0
|
my $module_name = shift; |
186
|
0
|
|
|
|
|
0
|
my ($topdir, $path, $pmfile); |
187
|
0
|
|
|
|
|
0
|
$topdir = $path = $module_name; |
188
|
0
|
|
|
|
|
0
|
$topdir =~ s{::}{-}g; |
189
|
0
|
|
|
|
|
0
|
$path =~ s{::}{/}g; |
190
|
0
|
|
|
|
|
0
|
$path .= q{.pm}; |
191
|
0
|
|
|
|
|
0
|
$pmfile = File::Spec->catfile( $topdir, q{lib}, $path ); |
192
|
0
|
|
|
|
|
0
|
return ($topdir, $pmfile); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub pod_present { |
196
|
0
|
|
|
0
|
0
|
0
|
my $linesref = shift; |
197
|
0
|
|
|
|
|
0
|
my $predictref = shift; |
198
|
0
|
|
|
|
|
0
|
my $podcount = grep {/^=(head|cut)/} @{$linesref}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
199
|
0
|
0
|
|
|
|
0
|
if (${$predictref}{'pod_present'} == 0) { |
|
0
|
|
|
|
|
0
|
|
200
|
0
|
|
|
|
|
0
|
is( $podcount, 0, "no POD correctly detected in module"); |
201
|
|
|
|
|
|
|
} else { |
202
|
0
|
|
|
|
|
0
|
isnt( $podcount, 0, "POD detected in module"); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub constructor_present { |
207
|
0
|
|
|
0
|
0
|
0
|
my $linesref = shift; |
208
|
0
|
|
|
|
|
0
|
my $predictref = shift; |
209
|
0
|
|
|
|
|
0
|
my $constructorcount = grep {/^=sub new/} @{$linesref}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
210
|
0
|
0
|
|
|
|
0
|
if (${$predictref}{'constructor_present'} == 0) { |
|
0
|
|
|
|
|
0
|
|
211
|
0
|
|
|
|
|
0
|
is( $constructorcount, 0, "constructor correctly absent from module"); |
212
|
|
|
|
|
|
|
} else { |
213
|
0
|
|
|
|
|
0
|
isnt( $constructorcount, 0, "constructor correctly present in module"); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub failsafe { |
218
|
11
|
|
|
11
|
0
|
410
|
my ($caller, $argslistref, $pattern, $message) = @_; |
219
|
11
|
|
|
|
|
30
|
my ($tdir, $obj); |
220
|
11
|
|
|
|
|
93
|
$tdir = tempdir( CLEANUP => 1); |
221
|
11
|
|
|
|
|
5669
|
ok(chdir $tdir, 'changed to temp directory for testing'); |
222
|
11
|
|
|
|
|
3798
|
local $@ = undef; |
223
|
11
|
|
|
|
|
26
|
eval { $obj = $caller->new (@$argslistref); }; |
|
11
|
|
|
|
|
118
|
|
224
|
11
|
|
|
|
|
898
|
like($@, qr/$pattern/, $message); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub licensetest { |
228
|
41
|
|
|
41
|
0
|
1662
|
my ($caller, $license, $pattern) = @_; |
229
|
41
|
|
|
|
|
102
|
my ($tdir, $mod); |
230
|
41
|
|
|
|
|
341
|
$tdir = tempdir( CLEANUP => 1); |
231
|
41
|
|
|
|
|
167067
|
ok(chdir $tdir, "changed to temp directory for testing $license"); |
232
|
|
|
|
|
|
|
|
233
|
41
|
|
|
|
|
13902
|
ok($mod = $caller->new( |
234
|
|
|
|
|
|
|
NAME => "Alpha::$license", |
235
|
|
|
|
|
|
|
LICENSE => $license, |
236
|
|
|
|
|
|
|
COMPACT => 1, |
237
|
|
|
|
|
|
|
), "object for module Alpha::$license created"); |
238
|
41
|
|
|
|
|
9951
|
ok( $mod->complete_build(), 'call complete_build()' ); |
239
|
41
|
|
|
|
|
10937
|
ok(chdir "Alpha-$license", "changed to Alpha-$license directory"); |
240
|
41
|
|
|
|
|
9258
|
my $licensetext = read_file_string('LICENSE'); |
241
|
41
|
|
|
|
|
215
|
like($licensetext, $pattern, "$license license has predicted content"); |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub _process_personal_defaults_file { |
245
|
85
|
|
|
85
|
|
142
|
my ($mmkr_dir, $pers_file) = @_; |
246
|
85
|
|
|
|
|
194
|
my $pers_file_hidden = $pers_file . '.hidden'; |
247
|
85
|
|
|
|
|
116
|
my %pers; |
248
|
85
|
|
|
|
|
1071
|
$pers{full} = File::Spec->catfile( $mmkr_dir, $pers_file ); |
249
|
85
|
|
|
|
|
517
|
$pers{hidden} = File::Spec->catfile( $mmkr_dir, $pers_file_hidden ); |
250
|
85
|
50
|
|
|
|
2252
|
if (-f $pers{full}) { |
251
|
0
|
|
|
|
|
0
|
$pers{atime} = (stat($pers{full}))[8]; |
252
|
0
|
|
|
|
|
0
|
$pers{modtime} = (stat($pers{full}))[9]; |
253
|
|
|
|
|
|
|
rename $pers{full}, |
254
|
|
|
|
|
|
|
$pers{hidden} |
255
|
0
|
0
|
|
|
|
0
|
or croak "Unable to rename $pers{full}: $!"; |
256
|
|
|
|
|
|
|
ok(! -f $pers{full}, |
257
|
0
|
|
|
|
|
0
|
"personal defaults file temporarily suppressed"); |
258
|
|
|
|
|
|
|
ok(-f $pers{hidden}, |
259
|
0
|
|
|
|
|
0
|
"personal defaults file now hidden"); |
260
|
|
|
|
|
|
|
} else { |
261
|
|
|
|
|
|
|
ok(! -f $pers{full}, |
262
|
85
|
|
|
|
|
645
|
"personal defaults file not found"); |
263
|
85
|
|
|
|
|
20187
|
ok(1, "personal defaults file not found"); |
264
|
|
|
|
|
|
|
} |
265
|
85
|
|
|
|
|
19684
|
return { %pers }; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub _reprocess_personal_defaults_file { |
269
|
85
|
|
|
85
|
|
111
|
my $pers_def_ref = shift;; |
270
|
85
|
50
|
|
|
|
1060
|
if(-f $pers_def_ref->{hidden} ) { |
271
|
|
|
|
|
|
|
rename $pers_def_ref->{hidden}, |
272
|
|
|
|
|
|
|
$pers_def_ref->{full}, |
273
|
0
|
0
|
|
|
|
0
|
or croak "Unable to rename $pers_def_ref->{hidden}: $!"; |
274
|
|
|
|
|
|
|
ok(-f $pers_def_ref->{full}, |
275
|
0
|
|
|
|
|
0
|
"personal defaults file re-established"); |
276
|
|
|
|
|
|
|
ok(! -f $pers_def_ref->{hidden}, |
277
|
0
|
|
|
|
|
0
|
"hidden personal defaults now gone"); |
278
|
|
|
|
|
|
|
ok( (utime $pers_def_ref->{atime}, |
279
|
|
|
|
|
|
|
$pers_def_ref->{modtime}, |
280
|
|
|
|
|
|
|
($pers_def_ref->{full}) |
281
|
0
|
|
|
|
|
0
|
), "atime and modtime of personal defaults file restored"); |
282
|
|
|
|
|
|
|
} else { |
283
|
85
|
|
|
|
|
342
|
ok(1, "test not relevant"); |
284
|
85
|
|
|
|
|
20541
|
ok(1, "test not relevant"); |
285
|
85
|
|
|
|
|
18434
|
ok(1, "test not relevant"); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub _get_els { |
290
|
3
|
|
|
3
|
|
4
|
my $persref = shift; |
291
|
3
|
|
|
|
|
9
|
my %pers = %$persref; |
292
|
3
|
|
|
|
|
4
|
my %pm = %{$pers{pm}}; |
|
3
|
|
|
|
|
5
|
|
293
|
3
|
|
|
|
|
4
|
my %hidden = %{$pers{hidden}}; |
|
3
|
|
|
|
|
5
|
|
294
|
3
|
|
|
|
|
11
|
return ( pm => scalar(keys %pm), hidden => scalar(keys %hidden) ); |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub _subclass_preparatory_tests { |
298
|
1
|
|
|
1
|
|
2811
|
my $odir = shift; |
299
|
1
|
|
|
|
|
9
|
my $tdir = tempdir( CLEANUP => 1); |
300
|
1
|
|
|
|
|
598
|
ok(chdir $tdir, 'changed to temp directory for testing'); |
301
|
|
|
|
|
|
|
|
302
|
1
|
|
|
|
|
418
|
my $mmkr_dir_ref = get_subhome_directory_status(".modulemaker"); |
303
|
1
|
|
|
|
|
57
|
my $mmkr_dir = make_subhome_directory($mmkr_dir_ref); |
304
|
1
|
|
|
|
|
190
|
ok($mmkr_dir, "home/.modulemaker directory now present on system"); |
305
|
1
|
|
|
|
|
304
|
my $eumm = File::Spec->catfile( qw| ExtUtils ModuleMaker | ); |
306
|
1
|
|
|
|
|
7
|
my $eumm_dir = File::Spec->catfile( $mmkr_dir, $eumm ); |
307
|
1
|
50
|
|
|
|
22
|
unless (-d $eumm_dir) { |
308
|
1
|
50
|
|
|
|
155
|
mkpath($eumm_dir) or croak "Unable to make path: $!"; |
309
|
|
|
|
|
|
|
} |
310
|
1
|
|
|
|
|
23
|
ok(-d $eumm_dir, "eumm directory now exists"); |
311
|
|
|
|
|
|
|
|
312
|
1
|
|
|
|
|
308
|
my $pers_file = "ExtUtils/ModuleMaker/Personal/Defaults.pm"; |
313
|
1
|
|
|
|
|
6
|
my $pers_def_ref = |
314
|
|
|
|
|
|
|
_process_personal_defaults_file( $mmkr_dir, $pers_file ); |
315
|
|
|
|
|
|
|
|
316
|
1
|
|
|
|
|
1
|
my $persref; |
317
|
|
|
|
|
|
|
|
318
|
1
|
|
|
|
|
4
|
$persref = _identify_pm_files_under_mmkr_dir($eumm_dir); |
319
|
1
|
|
|
|
|
2
|
my %els1 = _get_els($persref); |
320
|
|
|
|
|
|
|
|
321
|
1
|
|
|
|
|
2
|
_hide_pm_files_under_mmkr_dir($persref); |
322
|
|
|
|
|
|
|
|
323
|
1
|
|
|
|
|
1
|
$persref = _identify_pm_files_under_mmkr_dir($eumm_dir); |
324
|
1
|
|
|
|
|
3
|
my %els2 = _get_els($persref); |
325
|
|
|
|
|
|
|
|
326
|
1
|
50
|
|
|
|
3
|
if (! $els1{pm}) { |
|
|
0
|
|
|
|
|
|
327
|
|
|
|
|
|
|
is($els1{pm}, $els2{pm}, |
328
|
1
|
|
|
|
|
3
|
"no .pm files originally, so no .pm files now"); |
329
|
|
|
|
|
|
|
is($els1{pm}, $els2{hidden}, |
330
|
1
|
|
|
|
|
285
|
"no .pm files originally, so no .pm.hidden files now"); |
331
|
|
|
|
|
|
|
} elsif ($els1{pm}) { |
332
|
0
|
|
|
|
|
0
|
is($els2{pm}, 0, |
333
|
|
|
|
|
|
|
"original .pm files are now hidden"); |
334
|
|
|
|
|
|
|
is($els1{pm}, $els2{hidden}, |
335
|
0
|
|
|
|
|
0
|
".pm.hidden files exist"); |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
1
|
|
|
|
|
280
|
my $sourcedir = File::Spec->catdir( $odir, q{t}, q{testlib}, $eumm ); |
339
|
1
|
|
|
|
|
29
|
ok( -d $sourcedir, "source directory exists"); |
340
|
1
|
|
|
|
|
310
|
ok( -d $eumm_dir, "destination directory exists"); |
341
|
|
|
|
|
|
|
return { |
342
|
1
|
|
|
|
|
279
|
mmkr_dir_ref => $mmkr_dir_ref, |
343
|
|
|
|
|
|
|
persref => $persref, |
344
|
|
|
|
|
|
|
pers_def_ref => $pers_def_ref, |
345
|
|
|
|
|
|
|
initial_els_ref => \%els1, |
346
|
|
|
|
|
|
|
sourcedir => $sourcedir, |
347
|
|
|
|
|
|
|
eumm_dir => $eumm_dir, |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub _subclass_cleanup_tests { |
352
|
1
|
|
|
1
|
|
2489
|
my $cleanup_ref = shift; |
353
|
1
|
|
|
|
|
2
|
my $persref = $cleanup_ref->{persref}; |
354
|
1
|
|
|
|
|
2
|
my $pers_def_ref = $cleanup_ref->{pers_def_ref}; |
355
|
1
|
|
|
|
|
2
|
my $eumm_dir = $cleanup_ref->{eumm_dir}; |
356
|
1
|
|
|
|
|
2
|
my %els1 = %{ $cleanup_ref->{initial_els_ref} }; |
|
1
|
|
|
|
|
4
|
|
357
|
1
|
|
|
|
|
3
|
my $odir = $cleanup_ref->{odir}; |
358
|
1
|
|
|
|
|
2
|
my $mmkr_dir_ref = $cleanup_ref->{mmkr_dir_ref}; |
359
|
|
|
|
|
|
|
|
360
|
1
|
|
|
|
|
5
|
_reveal_pm_files_under_mmkr_dir($persref); |
361
|
|
|
|
|
|
|
|
362
|
1
|
|
|
|
|
2
|
$persref = _identify_pm_files_under_mmkr_dir($eumm_dir); |
363
|
1
|
|
|
|
|
4
|
my %els3 = _get_els($persref); |
364
|
|
|
|
|
|
|
|
365
|
1
|
50
|
|
|
|
3
|
if (! $els1{pm}) { |
|
|
0
|
|
|
|
|
|
366
|
|
|
|
|
|
|
is($els1{pm}, $els3{pm}, |
367
|
1
|
|
|
|
|
5
|
"no .pm files originally, so no .pm files now"); |
368
|
|
|
|
|
|
|
is($els1{pm}, $els3{hidden}, |
369
|
1
|
|
|
|
|
305
|
"no .pm files originally, so no .pm.hidden files now"); |
370
|
|
|
|
|
|
|
} elsif ($els1{pm}) { |
371
|
|
|
|
|
|
|
is($els1{pm}, $els3{pm}, |
372
|
0
|
|
|
|
|
0
|
"same number of .pm files as originally"); |
373
|
0
|
|
|
|
|
0
|
is($els3{hidden}, 0, |
374
|
|
|
|
|
|
|
"no more .pm.hidden files"); |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
1
|
|
|
|
|
358
|
_reprocess_personal_defaults_file($pers_def_ref); |
378
|
|
|
|
|
|
|
|
379
|
1
|
|
|
|
|
299
|
ok(chdir $odir, 'changed back to original directory after testing'); |
380
|
|
|
|
|
|
|
|
381
|
1
|
|
|
|
|
272
|
ok( restore_subhome_directory_status($mmkr_dir_ref), |
382
|
|
|
|
|
|
|
"original presence/absence of .modulemaker directory restored"); |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
sub _identify_pm_files_under_mmkr_dir { |
386
|
3
|
|
|
3
|
|
4
|
my $eumm_dir = shift; |
387
|
3
|
|
|
|
|
3
|
my (@pm_files, @pm_files_hidden); |
388
|
3
|
50
|
|
|
|
88
|
opendir my $dirh, $eumm_dir |
389
|
|
|
|
|
|
|
or croak "Unable to open $eumm_dir for reading: $!"; |
390
|
3
|
|
|
|
|
40
|
while (my $f = readdir($dirh)) { |
391
|
6
|
50
|
|
|
|
14
|
if ($f =~ /\.pm$/) { |
|
|
50
|
|
|
|
|
|
392
|
0
|
|
|
|
|
0
|
push @pm_files, File::Spec->catfile( $eumm_dir, $f ); |
393
|
|
|
|
|
|
|
} elsif ($f =~ /\.pm\.hidden$/) { |
394
|
0
|
|
|
|
|
0
|
push @pm_files_hidden, File::Spec->catfile( $eumm_dir, $f ); |
395
|
|
|
|
|
|
|
} else { |
396
|
6
|
|
|
|
|
17
|
next; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
} |
399
|
3
|
50
|
|
|
|
25
|
closedir $dirh or croak "Unable to close $eumm_dir after reading: $!"; |
400
|
|
|
|
|
|
|
# sanity check: |
401
|
|
|
|
|
|
|
# If there are .pm files, there should be no .pm.hidden files |
402
|
|
|
|
|
|
|
# and vice versa. |
403
|
3
|
0
|
50
|
|
|
8
|
if ( scalar(@pm_files) and scalar(@pm_files_hidden) ) { |
404
|
0
|
|
|
|
|
0
|
croak "Both .pm and .pm.hidden files found in $eumm_dir: $!"; |
405
|
|
|
|
|
|
|
} |
406
|
3
|
|
|
|
|
58
|
my %pers; |
407
|
|
|
|
|
|
|
my %pm; |
408
|
3
|
|
|
|
|
9
|
foreach my $f (@pm_files) { |
409
|
0
|
|
|
|
|
0
|
$pm{$f}{atime} = (stat($f))[8]; |
410
|
0
|
|
|
|
|
0
|
$pm{$f}{modtime} = (stat($f))[9]; |
411
|
|
|
|
|
|
|
} |
412
|
3
|
|
|
|
|
5
|
my %hidden; |
413
|
3
|
|
|
|
|
3
|
foreach my $f (@pm_files_hidden) { |
414
|
0
|
|
|
|
|
0
|
$hidden{$f}{atime} = (stat($f))[8]; |
415
|
0
|
|
|
|
|
0
|
$hidden{$f}{modtime} = (stat($f))[9]; |
416
|
|
|
|
|
|
|
} |
417
|
3
|
|
|
|
|
8
|
$pers{dir} = $eumm_dir;; |
418
|
3
|
|
|
|
|
3
|
$pers{pm} = \%pm; |
419
|
3
|
|
|
|
|
3
|
$pers{hidden} = \%hidden; |
420
|
3
|
|
|
|
|
12
|
return \%pers; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
sub _hide_pm_files_under_mmkr_dir { |
424
|
1
|
|
|
1
|
|
1
|
my $per_dir_ref = shift; |
425
|
1
|
|
|
|
|
1
|
my %pers = %{$per_dir_ref}; |
|
1
|
|
|
|
|
2
|
|
426
|
1
|
|
|
|
|
1
|
my %pm = %{$pers{pm}}; |
|
1
|
|
|
|
|
2
|
|
427
|
1
|
|
|
|
|
3
|
foreach my $f (keys %pm) { |
428
|
0
|
|
|
|
|
0
|
my $new = "$f.hidden"; |
429
|
0
|
0
|
|
|
|
0
|
rename $f, $new or croak "Unable to rename $f: $!"; |
430
|
0
|
|
|
|
|
0
|
utime $pm{$f}{atime}, $pm{$f}{modtime}, $new; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub _reveal_pm_files_under_mmkr_dir { |
435
|
1
|
|
|
1
|
|
3
|
my $per_dir_ref = shift; |
436
|
1
|
|
|
|
|
2
|
my %pers = %{$per_dir_ref}; |
|
1
|
|
|
|
|
4
|
|
437
|
1
|
|
|
|
|
1
|
my %hidden = %{$pers{hidden}}; |
|
1
|
|
|
|
|
3
|
|
438
|
1
|
|
|
|
|
6
|
foreach my $f (keys %hidden) { |
439
|
0
|
|
|
|
|
0
|
$f =~ m{(.*)\.hidden$}; |
440
|
0
|
|
|
|
|
0
|
my $new = $1; |
441
|
0
|
0
|
|
|
|
0
|
rename $f, $new or croak "Unable to rename $f: $!"; |
442
|
0
|
|
|
|
|
0
|
utime $hidden{$f}{atime}, $hidden{$f}{modtime}, $new; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub _save_pretesting_status { |
447
|
84
|
|
|
84
|
|
27110
|
my $mmkr_dir_ref = get_subhome_directory_status(".modulemaker"); |
448
|
84
|
|
|
|
|
4080
|
my $mmkr_dir = make_subhome_directory($mmkr_dir_ref); |
449
|
84
|
|
|
|
|
441921
|
ok( $mmkr_dir, "personal defaults directory now present on system"); |
450
|
84
|
|
|
|
|
21656
|
my $pers_file = "ExtUtils/ModuleMaker/Personal/Defaults.pm"; |
451
|
84
|
|
|
|
|
234
|
my $pers_def_ref = _process_personal_defaults_file( |
452
|
|
|
|
|
|
|
$mmkr_dir, |
453
|
|
|
|
|
|
|
$pers_file, |
454
|
|
|
|
|
|
|
); |
455
|
|
|
|
|
|
|
return { |
456
|
84
|
|
|
|
|
173004
|
cwd => cwd(), |
457
|
|
|
|
|
|
|
mmkr_dir_ref => $mmkr_dir_ref, |
458
|
|
|
|
|
|
|
pers_def_ref => $pers_def_ref, |
459
|
|
|
|
|
|
|
mmkr_dir => $mmkr_dir, # needed in make_selections_defaults |
460
|
|
|
|
|
|
|
pers_file => $pers_file, # needed in make_selections_defaults |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub _restore_pretesting_status { |
465
|
84
|
|
|
84
|
|
159182
|
my $statusref = shift; |
466
|
84
|
|
|
|
|
320
|
_reprocess_personal_defaults_file($statusref->{pers_def_ref}); |
467
|
|
|
|
|
|
|
ok(chdir $statusref->{cwd}, |
468
|
84
|
|
|
|
|
18860
|
"changed back to original directory after testing"); |
469
|
84
|
|
|
|
|
18676
|
ok( restore_subhome_directory_status($statusref->{mmkr_dir_ref}), |
470
|
|
|
|
|
|
|
"original presence/absence of .modulemaker directory restored"); |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=head1 SEE ALSO |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
F. |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=cut |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
1; |
480
|
|
|
|
|
|
|
|