1use strict; 2use warnings; 3package Perl::Critic::Policy::Tics::ProhibitLongLines; 4# ABSTRACT: 80 x 40 for life! 5$Perl::Critic::Policy::Tics::ProhibitLongLines::VERSION = '0.009'; 6#pod =head1 DESCRIPTION 7#pod 8#pod Please keep your code to about eighty columns wide, the One True Terminal 9#pod Width. Going over that occasionally is okay, but only once in a while. 10#pod 11#pod This policy always throws a violation for extremely long lines. It will also 12#pod throw a violation if there are too many lines that are slightly longer than the 13#pod preferred maximum length. If a only few lines exceed the preferred maximum 14#pod width, they're let slide and only extremely long lines are violations. 15#pod 16#pod =head1 CONFIGURATION 17#pod 18#pod There are three configuration options for this policy: 19#pod 20#pod base_max - the preferred maximum line length (default: 80) 21#pod hard_max - the length beyond which a line is "extremely long" 22#pod (default: base_max * 1.5) 23#pod 24#pod pct_allowed - the percentage of total lines which may fall between base_max 25#pod and hard_max before those violations are reported (default: 1) 26#pod 27#pod =cut 28 29use Perl::Critic::Utils; 30use parent qw(Perl::Critic::Policy); 31 32sub default_severity { $SEVERITY_LOW } 33sub default_themes { qw(tics) } 34sub applies_to { 'PPI::Document' } 35 36sub supported_parameters { qw(base_max hard_max pct_allowed) } 37 38my %_default = ( 39 base_max => 80, 40 pct_allowed => 1, 41); 42 43sub new { 44 my ($class, %arg) = @_; 45 my $self = $class->SUPER::new(%arg); 46 47 my %merge = (%_default, %arg); 48 49 Carp::croak "base_max for Tics::ProhibitLongLines must be an int, one or more" 50 unless $merge{base_max} =~ /\A\d+\z/ and $merge{base_max} >= 1; 51 52 $merge{hard_max} = $merge{base_max} * 1.5 unless exists $merge{hard_max}; 53 54 Carp::croak "base_max for Tics::ProhibitLongLines must be an int, one or more" 55 unless do { no warnings; ($merge{hard_max} = int($merge{hard_max})) >= 1 }; 56 57 Carp::croak "pct_allowed for Tics::ProhibitLongLines must be a positive int" 58 unless $merge{pct_allowed} =~ /\A\d+\z/ and $merge{pct_allowed} >= 0; 59 60 $self->{$_} = $merge{$_} for $self->supported_parameters; 61 62 bless $self => $class; 63} 64 65 66sub violates { 67 my ($self, $elem, $doc) = @_; 68 69 $elem->prune('PPI::Token::Data'); 70 $elem->prune('PPI::Token::End'); 71 72 my @lines = split /(?:\x0d\x0a|\x0a\x0d|\x0d|\x0a)/, $elem->serialize; 73 74 my @soft_violations; 75 my @hard_violations; 76 77 my $base = $self->{base_max}; 78 my $limit = $self->{hard_max}; 79 80 my $top = $elem->top(); 81 my $fn = $top->can('filename') ? $top->filename() : undef; 82 83 LINE: for my $ln (1 .. @lines) { 84 my $length = length $lines[ $ln - 1 ]; 85 86 next LINE unless $length > $base; 87 88 if ($length > $limit) { 89 my $viol = Perl::Critic::Tics::Violation::VirtualPos->new( 90 "Line is over hard length limit of $limit characters.", 91 "Keep lines to about $limit columns wide.", 92 $doc, 93 $self->get_severity, 94 ); 95 96 $viol->_set_location([ $ln, 1, 1, $ln, $fn ], $lines[ $ln - 1 ]); 97 98 push @hard_violations, $viol; 99 } else { 100 my $viol = Perl::Critic::Tics::Violation::VirtualPos->new( 101 "Line is over base length limit of $base characters.", 102 "Keep lines to about $limit columns wide.", 103 $doc, 104 $self->get_severity, 105 ); 106 107 $viol->_set_location([ $ln, 1, 1, $ln, $fn ], $lines[ $ln - 1 ]); 108 109 push @soft_violations, $viol; 110 } 111 } 112 113 my $allowed = sprintf '%u', @lines * ($self->{pct_allowed} / 100); 114 115 my $viols = @soft_violations + @hard_violations; 116 if ($viols > $allowed) { 117 return(@hard_violations, @soft_violations); 118 } else { 119 return @hard_violations; 120 } 121} 122 123{ 124 package # hide 125 Perl::Critic::Tics::Violation::VirtualPos; 126 BEGIN {require Perl::Critic::Violation; our @ISA = 'Perl::Critic::Violation';} 127 sub _set_location { 128 my ($self, $pos, $line) = @_; 129 $self->{__PACKAGE__}{pos} = $pos; 130 $self->{__PACKAGE__}{line} = $line; 131 } 132 sub location { $_[0]->{__PACKAGE__}{pos} } 133 sub source { $_[0]->{__PACKAGE__}{line} } 134} 135 1361; 137 138__END__ 139 140=pod 141 142=encoding UTF-8 143 144=head1 NAME 145 146Perl::Critic::Policy::Tics::ProhibitLongLines - 80 x 40 for life! 147 148=head1 VERSION 149 150version 0.009 151 152=head1 DESCRIPTION 153 154Please keep your code to about eighty columns wide, the One True Terminal 155Width. Going over that occasionally is okay, but only once in a while. 156 157This policy always throws a violation for extremely long lines. It will also 158throw a violation if there are too many lines that are slightly longer than the 159preferred maximum length. If a only few lines exceed the preferred maximum 160width, they're let slide and only extremely long lines are violations. 161 162=head1 CONFIGURATION 163 164There are three configuration options for this policy: 165 166 base_max - the preferred maximum line length (default: 80) 167 hard_max - the length beyond which a line is "extremely long" 168 (default: base_max * 1.5) 169 170 pct_allowed - the percentage of total lines which may fall between base_max 171 and hard_max before those violations are reported (default: 1) 172 173=head1 AUTHOR 174 175Ricardo SIGNES <rjbs@cpan.org> 176 177=head1 COPYRIGHT AND LICENSE 178 179This software is copyright (c) 2007 by Ricardo SIGNES. 180 181This is free software; you can redistribute it and/or modify it under 182the same terms as the Perl 5 programming language system itself. 183 184=cut 185