1 ##############################################################################
2 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm $
3 # $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
6 ##############################################################################
8 package Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros;
16 use Perl::Critic::Utils qw{ :characters :severities };
17 use base 'Perl::Critic::Policy';
19 our $VERSION = '1.088';
21 #-----------------------------------------------------------------------------
23 Readonly::Scalar my $LEADING_RX => qr<\A [+-]? (?: 0+ _* )+ [1-9]>mx;
24 Readonly::Scalar my $EXPL => [ 58 ];
26 #-----------------------------------------------------------------------------
28 sub supported_parameters {
33 q<Don't allow any leading zeros at all. Otherwise builtins that deal with Unix permissions, e.g. chmod, don't get flagged.>,
34 default_string => '0',
35 behavior => 'boolean',
40 sub default_severity { return $SEVERITY_HIGHEST }
41 sub default_themes { return qw< core pbp bugs > }
42 sub applies_to { return 'PPI::Token::Number::Octal' }
44 #-----------------------------------------------------------------------------
47 my ( $self, $elem, undef ) = @_;
49 return if $elem !~ $LEADING_RX;
50 return $self->_create_violation($elem) if $self->{_strict};
51 return if $self->_is_first_argument_of_chmod_or_umask($elem);
52 return if $self->_is_second_argument_of_mkdir($elem);
53 return if $self->_is_third_argument_of_dbmopen($elem);
54 return if $self->_is_fourth_argument_of_sysopen($elem);
55 return $self->_create_violation($elem);
58 sub _create_violation {
59 my ($self, $elem) = @_;
61 return $self->violation(
62 qq<Integer with leading zeros: "$elem">,
68 sub _is_first_argument_of_chmod_or_umask {
69 my ($self, $elem) = @_;
71 my $previous_token = _previous_token_that_isnt_a_parenthesis($elem);
72 return if not $previous_token;
74 my $content = $previous_token->content();
75 return $content eq 'chmod' || $content eq 'umask';
78 sub _is_second_argument_of_mkdir {
79 my ($self, $elem) = @_;
82 my $previous_token = _previous_token_that_isnt_a_parenthesis($elem);
83 return if not $previous_token;
84 return if $previous_token->content() ne $COMMA; # Don't know what it is.
88 _previous_token_that_isnt_a_parenthesis($previous_token);
89 return if not $previous_token;
92 _previous_token_that_isnt_a_parenthesis($previous_token);
93 return if not $previous_token;
95 return $previous_token->content() eq 'mkdir';
98 sub _is_third_argument_of_dbmopen {
99 my ($self, $elem) = @_;
102 my $previous_token = _previous_token_that_isnt_a_parenthesis($elem);
103 return if not $previous_token;
104 return if $previous_token->content() ne $COMMA; # Don't know what it is.
108 _previous_token_that_isnt_a_parenthesis($previous_token);
109 return if not $previous_token;
113 _previous_token_that_isnt_a_parenthesis($previous_token);
114 return if not $previous_token;
115 return if $previous_token->content() ne $COMMA; # Don't know what it is.
119 _previous_token_that_isnt_a_parenthesis($previous_token);
120 return if not $previous_token;
123 _previous_token_that_isnt_a_parenthesis($previous_token);
124 return if not $previous_token;
126 return $previous_token->content() eq 'dbmopen';
129 sub _is_fourth_argument_of_sysopen {
130 my ($self, $elem) = @_;
133 my $previous_token = _previous_token_that_isnt_a_parenthesis($elem);
134 return if not $previous_token;
135 return if $previous_token->content() ne $COMMA; # Don't know what it is.
139 _previous_token_that_isnt_a_parenthesis($previous_token);
140 while ($previous_token and $previous_token->content() ne $COMMA) {
142 _previous_token_that_isnt_a_parenthesis($previous_token);
144 return if not $previous_token;
145 return if $previous_token->content() ne $COMMA; # Don't know what it is.
149 _previous_token_that_isnt_a_parenthesis($previous_token);
150 return if not $previous_token;
154 _previous_token_that_isnt_a_parenthesis($previous_token);
155 return if not $previous_token;
156 return if $previous_token->content() ne $COMMA; # Don't know what it is.
160 _previous_token_that_isnt_a_parenthesis($previous_token);
161 return if not $previous_token;
164 _previous_token_that_isnt_a_parenthesis($previous_token);
165 return if not $previous_token;
167 return $previous_token->content() eq 'sysopen';
170 sub _previous_token_that_isnt_a_parenthesis {
173 my $previous_token = $elem->previous_token();
177 not $previous_token->significant()
178 or $previous_token->content() eq $LEFT_PAREN
179 or $previous_token->content() eq $RIGHT_PAREN
182 $previous_token = $previous_token->previous_token();
185 return $previous_token;
192 #-----------------------------------------------------------------------------
198 Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros - Write C<oct(755)> instead of C<0755>.
202 This Policy is part of the core L<Perl::Critic> distribution.
207 Perl interprets numbers with leading zeros as octal. If that's what
208 you really want, its better to use C<oct> and make it obvious.
210 $var = 041; # not ok, actually 33
213 chmod 0644, $file; # ok by default
214 dbmopen %database, 'foo.db', 0600; # ok by default
215 mkdir $directory, 0755; # ok by default
216 sysopen $filehandle, $filename, O_RDWR, 0666; # ok by default
217 umask 0002; # ok by default
221 If you want to ban all leading zeros, set C<strict> to a true value in
222 a F<.perlcriticrc> file.
224 [ValuesAndExpressions::ProhibitLeadingZeros]
230 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
234 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
236 This program is free software; you can redistribute it and/or modify
237 it under the same terms as Perl itself. The full text of this license
238 can be found in the LICENSE file included with this module.
244 # cperl-indent-level: 4
246 # indent-tabs-mode: nil
247 # c-indentation-style: bsd
249 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :