Login
Better diagnostic message form failures in &_load_profile_from_file to
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / CodeLayout / RequireTidyCode.pm
CommitLineData
dff08b70
JRT
1#######################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
c0b487cd 6# ex: set ts=8 sts=4 sw=4 expandtab
dff08b70
JRT
7########################################################################
8
59b05e08
JRT
9package Perl::Critic::Policy::CodeLayout::RequireTidyCode;
10
11use strict;
12use warnings;
bf159007 13use English qw(-no_match_vars);
59b05e08 14use Perl::Critic::Utils;
59b05e08
JRT
15use base 'Perl::Critic::Policy';
16
08d946e2 17our $VERSION = 0.21;
59b05e08 18
dff08b70
JRT
19#----------------------------------------------------------------------------
20
59b05e08 21my $desc = q{Code is not tidy};
5dc3db7a 22my $expl = [ 33 ];
59b05e08
JRT
23
24#----------------------------------------------------------------------------
25
6bf9b465 26sub default_severity { return $SEVERITY_LOWEST }
7a6b5c70 27sub default_themes { return qw(pbp cosmetic) }
faa35de4 28sub applies_to { return 'PPI::Document' }
dff08b70 29
02558daa
CD
30#---------------------------------------------------------------------------
31
32sub new {
33 my ($class, %args) = @_;
34 my $self = bless {}, $class;
35
36 #Set configuration if defined
37 $self->{_perltidyrc} = $args{perltidyrc};
38 if (defined $self->{_perltidyrc} && $self->{_perltidyrc} eq $EMPTY)
39 {
40 $self->{_perltidyrc} = \$EMPTY;
41 }
42
43 return $self;
44}
45
dff08b70 46#----------------------------------------------------------------------------
59b05e08
JRT
47
48sub violates {
49 my ( $self, $elem, $doc ) = @_;
bf159007
JRT
50
51 # If Perl::Tidy is missing, silently pass this test
52 eval { require Perl::Tidy; };
53 return if $EVAL_ERROR;
59b05e08 54
05bf01cd 55 # Perl::Tidy seems to produce slightly different output, depending
871ec032 56 # on the trailing whitespace in the input. As best I can tell,
fd9d73d0
JRT
57 # Perl::Tidy will truncate any extra trailing newlines, and if the
58 # input has no trailing newline, then it adds one. But when you
59 # re-run it through Perl::Tidy here, that final newline gets lost,
60 # which causes the policy to insist that the code is not tidy.
61 # This only occurs when Perl::Tidy is writing the output to a
62 # scalar, but does not occur when writing to a file. I may
63 # investigate further, but for now, this seems to do the trick.
871ec032 64
02558daa 65 my $source = $doc->serialize();
fd9d73d0 66 $source =~ s{ \s+ \Z}{\n}mx;
871ec032 67
44b74300
CD
68 # Remove the shell fix code from the top of program, if applicable
69 my $shebang_re = qr/\#![^\015\012]+[\015\012]+/xms;
70 my $shell_re = qr/eval [ ] 'exec [ ] [^\015\012]* [ ] \$0 [ ] \${1\+"\$@"}'
71 [ \t]*[\012\015]+ [ \t]*if[^\015\012]+[\015\012]+/xms;
72 $source =~ s/\A ($shebang_re) $shell_re /$1/xms;
73
59b05e08 74 my $dest = $EMPTY;
59b05e08
JRT
75 my $stderr = $EMPTY;
76
871ec032 77
6bf9b465
JRT
78 # Perl::Tidy gets confused if @ARGV has arguments from
79 # another program. Also, we need to override the
80 # stdout and stderr redirects that the user may have
81 # configured in their .perltidyrc file.
82 local @ARGV = qw(-nst -nse); ## no critic
ee99f507 83
d5fc0818
JRT
84 # Trap Perl::Tidy errors, just in case it dies
85 eval {
0a6f07d0
AL
86 Perl::Tidy::perltidy(
87 source => \$source,
88 destination => \$dest,
89 stderr => \$stderr,
02558daa 90 defined $self->{_perltidyrc} ? (perltidyrc => $self->{_perltidyrc}) : (),
d5fc0818
JRT
91 );
92 };
93
94 if ($stderr || $EVAL_ERROR) {
59b05e08
JRT
95
96 # Looks like perltidy had problems
44b74300 97 return $self->violation( 'perltidy had errors!!', $expl, $elem );
59b05e08
JRT
98 }
99
47639f94 100 if ( $source ne $dest ) {
2c6df011 101 return $self->violation( $desc, $expl, $elem );
59b05e08
JRT
102 }
103
104 return; #ok!
105}
106
1071;
108
6bf9b465
JRT
109#----------------------------------------------------------------------------
110
59b05e08
JRT
111__END__
112
113=pod
114
115=head1 NAME
116
117Perl::Critic::Policy::CodeLayout::RequireTidyCode
118
119=head1 DESCRIPTION
120
121Conway does make specific recommendations for whitespace and
122curly-braces in your code, but the most important thing is to adopt a
123consistent layout, regardless of the specifics. And the easiest way
124to do that is to use L<Perl::Tidy>. This policy will complain if
125you're code hasn't been run through Perl::Tidy.
126
02558daa
CD
127=head1 CONSTRUCTOR
128
129This Policy accepts an additional key-value pair in the constructor.
130The key must be C<perltidyrc> and the value is the filename of a
131Perl::Tidy configuration file. The default is C<undef>, which tells
132Perl::Tidy to look in it's default location. Users of Perl::Critic
133can configure this in their F<.perlcriticrc> file like this:
134
135 [CodeLayout::RequireTidyCode]
136 perltidyrc = /usr/share/perltidy.conf
137
138As a special case, setting C<perltidyrc> to the empty string tells
139Perl::Tidy not to load any configuration file at all and just use
140Perl::Tidy's own default style.
141
142 [CodeLayout::RequireTidyCode]
143 perltidyrc =
144
59b05e08
JRT
145=head1 NOTES
146
df249cc5
JRT
147L<Perl::Tidy> is not included in the Perl::Critic distribution. The
148latest version of Perl::Tidy can be downloaded from CPAN. If
149Perl::Tidy is not installed, this policy is silently ignored.
59b05e08
JRT
150
151=head1 SEE ALSO
152
153L<Perl::Tidy>
154
59b05e08
JRT
155=head1 AUTHOR
156
157Jeffrey Ryan Thalhammer <thaljef@cpan.org>
158
159=head1 COPYRIGHT
160
c3c88e54 161Copyright (c) 2005-2006 Jeffrey Ryan Thalhammer. All rights reserved.
59b05e08
JRT
162
163This program is free software; you can redistribute it and/or modify
164it under the same terms as Perl itself. The full text of this license
165can be found in the LICENSE file included with this module.
166
167=cut