will process F<somefile.pl> normally but issue a warning if either of
the issues 's' or 'r', but not 'p', described above, are encountered.
-A limitation is that warnings may not be requested for unused variables, type
-'u'. The is because this would produce many needless warnings, especially when
-perltidy is run on small snippets of code from within an editor. So
-unused variables can only be found with the B<-duv> option described in the
-previous section.
+The 'u' option (unused) has a limitation: it is not allowed in a F<.perltidyrc>
+configuration file. But it can be used on the command line provided that
+perltidy is operating on a named file. This rule is necessary to avoid
+warnings when perltidy is run on small snippets of code from within an editor.
A companion flag, B<--warn-variable-exclusion-list=string>, or B<-wvxl=string>,
-can be used to skip warning checks for a list of variables. For example,
+can be used to skip warning checks for a list of variable names. A leading
+and/or trailing '*' may be placed on any of these variable names to allow a
+partial match. For example
- perltidy -wvt='*' -wvxl='$self $class' somefile.pl
+For example,
+
+ perltidy -wvt='*' -wvxl='$self $class *_unused' somefile.pl
-will do all possible checks but not report any warnings for variables C<$self>
-and C<$class>.
+will do all possible checks but not report any warnings for variables C<$self>,
+C<$class>, and for example C<$value_unused>.
=item B<Use --dump-mixed-call-parens to find functions called both with and without parens>
# This routine is called to check the user-supplied run parameters
# and to configure the control hashes to them.
- $rOpts = shift;
+ ( $rOpts, my $wvt_in_args, my $num_files ) = @_;
initialize_whitespace_hashes();
initialize_call_paren_style();
- initialize_warn_variable_types();
+ initialize_warn_variable_types( $wvt_in_args, $num_files );
initialize_warn_mismatched_args();
$roption = { 'r' => 1, 's' => 1, 'p' => 1, 'u' => 1 };
}
+ my $issue_type_string = "Issue types are";
+ if ( $roption->{'u'} ) { $issue_type_string .= " 'u'=unused" }
+ if ( $roption->{'r'} ) { $issue_type_string .= " 'r'=reused" }
+ if ( $roption->{'s'} ) { $issue_type_string .= " 's'=multi-sigil" }
+ if ( $roption->{'p'} ) { $issue_type_string .= " 'p'=package crossing" }
+
# Unpack the control hash
my $check_sigil = $roption->{'s'};
my $check_cross_package = $roption->{'p'};
my @sorted =
sort { $a->{K} <=> $b->{K} || $a->{letter} cmp $b->{letter} } @warnings;
- return \@sorted;
+ return ( \@sorted, $issue_type_string );
} ## end sub scan_variable_usage
sub dump_unusual_variables {
# process a --dump-unusual-variables(-duv) command
- my $rlines = $self->scan_variable_usage();
+ my ( $rlines, $issue_type_string ) = $self->scan_variable_usage();
return unless ( $rlines && @{$rlines} );
+ my $input_stream_name = get_input_stream_name();
+
# output for multiple types
my $output_string = <<EOM;
-Issue types are 'u'=unused 'r'=reused 's'=multi-sigil 'p'=package crossing
+$input_stream_name: output for --dump-unusual-variables
+$issue_type_string
Line:Issue: Var: note
EOM
foreach my $item ( @{$rlines} ) {
sub initialize_warn_variable_types {
+ my ( $wvt_in_args, $num_files ) = @_;
+
# Initialization for:
# --warn-variable-types=s and
# --warn-variable-exclusion-list=s
+ # Given:
+ # $wvt_in_args = true if the -wvt parameter was on the command line
+ # $num_files = number of files on the command line
+
%warn_variable_types = ();
%is_warn_variable_excluded_name = ();
# r - reused scope
# s - reused sigil
# p - package boundaries crossed by lexical variables
+ # u - only if -wvt and filename(s) are on command line; see git #151
# Other controls:
# 0 - none of the above
# 1 - all of the above
# * - all of the above
- # u - [NOT AVAILABLE, use --dump-unusual-variables]
# Example:
# -wvt='s r' : do check types 's' and 'r'
my @all_opts = qw(r s p);
+ if ( $wvt_in_args && $num_files ) { push @all_opts, 'u' }
my %is_valid_option;
@is_valid_option{@all_opts} = (1) x scalar(@all_opts);
return;
}
else {
- # should be one of r,s,p - catch any error below
+ # should be one of r,s,p, maybe u - catch any error below
}
}
"--$wvt_key cannot contain $opt mixed with other options\n";
}
elsif ( $opt eq 'u' ) {
- Warn(<<EOM);
---$wvt_key=u is not available; use --dump-unusual-variables=u to find unused vars
+ if ( !$wvt_in_args ) {
+ Warn(<<EOM);
+--$wvt_key=u is not allowed in a .perltidyrc configuration file
EOM
+ }
+ else {
+ Warn(<<EOM);
+--$wvt_key=u is only available when processing specific filenames
+EOM
+ }
}
else {
$msg .= "--$wvt_key has unexpected symbol: '$opt'\n";
my @xl = split_words($excluded_names);
my $err_msg = EMPTY_STRING;
foreach my $name (@xl) {
- if ( $name !~ /^[\$\@\%]?\w+$/ ) {
+ if ( $name =~ /^([\$\@\%\*])?(\w+)(\*)?$/ ) {
+ my $left_star = $1;
+ my $key = $2;
+ my $right_star = $3;
+ if ( defined($left_star) ) {
+ if ( $left_star ne '*' ) {
+ $key = $left_star . $key;
+ $left_star = EMPTY_STRING;
+ }
+ }
+
+ # Wildcard matching codes:
+ # 1 = no stars
+ # 2 = left star only
+ # 3 = right star only
+ # 4 = both left and right stars
+ my $code = 1;
+ $code += 1 if ($left_star);
+ $code += 2 if ($right_star);
+
+ $is_warn_variable_excluded_name{$key} = $code;
+ }
+ else {
$err_msg .= "-wvxl has unexpected name: '$name'\n";
}
}
if ($err_msg) { Die($err_msg) }
- @is_warn_variable_excluded_name{@xl} = (1) x scalar(@xl);
}
return;
} ## end sub initialize_warn_variable_types
my $wv_option = $rOpts->{$wv_key};
return unless (%warn_variable_types);
- my $rwarnings = $self->scan_variable_usage( \%warn_variable_types );
+ my ( $rwarnings, $issue_type_string ) =
+ $self->scan_variable_usage( \%warn_variable_types );
return unless ( $rwarnings && @{$rwarnings} );
- my $message = "Begin scan for --$wv_key=$wv_option\n";
- $message .= <<EOM;
-Issue types are 'r'=reused 's'=multi-sigil 'p'=package crossing
-Line:Issue: Var: note
-EOM
+ my @wildcard_prefixes;
+ foreach my $key ( keys %is_warn_variable_excluded_name ) {
+ my $val = $is_warn_variable_excluded_name{$key};
+ if ( $val > 1 ) {
+ push @wildcard_prefixes, [ $key, $val ];
+ }
+ }
- # output the results, ignoring any excluded names
+ my $is_excluded = sub {
+
+ my $name = shift;
+
+ # check for direct match
+ if ( $is_warn_variable_excluded_name{$name} ) { return 1 }
+
+ # look for wildcard match
+ foreach (@wildcard_prefixes) {
+ my ( $key, $code ) = @{$_};
+ my $len_key = length($key);
+ my $len_name = length($name);
+ next if ( $len_name < $len_key );
+
+ # code 2 = left star only
+ if ( $code == 2 ) {
+ if ( substr( $name, -$len_key, $len_key ) eq $key ) { return 1 }
+ }
+
+ # code 3 = right star only
+ elsif ( $code == 3 ) {
+ if ( substr( $name, 0, $len_key ) eq $key ) { return 1 }
+ }
+
+ # code 4 = both left and right stars
+ elsif ( $code == 4 ) {
+ if ( index( $name, $key, 0 ) >= 0 ) { return 1 }
+ }
+ else {
+ DEVEL_MODE && Fault("unexpected code '$code' for '$name'\n");
+ }
+ }
+ return;
+ };
+
+ # loop to form error messages
+ my $message_middle = EMPTY_STRING;
foreach my $item ( @{$rwarnings} ) {
my $name = $item->{name};
- next if ( $is_warn_variable_excluded_name{$name} );
+
+ # ignore excluded names
+ next if ( $is_excluded->($name) );
+
my $lno = $item->{line_number};
my $letter = $item->{letter};
my $keyword = $item->{keyword};
my $note = $item->{note};
if ($note) { $note = ": $note" }
- $message .= "$lno:$letter: $keyword $name$note\n";
+ $message_middle .= "$lno:$letter: $keyword $name$note\n";
+ }
+
+ if ($message_middle) {
+ my $message = "Begin scan for --$wv_key=$wv_option\n";
+ $message .= <<EOM;
+$issue_type_string
+Line:Issue: Var: note
+EOM
+ $message .= $message_middle;
+ $message .= "End scan for --$wv_key=$wv_option:\n";
+ warning($message);
}
- $message .= "End scan for --$wv_key=$wv_option:\n";
- warning($message);
return;
} ## end sub warn_variable_types
projects / perltidy.git / commitdiff