line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::Critic::TestUtils; |
2
|
|
|
|
|
|
|
|
3
|
40
|
|
|
40
|
|
1489381
|
use 5.010001; |
|
40
|
|
|
|
|
227
|
|
4
|
40
|
|
|
40
|
|
229
|
use strict; |
|
40
|
|
|
|
|
113
|
|
|
40
|
|
|
|
|
889
|
|
5
|
40
|
|
|
40
|
|
214
|
use warnings; |
|
40
|
|
|
|
|
129
|
|
|
40
|
|
|
|
|
1269
|
|
6
|
|
|
|
|
|
|
|
7
|
40
|
|
|
40
|
|
5295
|
use English qw(-no_match_vars); |
|
40
|
|
|
|
|
36725
|
|
|
40
|
|
|
|
|
367
|
|
8
|
40
|
|
|
40
|
|
22439
|
use Readonly; |
|
40
|
|
|
|
|
46325
|
|
|
40
|
|
|
|
|
2112
|
|
9
|
|
|
|
|
|
|
|
10
|
40
|
|
|
40
|
|
342
|
use Exporter 'import'; |
|
40
|
|
|
|
|
115
|
|
|
40
|
|
|
|
|
1275
|
|
11
|
|
|
|
|
|
|
|
12
|
40
|
|
|
40
|
|
246
|
use File::Path (); |
|
40
|
|
|
|
|
94
|
|
|
40
|
|
|
|
|
773
|
|
13
|
40
|
|
|
40
|
|
263
|
use File::Spec (); |
|
40
|
|
|
|
|
114
|
|
|
40
|
|
|
|
|
724
|
|
14
|
40
|
|
|
40
|
|
236
|
use File::Spec::Unix (); |
|
40
|
|
|
|
|
119
|
|
|
40
|
|
|
|
|
641
|
|
15
|
40
|
|
|
40
|
|
20229
|
use File::Temp (); |
|
40
|
|
|
|
|
346839
|
|
|
40
|
|
|
|
|
1196
|
|
16
|
40
|
|
|
40
|
|
310
|
use File::Find qw( find ); |
|
40
|
|
|
|
|
95
|
|
|
40
|
|
|
|
|
2901
|
|
17
|
|
|
|
|
|
|
|
18
|
40
|
|
|
40
|
|
20705
|
use Perl::Critic; |
|
40
|
|
|
|
|
178
|
|
|
40
|
|
|
|
|
2184
|
|
19
|
40
|
|
|
40
|
|
370
|
use Perl::Critic::Config; |
|
40
|
|
|
|
|
124
|
|
|
40
|
|
|
|
|
1125
|
|
20
|
40
|
|
|
40
|
|
280
|
use Perl::Critic::Exception::Fatal::Generic qw( throw_generic ); |
|
40
|
|
|
|
|
130
|
|
|
40
|
|
|
|
|
2484
|
|
21
|
40
|
|
|
40
|
|
315
|
use Perl::Critic::Exception::Fatal::Internal qw( throw_internal ); |
|
40
|
|
|
|
|
114
|
|
|
40
|
|
|
|
|
1801
|
|
22
|
40
|
|
|
40
|
|
278
|
use Perl::Critic::UserProfile; |
|
40
|
|
|
|
|
111
|
|
|
40
|
|
|
|
|
1196
|
|
23
|
40
|
|
|
40
|
|
252
|
use Perl::Critic::Utils qw( :data_conversion ); |
|
40
|
|
|
|
|
174
|
|
|
40
|
|
|
|
|
2136
|
|
24
|
40
|
|
|
40
|
|
3981
|
use Perl::Critic::PolicyFactory (-test => 1); |
|
40
|
|
|
|
|
174
|
|
|
40
|
|
|
|
|
393
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our $VERSION = '1.150'; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Readonly::Array our @EXPORT_OK => qw( |
29
|
|
|
|
|
|
|
pcritique pcritique_with_violations |
30
|
|
|
|
|
|
|
critique critique_with_violations |
31
|
|
|
|
|
|
|
fcritique fcritique_with_violations |
32
|
|
|
|
|
|
|
subtests_in_tree |
33
|
|
|
|
|
|
|
should_skip_author_tests |
34
|
|
|
|
|
|
|
get_author_test_skip_message |
35
|
|
|
|
|
|
|
starting_points_including_examples |
36
|
|
|
|
|
|
|
bundled_policy_names |
37
|
|
|
|
|
|
|
names_of_policies_willing_to_work |
38
|
|
|
|
|
|
|
); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub assert_version { |
41
|
39
|
|
|
39
|
1
|
7756
|
my $expected_version = shift; |
42
|
|
|
|
|
|
|
|
43
|
39
|
50
|
|
|
|
259
|
if ( $expected_version ne $Perl::Critic::VERSION ) { |
44
|
0
|
|
|
|
|
0
|
require Carp; |
45
|
0
|
|
|
|
|
0
|
Carp::confess( "Expected Perl::Critic $expected_version but it is actually $Perl::Critic::VERSION" ); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
39
|
|
|
|
|
134
|
return; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
52
|
|
|
|
|
|
|
# If the user already has an existing perlcriticrc file, it will get |
53
|
|
|
|
|
|
|
# in the way of these test. This little tweak to ensures that we |
54
|
|
|
|
|
|
|
# don't find the perlcriticrc file. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub block_perlcriticrc { |
57
|
40
|
|
|
40
|
|
402
|
no warnings 'redefine'; ## no critic (ProhibitNoWarnings); |
|
40
|
|
|
|
|
149
|
|
|
40
|
|
|
|
|
87643
|
|
58
|
31
|
|
|
31
|
1
|
151
|
*Perl::Critic::UserProfile::_find_profile_path = sub { return }; ## no critic (ProtectPrivateVars) |
|
19
|
|
|
19
|
|
773
|
|
59
|
19
|
|
|
|
|
65
|
return 1; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
63
|
|
|
|
|
|
|
# Criticize a code snippet using only one policy. Returns the violations. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub pcritique_with_violations { |
66
|
23
|
|
|
23
|
1
|
93
|
my($policy, $code_ref, $config_ref) = @_; |
67
|
23
|
|
|
|
|
176
|
my $c = Perl::Critic->new( -profile => 'NONE' ); |
68
|
23
|
|
|
|
|
137
|
$c->add_policy(-policy => $policy, -config => $config_ref); |
69
|
23
|
|
|
|
|
128
|
return $c->critique($code_ref); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
73
|
|
|
|
|
|
|
# Criticize a code snippet using only one policy. Returns the number |
74
|
|
|
|
|
|
|
# of violations |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub pcritique { ##no critic(ArgUnpacking) |
77
|
23
|
|
|
23
|
1
|
20032
|
return scalar pcritique_with_violations(@_); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
81
|
|
|
|
|
|
|
# Criticize a code snippet using a specified config. Returns the violations. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub critique_with_violations { |
84
|
32
|
|
|
32
|
1
|
102
|
my ($code_ref, $config_ref) = @_; |
85
|
32
|
|
|
|
|
74
|
my $c = Perl::Critic->new( %{$config_ref} ); |
|
32
|
|
|
|
|
242
|
|
86
|
32
|
|
|
|
|
198
|
return $c->critique($code_ref); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
90
|
|
|
|
|
|
|
# Criticize a code snippet using a specified config. Returns the |
91
|
|
|
|
|
|
|
# number of violations |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub critique { ##no critic(ArgUnpacking) |
94
|
32
|
|
|
32
|
1
|
81752
|
return scalar critique_with_violations(@_); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
98
|
|
|
|
|
|
|
# Like pcritique_with_violations, but forces a PPI::Document::File context. |
99
|
|
|
|
|
|
|
# The $filename arg is a Unix-style relative path, like 'Foo/Bar.pm' |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Readonly::Scalar my $TEMP_FILE_PERMISSIONS => oct 700; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub fcritique_with_violations { |
104
|
27
|
|
|
27
|
1
|
78
|
my($policy, $code_ref, $filename, $config_ref) = @_; |
105
|
27
|
|
|
|
|
193
|
my $c = Perl::Critic->new( -profile => 'NONE' ); |
106
|
27
|
|
|
|
|
125
|
$c->add_policy(-policy => $policy, -config => $config_ref); |
107
|
|
|
|
|
|
|
|
108
|
27
|
|
|
|
|
98
|
my $dir = File::Temp::tempdir( 'PerlCritic-tmpXXXXXX', TMPDIR => 1 ); |
109
|
27
|
|
50
|
|
|
9232
|
$filename ||= 'Temp.pm'; |
110
|
27
|
|
|
|
|
238
|
my @fileparts = File::Spec::Unix->splitdir($filename); |
111
|
27
|
50
|
|
|
|
99
|
if (@fileparts > 1) { |
112
|
0
|
|
|
|
|
0
|
my $subdir = File::Spec->catdir($dir, @fileparts[0..$#fileparts-1]); |
113
|
0
|
|
|
|
|
0
|
File::Path::mkpath($subdir, 0, $TEMP_FILE_PERMISSIONS); |
114
|
|
|
|
|
|
|
} |
115
|
27
|
|
|
|
|
268
|
my $file = File::Spec->catfile($dir, @fileparts); |
116
|
27
|
50
|
|
|
|
1883
|
if (open my $fh, '>', $file) { |
117
|
27
|
|
|
|
|
87
|
print {$fh} ${$code_ref}; |
|
27
|
|
|
|
|
71
|
|
|
27
|
|
|
|
|
444
|
|
118
|
27
|
50
|
|
|
|
1064
|
close $fh or throw_generic "unable to close $file: $OS_ERROR"; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# Use eval so we can clean up before throwing an exception in case of |
122
|
|
|
|
|
|
|
# error. |
123
|
27
|
|
|
|
|
86
|
my @v = eval {$c->critique($file)}; |
|
27
|
|
|
|
|
134
|
|
124
|
27
|
|
|
|
|
5363
|
my $err = $EVAL_ERROR; |
125
|
27
|
|
|
|
|
9724
|
File::Path::rmtree($dir, 0, 1); |
126
|
27
|
50
|
|
|
|
148
|
if ($err) { |
127
|
0
|
|
|
|
|
0
|
throw_generic $err; |
128
|
|
|
|
|
|
|
} |
129
|
27
|
|
|
|
|
736
|
return @v; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
133
|
|
|
|
|
|
|
# Like pcritique, but forces a PPI::Document::File context. The |
134
|
|
|
|
|
|
|
# $filename arg is a Unix-style relative path, like 'Foo/Bar.pm' |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub fcritique { ##no critic(ArgUnpacking) |
137
|
27
|
|
|
27
|
1
|
19861
|
return scalar fcritique_with_violations(@_); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# Note: $include_extras is not documented in the POD because I'm not |
141
|
|
|
|
|
|
|
# committing to the interface yet. |
142
|
|
|
|
|
|
|
sub subtests_in_tree { |
143
|
0
|
|
|
0
|
1
|
0
|
my ($start, $include_extras) = @_; |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
0
|
my %subtests; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
find( |
148
|
|
|
|
|
|
|
{ |
149
|
|
|
|
|
|
|
wanted => sub { |
150
|
0
|
0
|
|
0
|
|
0
|
return if not -f; |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
|
|
0
|
my ($fileroot) = m{(.+)[.]run\z}xms; |
153
|
|
|
|
|
|
|
|
154
|
0
|
0
|
|
|
|
0
|
return if not $fileroot; |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
0
|
my @pathparts = File::Spec->splitdir($fileroot); |
157
|
0
|
0
|
|
|
|
0
|
if (@pathparts < 2) { |
158
|
0
|
|
|
|
|
0
|
throw_internal 'confusing policy test filename ' . $_; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
0
|
my $policy = join q{::}, @pathparts[-2, -1]; ## no critic (MagicNumbers) |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
0
|
my $globals = _globals_from_file( $_ ); |
164
|
0
|
0
|
|
|
|
0
|
if ( my $prerequisites = $globals->{prerequisites} ) { |
165
|
0
|
|
|
|
|
0
|
foreach my $prerequisite ( keys %{$prerequisites} ) { |
|
0
|
|
|
|
|
0
|
|
166
|
0
|
0
|
|
|
|
0
|
eval "require $prerequisite; 1" or return; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
0
|
my @subtests = _subtests_from_file( $_ ); |
171
|
|
|
|
|
|
|
|
172
|
0
|
0
|
|
|
|
0
|
if ($include_extras) { |
173
|
0
|
|
|
|
|
0
|
$subtests{$policy} = |
174
|
|
|
|
|
|
|
{ subtests => [ @subtests ], globals => $globals }; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
else { |
177
|
0
|
|
|
|
|
0
|
$subtests{$policy} = [ @subtests ]; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
0
|
return; |
181
|
|
|
|
|
|
|
}, |
182
|
0
|
|
|
|
|
0
|
no_chdir => 1, |
183
|
|
|
|
|
|
|
}, |
184
|
|
|
|
|
|
|
$start |
185
|
|
|
|
|
|
|
); |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
0
|
return \%subtests; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# Answer whether author test should be run. |
191
|
|
|
|
|
|
|
# |
192
|
|
|
|
|
|
|
# Note: this code is duplicated in |
193
|
|
|
|
|
|
|
# t/tlib/Perl/Critic/TestUtilitiesWithMinimalDependencies.pm. |
194
|
|
|
|
|
|
|
# If you change this here, make sure to change it there. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub should_skip_author_tests { |
197
|
0
|
|
|
0
|
1
|
0
|
return not $ENV{TEST_AUTHOR_PERL_CRITIC}; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub get_author_test_skip_message { |
201
|
|
|
|
|
|
|
## no critic (RequireInterpolation); |
202
|
0
|
|
|
0
|
1
|
0
|
return 'Author test. Set $ENV{TEST_AUTHOR_PERL_CRITIC} to a true value to run.'; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub starting_points_including_examples { |
207
|
0
|
0
|
|
0
|
1
|
0
|
return (-e 'blib' ? 'blib' : 'lib', 'examples'); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub _globals_from_file { |
211
|
0
|
|
|
0
|
|
0
|
my $test_file = shift; |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
0
|
my %valid_keys = hashify qw< prerequisites >; |
214
|
|
|
|
|
|
|
|
215
|
0
|
0
|
|
|
|
0
|
return if -z $test_file; # Skip if the Policy has a regular .t file. |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
0
|
my %globals; |
218
|
|
|
|
|
|
|
|
219
|
0
|
0
|
|
|
|
0
|
open my $handle, '<', $test_file ## no critic (RequireBriefOpen) |
220
|
|
|
|
|
|
|
or throw_internal "Couldn't open $test_file: $OS_ERROR"; |
221
|
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
0
|
while ( my $line = <$handle> ) { |
223
|
0
|
|
|
|
|
0
|
chomp; |
224
|
|
|
|
|
|
|
|
225
|
0
|
0
|
|
|
|
0
|
if ( |
226
|
|
|
|
|
|
|
my ($key,$value) = |
227
|
|
|
|
|
|
|
$line =~ m<\A [#][#] [ ] global [ ] (\S+) (?:\s+(.+))? >xms |
228
|
|
|
|
|
|
|
) { |
229
|
0
|
0
|
|
|
|
0
|
next if not $key; |
230
|
0
|
0
|
|
|
|
0
|
if ( not $valid_keys{$key} ) { |
231
|
0
|
|
|
|
|
0
|
throw_internal "Unknown global key $key in $test_file"; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
0
|
0
|
|
|
|
0
|
if ( $key eq 'prerequisites' ) { |
235
|
0
|
|
|
|
|
0
|
$value = { hashify( words_from_string($value) ) }; |
236
|
|
|
|
|
|
|
} |
237
|
0
|
|
|
|
|
0
|
$globals{$key} = $value; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} |
240
|
0
|
0
|
|
|
|
0
|
close $handle or throw_generic "unable to close $test_file: $OS_ERROR"; |
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
0
|
return \%globals; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# The internal representation of a subtest is just a hash with some |
246
|
|
|
|
|
|
|
# named keys. It could be an object with accessors for safety's sake, |
247
|
|
|
|
|
|
|
# but at this point I don't see why. |
248
|
|
|
|
|
|
|
sub _subtests_from_file { |
249
|
0
|
|
|
0
|
|
0
|
my $test_file = shift; |
250
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
0
|
my %valid_keys = hashify qw( name failures parms TODO error filename optional_modules ); |
252
|
|
|
|
|
|
|
|
253
|
0
|
0
|
|
|
|
0
|
return if -z $test_file; # Skip if the Policy has a regular .t file. |
254
|
|
|
|
|
|
|
|
255
|
0
|
0
|
|
|
|
0
|
open my $fh, '<', $test_file ## no critic (RequireBriefOpen) |
256
|
|
|
|
|
|
|
or throw_internal "Couldn't open $test_file: $OS_ERROR"; |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
0
|
my @subtests; |
259
|
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
0
|
my $incode = 0; |
261
|
0
|
|
|
|
|
0
|
my $cut_in_code = 0; |
262
|
0
|
|
|
|
|
0
|
my $subtest; |
263
|
|
|
|
|
|
|
my $lineno; |
264
|
0
|
|
|
|
|
0
|
while ( <$fh> ) { |
265
|
0
|
|
|
|
|
0
|
++$lineno; |
266
|
0
|
|
|
|
|
0
|
chomp; |
267
|
0
|
|
|
|
|
0
|
my $inheader = /^## name/ .. /^## cut/; ## no critic (ExtendedFormatting LineBoundaryMatching DotMatchAnything) |
268
|
|
|
|
|
|
|
|
269
|
0
|
|
|
|
|
0
|
my $line = $_; |
270
|
|
|
|
|
|
|
|
271
|
0
|
0
|
|
|
|
0
|
if ( $inheader ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
272
|
0
|
0
|
|
|
|
0
|
$line =~ m/\A [#]/xms or throw_internal "Code before cut: $test_file"; |
273
|
0
|
|
|
|
|
0
|
my ($key,$value) = $line =~ m/\A [#][#] [ ] (\S+) (?:\s+(.+))? /xms; |
274
|
0
|
0
|
|
|
|
0
|
next if !$key; |
275
|
0
|
0
|
|
|
|
0
|
next if $key eq 'cut'; |
276
|
0
|
0
|
|
|
|
0
|
if ( not $valid_keys{$key} ) { |
277
|
0
|
|
|
|
|
0
|
throw_internal "Unknown key $key in $test_file"; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
0
|
0
|
|
|
|
0
|
if ( $key eq 'name' ) { |
281
|
0
|
0
|
|
|
|
0
|
if ( $subtest ) { # Stash any current subtest |
282
|
0
|
|
|
|
|
0
|
push @subtests, _finalize_subtest( $subtest ); |
283
|
0
|
|
|
|
|
0
|
undef $subtest; |
284
|
|
|
|
|
|
|
} |
285
|
0
|
|
|
|
|
0
|
$subtest->{lineno} = $lineno; |
286
|
0
|
|
|
|
|
0
|
$incode = 0; |
287
|
0
|
|
|
|
|
0
|
$cut_in_code = 0; |
288
|
|
|
|
|
|
|
} |
289
|
0
|
0
|
|
|
|
0
|
if ($incode) { |
290
|
0
|
|
|
|
|
0
|
throw_internal "Header line found while still in code: $test_file"; |
291
|
|
|
|
|
|
|
} |
292
|
0
|
|
|
|
|
0
|
$subtest->{$key} = $value; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
elsif ( $subtest ) { |
295
|
0
|
|
|
|
|
0
|
$incode = 1; |
296
|
0
|
|
0
|
|
|
0
|
$cut_in_code ||= $line =~ m/ \A [#][#] [ ] cut \z /smx; |
297
|
|
|
|
|
|
|
# Don't start a subtest if we're not in one. |
298
|
|
|
|
|
|
|
# Don't add to the test if we have seen a '## cut'. |
299
|
0
|
0
|
|
|
|
0
|
$cut_in_code or push @{$subtest->{code}}, $line; |
|
0
|
|
|
|
|
0
|
|
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
elsif (@subtests) { |
302
|
|
|
|
|
|
|
## don't complain if we have not yet hit the first test |
303
|
0
|
|
|
|
|
0
|
throw_internal "Got some code but I'm not in a subtest: $test_file"; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
} |
306
|
0
|
0
|
|
|
|
0
|
close $fh or throw_generic "unable to close $test_file: $OS_ERROR"; |
307
|
0
|
0
|
|
|
|
0
|
if ( $subtest ) { |
308
|
0
|
0
|
|
|
|
0
|
if ( $incode ) { |
309
|
0
|
|
|
|
|
0
|
push @subtests, _finalize_subtest( $subtest ); |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
else { |
312
|
0
|
|
|
|
|
0
|
throw_internal "Incomplete subtest in $test_file"; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
0
|
|
|
|
|
0
|
return @subtests; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub _finalize_subtest { |
320
|
0
|
|
|
0
|
|
0
|
my $subtest = shift; |
321
|
|
|
|
|
|
|
|
322
|
0
|
0
|
|
|
|
0
|
if ( $subtest->{code} ) { |
323
|
0
|
|
|
|
|
0
|
$subtest->{code} = join "\n", @{$subtest->{code}}; |
|
0
|
|
|
|
|
0
|
|
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
else { |
326
|
0
|
|
|
|
|
0
|
throw_internal "$subtest->{name} has no code lines"; |
327
|
|
|
|
|
|
|
} |
328
|
0
|
0
|
|
|
|
0
|
if ( !defined $subtest->{failures} ) { |
329
|
0
|
|
|
|
|
0
|
throw_internal "$subtest->{name} does not specify failures"; |
330
|
|
|
|
|
|
|
} |
331
|
0
|
0
|
|
|
|
0
|
if ($subtest->{parms}) { |
332
|
0
|
|
|
|
|
0
|
$subtest->{parms} = eval $subtest->{parms}; ## no critic(StringyEval) |
333
|
0
|
0
|
|
|
|
0
|
if ($EVAL_ERROR) { |
334
|
0
|
|
|
|
|
0
|
throw_internal |
335
|
|
|
|
|
|
|
"$subtest->{name} has an error in the 'parms' property:\n" |
336
|
|
|
|
|
|
|
. $EVAL_ERROR; |
337
|
|
|
|
|
|
|
} |
338
|
0
|
0
|
|
|
|
0
|
if ('HASH' ne ref $subtest->{parms}) { |
339
|
0
|
|
|
|
|
0
|
throw_internal |
340
|
|
|
|
|
|
|
"$subtest->{name} 'parms' did not evaluate to a hashref"; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} else { |
343
|
0
|
|
|
|
|
0
|
$subtest->{parms} = {}; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
0
|
0
|
|
|
|
0
|
if (defined $subtest->{error}) { |
347
|
0
|
0
|
|
|
|
0
|
if ( $subtest->{error} =~ m{ \A / (.*) / \z }xms) { |
348
|
0
|
|
|
|
|
0
|
$subtest->{error} = eval {qr/$1/}; ## no critic (ExtendedFormatting LineBoundaryMatching DotMatchAnything) |
|
0
|
|
|
|
|
0
|
|
349
|
0
|
0
|
|
|
|
0
|
if ($EVAL_ERROR) { |
350
|
0
|
|
|
|
|
0
|
throw_internal |
351
|
|
|
|
|
|
|
"$subtest->{name} 'error' has a malformed regular expression"; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
0
|
return $subtest; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub bundled_policy_names { |
360
|
6
|
|
|
6
|
1
|
5756
|
require ExtUtils::Manifest; |
361
|
6
|
|
|
|
|
36387
|
my $manifest = ExtUtils::Manifest::maniread(); |
362
|
6
|
|
|
|
|
33917
|
my @policy_paths = map {m{\A lib/(Perl/Critic/Policy/.*).pm \z}xms} keys %{$manifest}; |
|
2580
|
|
|
|
|
4126
|
|
|
6
|
|
|
|
|
351
|
|
363
|
6
|
|
|
|
|
117
|
my @policies = map { join q{::}, split m{/}xms } @policy_paths; |
|
870
|
|
|
|
|
2967
|
|
364
|
6
|
|
|
|
|
424
|
my @sorted_policies = sort @policies; |
365
|
6
|
|
|
|
|
764
|
return @sorted_policies; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub names_of_policies_willing_to_work { |
369
|
1
|
|
|
1
|
1
|
9
|
my %configuration = @_; |
370
|
|
|
|
|
|
|
|
371
|
1
|
|
|
|
|
15
|
my @policies_willing_to_work = |
372
|
|
|
|
|
|
|
Perl::Critic::Config |
373
|
|
|
|
|
|
|
->new( %configuration ) |
374
|
|
|
|
|
|
|
->policies(); |
375
|
|
|
|
|
|
|
|
376
|
1
|
|
|
|
|
134
|
return map { ref } @policies_willing_to_work; |
|
143
|
|
|
|
|
1872
|
|
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
1; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
__END__ |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=pod |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=for stopwords RCS subtest subtests |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=head1 NAME |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
Perl::Critic::TestUtils - Utility functions for testing new Policies. |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=head1 INTERFACE SUPPORT |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
This is considered to be a public module. Any changes to its |
397
|
|
|
|
|
|
|
interface will go through a deprecation cycle. |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head1 SYNOPSIS |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
use Perl::Critic::TestUtils qw(critique pcritique fcritique); |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
my $code = '<<END_CODE'; |
405
|
|
|
|
|
|
|
package Foo::Bar; |
406
|
|
|
|
|
|
|
$foo = frobulator(); |
407
|
|
|
|
|
|
|
$baz = $foo ** 2; |
408
|
|
|
|
|
|
|
1; |
409
|
|
|
|
|
|
|
END_CODE |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# Critique code against all loaded policies... |
412
|
|
|
|
|
|
|
my $perl_critic_config = { -severity => 2 }; |
413
|
|
|
|
|
|
|
my $violation_count = critique( \$code, $perl_critic_config); |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
# Critique code against one policy... |
416
|
|
|
|
|
|
|
my $custom_policy = 'Miscellanea::ProhibitFrobulation' |
417
|
|
|
|
|
|
|
my $violation_count = pcritique( $custom_policy, \$code ); |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# Critique code against one filename-related policy... |
420
|
|
|
|
|
|
|
my $custom_policy = 'Modules::RequireFilenameMatchesPackage' |
421
|
|
|
|
|
|
|
my $violation_count = fcritique( $custom_policy, \$code, 'Foo/Bar.pm' ); |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head1 DESCRIPTION |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
This module is used by L<Perl::Critic|Perl::Critic> only for |
427
|
|
|
|
|
|
|
self-testing. It provides a few handy subroutines for testing new |
428
|
|
|
|
|
|
|
Perl::Critic::Policy modules. Look at the test programs that ship with |
429
|
|
|
|
|
|
|
Perl::Critic for more examples of how to use these subroutines. |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head1 EXPORTS |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=over |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=item assert_version( $version ) |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
Asserts that the C<$version> passed matches the version of Perl::Critic. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=item block_perlcriticrc() |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
If a user has a F<~/.perlcriticrc> file, this can interfere with |
444
|
|
|
|
|
|
|
testing. This handy method disables the search for that file -- |
445
|
|
|
|
|
|
|
simply call it at the top of your F<.t> program. Note that this is |
446
|
|
|
|
|
|
|
not easily reversible, but that should not matter. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=item critique_with_violations( $code_string_ref, $config_ref ) |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
Test a block of code against the specified Perl::Critic::Config |
452
|
|
|
|
|
|
|
instance (or C<undef> for the default). Returns the violations that |
453
|
|
|
|
|
|
|
occurred. |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=item critique( $code_string_ref, $config_ref ) |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
Test a block of code against the specified Perl::Critic::Config |
459
|
|
|
|
|
|
|
instance (or C<undef> for the default). Returns the number of |
460
|
|
|
|
|
|
|
violations that occurred. |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=item pcritique_with_violations( $policy_name, $code_string_ref, $config_ref ) |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
Like C<critique_with_violations()>, but tests only a single policy |
466
|
|
|
|
|
|
|
instead of the whole bunch. |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=item pcritique( $policy_name, $code_string_ref, $config_ref ) |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
Like C<critique()>, but tests only a single policy instead of the |
472
|
|
|
|
|
|
|
whole bunch. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=item fcritique_with_violations( $policy_name, $code_string_ref, $filename, $config_ref ) |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
Like C<pcritique_with_violations()>, but pretends that the code was |
478
|
|
|
|
|
|
|
loaded from the specified filename. This is handy for testing |
479
|
|
|
|
|
|
|
policies like C<Modules::RequireFilenameMatchesPackage> which care |
480
|
|
|
|
|
|
|
about the filename that the source derived from. |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
The C<$filename> parameter must be a relative path, not absolute. The |
483
|
|
|
|
|
|
|
file and all necessary subdirectories will be created via |
484
|
|
|
|
|
|
|
L<File::Temp|File::Temp> and will be automatically deleted. |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=item fcritique( $policy_name, $code_string_ref, $filename, $config_ref ) |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Like C<pcritique()>, but pretends that the code was loaded from the |
490
|
|
|
|
|
|
|
specified filename. This is handy for testing policies like |
491
|
|
|
|
|
|
|
C<Modules::RequireFilenameMatchesPackage> which care about the |
492
|
|
|
|
|
|
|
filename that the source derived from. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
The C<$filename> parameter must be a relative path, not absolute. The |
495
|
|
|
|
|
|
|
file and all necessary subdirectories will be created via |
496
|
|
|
|
|
|
|
L<File::Temp|File::Temp> and will be automatically deleted. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=item subtests_in_tree( $dir ) |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
Searches the specified directory recursively for F<.run> files. Each |
502
|
|
|
|
|
|
|
one found is parsed and a hash-of-list-of-hashes is returned. The |
503
|
|
|
|
|
|
|
outer hash is keyed on policy short name, like |
504
|
|
|
|
|
|
|
C<Modules::RequireEndWithOne>. The inner hash specifies a single test |
505
|
|
|
|
|
|
|
to be handed to C<pcritique()> or C<fcritique()>, including the code |
506
|
|
|
|
|
|
|
string, test name, etc. See below for the syntax of the F<.run> |
507
|
|
|
|
|
|
|
files. |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=item should_skip_author_tests() |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
Answers whether author tests should run. |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=item get_author_test_skip_message() |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
Returns a string containing the message that should be emitted when a |
518
|
|
|
|
|
|
|
test is skipped due to it being an author test when author tests are |
519
|
|
|
|
|
|
|
not enabled. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=item starting_points_including_examples() |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
Returns a list of the directories contain code that needs to be tested |
525
|
|
|
|
|
|
|
when it is desired that the examples be included. |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=item bundled_policy_names() |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Returns a list of Policy packages that come bundled with this package. |
531
|
|
|
|
|
|
|
This functions by searching F<MANIFEST> for |
532
|
|
|
|
|
|
|
F<lib/Perl/Critic/Policy/*.pm> and converts the results to package |
533
|
|
|
|
|
|
|
names. |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=item names_of_policies_willing_to_work( %configuration ) |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
Returns a list of the packages of policies that are willing to |
539
|
|
|
|
|
|
|
function on the current system using the specified configuration. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=back |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=head1 F<.run> file information |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
Testing a policy follows a very simple pattern: |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
* Policy name |
550
|
|
|
|
|
|
|
* Subtest name |
551
|
|
|
|
|
|
|
* Optional parameters |
552
|
|
|
|
|
|
|
* Number of failures expected |
553
|
|
|
|
|
|
|
* Optional exception expected |
554
|
|
|
|
|
|
|
* Optional filename for code |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
Each of the subtests for a policy is collected in a single F<.run> |
557
|
|
|
|
|
|
|
file, with test properties as comments in front of each code block |
558
|
|
|
|
|
|
|
that describes how we expect Perl::Critic to react to the code. For |
559
|
|
|
|
|
|
|
example, say you have a policy called Variables::ProhibitVowels: |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
(In file t/Variables/ProhibitVowels.run) |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
## name Basics |
564
|
|
|
|
|
|
|
## failures 1 |
565
|
|
|
|
|
|
|
## cut |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
my $vrbl_nm = 'foo'; # Good, vowel-free name |
568
|
|
|
|
|
|
|
my $wango = 12; # Bad, pronouncable name |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
## name Sometimes Y |
572
|
|
|
|
|
|
|
## failures 1 |
573
|
|
|
|
|
|
|
## cut |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
my $yllw = 0; # "y" not a vowel here |
576
|
|
|
|
|
|
|
my $rhythm = 12; # But here it is |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
These are called "subtests", and two are shown above. The beauty of |
579
|
|
|
|
|
|
|
incorporating multiple subtests in a file is that the F<.run> is |
580
|
|
|
|
|
|
|
itself a (mostly) valid Perl file, and not hidden in a HEREDOC, so |
581
|
|
|
|
|
|
|
your editor's color-coding still works, and it is much easier to work |
582
|
|
|
|
|
|
|
with the code and the POD. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
If you need to pass any configuration parameters for your subtest, do |
585
|
|
|
|
|
|
|
so like this: |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
## parms { allow_y => '0' } |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
Note that all the values in this hash must be strings because that's |
590
|
|
|
|
|
|
|
what Perl::Critic will hand you from a F<.perlcriticrc>. |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
If it's a TODO subtest (probably because of some weird corner of PPI |
593
|
|
|
|
|
|
|
that we exercised that Adam is getting around to fixing, right?), then |
594
|
|
|
|
|
|
|
make a C<##TODO> entry. |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
## TODO Should pass when PPI 1.xxx comes out |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
If the code is expected to trigger an exception in the policy, |
599
|
|
|
|
|
|
|
indicate that like so: |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
## error 1 |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
If you want to test the error message, mark it with C</.../> to |
604
|
|
|
|
|
|
|
indicate a C<like()> test: |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
## error /Can't load Foo::Bar/ |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
If the policy you are testing cares about the filename of the code, |
609
|
|
|
|
|
|
|
you can indicate that C<fcritique> should be used like so (see |
610
|
|
|
|
|
|
|
C<fcritique> for more details): |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
## filename lib/Foo/Bar.pm |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
The value of C<parms> will get C<eval>ed and passed to C<pcritique()>, |
615
|
|
|
|
|
|
|
so be careful. |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
In general, a subtest document runs from the C<## cut> that starts it to |
618
|
|
|
|
|
|
|
either the next C<## name> or the end of the file. In very rare circumstances |
619
|
|
|
|
|
|
|
you may need to end the test document earlier. A second C<## cut> will do |
620
|
|
|
|
|
|
|
this. The only known need for this is in |
621
|
|
|
|
|
|
|
F<t/Miscellanea/RequireRcsKeywords.run>, where it is used to prevent the RCS |
622
|
|
|
|
|
|
|
keywords in the file footer from producing false positives or negatives in the |
623
|
|
|
|
|
|
|
last test. |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
Note that nowhere within the F<.run> file itself do you specify the |
626
|
|
|
|
|
|
|
policy that you're testing. That's implicit within the filename. |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=head1 BUGS AND CAVEATS AND TODO ITEMS |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
Test that we have a t/*/*.run for each lib/*/*.pm |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Allow us to specify the nature of the failures, and which one. If |
634
|
|
|
|
|
|
|
there are 15 lines of code, and six of them fail, how do we know |
635
|
|
|
|
|
|
|
they're the right six? |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=head1 AUTHOR |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
Chris Dolan <cdolan@cpan.org> |
641
|
|
|
|
|
|
|
and the rest of the L<Perl::Critic|Perl::Critic> team. |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=head1 COPYRIGHT |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
Copyright (c) 2005-2023 Chris Dolan. |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
649
|
|
|
|
|
|
|
it under the same terms as Perl itself. The full text of this license |
650
|
|
|
|
|
|
|
can be found in the LICENSE file included with this module. |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
=cut |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
# Local Variables: |
655
|
|
|
|
|
|
|
# mode: cperl |
656
|
|
|
|
|
|
|
# cperl-indent-level: 4 |
657
|
|
|
|
|
|
|
# fill-column: 78 |
658
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
659
|
|
|
|
|
|
|
# c-indentation-style: bsd |
660
|
|
|
|
|
|
|
# End: |
661
|
|
|
|
|
|
|
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : |