Commit | Line | Data |
---|---|---|
e68db767 | 1 | ############################################################################## |
39cd321a JRT |
2 | # $URL$ |
3 | # $Date$ | |
4 | # $Author$ | |
5 | # $Revision$ | |
e68db767 | 6 | ############################################################################## |
39cd321a | 7 | |
59b05e08 JRT |
8 | package Perl::Critic::Policy; |
9 | ||
df6dee2b | 10 | use 5.006001; |
59b05e08 JRT |
11 | use strict; |
12 | use warnings; | |
0f8f6b42 | 13 | |
8c83273d | 14 | use English qw< -no_match_vars >; |
0f8f6b42 | 15 | use Readonly; |
c680a9c9 | 16 | |
2b141872 | 17 | use File::Spec (); |
3fbc79a5 | 18 | use String::Format qw< stringf >; |
c680a9c9 | 19 | |
3fbc79a5 | 20 | use overload ( q<""> => 'to_string', cmp => '_compare' ); |
c680a9c9 | 21 | |
16d279c3 | 22 | use Perl::Critic::Utils qw< |
bbf4108c | 23 | :characters |
985e0116 | 24 | :booleans |
bbf4108c ES |
25 | :severities |
26 | :data_conversion | |
70f3f307 | 27 | interpolate |
3fbc79a5 | 28 | is_integer |
0f8f6b42 | 29 | policy_long_name |
70f3f307 | 30 | policy_short_name |
3fbc79a5 | 31 | severity_to_number |
16d279c3 | 32 | >; |
459ede25 | 33 | use Perl::Critic::Utils::DataConversion qw< dor >; |
b2236a84 ES |
34 | use Perl::Critic::Utils::POD qw< |
35 | get_module_abstract_for_module | |
36 | get_raw_module_abstract_for_module | |
37 | >; | |
0f8f6b42 ES |
38 | use Perl::Critic::Exception::AggregateConfiguration; |
39 | use Perl::Critic::Exception::Configuration; | |
40 | use Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter; | |
41 | use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue; | |
42 | use Perl::Critic::Exception::Fatal::PolicyDefinition | |
43 | qw< throw_policy_definition >; | |
2e568513 | 44 | use Perl::Critic::PolicyConfig qw<>; |
8c83273d | 45 | use Perl::Critic::PolicyParameter qw<>; |
0f8f6b42 ES |
46 | use Perl::Critic::Violation qw<>; |
47 | ||
48 | use Exception::Class; # this must come after "use P::C::Exception::*" | |
59b05e08 | 49 | |
173667ce | 50 | our $VERSION = '1.093_01'; |
59b05e08 | 51 | |
fd5bd7b5 JRT |
52 | #----------------------------------------------------------------------------- |
53 | ||
459ede25 ES |
54 | Readonly::Scalar my $NO_LIMIT => 'no_limit'; |
55 | ||
56 | #----------------------------------------------------------------------------- | |
57 | ||
8c83273d | 58 | my $FORMAT = "%p\n"; #Default stringy format |
0f8f6b42 ES |
59 | |
60 | #----------------------------------------------------------------------------- | |
61 | ||
8c83273d ES |
62 | sub new { |
63 | my ($class, %config) = @_; | |
64 | ||
65 | my $self = bless {}, $class; | |
66 | ||
2e568513 ES |
67 | my $config_object; |
68 | if ($config{_config_object}) { | |
69 | $config_object = $config{_config_object}; | |
70 | } | |
71 | else { | |
72 | $config_object = | |
73 | Perl::Critic::PolicyConfig->new( | |
74 | $self->get_short_name(), | |
75 | \%config, | |
76 | ); | |
77 | } | |
78 | ||
79 | $self->__set_config( $config_object ); | |
8c83273d ES |
80 | |
81 | my @parameters; | |
82 | my $parameter_metadata_available = 0; | |
83 | ||
84 | if ( $class->can('supported_parameters') ) { | |
85 | $parameter_metadata_available = 1; | |
86 | @parameters = | |
87 | map | |
88 | { Perl::Critic::PolicyParameter->new($_) } | |
89 | $class->supported_parameters(); | |
90 | } | |
91 | $self->{_parameter_metadata_available} = $parameter_metadata_available; | |
92 | $self->{_parameters} = \@parameters; | |
93 | ||
94 | my $errors = Perl::Critic::Exception::AggregateConfiguration->new(); | |
95 | foreach my $parameter ( @parameters ) { | |
96 | eval { | |
2e568513 | 97 | $parameter->parse_and_validate_config_value( $self, $config_object ); |
dd813c73 ES |
98 | } |
99 | or do { | |
100 | $errors->add_exception_or_rethrow($EVAL_ERROR); | |
101 | }; | |
8c83273d | 102 | |
2e568513 | 103 | $config_object->remove( $parameter->get_name() ); |
8c83273d ES |
104 | } |
105 | ||
106 | if ($parameter_metadata_available) { | |
2e568513 | 107 | $self->_validate_config_keys($errors, $config_object); |
8c83273d ES |
108 | } |
109 | ||
110 | if ( $errors->has_exceptions() ) { | |
111 | $errors->rethrow(); | |
112 | } | |
113 | ||
114 | return $self; | |
115 | } | |
c2018d77 | 116 | |
6036a254 | 117 | #----------------------------------------------------------------------------- |
59b05e08 | 118 | |
8c83273d ES |
119 | sub initialize_if_enabled { |
120 | return $TRUE; | |
faa35de4 JRT |
121 | } |
122 | ||
6036a254 | 123 | #----------------------------------------------------------------------------- |
9f1d5408 | 124 | |
78afb6d4 ES |
125 | sub prepare_to_scan_document { |
126 | return $TRUE; | |
bb5a5c57 ES |
127 | } |
128 | ||
129 | #----------------------------------------------------------------------------- | |
130 | ||
05e2d404 JRT |
131 | sub can_be_disabled { |
132 | return $TRUE; | |
133 | } | |
134 | ||
135 | #----------------------------------------------------------------------------- | |
136 | ||
8c83273d ES |
137 | sub _validate_config_keys { |
138 | my ( $self, $errors, $config ) = @_; | |
985e0116 | 139 | |
2e568513 | 140 | for my $offered_param ( $config->get_parameter_names() ) { |
8c83273d ES |
141 | $errors->add_exception( |
142 | Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter->new( | |
143 | policy => $self->get_short_name(), | |
144 | option_name => $offered_param, | |
145 | source => undef, | |
146 | ) | |
147 | ); | |
148 | } | |
149 | ||
150 | return; | |
985e0116 ES |
151 | } |
152 | ||
8c83273d | 153 | #----------------------------------------------------------------------------- |
985e0116 | 154 | |
8c83273d ES |
155 | sub __get_parameter_name { |
156 | my ( $self, $parameter ) = @_; | |
985e0116 | 157 | |
8c83273d | 158 | return '_' . $parameter->get_name(); |
985e0116 ES |
159 | } |
160 | ||
161 | #----------------------------------------------------------------------------- | |
162 | ||
8c83273d ES |
163 | sub __set_parameter_value { |
164 | my ( $self, $parameter, $value ) = @_; | |
165 | ||
166 | $self->{ $self->__get_parameter_name($parameter) } = $value; | |
167 | ||
168 | return; | |
985e0116 ES |
169 | } |
170 | ||
171 | #----------------------------------------------------------------------------- | |
172 | ||
3fbc79a5 | 173 | sub __set_base_parameters { |
2e568513 | 174 | my ($self) = @_; |
3fbc79a5 | 175 | |
2e568513 | 176 | my $config = $self->__get_config(); |
3fbc79a5 ES |
177 | my $errors = Perl::Critic::Exception::AggregateConfiguration->new(); |
178 | ||
2e568513 | 179 | $self->_set_maximum_violations_per_document($errors); |
3fbc79a5 | 180 | |
2e568513 | 181 | my $user_severity = $config->get_severity(); |
3fbc79a5 ES |
182 | if ( defined $user_severity ) { |
183 | my $normalized_severity = severity_to_number( $user_severity ); | |
184 | $self->set_severity( $normalized_severity ); | |
185 | } | |
186 | ||
2e568513 | 187 | my $user_set_themes = $config->get_set_themes(); |
3fbc79a5 ES |
188 | if ( defined $user_set_themes ) { |
189 | my @set_themes = words_from_string( $user_set_themes ); | |
190 | $self->set_themes( @set_themes ); | |
191 | } | |
192 | ||
2e568513 | 193 | my $user_add_themes = $config->get_add_themes(); |
3fbc79a5 ES |
194 | if ( defined $user_add_themes ) { |
195 | my @add_themes = words_from_string( $user_add_themes ); | |
196 | $self->add_themes( @add_themes ); | |
197 | } | |
198 | ||
199 | if ( $errors->has_exceptions() ) { | |
200 | $errors->rethrow(); | |
201 | } | |
202 | ||
203 | return; | |
204 | } | |
205 | ||
206 | #----------------------------------------------------------------------------- | |
207 | ||
208 | sub _set_maximum_violations_per_document { | |
2e568513 | 209 | my ($self, $errors) = @_; |
3fbc79a5 | 210 | |
2e568513 ES |
211 | my $config = $self->__get_config(); |
212 | ||
213 | if ( $config->is_maximum_violations_per_document_unlimited() ) { | |
214 | return; | |
215 | } | |
3fbc79a5 | 216 | |
2e568513 ES |
217 | my $user_maximum_violations = |
218 | $config->get_maximum_violations_per_document(); | |
3fbc79a5 | 219 | |
2e568513 ES |
220 | if ( not is_integer($user_maximum_violations) ) { |
221 | $errors->add_exception( | |
222 | new_parameter_value_exception( | |
223 | 'maximum_violations_per_document', | |
224 | $user_maximum_violations, | |
225 | undef, | |
226 | "does not look like an integer.\n" | |
227 | ) | |
228 | ); | |
229 | ||
230 | return; | |
231 | } | |
232 | elsif ( $user_maximum_violations < 0 ) { | |
233 | $errors->add_exception( | |
234 | new_parameter_value_exception( | |
235 | 'maximum_violations_per_document', | |
236 | $user_maximum_violations, | |
237 | undef, | |
238 | "is not greater than or equal to zero.\n" | |
239 | ) | |
3fbc79a5 | 240 | ); |
2e568513 ES |
241 | |
242 | return; | |
3fbc79a5 ES |
243 | } |
244 | ||
2e568513 ES |
245 | $self->set_maximum_violations_per_document( |
246 | $user_maximum_violations | |
247 | ); | |
248 | ||
3fbc79a5 ES |
249 | return; |
250 | } | |
251 | ||
252 | #----------------------------------------------------------------------------- | |
253 | ||
2e568513 | 254 | # Unparsed configuration, P::C::PolicyConfig. Compare with get_parameters(). |
8c83273d ES |
255 | sub __get_config { |
256 | my ($self) = @_; | |
257 | ||
258 | return $self->{_config}; | |
259 | } | |
260 | ||
261 | sub __set_config { | |
262 | my ($self, $config) = @_; | |
263 | ||
264 | $self->{_config} = $config; | |
265 | ||
266 | return; | |
267 | } | |
268 | ||
269 | #----------------------------------------------------------------------------- | |
270 | ||
0f8f6b42 ES |
271 | sub get_long_name { |
272 | my ($self) = @_; | |
273 | ||
274 | return policy_long_name(ref $self); | |
275 | } | |
276 | ||
277 | #----------------------------------------------------------------------------- | |
278 | ||
279 | sub get_short_name { | |
280 | my ($self) = @_; | |
281 | ||
282 | return policy_short_name(ref $self); | |
283 | } | |
284 | ||
285 | #----------------------------------------------------------------------------- | |
286 | ||
faa35de4 JRT |
287 | sub applies_to { |
288 | return qw(PPI::Element); | |
289 | } | |
290 | ||
6036a254 | 291 | #----------------------------------------------------------------------------- |
faa35de4 | 292 | |
16d279c3 ES |
293 | sub set_maximum_violations_per_document { |
294 | my ($self, $maximum_violations_per_document) = @_; | |
295 | ||
296 | $self->{_maximum_violations_per_document} = | |
297 | $maximum_violations_per_document; | |
298 | ||
299 | return $self; | |
300 | } | |
301 | ||
302 | #----------------------------------------------------------------------------- | |
303 | ||
304 | sub get_maximum_violations_per_document { | |
305 | my ($self) = @_; | |
306 | ||
307 | return | |
308 | exists $self->{_maximum_violations_per_document} | |
309 | ? $self->{_maximum_violations_per_document} | |
310 | : $self->default_maximum_violations_per_document(); | |
311 | } | |
312 | ||
313 | #----------------------------------------------------------------------------- | |
314 | ||
315 | sub default_maximum_violations_per_document { | |
316 | return; | |
317 | } | |
318 | ||
319 | #----------------------------------------------------------------------------- | |
320 | ||
faa35de4 JRT |
321 | sub set_severity { |
322 | my ($self, $severity) = @_; | |
323 | $self->{_severity} = $severity; | |
324 | return $self; | |
325 | } | |
326 | ||
6036a254 | 327 | #----------------------------------------------------------------------------- |
faa35de4 JRT |
328 | |
329 | sub get_severity { | |
330 | my ($self) = @_; | |
331 | return $self->{_severity} || $self->default_severity(); | |
332 | } | |
333 | ||
6036a254 | 334 | #----------------------------------------------------------------------------- |
faa35de4 JRT |
335 | |
336 | sub default_severity { | |
337 | return $SEVERITY_LOWEST; | |
338 | } | |
339 | ||
6036a254 | 340 | #----------------------------------------------------------------------------- |
faa35de4 JRT |
341 | |
342 | sub set_themes { | |
343 | my ($self, @themes) = @_; | |
344 | $self->{_themes} = [ sort @themes ]; | |
345 | return $self; | |
346 | } | |
347 | ||
6036a254 | 348 | #----------------------------------------------------------------------------- |
faa35de4 JRT |
349 | |
350 | sub get_themes { | |
351 | my ($self) = @_; | |
7a6b5c70 JRT |
352 | return sort @{ $self->{_themes} } if defined $self->{_themes}; |
353 | return sort $self->default_themes(); | |
faa35de4 JRT |
354 | } |
355 | ||
6036a254 | 356 | #----------------------------------------------------------------------------- |
faa35de4 JRT |
357 | |
358 | sub add_themes { | |
359 | my ($self, @additional_themes) = @_; | |
360 | #By hashifying the themes, we squish duplicates | |
361 | my %merged = hashify( $self->get_themes(), @additional_themes); | |
7a6b5c70 | 362 | $self->{_themes} = [ keys %merged]; |
faa35de4 JRT |
363 | return $self; |
364 | } | |
365 | ||
6036a254 | 366 | #----------------------------------------------------------------------------- |
faa35de4 JRT |
367 | |
368 | sub default_themes { | |
369 | return (); | |
370 | } | |
371 | ||
6036a254 | 372 | #----------------------------------------------------------------------------- |
faa35de4 | 373 | |
c2f5bc1f ES |
374 | sub get_abstract { |
375 | my ($self) = @_; | |
376 | ||
377 | return get_module_abstract_for_module( ref $self ); | |
378 | } | |
379 | ||
380 | #----------------------------------------------------------------------------- | |
381 | ||
b2236a84 ES |
382 | sub get_raw_abstract { |
383 | my ($self) = @_; | |
384 | ||
385 | return get_raw_module_abstract_for_module( ref $self ); | |
386 | } | |
387 | ||
388 | #----------------------------------------------------------------------------- | |
389 | ||
8c83273d ES |
390 | sub parameter_metadata_available { |
391 | my ($self) = @_; | |
392 | ||
393 | return $self->{_parameter_metadata_available}; | |
394 | } | |
395 | ||
396 | #----------------------------------------------------------------------------- | |
397 | ||
398 | sub get_parameters { | |
399 | my ($self) = @_; | |
400 | ||
401 | return $self->{_parameters}; | |
402 | } | |
403 | ||
404 | #----------------------------------------------------------------------------- | |
405 | ||
faa35de4 | 406 | sub violates { |
0f8f6b42 ES |
407 | my ($self) = @_; |
408 | ||
409 | return throw_policy_definition | |
410 | $self->get_short_name() . q/ does not implement violates()./; | |
faa35de4 JRT |
411 | } |
412 | ||
6036a254 | 413 | #----------------------------------------------------------------------------- |
dff08b70 | 414 | |
6e7d6c9f | 415 | sub violation { ##no critic(ArgUnpacking) |
815b71d0 | 416 | my ( $self, $desc, $expl, $elem ) = @_; |
c436bd4d | 417 | # HACK!! Use goto instead of an explicit call because P::C::V::new() uses caller() |
fc89259a CD |
418 | my $sev = $self->get_severity(); |
419 | @_ = ('Perl::Critic::Violation', $desc, $expl, $elem, $sev ); | |
420 | goto &Perl::Critic::Violation::new; | |
815b71d0 AL |
421 | } |
422 | ||
8c83273d ES |
423 | #----------------------------------------------------------------------------- |
424 | ||
3fbc79a5 | 425 | sub new_parameter_value_exception { |
8c83273d ES |
426 | my ( $self, $option_name, $option_value, $source, $message_suffix ) = @_; |
427 | ||
3fbc79a5 | 428 | return Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new( |
8c83273d ES |
429 | policy => $self->get_short_name(), |
430 | option_name => $option_name, | |
431 | option_value => $option_value, | |
432 | source => $source, | |
433 | message_suffix => $message_suffix | |
434 | ); | |
435 | } | |
8c83273d | 436 | |
c2018d77 | 437 | #----------------------------------------------------------------------------- |
0f8f6b42 | 438 | |
3fbc79a5 ES |
439 | ## no critic (Subroutines::RequireFinalReturn) |
440 | sub throw_parameter_value_exception { | |
441 | my ( $self, $option_name, $option_value, $source, $message_suffix ) = @_; | |
442 | ||
443 | $self->new_parameter_value_exception( | |
444 | $option_name, $option_value, $source, $message_suffix | |
445 | ) | |
446 | ->throw(); | |
447 | } | |
448 | ## use critic | |
449 | ||
450 | ||
451 | #----------------------------------------------------------------------------- | |
452 | ||
fd5bd7b5 | 453 | # Static methods. |
c2018d77 | 454 | |
6e7d6c9f | 455 | sub set_format { return $FORMAT = $_[0] } ##no critic(ArgUnpacking) |
1f4dafe4 JRT |
456 | sub get_format { return $FORMAT } |
457 | ||
458 | #----------------------------------------------------------------------------- | |
459 | ||
c2018d77 | 460 | sub to_string { |
6e7d6c9f | 461 | my ($self, @args) = @_; |
c2018d77 JRT |
462 | |
463 | # Wrap the more expensive ones in sub{} to postpone evaluation | |
464 | my %fspec = ( | |
0f8f6b42 ES |
465 | 'P' => sub { $self->get_long_name() }, |
466 | 'p' => sub { $self->get_short_name() }, | |
c2f5bc1f ES |
467 | 'a' => sub { dor($self->get_abstract(), $EMPTY) }, |
468 | 'O' => sub { $self->_format_parameters(@_) }, | |
469 | 'U' => sub { $self->_format_lack_of_parameter_metadata(@_) }, | |
470 | 'S' => sub { $self->default_severity() }, | |
471 | 's' => sub { $self->get_severity() }, | |
c2018d77 JRT |
472 | 'T' => sub { join $SPACE, $self->default_themes() }, |
473 | 't' => sub { join $SPACE, $self->get_themes() }, | |
459ede25 ES |
474 | 'V' => sub { dor( $self->default_maximum_violations_per_document(), $NO_LIMIT ) }, |
475 | 'v' => sub { dor( $self->get_maximum_violations_per_document(), $NO_LIMIT ) }, | |
c2018d77 JRT |
476 | ); |
477 | return stringf($FORMAT, %fspec); | |
478 | } | |
479 | ||
0f8f6b42 | 480 | sub _format_parameters { |
fd5bd7b5 | 481 | my ($self, $format) = @_; |
8c83273d ES |
482 | |
483 | return $EMPTY if not $self->parameter_metadata_available(); | |
484 | ||
485 | my $separator; | |
486 | if ($format) { | |
487 | $separator = $EMPTY; | |
488 | } else { | |
489 | $separator = $SPACE; | |
490 | $format = '%n'; | |
491 | } | |
492 | ||
493 | return | |
494 | join | |
495 | $separator, | |
496 | map { $_->to_formatted_string($format) } @{ $self->get_parameters() }; | |
497 | } | |
498 | ||
499 | sub _format_lack_of_parameter_metadata { | |
500 | my ($self, $message) = @_; | |
501 | ||
502 | return $EMPTY if $self->parameter_metadata_available(); | |
503 | return interpolate($message) if $message; | |
504 | ||
505 | return | |
506 | 'Cannot programmatically discover what parameters this policy takes.'; | |
fd5bd7b5 JRT |
507 | } |
508 | ||
2b141872 ES |
509 | sub _get_source_file { |
510 | my ($self) = @_; | |
511 | ||
512 | my $relative_path = | |
513 | File::Spec->catfile( split m/::/xms, ref $self ) . '.pm'; | |
514 | ||
515 | return $INC{$relative_path}; | |
516 | } | |
517 | ||
b67a8c74 | 518 | |
c2018d77 JRT |
519 | #----------------------------------------------------------------------------- |
520 | # Apparently, some perls do not implicitly stringify overloading | |
521 | # objects before doing a comparison. This causes a couple of our | |
522 | # sorting tests to fail. To work around this, we overload C<cmp> to | |
523 | # do it explicitly. | |
524 | # | |
525 | # 20060503 - More information: This problem has been traced to | |
526 | # Test::Simple versions <= 0.60, not perl itself. Upgrading to | |
527 | # Test::Simple v0.62 will fix the problem. But rather than forcing | |
528 | # everyone to upgrade, I have decided to leave this workaround in | |
529 | # place. | |
530 | ||
531 | sub _compare { return "$_[0]" cmp "$_[1]" } | |
532 | ||
59b05e08 JRT |
533 | 1; |
534 | ||
535 | __END__ | |
536 | ||
6036a254 | 537 | #----------------------------------------------------------------------------- |
9f1d5408 | 538 | |
59b05e08 JRT |
539 | =pod |
540 | ||
541 | =head1 NAME | |
542 | ||
c728943a | 543 | Perl::Critic::Policy - Base class for all Policy modules. |
59b05e08 | 544 | |
16d279c3 | 545 | |
59b05e08 JRT |
546 | =head1 DESCRIPTION |
547 | ||
548 | Perl::Critic::Policy is the abstract base class for all Policy | |
6bf9b465 JRT |
549 | objects. If you're developing your own Policies, your job is to |
550 | implement and override its methods in a subclass. To work with the | |
11f53956 ES |
551 | L<Perl::Critic|Perl::Critic> engine, your implementation must behave |
552 | as described below. For a detailed explanation on how to make new | |
553 | Policy modules, please see the | |
554 | L<Perl::Critic::DEVELOPER|Perl::Critic::DEVELOPER> document included | |
555 | in this distribution. | |
59b05e08 | 556 | |
16d279c3 | 557 | |
59b05e08 JRT |
558 | =head1 METHODS |
559 | ||
16d279c3 | 560 | =over |
59b05e08 | 561 | |
8c050cac | 562 | =item C<< new(key1 => value1, key2 => value2 ... ) >> |
59b05e08 | 563 | |
985e0116 ES |
564 | Returns a reference to a new subclass of Perl::Critic::Policy. If your |
565 | Policy requires any special arguments, they will be passed in here as | |
11f53956 ES |
566 | key-value pairs. Users of L<perlcritic|perlcritic> can specify these |
567 | in their config file. Unless you override the C<new> method, the | |
568 | default method simply returns a reference to an empty hash that has | |
569 | been blessed into your subclass. However, you really should not | |
570 | override this; override C<initialize_if_enabled()> instead. | |
985e0116 ES |
571 | |
572 | This constructor is always called regardless of whether the user has | |
573 | enabled this Policy or not. | |
574 | ||
16d279c3 | 575 | |
bb5a5c57 | 576 | =item C<< initialize_if_enabled( $config ) >> |
985e0116 | 577 | |
bb5a5c57 ES |
578 | This receives an instance of |
579 | L<Perl::Critic::PolicyConfig|Perl::Critic::PolicyConfig> as a | |
580 | parameter, and is only invoked if this Policy is enabled by the user. | |
985e0116 ES |
581 | Thus, this is the preferred place for subclasses to do any |
582 | initialization. | |
583 | ||
584 | Implementations of this method should return a boolean value | |
585 | indicating whether the Policy should continue to be enabled. For most | |
586 | subclasses, this will always be C<$TRUE>. Policies that depend upon | |
587 | external modules or other system facilities that may or may not be | |
588 | available should test for the availability of these dependencies and | |
589 | return C<$FALSE> if they are not. | |
59b05e08 | 590 | |
16d279c3 | 591 | |
78afb6d4 | 592 | =item C<< prepare_to_scan_document( $document ) >> |
bb5a5c57 | 593 | |
78afb6d4 ES |
594 | The parameter is about to be scanned by this Policy. Whatever this |
595 | Policy wants to do in terms of preparation should happen here. | |
596 | Returns a boolean value indicating whether the document should be | |
597 | scanned at all; if this is a false value, this Policy won't be applied | |
598 | to the document. By default, does nothing but return C<$TRUE>. | |
bb5a5c57 ES |
599 | |
600 | ||
8c050cac | 601 | =item C< violates( $element, $document ) > |
59b05e08 | 602 | |
11f53956 ES |
603 | Given a L<PPI::Element|PPI::Element> and a |
604 | L<PPI::Document|PPI::Document>, returns one or more | |
605 | L<Perl::Critic::Violation|Perl::Critic::Violation> objects if the | |
606 | C<$element> violates this Policy. If there are no violations, then it | |
607 | returns an empty list. If the Policy encounters an exception, then it | |
608 | should C<croak> with an error message and let the caller decide how to | |
609 | handle it. | |
59b05e08 | 610 | |
9f1d5408 JRT |
611 | C<violates()> is an abstract method and it will abort if you attempt |
612 | to invoke it directly. It is the heart of all Policy modules, and | |
613 | your subclass B<must> override this method. | |
59b05e08 | 614 | |
16d279c3 | 615 | |
8c050cac | 616 | =item C< violation( $description, $explanation, $element ) > |
815b71d0 AL |
617 | |
618 | Returns a reference to a new C<Perl::Critic::Violation> object. The | |
619 | arguments are a description of the violation (as string), an | |
620 | explanation for the policy (as string) or a series of page numbers in | |
11f53956 ES |
621 | PBP (as an ARRAY ref), a reference to the L<PPI|PPI> element that |
622 | caused the violation. | |
815b71d0 | 623 | |
11f53956 ES |
624 | These are the same as the constructor to |
625 | L<Perl::Critic::Violation|Perl::Critic::Violation>, but without the | |
626 | severity. The Policy itself knows the severity. | |
815b71d0 | 627 | |
16d279c3 | 628 | |
3fbc79a5 ES |
629 | =item C< new_parameter_value_exception( $option_name, $option_value, $source, $message_suffix ) > |
630 | ||
631 | Create a | |
11f53956 | 632 | L<Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue|Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue> |
3fbc79a5 ES |
633 | for this Policy. |
634 | ||
635 | ||
8c83273d ES |
636 | =item C< throw_parameter_value_exception( $option_name, $option_value, $source, $message_suffix ) > |
637 | ||
638 | Create and throw a | |
11f53956 | 639 | L<Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue|Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue>. |
8c83273d ES |
640 | Useful in parameter parser implementations. |
641 | ||
16d279c3 | 642 | |
0f8f6b42 ES |
643 | =item C< get_long_name() > |
644 | ||
645 | Return the full package name of this policy. | |
646 | ||
16d279c3 | 647 | |
0f8f6b42 ES |
648 | =item C< get_short_name() > |
649 | ||
650 | Return the name of this policy without the "Perl::Critic::Policy::" | |
651 | prefix. | |
652 | ||
16d279c3 | 653 | |
8c050cac | 654 | =item C< applies_to() > |
bf159007 | 655 | |
9f1d5408 JRT |
656 | Returns a list of the names of PPI classes that this Policy cares |
657 | about. By default, the result is C<PPI::Element>. Overriding this | |
658 | method in Policy subclasses should lead to significant performance | |
659 | increases. | |
660 | ||
16d279c3 ES |
661 | |
662 | =item C< default_maximum_violations_per_document() > | |
663 | ||
664 | Returns the default maximum number of violations for this policy to | |
665 | report per document. By default, this not defined, but subclasses may | |
666 | override this. | |
667 | ||
668 | ||
669 | =item C< get_maximum_violations_per_document() > | |
670 | ||
671 | Returns the maximum number of violations this policy will report for a | |
672 | single document. If this is not defined, then there is no limit. If | |
673 | L<set_maximum_violations_per_document()> has not been invoked, then | |
674 | L<default_maximum_violations_per_document()> is returned. | |
675 | ||
676 | ||
677 | =item C< set_maximum_violations_per_document() > | |
678 | ||
679 | Specify the maximum violations that this policy should report for a | |
680 | document. | |
681 | ||
682 | ||
8c050cac | 683 | =item C< default_severity() > |
9f1d5408 JRT |
684 | |
685 | Returns the default severity for violating this Policy. See the | |
11f53956 ES |
686 | C<$SEVERITY> constants in L<Perl::Critic::Utils|Perl::Critic::Utils> |
687 | for an enumeration of possible severity values. By default, this | |
688 | method returns C<$SEVERITY_LOWEST>. Authors of Perl::Critic::Policy | |
689 | subclasses should override this method to return a value that they | |
690 | feel is appropriate for their Policy. In general, Polices that are | |
691 | widely accepted or tend to prevent bugs should have a higher severity | |
692 | than those that are more subjective or cosmetic in nature. | |
9f1d5408 | 693 | |
16d279c3 | 694 | |
8c050cac | 695 | =item C< get_severity() > |
9f1d5408 JRT |
696 | |
697 | Returns the severity of violating this Policy. If the severity has | |
698 | not been explicitly defined by calling C<set_severity>, then the | |
699 | C<default_severity> is returned. See the C<$SEVERITY> constants in | |
11f53956 ES |
700 | L<Perl::Critic::Utils|Perl::Critic::Utils> for an enumeration of |
701 | possible severity values. | |
9f1d5408 | 702 | |
16d279c3 | 703 | |
8c050cac | 704 | =item C< set_severity( $N ) > |
9f1d5408 JRT |
705 | |
706 | Sets the severity for violating this Policy. Clients of | |
707 | Perl::Critic::Policy objects can call this method to assign a | |
708 | different severity to the Policy if they don't agree with the | |
709 | C<default_severity>. See the C<$SEVERITY> constants in | |
11f53956 ES |
710 | L<Perl::Critic::Utils|Perl::Critic::Utils> for an enumeration of |
711 | possible values. | |
dff08b70 | 712 | |
16d279c3 | 713 | |
8c050cac | 714 | =item C< default_themes() > |
faa35de4 JRT |
715 | |
716 | Returns a sorted list of the default themes associated with this | |
717 | Policy. The default method returns an empty list. Policy authors | |
718 | should override this method to return a list of themes that are | |
719 | appropriate for their policy. | |
720 | ||
16d279c3 | 721 | |
8c050cac | 722 | =item C< get_themes() > |
faa35de4 JRT |
723 | |
724 | Returns a sorted list of the themes associated with this Policy. If | |
dc93df4f | 725 | you haven't added themes or set the themes explicitly, this method |
faa35de4 JRT |
726 | just returns the default themes. |
727 | ||
16d279c3 | 728 | |
8c050cac | 729 | =item C< set_themes( @THEME_LIST ) > |
faa35de4 JRT |
730 | |
731 | Sets the themes associated with this Policy. Any existing themes are | |
732 | overwritten. Duplicate themes will be removed. | |
733 | ||
16d279c3 | 734 | |
8c050cac | 735 | =item C< add_themes( @THEME_LIST ) > |
faa35de4 JRT |
736 | |
737 | Appends additional themes to this Policy. Any existing themes are | |
738 | preserved. Duplicate themes will be removed. | |
739 | ||
05e2d404 JRT |
740 | =item C< can_be_disabled() > |
741 | ||
742 | Returns a true value if this Policy can be disabled by a C<"## no critic"> | |
743 | marker. The default method returns true. Most Policies should never need | |
744 | to override this. But If you want to write a policy that cannot be disabled, | |
745 | override this method to return false. Note that this only affects the | |
746 | C<"## no critic"> markers -- the Policy can still be disabled via the | |
747 | F<.perlcriticrc> file. | |
16d279c3 | 748 | |
c2f5bc1f ES |
749 | =item C< get_abstract() > |
750 | ||
751 | Retrieve the abstract for this policy (the part of the NAME section of | |
752 | the POD after the module name), if it is available. | |
753 | ||
754 | ||
b2236a84 ES |
755 | =item C< get_raw_abstract() > |
756 | ||
757 | Retrieve the abstract for this policy (the part of the NAME section of | |
758 | the POD after the module name), if it is available, in the unparsed | |
759 | form. | |
760 | ||
761 | ||
8c83273d ES |
762 | =item C< parameter_metadata_available() > |
763 | ||
764 | Returns whether information about the parameters is available. | |
765 | ||
16d279c3 | 766 | |
8c83273d ES |
767 | =item C< get_parameters() > |
768 | ||
769 | Returns a reference to an array containing instances of | |
11f53956 | 770 | L<Perl::Critic::PolicyParameter|Perl::Critic::PolicyParameter>. |
8c83273d ES |
771 | |
772 | Note that this will return an empty list if the parameters for this | |
773 | policy are unknown. In order to differentiate between this | |
774 | circumstance and the one where this policy does not take any | |
775 | parameters, it is necessary to call C<parameter_metadata_available()>. | |
776 | ||
16d279c3 | 777 | |
8c83273d ES |
778 | =item C< get_parameter( $parameter_name ) > |
779 | ||
11f53956 ES |
780 | Returns the |
781 | L<Perl::Critic::PolicyParameter|Perl::Critic::PolicyParameter> with | |
782 | the specified name. | |
8c83273d | 783 | |
16d279c3 | 784 | |
1f4dafe4 JRT |
785 | =item C<set_format( $FORMAT )> |
786 | ||
0f8f6b42 ES |
787 | Class method. Sets the format for all Policy objects when they are |
788 | evaluated in string context. The default is C<"%p\n">. See | |
789 | L<"OVERLOADS"> for formatting options. | |
1f4dafe4 | 790 | |
16d279c3 | 791 | |
1f4dafe4 JRT |
792 | =item C<get_format()> |
793 | ||
0f8f6b42 ES |
794 | Class method. Returns the current format for all Policy objects when |
795 | they are evaluated in string context. | |
1f4dafe4 | 796 | |
16d279c3 | 797 | |
14a6a3ef CD |
798 | =item C<to_string()> |
799 | ||
800 | Returns a string representation of the policy. The content of the | |
801 | string depends on the current value of the C<$FORMAT> package | |
802 | variable. See L<"OVERLOADS"> for the details. | |
803 | ||
16d279c3 | 804 | |
59b05e08 JRT |
805 | =back |
806 | ||
16d279c3 | 807 | |
59b05e08 JRT |
808 | =head1 DOCUMENTATION |
809 | ||
11f53956 ES |
810 | When your Policy module first C<use>s |
811 | L<Perl::Critic::Violation|Perl::Critic::Violation>, it will try and | |
812 | extract the DESCRIPTION section of your Policy module's POD. This | |
813 | information is displayed by Perl::Critic if the verbosity level is set | |
814 | accordingly. Therefore, please include a DESCRIPTION section in the | |
815 | POD for any Policy modules that you author. Thanks. | |
59b05e08 | 816 | |
16d279c3 | 817 | |
14a6a3ef CD |
818 | =head1 OVERLOADS |
819 | ||
820 | Perl::Critic::Violation overloads the C<""> operator to produce neat | |
821 | little messages when evaluated in string context. The format depends | |
822 | on the current value of the C<$FORMAT> package variable. | |
823 | ||
824 | Formats are a combination of literal and escape characters similar to | |
825 | the way C<sprintf> works. If you want to know the specific formatting | |
11f53956 ES |
826 | capabilities, look at L<String::Format|String::Format>. Valid escape |
827 | characters are: | |
14a6a3ef | 828 | |
16d279c3 | 829 | |
fc5b8cef ES |
830 | =over |
831 | ||
c2f5bc1f ES |
832 | =item C<%P> |
833 | ||
834 | Name of the Policy module. | |
835 | ||
836 | ||
837 | =item C<%p> | |
838 | ||
839 | Name of the Policy without the C<Perl::Critic::Policy::> prefix. | |
840 | ||
841 | ||
842 | =item C<%a> | |
843 | ||
844 | The policy abstract. | |
845 | ||
846 | ||
fc5b8cef ES |
847 | =item C<%O> |
848 | ||
8c83273d ES |
849 | List of supported policy parameters. Takes an option of a format |
850 | string for L<Perl::Critic::PolicyParameter/"to_formatted_string">. | |
851 | For example, this can be used like C<%{%n - %d\n}O> to get a list of | |
852 | parameter names followed by their descriptions. | |
853 | ||
16d279c3 | 854 | |
8c83273d ES |
855 | =item C<%U> |
856 | ||
857 | A message stating that the parameters for the policy are unknown if | |
858 | C<parameter_metadata_available()> returns false. Takes an option of | |
859 | what the message should be, which defaults to "Cannot programmatically | |
860 | discover what parameters this policy takes.". The value of this | |
861 | option is interpolated in order to expand the standard escape | |
862 | sequences (C<\n>, C<\t>, etc.). | |
fc5b8cef | 863 | |
16d279c3 | 864 | |
fc5b8cef ES |
865 | =item C<%S> |
866 | ||
867 | The default severity level of the policy. | |
868 | ||
16d279c3 | 869 | |
fc5b8cef ES |
870 | =item C<%s> |
871 | ||
872 | The current severity level of the policy. | |
873 | ||
16d279c3 | 874 | |
fc5b8cef ES |
875 | =item C<%T> |
876 | ||
877 | The default themes for the policy. | |
878 | ||
16d279c3 | 879 | |
fc5b8cef ES |
880 | =item C<%t> |
881 | ||
882 | The current themes for the policy. | |
883 | ||
16d279c3 | 884 | |
c2f5bc1f ES |
885 | =item C<%V> |
886 | ||
887 | The default maximum number of violations per document of the policy. | |
888 | ||
889 | ||
890 | =item C<%v> | |
891 | ||
892 | The current maximum number of violations per document of the policy. | |
893 | ||
894 | ||
fc5b8cef ES |
895 | =back |
896 | ||
14a6a3ef | 897 | |
59b05e08 JRT |
898 | =head1 AUTHOR |
899 | ||
900 | Jeffrey Ryan Thalhammer <thaljef@cpan.org> | |
901 | ||
16d279c3 | 902 | |
59b05e08 JRT |
903 | =head1 COPYRIGHT |
904 | ||
20dfddeb | 905 | Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved. |
59b05e08 JRT |
906 | |
907 | This program is free software; you can redistribute it and/or modify | |
908 | it under the same terms as Perl itself. The full text of this license | |
909 | can be found in the LICENSE file included with this module. | |
910 | ||
911 | =cut | |
737d3b65 CD |
912 | |
913 | # Local Variables: | |
914 | # mode: cperl | |
915 | # cperl-indent-level: 4 | |
916 | # fill-column: 78 | |
917 | # indent-tabs-mode: nil | |
918 | # c-indentation-style: bsd | |
919 | # End: | |
96fed375 | 920 | # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : |