# sure if this can be avoided.
[-Subroutines::ProhibitNestedSubs]
-# Make adjustment so that we don't require arg unpacking for very short
-# (possibly time-critical) subs.
+# Make an exception for very short (possibly time-critical) subs.
[Subroutines::RequireArgUnpacking]
short_subroutine_statements = 2
# supported, this restriction can be deleted
[-Variables::RequireLocalizedPunctuationVars]
-# sub 'backup_method_copy' in Perl::Tidy.pm has about 25 lines between open
-# and close, largely comments, so set the limit a bit higher.
+# Set the line limit a bit higher for sub 'backup_method_copy' in Perl::Tidy.pm
+# which has about 25 lines between open and close, largely comments.
[InputOutput::RequireBriefOpen]
lines=30
[-ControlStructures::ProhibitCascadingIfElse]
# This is a reasonable starting point but does not work well as a rigid rule.
+# So we have to turn it off.
[-ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions]
# This is a good general policy but not always possible in time-critical subs
max_characters=250
# A problem with ReqireExtendedFormatting is that it makes things needlessly
-# complex when matching things like line feeds and carriage returns. So
-# skip this.
+# complex when matching things like line feeds and carriage returns.
[-RegularExpressions::RequireExtendedFormatting]
#--------------------------------------------------------------
# to see what is going on.
[-ControlStructures::ProhibitPostfixControls]
-# Sometimes an unless statement is clearer than an if block, so why not use
-# it? For example, I might prefer the first of these:
-# return unless ($everything_is_ok);
-# vs.
-# return if (!$everything_is_ok);
-[-ControlStructures::ProhibitUnlessBlocks]
-
# This is a good general idea but has to be turned off because there are many
# cases where a number has been explained in a comment or is obvious.
[-ValuesAndExpressions::ProhibitMagicNumbers]
# you have a comparison of the form $b->[*] <=> $a->[*]. So skip this.
[-BuiltinFunctions::ProhibitReverseSortBlock]
-# There are too many of these in perltidy to change, and they seem fine.
+# There are too many of these in perltidy to change, and they seem fine
+# and not worth the effort of changing.
[-RegularExpressions::ProhibitEscapedMetacharacters]
# As the documentation says, this policy is not for everyone
# So skip this:
[-ValuesAndExpressions::ProhibitInterpolationOfLiterals]
-# These have been checked and are correct as written. So this policy
-# has to be turned off.
+# The cases flagged by this policy are correct as written. We have to
+# skip this.
[-ValuesAndExpressions::RequireInterpolationOfMetachars]
# Disagree: parens can add clarity and may even be essential, for example in
my @parts = @_;
# use File::Spec if we can
- unless ($missing_file_spec) {
+ if ( !$missing_file_spec ) {
return File::Spec->catfile(@parts);
}
my ($key) = @_;
my $hash_ref = $input_hash{$key};
if ( defined($hash_ref) ) {
- unless ( ref($hash_ref) eq 'HASH' ) {
+ if ( ref($hash_ref) ne 'HASH' ) {
my $what = ref($hash_ref);
my $but_is =
$what ? "but is ref to $what" : "but is not a reference";
# validate dump_options_type
if ( defined($dump_options) ) {
- unless ( defined($dump_options_type) ) {
+ if ( !defined($dump_options_type) ) {
$dump_options_type = 'perltidyrc';
}
if ( $dump_options_type ne 'perltidyrc'
$rOpts->{'encode-output-strings'} ? 'eos' : 'neos';
# be sure we have a valid output format
- unless ( exists $default_file_extension{ $rOpts->{'format'} } ) {
+ if ( !exists $default_file_extension{ $rOpts->{'format'} } ) {
my $formats = join SPACE,
sort map { "'" . $_ . "'" } keys %default_file_extension;
my $fmt = $rOpts->{'format'};
my $backup_file = $input_file . $backup_extension;
- unless ( -f $input_file ) {
+ if ( !-f $input_file ) {
# no real file to backup ..
# This shouldn't happen because of numerous preliminary checks
my $backup_name = $input_file . $backup_extension;
- unless ( -f $input_file ) {
+ if ( !-f $input_file ) {
# oh, oh, no real file to backup ..
# shouldn't happen because of numerous preliminary checks
else {
$fileroot = $input_file;
$display_name = $input_file;
- unless ( -e $input_file ) {
+ if ( !-e $input_file ) {
# file doesn't exist - check for a file glob
if ( $input_file =~ /([\?\*\[\{])/ ) {
next;
}
- unless ( -f $input_file ) {
+ if ( !-f $input_file ) {
Warn("skipping file: $input_file: not a regular file\n");
next;
}
# If for example a source file got clobbered somehow,
# the old .tdy or .bak files might still exist so we
# shouldn't overwrite them with zero length files.
- unless ( -s $input_file ) {
+ if ( !-s $input_file ) {
Warn("skipping file: $input_file: Zero size\n");
next;
}
next;
}
- unless ( ( -T $input_file ) || $rOpts->{'force-read-binary'} ) {
+ if ( !-T $input_file && !$rOpts->{'force-read-binary'} ) {
Warn("skipping file: $input_file: Non-text (override with -f)\n"
);
next;
my ( $base, $old_path ) = fileparse($fileroot);
my $new_path = $rOpts->{'output-path'};
- unless ( -d $new_path ) {
- unless ( mkdir $new_path, 0777 ) {
- Die("unable to create directory $new_path: $OS_ERROR\n"
- );
- }
+ if ( !-d $new_path ) {
+ mkdir( $new_path, 0777 )
+ or
+ Die("unable to create directory $new_path: $OS_ERROR\n");
}
my $path = $new_path;
$fileroot = catfile( $path, $base );
- unless ($fileroot) {
+ if ( !$fileroot ) {
Die(<<EOM);
------------------------------------------------------------------------
Problem combining $new_path and $base to make a filename; check -opath
Die("I don't know how to do -format=$rOpts->{'format'}\n");
}
- unless ($formatter) {
+ if ( !$formatter ) {
Die("Unable to continue with $rOpts->{'format'} formatting\n");
}
local @ARGV = ();
# do not load the defaults if we are just dumping perltidyrc
- unless ( $dump_options_type eq 'perltidyrc' ) {
+ if ( $dump_options_type ne 'perltidyrc' ) {
for my $i ( @{$rdefaults} ) { push @ARGV, "--" . $i }
}
if ( !GetOptions( \%Opts, @{$roption_string} ) ) {
}
}
}
- unless ( -e $config_file ) {
+ if ( !-e $config_file ) {
Warn(
"cannot find file given with -pro=$config_file: $OS_ERROR\n"
);
#----------------------------------------
# read any .perltidyrc configuration file
#----------------------------------------
- unless ($saw_ignore_profile) {
+ if ( !$saw_ignore_profile ) {
# resolve possible conflict between $perltidyrc_stream passed
# as call parameter to perltidy and -pro=filename on command
# If $os is undefined, the above code is out of date. Suggested updates
# are welcome.
- unless ( defined $os ) {
+ if ( !defined($os) ) {
$os = EMPTY_STRING;
# Deactivated this message 20180322 because it was needlessly
# implement outdenting preferences for keywords
%outdent_keyword = ();
my @okw = split_words( $rOpts->{'outdent-keyword-list'} );
- unless (@okw) {
+ if ( !@okw ) {
@okw = qw(next last redo goto return); # defaults
}
if ( defined($kpit_value) && $kpit_value != 1 ) {
my @kpit =
split_words( $rOpts->{'keyword-paren-inner-tightness-list'} );
- unless (@kpit) {
+ if ( !@kpit ) {
@kpit = qw(if elsif unless while until for foreach); # defaults
}
# for leading '.' align all but 'short' quotes; the idea
# is to not place something like "\n" on a single line.
if ( $right_key eq '.' ) {
- unless (
- $last_nonblank_type eq '.'
- && ( $token_length <=
- $rOpts_short_concatenation_item_length )
- && ( !$is_closing_token{$token} )
- )
- {
+
+ my $is_short_quote = $last_nonblank_type eq '.'
+ && ( $token_length <=
+ $rOpts_short_concatenation_item_length )
+ && !$is_closing_token{$token};
+
+ if ( !$is_short_quote ) {
$bias{$right_key} += $delta_bias;
}
}
$flags .= "-ce" if ( $rOpts->{'cuddled-else'} );
$flags .= " -cbl='$cuddled_string'";
- unless ( $rOpts->{'cuddled-else'} ) {
+ if ( !$rOpts->{'cuddled-else'} ) {
$flags .= "\nNote: You must specify -ce to generate a cuddled hash";
}
sub make_format_skipping_pattern {
my ( $opt_name, $default ) = @_;
my $param = $rOpts->{$opt_name};
- unless ($param) { $param = $default }
+ if ( !$param ) { $param = $default }
$param =~ s/^\s*//;
if ( $param !~ /^#/ ) {
Die("ERROR: the $opt_name parameter '$param' must begin with '#'\n");
# returns a list of all selected package statements in a file
my @package_list;
- unless ( $rdump_block_types->{'*'}
- || $rdump_block_types->{'package'}
- || $rdump_block_types->{'class'} )
+ if ( !$rdump_block_types->{'*'}
+ && !$rdump_block_types->{'package'}
+ && !$rdump_block_types->{'class'} )
{
return \@package_list;
}
}
my $rK_range = $line_of_tokens->{_rK_range};
my ( $Kfirst, $Klast ) = @{$rK_range};
- unless ( defined($Kfirst) && $rLL->[$Klast]->[_TYPE_] eq '#' ) {
+ if ( !defined($Kfirst) || $rLL->[$Klast]->[_TYPE_] ne '#' ) {
# shouldn't happen
DEVEL_MODE && Fault("did not get a comment\n");
my $rK_range = $line_of_tokens->{_rK_range};
my ( $Kfirst, $Klast ) = @{$rK_range};
- unless ( defined($Kfirst) && $rLL->[$Klast]->[_TYPE_] eq '#' ) {
+ if ( !defined($Kfirst) || $rLL->[$Klast]->[_TYPE_] ne '#' ) {
if (DEVEL_MODE) {
my $lno = $ix + 1;
Fault(<<EOM);
my $type_prev = $rLL->[$Kprev]->[_TYPE_];
my $type_pp = 'b';
if ( $Kprev >= 0 ) { $type_pp = $rLL->[ $Kprev - 1 ]->[_TYPE_] }
- unless (
- $type_prev =~ /^[\,\.\;]/
- || $type_prev =~ /^[=\{\[\(\L]/
- && ( $type_pp eq 'b' || $type_pp eq '}' || $type_first eq 'k' )
- || $type_first =~ /^[=\,\.\;\{\[\(\L]/
- || $type_first eq '||'
- || (
- $type_first eq 'k'
- && ( $token_first eq 'if'
- || $token_first eq 'or' )
- )
- )
- {
+
+ my $is_good_location =
+
+ $type_prev =~ /^[\,\.\;]/
+ || ( $type_prev =~ /^[=\{\[\(\L]/
+ && ( $type_pp eq 'b' || $type_pp eq '}' || $type_first eq 'k' ) )
+ || $type_first =~ /^[=\,\.\;\{\[\(\L]/
+ || $type_first eq '||'
+ || (
+ $type_first eq 'k'
+ && ( $token_first eq 'if'
+ || $token_first eq 'or' )
+ );
+
+ if ( !$is_good_location ) {
$msg =
"Skipping weld: poor break with -lp and ci at type_first='$type_first' type_prev='$type_prev' type_pp=$type_pp\n";
$new_weld_ok = 0;
#--------------------------------------------
if ( $self->[_save_logfile_] ) {
+ my $guessed_indentation_level =
+ $line_of_tokens->{_guessed_indentation_level};
+
# Compare input/output indentation except for:
# - hanging side comments
# - continuation lines (have unknown leading blank space)
# - and lines which are quotes (they may have been outdented)
- my $guessed_indentation_level =
- $line_of_tokens->{_guessed_indentation_level};
+ my $exception =
+ $CODE_type eq 'HSC'
+ || $rtok_first->[_CI_LEVEL_] > 0
+ || $guessed_indentation_level == 0
+ && $rtok_first->[_TYPE_] eq 'Q';
- unless ( $CODE_type eq 'HSC'
- || $rtok_first->[_CI_LEVEL_] > 0
- || $guessed_indentation_level == 0
- && $rtok_first->[_TYPE_] eq 'Q' )
- {
+ if ( !$exception ) {
my $input_line_number = $line_of_tokens->{_line_number};
$self->compare_indentation_levels( $K_first,
$guessed_indentation_level, $input_line_number );
# } else ...
if ($rbrace_follower) {
my $token = $rtoken_vars->[_TOKEN_];
- unless ( $rbrace_follower->{$token} ) {
+ if ( !$rbrace_follower->{$token} ) {
$self->end_batch() if ( $max_index_to_go >= 0 );
}
$rbrace_follower = undef;
{
# but only if allowed
- unless ($nobreak_BEFORE_BLOCK) {
+ if ( !$nobreak_BEFORE_BLOCK ) {
# since we already stored this token, we must unstore it
$self->unstore_token_to_go();
elsif ( ( $next_nonblank_token_type eq 'b' )
&& $rOpts_add_newlines )
{
- unless ($rbrace_follower) {
+ if ( !$rbrace_follower ) {
$self->end_batch()
unless ( $no_internal_newlines
|| $max_index_to_go < 0 );
if ( substr( $block_type, -2, 2 ) eq '()' ) {
$stripped_block_type = substr( $block_type, 0, -2 );
}
- unless ( $tokens_to_go[$i_start] eq $stripped_block_type ) {
+ if ( $tokens_to_go[$i_start] ne $stripped_block_type ) {
return;
}
}
if ( $types_to_go[$i_start] eq 'b' ) {
$i_start++;
}
- unless ( $tokens_to_go[$i_start] eq $block_type ) {
+ if ( $tokens_to_go[$i_start] ne $block_type ) {
return;
}
}
$nline = 0 if ( $i_opening < $ri_start->[$nline] );
# find the correct line
- unless ( $i_opening > $ri_last->[-1] ) {
+ if ( $i_opening <= $ri_last->[-1] ) {
while ( $i_opening > $ri_last->[$nline] ) { $nline++; }
}
# Nesting depths are set to be >=0 in sub write_line, so it should
# not be possible to get here unless the code has a bracing error
# which leaves a closing brace with zero nesting depth.
- unless ( get_saw_brace_error() ) {
+ if ( !get_saw_brace_error() ) {
if (DEVEL_MODE) {
Fault(<<EOM);
Program bug in pad_array_to_go: hit nesting error which should have been caught
}
}
- unless ( $tokens_to_go[$ibeg_2] =~ /^[\{\(\[]$/ ) {
+ if ( $tokens_to_go[$ibeg_2] !~ /^[\{\(\[]$/ ) {
$forced_breakpoint_to_go[$iend_1] = 0;
}
}
# keywords look best at start of lines,
# but combine things like "1 while"
- unless ( $is_assignment{$type_iend_1} ) {
+ if ( !$is_assignment{$type_iend_1} ) {
return
if ( ( $type_iend_1 ne 'k' )
&& ( $tokens_to_go[$ibeg_2] ne 'while' ) );
my $icomma = $last_comma_index[$depth];
if ( defined($icomma) && ( $i_opening - $icomma ) < 5 ) {
- unless ( $forced_breakpoint_to_go[$icomma] ) {
+ if ( !$forced_breakpoint_to_go[$icomma] ) {
$self->set_forced_breakpoint($icomma);
}
}
# NOTE: we should really use the true break count here,
# which can be greater if there are large terms and
# little space, but usually this will work well enough.
- unless ($must_break_open) {
+ if ( !$must_break_open ) {
if ( $break_count <= 1 ) {
${$rdo_not_break_apart} = 1;
$ri_ragged_break_list );
++$break_count if ($use_separate_first_term);
- unless ($must_break_open_container) {
+ if ( !$must_break_open_container ) {
if ( $break_count <= 1 ) {
${$rdo_not_break_apart} = 1;
}
$total_variation_2 = $total_variation_2[0] + $total_variation_2[1];
my $factor = ( $item_count > 10 ) ? 1 : ( $item_count > 5 ) ? 0.75 : 0;
- unless ( $total_variation_2 < $factor * $total_variation_1 ) {
+ if ( $total_variation_2 >= $factor * $total_variation_1 ) {
$number_of_fields_best = 1;
}
}
min( $ovt, $self->[_rmax_vertical_tightness_]->{$seqno} );
}
- unless (
- $ovt < 2
- && ( $nesting_depth_to_go[ $iend_next + 1 ] !=
+ if (
+ $ovt >= 2
+ || ( $nesting_depth_to_go[ $iend_next + 1 ] ==
$nesting_depth_to_go[$ibeg_next] )
)
{
projects / perltidy.git / commitdiff