File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/RestrictLongStrings.pm
Criterion Covered Total %
statement 36 36 100.0
branch 9 10 90.0
condition 2 6 33.3
subroutine 12 12 100.0
pod 4 5 80.0
total 63 69 91.3


line stmt bran cond sub pod time code
1             #######################################################################
2             # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/distributions/Perl-Critic-More/lib/Perl/Critic/Policy/ValuesAndExpressions/RestrictLongStrings.pm $
3             # $Date: 2013-10-29 09:39:11 -0700 (Tue, 29 Oct 2013) $
4             # $Author: thaljef $
5             # $Revision: 4222 $
6             ########################################################################
7              
8             package Perl::Critic::Policy::ValuesAndExpressions::RestrictLongStrings;
9              
10 6     6   5386 use 5.006001;
  6         19  
  6         225  
11              
12 6     6   30 use strict;
  6         798  
  6         674  
13 6     6   196 use warnings;
  6         11  
  6         1012  
14              
15 6     6   204 use Carp;
  6         14  
  6         1232  
16 6     6   31 use Readonly;
  6         13  
  6         2549  
17              
18 6     6   245 use Perl::Critic::Utils qw{ :severities };
  6         11  
  6         332  
19 6     6   787 use base 'Perl::Critic::Policy';
  6         11  
  6         2192  
20              
21             our $VERSION = '1.003';
22              
23             #---------------------------------------------------------------------------
24              
25             Readonly::Scalar my $DESC => 'Long string mixed with code';
26             Readonly::Scalar my $EXPL =>
27             'Put long strings in their own subroutine or split them';
28              
29             #---------------------------------------------------------------------------
30              
31 8     8 1 318 sub default_severity { return $SEVERITY_LOW }
32 1     1 1 86 sub default_themes { return qw< more readability > }
33 6     6 1 45110 sub applies_to { return 'PPI::Token::Quote' }
34              
35             sub supported_parameters {
36             return (
37 10     10 0 59932 { name => 'max_length',
38             description => 'The maximum line length to allow.',
39             default_string => '78',
40             behavior => 'integer',
41             integer_minimum => 1,
42             },
43             );
44             }
45              
46             #---------------------------------------------------------------------------
47              
48             sub violates {
49 17     17 1 1420 my ( $self, $elem, $doc ) = @_;
50              
51 17         94 my $length = length $elem->string;
52 17 100       240 return if $length <= $self->{_max_length};
53              
54             # Allow long strings in the last statment of a subroutine
55 9         72 my $stmt = $elem->statement;
56 9 100       197 if ( !$stmt->snext_sibling ) {
57 3         90 my $stmt_parent = $stmt->parent;
58 3 100       34 if ( $stmt_parent->isa('PPI::Structure::Block') ) {
59              
60             # Named subroutine
61 2 100       16 return if $stmt_parent->parent->isa('PPI::Statement::Sub');
62              
63             # Anonymous subroutine
64 1         19 my $sib = $stmt_parent->sprevious_sibling;
65 1 50 33     39 return if $sib && $sib->isa('PPI::Token::Word') && 'sub' eq $sib;
      33        
66             }
67             }
68              
69 7         201 return $self->violation( $DESC, $EXPL, $elem );
70             }
71              
72             1;
73              
74             __END__
75              
76             #---------------------------------------------------------------------------
77              
78             =pod
79              
80             =for stopwords
81              
82             =head1 NAME
83              
84             Perl::Critic::Policy::ValuesAndExpressions::RestrictLongStrings - Stop mixing long strings with code.
85              
86              
87             =head1 AFFILIATION
88              
89             This policy is part of L<Perl::Critic::More|Perl::Critic::More>, a bleeding
90             edge supplement to L<Perl::Critic|Perl::Critic>.
91              
92              
93             =head1 DESCRIPTION
94              
95             Long text strings in the middle of code is very distracting and wreaks havoc
96             on code formatting. Consider putting long strings in external data files,
97             C<__DATA__> sections, or in their own subroutines.
98              
99             This policy complains if a long string is not the last line of a subroutine.
100             "Long" is defined as 78 characters by default. This value can be altered in
101             your Perl::Critic configuration via the C<max_length> property. For example,
102             you may add the following to your F<.perlcriticrc> file:
103              
104             [ValuesAndExpressions::RestrictLongStrings]
105             max_length = 50
106              
107              
108             =head1 TODO
109              
110             Add option to allow long strings that don't include newlines.
111              
112              
113             =head1 AUTHOR
114              
115             Chris Dolan <cdolan@cpan.org>
116              
117              
118             =head1 COPYRIGHT
119              
120             Copyright (c) 2006-2008 Chris Dolan
121              
122             This program is free software; you can redistribute it and/or modify
123             it under the same terms as Perl itself. The full text of this license
124             can be found in the LICENSE file included with this module.
125              
126             =cut
127              
128             # Local Variables:
129             # mode: cperl
130             # cperl-indent-level: 4
131             # fill-column: 78
132             # indent-tabs-mode: nil
133             # c-indentation-style: bsd
134             # End:
135             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :