vcs.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm $
   3 #     $Date: 2008-07-04 10:33:13 -0500 (Fri, 04 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2490 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::CodeLayout::RequireTidyCode;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use English qw(-no_match_vars);
  16 use Perl::Critic::Utils qw{ :booleans :characters :severities };
  17 use base 'Perl::Critic::Policy';
  18
  19 our $VERSION = '1.088';
  20
  21 #-----------------------------------------------------------------------------
  22
  23 Readonly::Scalar my $DESC => q{Code is not tidy};
  24 Readonly::Scalar my $EXPL => [ 33 ];
  25
  26 #-----------------------------------------------------------------------------
  27
  28 sub supported_parameters {
  29     return (
  30         {
  31             name            => 'perltidyrc',
  32             description     => 'The Perl::Tidy configuration file to use, if any.',
  33             default_string  => undef,
  34         },
  35     );
  36 }
  37
  38 sub default_severity { return $SEVERITY_LOWEST      }
  39 sub default_themes   { return qw(core pbp cosmetic) }
  40 sub applies_to       { return 'PPI::Document'       }
  41
  42 #-----------------------------------------------------------------------------
  43
  44 sub initialize_if_enabled {
  45     my ($self, $config) = @_;
  46
  47     # workaround for Test::Without::Module v0.11
  48     local $EVAL_ERROR = undef;
  49
  50     # If Perl::Tidy is missing, bow out.
  51     eval { require Perl::Tidy; } or return $FALSE;
  52
  53     #Set configuration if defined
  54     if (defined $self->{_perltidyrc} && $self->{_perltidyrc} eq $EMPTY) {
  55         $self->{_perltidyrc} = \$EMPTY;
  56     }
  57
  58     return $TRUE;
  59 }
  60
  61 #-----------------------------------------------------------------------------
  62
  63 sub violates {
  64     my ( $self, $elem, $doc ) = @_;
  65
  66     # Perl::Tidy seems to produce slightly different output, depending
  67     # on the trailing whitespace in the input.  As best I can tell,
  68     # Perl::Tidy will truncate any extra trailing newlines, and if the
  69     # input has no trailing newline, then it adds one.  But when you
  70     # re-run it through Perl::Tidy here, that final newline gets lost,
  71     # which causes the policy to insist that the code is not tidy.
  72     # This only occurs when Perl::Tidy is writing the output to a
  73     # scalar, but does not occur when writing to a file.  I may
  74     # investigate further, but for now, this seems to do the trick.
  75
  76     my $source = $doc->serialize();
  77     $source =~ s{ \s+ \Z}{\n}mx;
  78
  79     # Remove the shell fix code from the top of program, if applicable
  80     ## no critic(ProhibitComplexRegexes)
  81     my $shebang_re = qr< [#]! [^\015\012]+ [\015\012]+ >xms;
  82     my $shell_re   = qr<eval [ ] 'exec [ ] [^\015\012]* [ ] \$0 [ ] \${1[+]"\$@"}'
  83                         [ \t]*[\012\015]+ [ \t]* if [^\015\012]+ [\015\012]+ >xms;
  84     $source =~ s/\A ($shebang_re) $shell_re /$1/xms;
  85
  86     my $dest    = $EMPTY;
  87     my $stderr  = $EMPTY;
  88
  89
  90     # Perl::Tidy gets confused if @ARGV has arguments from
  91     # another program.  Also, we need to override the
  92     # stdout and stderr redirects that the user may have
  93     # configured in their .perltidyrc file.
  94     local @ARGV = qw(-nst -nse);  ## no critic
  95
  96     # Trap Perl::Tidy errors, just in case it dies
  97     my $eval_worked = eval {
  98         Perl::Tidy::perltidy(
  99             source      => \$source,
 100             destination => \$dest,
 101             stderr      => \$stderr,
 102             defined $self->{_perltidyrc} ? (perltidyrc => $self->{_perltidyrc}) : (),
 103        );
 104        1;
 105     };
 106
 107     if ($stderr or not $eval_worked) {
 108         # Looks like perltidy had problems
 109         return $self->violation( 'perltidy had errors!!', $EXPL, $elem );
 110     }
 111
 112     if ( $source ne $dest ) {
 113         return $self->violation( $DESC, $EXPL, $elem );
 114     }
 115
 116     return;    #ok!
 117 }
 118
 119 1;
 120
 121 #-----------------------------------------------------------------------------
 122
 123 __END__
 124
 125 =pod
 126
 127 =head1 NAME
 128
 129 Perl::Critic::Policy::CodeLayout::RequireTidyCode - Must run code through L<perltidy>.
 130
 131 =head1 AFFILIATION
 132
 133 This Policy is part of the core L<Perl::Critic> distribution.
 134
 135
 136 =head1 DESCRIPTION
 137
 138 Conway does make specific recommendations for whitespace and
 139 curly-braces in your code, but the most important thing is to adopt a
 140 consistent layout, regardless of the specifics.  And the easiest way
 141 to do that is to use L<Perl::Tidy>.  This policy will complain if
 142 you're code hasn't been run through Perl::Tidy.
 143
 144 =head1 CONFIGURATION
 145
 146 This policy can be configured to tell Perl::Tidy to use a particular
 147 F<perltidyrc> file or no configuration at all.  By default, Perl::Tidy is told
 148 to look in its default location for configuration.  Perl::Critic can be told to
 149 tell Perl::Tidy to use a specific configuration file by putting an entry in a
 150 F<.perlcriticrc> file like this:
 151
 152   [CodeLayout::RequireTidyCode]
 153   perltidyrc = /usr/share/perltidy.conf
 154
 155 As a special case, setting C<perltidyrc> to the empty string tells
 156 Perl::Tidy not to load any configuration file at all and just use
 157 Perl::Tidy's own default style.
 158
 159   [CodeLayout::RequireTidyCode]
 160   perltidyrc =
 161
 162 =head1 NOTES
 163
 164 L<Perl::Tidy> is not included in the Perl::Critic distribution.  The
 165 latest version of Perl::Tidy can be downloaded from CPAN.  If
 166 Perl::Tidy is not installed, this policy is silently ignored.
 167
 168 =head1 SEE ALSO
 169
 170 L<Perl::Tidy>
 171
 172 =head1 AUTHOR
 173
 174 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 175
 176 =head1 COPYRIGHT
 177
 178 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 179
 180 This program is free software; you can redistribute it and/or modify
 181 it under the same terms as Perl itself.  The full text of this license
 182 can be found in the LICENSE file included with this module.
 183
 184 =cut
 185
 186 # Local Variables:
 187 #   mode: cperl
 188 #   cperl-indent-level: 4
 189 #   fill-column: 78
 190 #   indent-tabs-mode: nil
 191 #   c-indentation-style: bsd
 192 # End:
 193 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :