File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm
Criterion Covered Total %
statement 25 25 100.0
branch 2 2 100.0
condition n/a
subroutine 11 11 100.0
pod 4 5 80.0
total 42 43 97.6


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator;
2              
3 40     40   26861 use 5.010001;
  40         244  
4 40     40   251 use strict;
  40         91  
  40         845  
5 40     40   205 use warnings;
  40         100  
  40         1117  
6 40     40   237 use Readonly;
  40         120  
  40         2141  
7              
8 40     40   304 use Perl::Critic::Utils qw{ :severities };
  40         139  
  40         2204  
9 40     40   5348 use parent 'Perl::Critic::Policy';
  40         120  
  40         224  
10              
11             our $VERSION = '1.146';
12              
13             #-----------------------------------------------------------------------------
14              
15             Readonly::Scalar my $HEREDOC_RX => qr{ \A << ~? \s* (["']?) [[:upper:]_] [[:upper:]\d_]* \1 \z }xms;
16             Readonly::Scalar my $DESC => q{Heredoc terminator not alphanumeric and upper-case};
17             Readonly::Scalar my $EXPL => [ 64 ];
18              
19             #-----------------------------------------------------------------------------
20              
21 97     97 0 1678 sub supported_parameters { return () }
22 78     78 1 344 sub default_severity { return $SEVERITY_LOW }
23 84     84 1 398 sub default_themes { return qw(core pbp cosmetic) }
24 38     38 1 129 sub applies_to { return 'PPI::Token::HereDoc' }
25              
26             #-----------------------------------------------------------------------------
27              
28             sub violates {
29 7     7 1 21 my ( $self, $elem, undef ) = @_;
30              
31 7 100       44 if ( $elem !~ $HEREDOC_RX ) {
32 4         49 return $self->violation( $DESC, $EXPL, $elem );
33             }
34 3         36 return; #ok!
35             }
36              
37             1;
38              
39             __END__
40              
41             #-----------------------------------------------------------------------------
42              
43             =pod
44              
45             =head1 NAME
46              
47             Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator - Write C< <<'THE_END'; > instead of C< <<'theEnd'; >.
48              
49              
50             =head1 AFFILIATION
51              
52             This Policy is part of the core L<Perl::Critic|Perl::Critic>
53             distribution.
54              
55              
56             =head1 DESCRIPTION
57              
58             For legibility, HEREDOC terminators should be all UPPER CASE letters
59             (and numbers), without any whitespace. Conway also recommends using a
60             standard prefix like "END_" but this policy doesn't enforce that.
61              
62             print <<'the End'; #not ok
63             Hello World
64             the End
65              
66             print <<'THE_END'; #ok
67             Hello World
68             THE_END
69              
70              
71             =head1 CONFIGURATION
72              
73             This Policy is not configurable except for the standard options.
74              
75              
76             =head1 SEE ALSO
77              
78             L<Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator|Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator>
79              
80              
81             =head1 AUTHOR
82              
83             Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
84              
85              
86             =head1 COPYRIGHT
87              
88             Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
89              
90             This program is free software; you can redistribute it and/or modify
91             it under the same terms as Perl itself. The full text of this license
92             can be found in the LICENSE file included with this module.
93              
94             =cut
95              
96             # Local Variables:
97             # mode: cperl
98             # cperl-indent-level: 4
99             # fill-column: 78
100             # indent-tabs-mode: nil
101             # c-indentation-style: bsd
102             # End:
103             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :