File Coverage

blib/lib/Perl/Critic/Policy/CodeLayout/RequireKRBracing.pm
Criterion Covered Total %
statement 55 57 96.4
branch 25 32 78.1
condition 14 21 66.6
subroutine 11 12 91.6
pod 4 4 100.0
total 109 126 86.5


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::CodeLayout::RequireKRBracing;
2 2     2   1975 use strict;
  2         7  
  2         59  
3 2     2   10 use warnings;
  2         13  
  2         55  
4 2     2   11 use parent qw[ Perl::Critic::Policy ];
  2         4  
  2         16  
5 2     2   113 use Perl::Critic::Utils qw[ :severities ];
  2         4  
  2         111  
6 2     2   279 use List::MoreUtils qw[ any ];
  2         4  
  2         13  
7              
8 2     2   1292 use constant PBP_PAGE => 9;
  2         4  
  2         1510  
9              
10             my %affected_conditional = map { $_ => 1 } qw( if while unless until );
11             my %affected_list_loop = map { $_ => 1 } qw( for foreach );
12             my %affected_followup = map { $_ => 1 } qw( else elsif continue );
13              
14 10     10 1 150 sub default_severity { return $SEVERITY_LOW }
15 0     0 1 0 sub default_themes { return qw[ cosmetic pbp ] }
16 13     13 1 171269 sub applies_to { return 'PPI::Structure::Block' }
17              
18             sub violates {
19 20     20 1 1341 my ($self, $elem, $doc) = @_;
20              
21 20         76 my ($keyword, $parens) = _affected_construct($elem);
22 20 100   34   92 return if any { not defined } $keyword, $parens; # no affected construct detected
  34         88  
23              
24 14         61 my $inter_whitespace = $elem->previous_sibling();
25 14 100       333 if (not $inter_whitespace->isa('PPI::Token::Whitespace')) {
26 2         19 return $self->violation("No whitespace between closing '$keyword' parenthesis and opening brace",
27             PBP_PAGE, $elem);
28             }
29              
30 12         91 my $pre_whitespace = $parens->previous_sibling();
31 12 100       228 if (not $pre_whitespace->isa('PPI::Token::Whitespace')) {
32 3         12 return $self->violation("No whitespace before opening '$keyword' parenthesis", PBP_PAGE, $parens);
33             }
34              
35 9 100       27 if (index($inter_whitespace->content, "\n") != -1) {
36 2         16 return $self->violation("Opening brace of '$keyword' block is not on the same line", PBP_PAGE, $elem);
37             }
38              
39 7         54 my $next_keyword = $elem->snext_sibling(); # else / elsif / continue
40 7 50 66     202 if ( ref $next_keyword
      66        
41             and $next_keyword->isa('PPI::Token::Word')
42             and $affected_followup{$next_keyword})
43             {
44 5         42 my $follow_whitespace = $elem->next_sibling();
45              
46 5         115 my $no_whitespace = "No whitespace between closing brace and '$next_keyword'";
47 5 100       48 return $self->violation($no_whitespace, PBP_PAGE, $next_keyword)
48             if not $follow_whitespace->isa('PPI::Token::Whitespace');
49              
50 4         13 my $no_newline = "'$next_keyword' is on the same line as closing brace";
51 4 100       23 return $self->violation($no_newline, PBP_PAGE, $next_keyword)
52             if index($follow_whitespace->content, "\n") == -1;
53             }
54              
55 4         20 return;
56             }
57              
58             sub _affected_construct {
59 20     20   39 my ($elem) = @_;
60              
61 20         65 my $parens = $elem->sprevious_sibling();
62 20 50       644 return if not ref $parens;
63              
64 20         80 my $is_conditional = $parens->isa('PPI::Structure::Condition'); # if / while / unless / until
65 20         97 my $is_list_loop = $parens->isa('PPI::Structure::List'); # for / foreach
66 20 100 100     99 return if not($is_conditional or $is_list_loop);
67              
68 15         39 my $keyword = $parens->sprevious_sibling();
69 15 100 33     359 if ($keyword->isa('PPI::Token::Word')) { # a conditional or foreach without an explicit iterator
    50          
70 13 100 100     52 return if $is_conditional and not $affected_conditional{$keyword};
71 12 50 66     93 return if $is_list_loop and not $affected_list_loop{$keyword};
72             }
73             elsif ($is_list_loop and $keyword->isa('PPI::Token::Symbol')) { # foreach with an explicit iterator
74 2         12 $keyword = $keyword->sprevious_sibling(); # go back to either 'my' or 'for'/'foreach'
75 2 50 33     60 $keyword = $keyword->sprevious_sibling # go back one more token in case of 'my'
76             if $keyword->isa('PPI::Token::Word')
77             and $keyword->content eq 'my';
78              
79             # Should have found the actual keyword by now
80 2 50       59 return if not $keyword->isa('PPI::Token::Word');
81 2 50       7 return if not $affected_list_loop{$keyword};
82             }
83             else {
84 0         0 return;
85             }
86              
87 14         67 return ($keyword, $parens);
88             }
89              
90             1;
91             __END__
92             =pod
93              
94             =head1 NAME
95              
96             Perl::Critic::Policy::CodeLayout::RequireKRBracing - brace in K&R style
97              
98             =head1 AFFILIATION
99              
100             This policy as a part of the L<Perl::Critic::PolicyBundle::SNEZ> distribution.
101              
102             =head1 DESCRIPTION
103              
104             The K&R style requires less lines per block than BSD and GNU styles without
105             sacrificing the recognizability of its boundaries. Place the opening brace
106             of a block at the end of the construct which controls it, not on a new line.
107              
108             # not ok
109             foreach my $name (@names)
110             {
111             print "$name\n";
112             sign_up($name);
113             }
114              
115             # ok
116             foreach my $name (@names) {
117             print "$name\n";
118             sign_up($name);
119             }
120              
121             =head1 CONFIGURATION
122              
123             This Policy is not configurable except for the standard options.
124              
125             =head1 COPYRIGHT
126              
127             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
128              
129             =cut