From 8ec6ddeb0ec2d164cc8d9336662d7c177010be02 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Fri, 4 Oct 2024 13:02:02 -0700 Subject: [PATCH] allow 0 as filename for script files or profiles --- lib/Perl/Tidy.pm | 50 +++++++++++++++++---------------- lib/Perl/Tidy/Formatter.pm | 25 +++++++++++------ local-docs/Release-Checklist.md | 4 +-- 3 files changed, 44 insertions(+), 35 deletions(-) diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 76ae1492..375f581c 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -2041,7 +2041,8 @@ sub process_all_files { my $debugfile_stream = $rinput_hash->{'debugfile'}; my $number_of_files = @{$rfiles}; - while ( my $input_file = shift @{$rfiles} ) { + while ( @{$rfiles} ) { + my $input_file = shift @{$rfiles}; my $fileroot; my @input_file_stat; @@ -3336,7 +3337,7 @@ sub make_logfile_header { } my $options_string = join( SPACE, @{$rraw_options} ); - if ($config_file) { + if ( defined($config_file) ) { $msg .= "Found Configuration File >>> $config_file \n"; } $msg .= "Configuration and command line parameters for this run:\n"; @@ -4507,9 +4508,9 @@ sub _process_command_line { } my @raw_options = (); - my $config_file = EMPTY_STRING; my $saw_ignore_profile = 0; my $saw_dump_profile = 0; + my $config_file; #-------------------------------------------------------------- # Take a first look at the command-line parameters. Do as many @@ -4528,7 +4529,7 @@ sub _process_command_line { $saw_dump_profile = 1; } elsif ( $i =~ /^-(pro|profile)=(.+)/ ) { - if ($config_file) { + if ( defined($config_file) ) { Warn( "Only one -pro=filename allowed, using '$2' instead of '$config_file'\n" ); @@ -4542,9 +4543,9 @@ sub _process_command_line { { $start_dir = '.' if !$start_dir; $start_dir = Cwd::realpath($start_dir); - if ( my $found_file = - find_file_upwards( $start_dir, $search_file ) ) - { + my $found_file = + find_file_upwards( $start_dir, $search_file ); + if ( defined($found_file) ) { $config_file = $found_file; } } @@ -4553,7 +4554,6 @@ sub _process_command_line { Die( "cannot find file given with -pro=$config_file: $OS_ERROR\n" ); - $config_file = EMPTY_STRING; } } elsif ( $i =~ /^-(pro|profile)=?$/ ) { @@ -4619,7 +4619,7 @@ sub _process_command_line { # as call parameter to perltidy and -pro=filename on command # line. if ($perltidyrc_stream) { - if ($config_file) { + if ( defined($config_file) ) { Warn(</.../, meaning look upwards from directory my $config_file = shift; - if ($config_file) { + if ( defined($config_file) ) { if ( my ( $start_dir, $search_file ) = ( $config_file =~ m{^(.*)\.\.\./(.*)$} ) ) { @@ -5494,9 +5495,8 @@ sub find_config_file { "# Searching Upward: $config_file\n"; $start_dir = '.' if !$start_dir; $start_dir = Cwd::realpath($start_dir); - if ( my $found_file = - find_file_upwards( $start_dir, $search_file ) ) - { + my $found_file = find_file_upwards( $start_dir, $search_file ); + if ( defined($found_file) ) { $config_file = $found_file; ${$rconfig_file_chatter} .= "# Found: $config_file\n"; } @@ -5746,8 +5746,9 @@ sub read_config_file { foreach my $item ( @{$rline_hash} ) { my $line = $item->{line}; my $line_no = $item->{line_no}; - $line =~ s/^ \s+ | \s+ $//gx; # trim both ends - next unless $line; + $line =~ s/^\s+//; + $line =~ s/\s+$//; + next unless ( length($line) ); my $body = $line; @@ -5850,7 +5851,7 @@ sub strip_comments_and_join_quotes { my $msg = EMPTY_STRING; my $rline_hash = []; - # quote variables + # quote state variables my $quote_char = EMPTY_STRING; my $quote_start_line = EMPTY_STRING; my $quote_start_line_no = -1; @@ -5867,6 +5868,7 @@ sub strip_comments_and_join_quotes { $line_no++; $line =~ s/^\s+//; $line =~ s/\s+$//; + next unless ( length($line) ); if ( !$quote_char ) { @@ -5907,7 +5909,7 @@ sub strip_comments_and_join_quotes { # -sbcp=# # Otherwise, it would have to be quoted: # -sbcp='#' - if ( !length($out_string) || $out_string =~ /\s$/ ) { + if ( !length($out_string) || $out_string =~ s/\s+$// ) { last; } $out_string .= $1; diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 4e2db39c..c109938f 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -1478,9 +1478,10 @@ sub split_words { # given a string containing words separated by whitespace, # return the list of words my ($str) = @_; - return unless $str; + return unless defined($str); $str =~ s/\s+$//; $str =~ s/^\s+//; + return unless length($str); return split /\s+/, $str; } ## end sub split_words @@ -1935,6 +1936,8 @@ sub initialize_weld_nested_exclusion_rules { my $opt_name = 'weld-nested-exclusion-list'; my $str = $rOpts->{$opt_name}; + + # let a '0' be the same as not defined return unless ($str); $str =~ s/^\s+//; $str =~ s/\s+$//; @@ -2099,6 +2102,8 @@ EOM sub initialize_line_up_parentheses_control_hash { my ( $str, $opt_name ) = @_; + + # let a 0 be the same as not defined return unless ($str); $str =~ s/^\s+//; $str =~ s/\s+$//; @@ -2123,7 +2128,7 @@ sub initialize_line_up_parentheses_control_hash { if ( $item =~ /^([^\(\]\{]*)?([\(\{\[])(\d)?$/ ) { $flag1 = $1 if $1; $key = $2 if $2; - $flag2 = $3 if $3; + $flag2 = $3 if defined($3); } else { $msg1 .= " '$item_save'"; @@ -2648,6 +2653,8 @@ use constant DEBUG_KB => 0; sub initialize_keep_old_breakpoints { my ( $str, $short_name, $rkeep_break_hash ) = @_; + + # 0 will be treated same as not defined return unless $str; my %flags = (); @@ -9548,7 +9555,7 @@ sub get_qw_list { # nothing if error my $rLL = $self->[_rLL_]; - return unless ($Kn); + return unless defined($Kn); my $type_n = $rLL->[$Kn]->[_TYPE_]; return unless ( $type_n eq 'q' ); my $token_n = $rLL->[$Kn]->[_TOKEN_]; @@ -9585,7 +9592,7 @@ sub expand_quoted_word_list { # ref to list if found words # undef if not successful, or non-constant list item encountered my $rLL = $self->[_rLL_]; - return unless ($Kbeg); + return unless defined($Kbeg); my $Klimit = @{$rLL} - 1; my @list; my $Kn = $Kbeg - 1; @@ -16388,7 +16395,7 @@ sub count_sub_input_args { elsif ( $type eq 'Q' ) { my $K_last_code = $self->K_previous_code($KK); - next unless $K_last_code; + next unless defined($K_last_code); my $K_last_type = $rLL->[$K_last_code]->[_TYPE_]; if ( $K_last_type eq 'Q' ) { @@ -16692,15 +16699,15 @@ sub count_return_values_wanted { my $seqno_c = $rLL->[$K_c]->[_TYPE_SEQUENCE_]; return if ( !$seqno_c ); my $Ko_c = $self->[_K_opening_container_]->{$seqno_c}; - return unless ($Ko_c); + return unless defined($Ko_c); my $K_c_new = $self->K_previous_code($Ko_c); - return unless ($K_c_new); + return unless defined($K_c_new); $type_c = $rLL->[$K_c_new]->[_TYPE_]; $token_c = $rLL->[$K_c_new]->[_TOKEN_]; if ( $type_c eq '->' ) { $K_c_new = $self->K_previous_code($K_c_new); - return unless ($K_c_new); + return unless defined($K_c_new); $type_c = $rLL->[$K_c_new]->[_TYPE_]; $token_c = $rLL->[$K_c_new]->[_TOKEN_]; } @@ -16876,7 +16883,7 @@ sub update_sub_call_paren_info { my $seqno = $rLL->[$K_closing_bracket]->[_TYPE_SEQUENCE_]; return unless ($seqno); my $Ko = $K_opening_container->{$seqno}; - return unless ($Ko); + return unless defined($Ko); my $Knum = $self->K_next_code($Ko); return unless ( $Knum && $rLL->[$Knum]->[_TOKEN_] eq '0' ); my $Kc = $self->K_next_code($Knum); diff --git a/local-docs/Release-Checklist.md b/local-docs/Release-Checklist.md index c1ff82fa..d1efa738 100644 --- a/local-docs/Release-Checklist.md +++ b/local-docs/Release-Checklist.md @@ -35,8 +35,8 @@ - perlbrew list [show installed versions] - perlbrew available --all [show all available versions] - or see https://www.cpan.org/src/README.html - - perlbrew install perl-5.8.0 [install perl-5.8.0, may need to force] - - perlbrew use perl-5.8.0 [switch to 5.8.0 in current shell] + - perlbrew install perl-5.8.1 [install perl-5.8.1, may need to force] + - perlbrew use perl-5.8.1 [switch to 5.8.1 in current shell] - Run tidyall -a to be sure code is tidied - note that I have tidyall set to also run perlcritic right now - run podchecker on all .pod files -- 2.39.5