Login
Created a new Policy to prohibit an unrestricted ## no critic.
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy.pm
CommitLineData
e68db767 1##############################################################################
39cd321a
JRT
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
e68db767 6##############################################################################
39cd321a 7
59b05e08
JRT
8package Perl::Critic::Policy;
9
df6dee2b 10use 5.006001;
59b05e08
JRT
11use strict;
12use warnings;
0f8f6b42 13
8c83273d 14use English qw< -no_match_vars >;
0f8f6b42 15use Readonly;
c680a9c9 16
2b141872 17use File::Spec ();
3fbc79a5 18use String::Format qw< stringf >;
c680a9c9 19
3fbc79a5 20use overload ( q<""> => 'to_string', cmp => '_compare' );
c680a9c9 21
16d279c3 22use 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 33use Perl::Critic::Utils::DataConversion qw< dor >;
b2236a84
ES
34use Perl::Critic::Utils::POD qw<
35 get_module_abstract_for_module
36 get_raw_module_abstract_for_module
37>;
0f8f6b42
ES
38use Perl::Critic::Exception::AggregateConfiguration;
39use Perl::Critic::Exception::Configuration;
40use Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter;
41use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue;
42use Perl::Critic::Exception::Fatal::PolicyDefinition
43 qw< throw_policy_definition >;
2e568513 44use Perl::Critic::PolicyConfig qw<>;
8c83273d 45use Perl::Critic::PolicyParameter qw<>;
0f8f6b42
ES
46use Perl::Critic::Violation qw<>;
47
48use Exception::Class; # this must come after "use P::C::Exception::*"
59b05e08 49
173667ce 50our $VERSION = '1.093_01';
59b05e08 51
fd5bd7b5
JRT
52#-----------------------------------------------------------------------------
53
459ede25
ES
54Readonly::Scalar my $NO_LIMIT => 'no_limit';
55
56#-----------------------------------------------------------------------------
57
8c83273d 58my $FORMAT = "%p\n"; #Default stringy format
0f8f6b42
ES
59
60#-----------------------------------------------------------------------------
61
8c83273d
ES
62sub 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
119sub initialize_if_enabled {
120 return $TRUE;
faa35de4
JRT
121}
122
6036a254 123#-----------------------------------------------------------------------------
9f1d5408 124
78afb6d4
ES
125sub prepare_to_scan_document {
126 return $TRUE;
bb5a5c57
ES
127}
128
129#-----------------------------------------------------------------------------
130
05e2d404
JRT
131sub can_be_disabled {
132 return $TRUE;
133}
134
135#-----------------------------------------------------------------------------
136
8c83273d
ES
137sub _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
155sub __get_parameter_name {
156 my ( $self, $parameter ) = @_;
985e0116 157
8c83273d 158 return '_' . $parameter->get_name();
985e0116
ES
159}
160
161#-----------------------------------------------------------------------------
162
8c83273d
ES
163sub __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 173sub __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
208sub _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
255sub __get_config {
256 my ($self) = @_;
257
258 return $self->{_config};
259}
260
261sub __set_config {
262 my ($self, $config) = @_;
263
264 $self->{_config} = $config;
265
266 return;
267}
268
269 #-----------------------------------------------------------------------------
270
0f8f6b42
ES
271sub get_long_name {
272 my ($self) = @_;
273
274 return policy_long_name(ref $self);
275}
276
277#-----------------------------------------------------------------------------
278
279sub get_short_name {
280 my ($self) = @_;
281
282 return policy_short_name(ref $self);
283}
284
285#-----------------------------------------------------------------------------
286
faa35de4
JRT
287sub applies_to {
288 return qw(PPI::Element);
289}
290
6036a254 291#-----------------------------------------------------------------------------
faa35de4 292
16d279c3
ES
293sub 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
304sub 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
315sub default_maximum_violations_per_document {
316 return;
317}
318
319#-----------------------------------------------------------------------------
320
faa35de4
JRT
321sub set_severity {
322 my ($self, $severity) = @_;
323 $self->{_severity} = $severity;
324 return $self;
325}
326
6036a254 327#-----------------------------------------------------------------------------
faa35de4
JRT
328
329sub get_severity {
330 my ($self) = @_;
331 return $self->{_severity} || $self->default_severity();
332}
333
6036a254 334#-----------------------------------------------------------------------------
faa35de4
JRT
335
336sub default_severity {
337 return $SEVERITY_LOWEST;
338}
339
6036a254 340#-----------------------------------------------------------------------------
faa35de4
JRT
341
342sub set_themes {
343 my ($self, @themes) = @_;
344 $self->{_themes} = [ sort @themes ];
345 return $self;
346}
347
6036a254 348#-----------------------------------------------------------------------------
faa35de4
JRT
349
350sub 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
358sub 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
368sub default_themes {
369 return ();
370}
371
6036a254 372#-----------------------------------------------------------------------------
faa35de4 373
c2f5bc1f
ES
374sub get_abstract {
375 my ($self) = @_;
376
377 return get_module_abstract_for_module( ref $self );
378}
379
380#-----------------------------------------------------------------------------
381
b2236a84
ES
382sub get_raw_abstract {
383 my ($self) = @_;
384
385 return get_raw_module_abstract_for_module( ref $self );
386}
387
388#-----------------------------------------------------------------------------
389
8c83273d
ES
390sub parameter_metadata_available {
391 my ($self) = @_;
392
393 return $self->{_parameter_metadata_available};
394}
395
396#-----------------------------------------------------------------------------
397
398sub get_parameters {
399 my ($self) = @_;
400
401 return $self->{_parameters};
402}
403
404#-----------------------------------------------------------------------------
405
faa35de4 406sub 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 415sub 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 425sub 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)
440sub 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 455sub set_format { return $FORMAT = $_[0] } ##no critic(ArgUnpacking)
1f4dafe4
JRT
456sub get_format { return $FORMAT }
457
458#-----------------------------------------------------------------------------
459
c2018d77 460sub 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 480sub _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
499sub _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
509sub _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
531sub _compare { return "$_[0]" cmp "$_[1]" }
532
59b05e08
JRT
5331;
534
535__END__
536
6036a254 537#-----------------------------------------------------------------------------
9f1d5408 538
59b05e08
JRT
539=pod
540
541=head1 NAME
542
c728943a 543Perl::Critic::Policy - Base class for all Policy modules.
59b05e08 544
16d279c3 545
59b05e08
JRT
546=head1 DESCRIPTION
547
548Perl::Critic::Policy is the abstract base class for all Policy
6bf9b465
JRT
549objects. If you're developing your own Policies, your job is to
550implement and override its methods in a subclass. To work with the
11f53956
ES
551L<Perl::Critic|Perl::Critic> engine, your implementation must behave
552as described below. For a detailed explanation on how to make new
553Policy modules, please see the
554L<Perl::Critic::DEVELOPER|Perl::Critic::DEVELOPER> document included
555in 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
564Returns a reference to a new subclass of Perl::Critic::Policy. If your
565Policy requires any special arguments, they will be passed in here as
11f53956
ES
566key-value pairs. Users of L<perlcritic|perlcritic> can specify these
567in their config file. Unless you override the C<new> method, the
568default method simply returns a reference to an empty hash that has
569been blessed into your subclass. However, you really should not
570override this; override C<initialize_if_enabled()> instead.
985e0116
ES
571
572This constructor is always called regardless of whether the user has
573enabled this Policy or not.
574
16d279c3 575
bb5a5c57 576=item C<< initialize_if_enabled( $config ) >>
985e0116 577
bb5a5c57
ES
578This receives an instance of
579L<Perl::Critic::PolicyConfig|Perl::Critic::PolicyConfig> as a
580parameter, and is only invoked if this Policy is enabled by the user.
985e0116
ES
581Thus, this is the preferred place for subclasses to do any
582initialization.
583
584Implementations of this method should return a boolean value
585indicating whether the Policy should continue to be enabled. For most
586subclasses, this will always be C<$TRUE>. Policies that depend upon
587external modules or other system facilities that may or may not be
588available should test for the availability of these dependencies and
589return C<$FALSE> if they are not.
59b05e08 590
16d279c3 591
78afb6d4 592=item C<< prepare_to_scan_document( $document ) >>
bb5a5c57 593
78afb6d4
ES
594The parameter is about to be scanned by this Policy. Whatever this
595Policy wants to do in terms of preparation should happen here.
596Returns a boolean value indicating whether the document should be
597scanned at all; if this is a false value, this Policy won't be applied
598to 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
603Given a L<PPI::Element|PPI::Element> and a
604L<PPI::Document|PPI::Document>, returns one or more
605L<Perl::Critic::Violation|Perl::Critic::Violation> objects if the
606C<$element> violates this Policy. If there are no violations, then it
607returns an empty list. If the Policy encounters an exception, then it
608should C<croak> with an error message and let the caller decide how to
609handle it.
59b05e08 610
9f1d5408
JRT
611C<violates()> is an abstract method and it will abort if you attempt
612to invoke it directly. It is the heart of all Policy modules, and
613your subclass B<must> override this method.
59b05e08 614
16d279c3 615
8c050cac 616=item C< violation( $description, $explanation, $element ) >
815b71d0
AL
617
618Returns a reference to a new C<Perl::Critic::Violation> object. The
619arguments are a description of the violation (as string), an
620explanation for the policy (as string) or a series of page numbers in
11f53956
ES
621PBP (as an ARRAY ref), a reference to the L<PPI|PPI> element that
622caused the violation.
815b71d0 623
11f53956
ES
624These are the same as the constructor to
625L<Perl::Critic::Violation|Perl::Critic::Violation>, but without the
626severity. 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
631Create a
11f53956 632L<Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue|Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue>
3fbc79a5
ES
633for this Policy.
634
635
8c83273d
ES
636=item C< throw_parameter_value_exception( $option_name, $option_value, $source, $message_suffix ) >
637
638Create and throw a
11f53956 639L<Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue|Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue>.
8c83273d
ES
640Useful in parameter parser implementations.
641
16d279c3 642
0f8f6b42
ES
643=item C< get_long_name() >
644
645Return the full package name of this policy.
646
16d279c3 647
0f8f6b42
ES
648=item C< get_short_name() >
649
650Return the name of this policy without the "Perl::Critic::Policy::"
651prefix.
652
16d279c3 653
8c050cac 654=item C< applies_to() >
bf159007 655
9f1d5408
JRT
656Returns a list of the names of PPI classes that this Policy cares
657about. By default, the result is C<PPI::Element>. Overriding this
658method in Policy subclasses should lead to significant performance
659increases.
660
16d279c3
ES
661
662=item C< default_maximum_violations_per_document() >
663
664Returns the default maximum number of violations for this policy to
665report per document. By default, this not defined, but subclasses may
666override this.
667
668
669=item C< get_maximum_violations_per_document() >
670
671Returns the maximum number of violations this policy will report for a
672single document. If this is not defined, then there is no limit. If
673L<set_maximum_violations_per_document()> has not been invoked, then
674L<default_maximum_violations_per_document()> is returned.
675
676
677=item C< set_maximum_violations_per_document() >
678
679Specify the maximum violations that this policy should report for a
680document.
681
682
8c050cac 683=item C< default_severity() >
9f1d5408
JRT
684
685Returns the default severity for violating this Policy. See the
11f53956
ES
686C<$SEVERITY> constants in L<Perl::Critic::Utils|Perl::Critic::Utils>
687for an enumeration of possible severity values. By default, this
688method returns C<$SEVERITY_LOWEST>. Authors of Perl::Critic::Policy
689subclasses should override this method to return a value that they
690feel is appropriate for their Policy. In general, Polices that are
691widely accepted or tend to prevent bugs should have a higher severity
692than those that are more subjective or cosmetic in nature.
9f1d5408 693
16d279c3 694
8c050cac 695=item C< get_severity() >
9f1d5408
JRT
696
697Returns the severity of violating this Policy. If the severity has
698not been explicitly defined by calling C<set_severity>, then the
699C<default_severity> is returned. See the C<$SEVERITY> constants in
11f53956
ES
700L<Perl::Critic::Utils|Perl::Critic::Utils> for an enumeration of
701possible severity values.
9f1d5408 702
16d279c3 703
8c050cac 704=item C< set_severity( $N ) >
9f1d5408
JRT
705
706Sets the severity for violating this Policy. Clients of
707Perl::Critic::Policy objects can call this method to assign a
708different severity to the Policy if they don't agree with the
709C<default_severity>. See the C<$SEVERITY> constants in
11f53956
ES
710L<Perl::Critic::Utils|Perl::Critic::Utils> for an enumeration of
711possible values.
dff08b70 712
16d279c3 713
8c050cac 714=item C< default_themes() >
faa35de4
JRT
715
716Returns a sorted list of the default themes associated with this
717Policy. The default method returns an empty list. Policy authors
718should override this method to return a list of themes that are
719appropriate for their policy.
720
16d279c3 721
8c050cac 722=item C< get_themes() >
faa35de4
JRT
723
724Returns a sorted list of the themes associated with this Policy. If
dc93df4f 725you haven't added themes or set the themes explicitly, this method
faa35de4
JRT
726just returns the default themes.
727
16d279c3 728
8c050cac 729=item C< set_themes( @THEME_LIST ) >
faa35de4
JRT
730
731Sets the themes associated with this Policy. Any existing themes are
732overwritten. Duplicate themes will be removed.
733
16d279c3 734
8c050cac 735=item C< add_themes( @THEME_LIST ) >
faa35de4
JRT
736
737Appends additional themes to this Policy. Any existing themes are
738preserved. Duplicate themes will be removed.
739
05e2d404
JRT
740=item C< can_be_disabled() >
741
742Returns a true value if this Policy can be disabled by a C<"## no critic">
743marker. The default method returns true. Most Policies should never need
744to override this. But If you want to write a policy that cannot be disabled,
745override this method to return false. Note that this only affects the
746C<"## no critic"> markers -- the Policy can still be disabled via the
747F<.perlcriticrc> file.
16d279c3 748
c2f5bc1f
ES
749=item C< get_abstract() >
750
751Retrieve the abstract for this policy (the part of the NAME section of
752the POD after the module name), if it is available.
753
754
b2236a84
ES
755=item C< get_raw_abstract() >
756
757Retrieve the abstract for this policy (the part of the NAME section of
758the POD after the module name), if it is available, in the unparsed
759form.
760
761
8c83273d
ES
762=item C< parameter_metadata_available() >
763
764Returns whether information about the parameters is available.
765
16d279c3 766
8c83273d
ES
767=item C< get_parameters() >
768
769Returns a reference to an array containing instances of
11f53956 770L<Perl::Critic::PolicyParameter|Perl::Critic::PolicyParameter>.
8c83273d
ES
771
772Note that this will return an empty list if the parameters for this
773policy are unknown. In order to differentiate between this
774circumstance and the one where this policy does not take any
775parameters, it is necessary to call C<parameter_metadata_available()>.
776
16d279c3 777
8c83273d
ES
778=item C< get_parameter( $parameter_name ) >
779
11f53956
ES
780Returns the
781L<Perl::Critic::PolicyParameter|Perl::Critic::PolicyParameter> with
782the specified name.
8c83273d 783
16d279c3 784
1f4dafe4
JRT
785=item C<set_format( $FORMAT )>
786
0f8f6b42
ES
787Class method. Sets the format for all Policy objects when they are
788evaluated in string context. The default is C<"%p\n">. See
789L<"OVERLOADS"> for formatting options.
1f4dafe4 790
16d279c3 791
1f4dafe4
JRT
792=item C<get_format()>
793
0f8f6b42
ES
794Class method. Returns the current format for all Policy objects when
795they are evaluated in string context.
1f4dafe4 796
16d279c3 797
14a6a3ef
CD
798=item C<to_string()>
799
800Returns a string representation of the policy. The content of the
801string depends on the current value of the C<$FORMAT> package
802variable. See L<"OVERLOADS"> for the details.
803
16d279c3 804
59b05e08
JRT
805=back
806
16d279c3 807
59b05e08
JRT
808=head1 DOCUMENTATION
809
11f53956
ES
810When your Policy module first C<use>s
811L<Perl::Critic::Violation|Perl::Critic::Violation>, it will try and
812extract the DESCRIPTION section of your Policy module's POD. This
813information is displayed by Perl::Critic if the verbosity level is set
814accordingly. Therefore, please include a DESCRIPTION section in the
815POD for any Policy modules that you author. Thanks.
59b05e08 816
16d279c3 817
14a6a3ef
CD
818=head1 OVERLOADS
819
820Perl::Critic::Violation overloads the C<""> operator to produce neat
821little messages when evaluated in string context. The format depends
822on the current value of the C<$FORMAT> package variable.
823
824Formats are a combination of literal and escape characters similar to
825the way C<sprintf> works. If you want to know the specific formatting
11f53956
ES
826capabilities, look at L<String::Format|String::Format>. Valid escape
827characters are:
14a6a3ef 828
16d279c3 829
fc5b8cef
ES
830=over
831
c2f5bc1f
ES
832=item C<%P>
833
834Name of the Policy module.
835
836
837=item C<%p>
838
839Name of the Policy without the C<Perl::Critic::Policy::> prefix.
840
841
842=item C<%a>
843
844The policy abstract.
845
846
fc5b8cef
ES
847=item C<%O>
848
8c83273d
ES
849List of supported policy parameters. Takes an option of a format
850string for L<Perl::Critic::PolicyParameter/"to_formatted_string">.
851For example, this can be used like C<%{%n - %d\n}O> to get a list of
852parameter names followed by their descriptions.
853
16d279c3 854
8c83273d
ES
855=item C<%U>
856
857A message stating that the parameters for the policy are unknown if
858C<parameter_metadata_available()> returns false. Takes an option of
859what the message should be, which defaults to "Cannot programmatically
860discover what parameters this policy takes.". The value of this
861option is interpolated in order to expand the standard escape
862sequences (C<\n>, C<\t>, etc.).
fc5b8cef 863
16d279c3 864
fc5b8cef
ES
865=item C<%S>
866
867The default severity level of the policy.
868
16d279c3 869
fc5b8cef
ES
870=item C<%s>
871
872The current severity level of the policy.
873
16d279c3 874
fc5b8cef
ES
875=item C<%T>
876
877The default themes for the policy.
878
16d279c3 879
fc5b8cef
ES
880=item C<%t>
881
882The current themes for the policy.
883
16d279c3 884
c2f5bc1f
ES
885=item C<%V>
886
887The default maximum number of violations per document of the policy.
888
889
890=item C<%v>
891
892The 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
900Jeffrey Ryan Thalhammer <thaljef@cpan.org>
901
16d279c3 902
59b05e08
JRT
903=head1 COPYRIGHT
904
20dfddeb 905Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
59b05e08
JRT
906
907This program is free software; you can redistribute it and/or modify
908it under the same terms as Perl itself. The full text of this license
909can 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 :