From: Steve Hancock Date: Wed, 3 Jan 2024 02:50:29 +0000 (-0800) Subject: fix numerous issues in examples found with -duv X-Git-Tag: 20230912.12~19 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=f4652c07875487cfc7006a7507bba8263bfe949b;p=perltidy.git fix numerous issues in examples found with -duv --- diff --git a/examples/bbtidy.pl b/examples/bbtidy.pl index 79cd4429..9d66758d 100644 --- a/examples/bbtidy.pl +++ b/examples/bbtidy.pl @@ -3,10 +3,12 @@ # This program was posted on the MacPerl mailing list by # Charles Albrecht as one way to get perltidy to work as a filter # under BBEdit. +# 20240102: slh fixed obvious error found with -duv: ('my' inside BEGIN block) use Perl::Tidy; -BEGIN { my $input_string = ""; my $output_string = ""; } +my ($input_string, $output_string); +BEGIN { $input_string = ""; $output_string = ""; } $input_string .= $_; diff --git a/examples/break_long_quotes.pl b/examples/break_long_quotes.pl index ba40d9a5..85086aec 100755 --- a/examples/break_long_quotes.pl +++ b/examples/break_long_quotes.pl @@ -25,23 +25,28 @@ use Getopt::Std; $| = 1; use vars qw($opt_l $opt_h); -my $usage = <outfile where n=line length (default 72) EOM -getopts('hl:') or die "$usage"; -if ($opt_h) { die $usage } -if ( !defined $opt_l ) { - $opt_l = 70; -} -else { - $opt_l =~ /^\d+$/ or die "$usage"; -} + getopts('hl:') or die "$usage"; + if ($opt_h) { die $usage } + if ( !defined $opt_l ) { + $opt_l = 70; + } + else { + $opt_l =~ /^\d+$/ or die "$usage"; + } -unless ( @ARGV == 1 ) { die $usage } -my $file = $ARGV[0]; -scan_file( $file, $opt_l ); + unless ( @ARGV == 1 ) { die $usage } + my $file = $ARGV[0]; + scan_file( $file, $opt_l ); +} sub scan_file { my ( $file, $line_length ) = @_; @@ -51,13 +56,13 @@ sub scan_file { unless ($fh) { die "cannot open '$file': $!\n" } my $formatter = MyWriter->new($line_length); - my $err=perltidy( + my $err = perltidy( 'formatter' => $formatter, # callback object 'source' => $fh, 'argv' => "-npro -se", # don't need .perltidyrc # errors to STDOUT ); - if ($err){ + if ($err) { die "Error calling perltidy\n"; } $fh->close(); @@ -107,7 +112,7 @@ sub write_line { # find leading whitespace my $leading_whitespace = ( $input_line =~ /^(\s*)/ ) ? $1 : ""; - if ($starting_in_quote) {$leading_whitespace=""}; + if ($starting_in_quote) { $leading_whitespace = "" } my $new_line = $leading_whitespace; # loop over tokens looking for quotes (token type Q) @@ -119,7 +124,7 @@ sub write_line { # look for long quoted strings on a single line # (multiple line quotes not currently handled) if ( $$rtoken_type[$j] eq 'Q' - && !( $j == 0 && $starting_in_quote ) + && !( $j == 0 && $starting_in_quote ) && !( $j == $jmax && $ending_in_quote ) && ( length($token) > $max_quote_length ) ) { @@ -148,7 +153,7 @@ EOM } ## end if ( $line_type eq 'CODE') # print the line - $self->print($input_line."\n"); + $self->print( $input_line . "\n" ); return; } ## end sub write_line @@ -157,8 +162,7 @@ sub break_at_blanks { # break a string at one or more spaces so that the longest substring is # less than the desired length (if possible). my ( $str, $quote_char, $max_length ) = @_; - my $blank = ' '; - my $prev_char = ""; + my $blank = ' '; my @break_after_pos; my $quote_pos = -1; while ( ( $quote_pos = index( $str, $blank, 1 + $quote_pos ) ) >= 0 ) { @@ -196,5 +200,4 @@ sub print { # called once after the last line of a file sub finish_formatting { my $self = shift; - $self->flush_comments(); } diff --git a/examples/delete_ending_blank_lines.pl b/examples/delete_ending_blank_lines.pl index 7acad2e3..360aa2fd 100755 --- a/examples/delete_ending_blank_lines.pl +++ b/examples/delete_ending_blank_lines.pl @@ -3,7 +3,7 @@ use strict; # Example script for removing trailing blank lines of code from a perl script # This is from the examples/ directory of the perltidy distribution and may -# be modified as needed. +# be modified as needed. # This was written in response to RT #118553, "leave only one newline at end of file". # Adding the requested feature to perltidy itself would have very undesirable @@ -18,43 +18,48 @@ use Perl::Tidy; use IO::File; $| = 1; use vars qw($opt_h); -my $usage = <outfile EOM -getopts('h') or die "$usage"; -if ($opt_h) { die $usage } - -# Make the source for perltidy, which will be a filehandle -# or just '-' if the source is stdin -my ($file, $fh, $source); -if ( @ARGV == 0 ) { - $source = '-'; -} -elsif ( @ARGV == 1 ) { - $file = $ARGV[0]; - $fh = IO::File->new( $file, 'r' ); - unless ($fh) { die "cannot open '$file': $!\n" } - $source = $fh; -} -else { die $usage } - -# make the callback object -my $formatter = MyFormatter->new(); - -my $dest; - -# start perltidy, which will start calling our write_line() -my $err=perltidy( - 'formatter' => $formatter, # callback object - 'source' => $source, - 'destination' => \$dest, # (not really needed) - 'argv' => "-npro -se", # dont need .perltidyrc - # errors to STDOUT -); -if ($err) { - die "Error calling perltidy\n"; + getopts('h') or die "$usage"; + if ($opt_h) { die $usage } + + # Make the source for perltidy, which will be a filehandle + # or just '-' if the source is stdin + my ( $file, $fh, $source ); + if ( @ARGV == 0 ) { + $source = '-'; + } + elsif ( @ARGV == 1 ) { + $file = $ARGV[0]; + $fh = IO::File->new( $file, 'r' ); + unless ($fh) { die "cannot open '$file': $!\n" } + $source = $fh; + } + else { die $usage } + + # make the callback object + my $formatter = MyFormatter->new(); + + my $dest; + + # start perltidy, which will start calling our write_line() + my $err = perltidy( + 'formatter' => $formatter, # callback object + 'source' => $source, + 'destination' => \$dest, # (not really needed) + 'argv' => "-npro -se", # dont need .perltidyrc + # errors to STDOUT + ); + if ($err) { + die "Error calling perltidy\n"; + } + $fh->close() if $fh; + return; } -$fh->close() if $fh; package MyFormatter; @@ -68,8 +73,8 @@ sub new { sub write_line { # This is called from perltidy line-by-line; we just save lines - my $self = shift; - my $line_of_tokens = shift; + my $self = shift; + my $line_of_tokens = shift; push @lines, $line_of_tokens; } @@ -78,22 +83,22 @@ sub finish_formatting { my $self = shift; # remove all trailing blank lines of code - while (my $line_of_tokens = pop(@lines)) { - my $line_type = $line_of_tokens->{_line_type}; - my $input_line = $line_of_tokens->{_line_text}; + while ( my $line_of_tokens = pop(@lines) ) { + my $line_type = $line_of_tokens->{_line_type}; + my $input_line = $line_of_tokens->{_line_text}; if ( $line_type eq 'CODE' ) { chomp $input_line; next unless ($input_line); } - push @lines, $line_of_tokens; - last; + push @lines, $line_of_tokens; + last; } # write remaining lines foreach my $line_of_tokens (@lines) { - my $line_type = $line_of_tokens->{_line_type}; - my $input_line = $line_of_tokens->{_line_text}; - print $input_line; + my $line_type = $line_of_tokens->{_line_type}; + my $input_line = $line_of_tokens->{_line_text}; + print $input_line; } return; } diff --git a/examples/find_naughty.pl b/examples/find_naughty.pl index fb5719ce..f24c15f9 100755 --- a/examples/find_naughty.pl +++ b/examples/find_naughty.pl @@ -6,7 +6,7 @@ use strict; # # usage: # find_naughty file1 [file2 [...]] -# find_naughty $source, - ); + unless (@ARGV) { unshift @ARGV, '-' } # stdin + foreach my $source (@ARGV) { + PerlTokenSearch::find_naughty( _source => $source, ); + } + return; } ##################################################################### @@ -41,7 +44,7 @@ foreach my $source (@ARGV) { # source filehandle and looks for selected variables. # # It works by making a callback object with a write_line() method to -# receive tokenized lines from perltidy. +# receive tokenized lines from perltidy. # # Usage: # @@ -60,15 +63,15 @@ use Perl::Tidy; sub find_naughty { - my %args = ( @_ ); + my %args = (@_); print "Testing File: $args{_source}\n"; # run perltidy, which will call $formatter's write_line() for each line - my $err=perltidy( + my $err = perltidy( 'source' => $args{_source}, 'formatter' => bless( \%args, __PACKAGE__ ), # callback object - 'argv' => "-npro -se", # -npro : ignore .perltidyrc, - # -se : errors to STDOUT + 'argv' => "-npro -se", # -npro : ignore .perltidyrc, + # -se : errors to STDOUT ); if ($err) { die "Error calling perltidy\n"; @@ -80,7 +83,7 @@ sub write_line { # This is called back from perltidy line-by-line # We're looking for $`, $&, and $' my ( $self, $line_of_tokens ) = @_; - my $source = $self->{_source}; + my $source = $self->{_source}; # pull out some stuff we might need my $line_type = $line_of_tokens->{_line_type}; @@ -104,8 +107,7 @@ sub write_line { # and check it if ( $token =~ /^\$[\`\&\']$/ ) { - print STDERR - "$source:$input_line_number: $token\n"; + print STDERR "$source:$input_line_number: $token\n"; } } } diff --git a/examples/perlcomment.pl b/examples/perlcomment.pl index 6c0343e5..d0286f5f 100755 --- a/examples/perlcomment.pl +++ b/examples/perlcomment.pl @@ -43,23 +43,28 @@ use Text::Autoformat; $| = 1; use vars qw($opt_l $opt_h); -my $usage = <outfile where n=line length (default 72) EOM -getopts('hl:') or die "$usage"; -if ($opt_h) { die $usage } -if ( !defined $opt_l ) { - $opt_l = 72; -} -else { - $opt_l =~ /^\d+$/ or die "$usage"; -} + getopts('hl:') or die "$usage"; + if ($opt_h) { die $usage } + if ( !defined $opt_l ) { + $opt_l = 72; + } + else { + $opt_l =~ /^\d+$/ or die "$usage"; + } -unless ( @ARGV == 1 ) { die $usage } -my $file = $ARGV[0]; -autoformat_file( $file, $opt_l ); + unless ( @ARGV == 1 ) { die $usage } + my $file = $ARGV[0]; + autoformat_file( $file, $opt_l ); + return; +} sub autoformat_file { my ( $file, $line_length ) = @_; diff --git a/examples/perllinetype.pl b/examples/perllinetype.pl index 6164b959..cf0a4faa 100755 --- a/examples/perllinetype.pl +++ b/examples/perllinetype.pl @@ -18,43 +18,47 @@ use Perl::Tidy; use IO::File; $| = 1; use vars qw($opt_h); -my $usage = <outfile EOM -getopts('h') or die "$usage"; -if ($opt_h) { die $usage } + getopts('h') or die "$usage"; + if ($opt_h) { die $usage } -# Make the source for perltidy, which will be a filehandle -# or just '-' if the source is stdin -my ($file, $fh, $source); -if ( @ARGV == 0 ) { - $source = '-'; -} -elsif ( @ARGV == 1 ) { - $file = $ARGV[0]; - $fh = IO::File->new( $file, 'r' ); - unless ($fh) { die "cannot open '$file': $!\n" } - $source = $fh; -} -else { die $usage } + # Make the source for perltidy, which will be a filehandle + # or just '-' if the source is stdin + my ( $file, $fh, $source ); + if ( @ARGV == 0 ) { + $source = '-'; + } + elsif ( @ARGV == 1 ) { + $file = $ARGV[0]; + $fh = IO::File->new( $file, 'r' ); + unless ($fh) { die "cannot open '$file': $!\n" } + $source = $fh; + } + else { die $usage } -# make the callback object -my $formatter = MyFormatter->new(); + # make the callback object + my $formatter = MyFormatter->new(); -my $dest; + my $dest; -# start perltidy, which will start calling our write_line() -my $err=perltidy( - 'formatter' => $formatter, # callback object - 'source' => $source, - 'destination' => \$dest, # (not really needed) - 'argv' => "-npro -se", # dont need .perltidyrc - # errors to STDOUT -); -if ($err) { - die "Error calling perltidy\n"; + # start perltidy, which will start calling our write_line() + my $err = perltidy( + 'formatter' => $formatter, # callback object + 'source' => $source, + 'destination' => \$dest, # (not really needed) + 'argv' => "-npro -se", # dont need .perltidyrc + # errors to STDOUT + ); + if ($err) { + die "Error calling perltidy\n"; + } + $fh->close() if $fh; } -$fh->close() if $fh; package MyFormatter; diff --git a/examples/perlmask.pl b/examples/perlmask.pl index 5d94e4fd..2165b7ae 100755 --- a/examples/perlmask.pl +++ b/examples/perlmask.pl @@ -48,30 +48,35 @@ use Getopt::Std; use IO::File; $| = 1; use vars qw($opt_c $opt_h); -my $usage = <outfile EOM -getopts('c:h') or die "$usage"; -if ($opt_h) { die $usage } -unless ( defined($opt_c) ) { $opt_c = 0 } -if (@ARGV > 1) { die $usage } + getopts('c:h') or die "$usage"; + if ($opt_h) { die $usage } + unless ( defined($opt_c) ) { $opt_c = 0 } + if ( @ARGV > 1 ) { die $usage } -my $source=$ARGV[0]; # an undefined filename will become stdin + my $source = $ARGV[0]; # an undefined filename will become stdin -# strings to hold the files (arrays could be used to) -my ( $masked_file, $original_file ); + # strings to hold the files (arrays could be used to) + my ( $masked_file, $original_file ); -PerlMask::perlmask( - _source => $source, - _rmasked_file => \$masked_file, - _roriginal_file => \$original_file, # optional - _compression => $opt_c # optional, default=0 -); + PerlMask::perlmask( + _source => $source, + _rmasked_file => \$masked_file, + _roriginal_file => \$original_file, # optional + _compression => $opt_c # optional, default=0 + ); -# Now we have the masked and original files in strings of equal length. -# We could search for specific text in the masked file here. But here -# we'll just print the masked file: -if ($masked_file) { print $masked_file; } + # Now we have the masked and original files in strings of equal length. + # We could search for specific text in the masked file here. But here + # we'll just print the masked file: + if ($masked_file) { print $masked_file; } + return; +} ##################################################################### # @@ -112,25 +117,25 @@ use Perl::Tidy; sub perlmask { - my %args = ( _compression => 0, @_ ); + my %args = ( _compression => 0, @_ ); my $rfile = $args{_rmasked_file}; unless ( defined($rfile) ) { croak "Missing required parameter '_rmasked_file' in call to perlmask\n"; } - my $ref=ref($rfile); + my $ref = ref($rfile); unless ( $ref =~ /^(SCALAR|ARRAY)$/ ) { - croak < $args{_source}, 'formatter' => bless( \%args, __PACKAGE__ ), # callback object - 'argv' => "-npro -se", # -npro : ignore .perltidyrc, - # -se : errors to STDOUT + 'argv' => "-npro -se", # -npro : ignore .perltidyrc, + # -se : errors to STDOUT ); if ($err) { die "Error calling perltidy\n"; @@ -173,11 +178,11 @@ sub write_line { my $len = length($input_line); if ( $opt_c == 0 && $len > 0 ) { print_line( $roriginal_file, $input_line ) if $roriginal_file; - print_line( $rmasked_file, '#' x $len ); + print_line( $rmasked_file, '#' x $len ); } else { print_line( $roriginal_file, $input_line ) if $roriginal_file; - print_line( $rmasked_file, "" ); + print_line( $rmasked_file, "" ); } return; } @@ -189,7 +194,7 @@ sub write_line { if ( $opt_c <= 1 ) { # Find leading whitespace. But be careful..we don't want the - # whitespace if it is part of quoted text, because it will + # whitespace if it is part of quoted text, because it will # already be contained in a token. if ( $input_line =~ /^(\s+)/ && !$line_of_tokens->{_starting_in_quote} ) { @@ -232,7 +237,7 @@ sub write_line { } } print_line( $roriginal_file, $input_line ) if $roriginal_file; - print_line( $rmasked_file, $masked_line ); + print_line( $rmasked_file, $masked_line ); # self-check lengths; this error should never happen if ( $opt_c == 0 && length($masked_line) != length($input_line) ) { diff --git a/examples/perltidyrc_dump.pl b/examples/perltidyrc_dump.pl index f2008e71..49f243d3 100755 --- a/examples/perltidyrc_dump.pl +++ b/examples/perltidyrc_dump.pl @@ -11,7 +11,9 @@ use strict; # # Steve Hancock, June 2006 # -my $usage = < 1 ) { die "$usage" } - -my $config_file = $ARGV[0]; -my ( - $error_message, $rOpts, $rGetopt_flags, - $rsections, $rabbreviations, $rOpts_default, - $rabbreviations_default, - -) = read_perltidyrc($config_file); - -# always check the error message first -if ($error_message) { - die "$error_message\n"; -} + use Getopt::Std; + my %my_opts; + my $cmdline = $0 . " " . join " ", @ARGV; + getopts( 'hdsq', \%my_opts ) or die "$usage"; + if ( $my_opts{h} ) { die "$usage" } + if ( @ARGV > 1 ) { die "$usage" } + + my $config_file = $ARGV[0]; + my ( + $error_message, $rOpts, $rGetopt_flags, + $rsections, $rabbreviations, $rOpts_default, + $rabbreviations_default, + + ) = read_perltidyrc($config_file); + + # always check the error message first + if ($error_message) { + die "$error_message\n"; + } -# make a list of perltidyrc options which are same as default -my %equals_default; -foreach my $long_name ( keys %{$rOpts} ) { - my $val = $rOpts->{$long_name}; - if ( defined( $rOpts_default->{$long_name} ) ) { - my $val2 = $rOpts_default->{$long_name}; - if ( defined($val2) && defined($val) ) { - $equals_default{$long_name} = ( $val2 eq $val ); + # make a list of perltidyrc options which are same as default + my %equals_default; + foreach my $long_name ( keys %{$rOpts} ) { + my $val = $rOpts->{$long_name}; + if ( defined( $rOpts_default->{$long_name} ) ) { + my $val2 = $rOpts_default->{$long_name}; + if ( defined($val2) && defined($val) ) { + $equals_default{$long_name} = ( $val2 eq $val ); + } } } -} -# Optional: minimize the perltidyrc file length by deleting long_names -# in $rOpts which are also in $rOpts_default and have the same value. -# This would be useful if a perltidyrc file has been constructed from a -# full parameter dump, for example. -if ( $my_opts{d} ) { - foreach my $long_name ( keys %{$rOpts} ) { - delete $rOpts->{$long_name} if $equals_default{$long_name}; + # Optional: minimize the perltidyrc file length by deleting long_names + # in $rOpts which are also in $rOpts_default and have the same value. + # This would be useful if a perltidyrc file has been constructed from a + # full parameter dump, for example. + if ( $my_opts{d} ) { + foreach my $long_name ( keys %{$rOpts} ) { + delete $rOpts->{$long_name} if $equals_default{$long_name}; + } } -} -# find user-defined abbreviations -my %abbreviations_user; -foreach my $key ( keys %$rabbreviations ) { - unless ( $rabbreviations_default->{$key} ) { - $abbreviations_user{$key} = $rabbreviations->{$key}; + # find user-defined abbreviations + my %abbreviations_user; + foreach my $key ( keys %$rabbreviations ) { + unless ( $rabbreviations_default->{$key} ) { + $abbreviations_user{$key} = $rabbreviations->{$key}; + } } -} -# dump the options, if any -if ( %$rOpts || %abbreviations_user ) { - dump_options( $cmdline, \%my_opts, $rOpts, $rGetopt_flags, $rsections, - $rabbreviations, \%equals_default, \%abbreviations_user ); -} -else { - if ($config_file) { - print STDERR <short_name abbreviations my %short_name; - foreach my $abbrev ( keys %{$rabbreviations} ) { - foreach my $abbrev ( sort keys %$rabbreviations ) { - my @list = @{ $$rabbreviations{$abbrev} }; - - # an abbreviation may expand into one or more other words, - # but only those that expand to a single word (which must be - # one of the long names) are the short names that we want - # here. - next unless @list == 1; - my $long_name = $list[0]; - $short_name{$long_name} = $abbrev; - } + foreach my $abbrev ( sort keys %$rabbreviations ) { + my @list = @{ $$rabbreviations{$abbrev} }; + + # an abbreviation may expand into one or more other words, + # but only those that expand to a single word (which must be + # one of the long names) are the short names that we want + # here. + next unless @list == 1; + my $long_name = $list[0]; + $short_name{$long_name} = $abbrev; } unless ( $rmy_opts->{q} ) { diff --git a/examples/perlxmltok.pl b/examples/perlxmltok.pl index 17ef080f..a68c9512 100755 --- a/examples/perlxmltok.pl +++ b/examples/perlxmltok.pl @@ -18,41 +18,47 @@ use Perl::Tidy; use IO::File; use Getopt::Std; use vars qw($opt_h); -my $file; -my $usage = <outfile EOM -getopts('h') or die "$usage"; -if ($opt_h) {die $usage} -if ( @ARGV == 1 ) { - $file = $ARGV[0]; -} -else { die $usage } -my $source; -my $fh; -if ($file) { - $fh = IO::File->new( $file, 'r' ); - unless ($fh) { die "cannot open '$file': $!\n" } - $source = $fh; -} -else { - $source = '-'; -} -my $formatter = Perl::Tidy::XmlWriter->new($file); -my $dest; - -# start perltidy, which will start calling our write_line() -my $err = perltidy( - 'formatter' => $formatter, # callback object - 'source' => $source, - 'destination' => \$dest, # not really needed - 'argv' => "-npro -se", # dont need .perltidyrc - # errors to STDOUT -); -if ($err) { - die "Error calling perltidy\n"; + getopts('h') or die "$usage"; + if ($opt_h) { die $usage } + if ( @ARGV == 1 ) { + $file = $ARGV[0]; + } + else { die $usage } + my $source; + my $fh; + if ($file) { + $fh = IO::File->new( $file, 'r' ); + unless ($fh) { die "cannot open '$file': $!\n" } + $source = $fh; + } + else { + $source = '-'; + } + my $formatter = Perl::Tidy::XmlWriter->new($file); + my $dest; + + # start perltidy, which will start calling our write_line() + my $err = perltidy( + 'formatter' => $formatter, # callback object + 'source' => $source, + 'destination' => \$dest, # not really needed + 'argv' => "-npro -se", # dont need .perltidyrc + # errors to STDOUT + ); + if ($err) { + die "Error calling perltidy\n"; + } + $fh->close() if $fh; + return; } -$fh->close() if $fh; ##################################################################### # @@ -222,7 +228,7 @@ BEGIN { sub markup_tokens { my $self = shift; my ( $rtokens, $rtoken_type ) = @_; - my ( @marked_tokens, $j, $string, $type, $token ); + my ( @marked_tokens, $j, $type, $token ); for ( $j = 0 ; $j < @$rtoken_type ; $j++ ) { $type = $$rtoken_type[$j];