File Coverage

blib/lib/Perl/Critic/Policy.pm
Criterion Covered Total %
statement 192 210 91.4
branch 26 36 72.2
condition 5 12 41.6
subroutine 63 69 91.3
pod 29 29 100.0
total 315 356 88.4


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