X-Git-Url: https://git.donarmstrong.com/perltidy.git?a=blobdiff_plain;f=lib%2FPerl%2FTidy.pm;h=a97b7aad43603081bbf509ae4c19ea88806828a5;hb=880633cc084e9d787eb9f760d3851c5d660db17c;hp=ffeb8b80c2cde56bc19b01249146f9b32ce1b3c7;hpb=57d829ae0e2c75828f8ecc9c7139579350927dbc;p=perltidy.git diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index ffeb8b8..a97b7aa 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -3,7 +3,7 @@ # # perltidy - a perl script indenter and formatter # -# Copyright (c) 2000-2021 by Steve Hancock +# Copyright (c) 2000-2022 by Steve Hancock # Distributed under the GPL license agreement; see file COPYING # # This program is free software; you can redistribute it and/or modify @@ -110,7 +110,7 @@ BEGIN { # Release version must be bumped, and it is probably past time for a # release anyway. - $VERSION = '20210717'; + $VERSION = '20220217'; } sub DESTROY { @@ -777,6 +777,7 @@ EOM Perl::Tidy::Formatter::check_options($rOpts); Perl::Tidy::Tokenizer::check_options($rOpts); + Perl::Tidy::VerticalAligner::check_options($rOpts); if ( $rOpts->{'format'} eq 'html' ) { Perl::Tidy::HtmlWriter->check_options($rOpts); } @@ -1019,6 +1020,7 @@ EOM my $encoding_in = ""; my $rOpts_character_encoding = $rOpts->{'character-encoding'}; my $encoding_log_message; + my $decoded_input_as = ""; # Case 1. See if we already have an encoded string. In that # case, we have to ignore any encoding flag. @@ -1081,9 +1083,13 @@ EOM $encoding_log_message .= <{'assert-tidy'} || $rOpts->{'assert-untidy'}; + # Postpone final output to a destination SCALAR or ARRAY ref to allow + # possible encoding at the end of processing. + my $destination_buffer; + my $use_destination_buffer; + if ( + ref($destination_stream) + && ( ref($destination_stream) eq 'SCALAR' + || ref($destination_stream) eq 'ARRAY' ) + ) + { + $use_destination_buffer = 1; + $output_file = \$destination_buffer; + } + $sink_object = Perl::Tidy::LineSink->new( output_file => $use_buffer ? \$postfilter_buffer : $output_file, line_separator => $line_separator, @@ -1558,7 +1580,7 @@ EOM last; } } ## end if ( $iter < $max_iterations) - } # end loop over iterations for one source file + } ## end loop over iterations for one source file # restore objects which have been temporarily undefined # for second and higher iterations @@ -1644,7 +1666,53 @@ EOM $source_object->close_input_file(); } - # Save names of the input and output files for syntax check + #------------------------------------------------------------------ + # For string output, store the result to the destination, encoding + # if requested. This is a fix for issue git #83 (tidyall issue) + #------------------------------------------------------------------ + if ($use_destination_buffer) { + + # At this point, all necessary encoding has been done except for + # output to a string or array ref. We use the -eos flag to decide + # if we should encode. + + # -neos, DEFAULT: perltidy does not return encoded string output. + # This is a result of the code evolution but not very convenient for + # most applications. It would be hard to change without breaking + # some programs. + + # -eos flag set: If perltidy decodes a string, regardless of + # source, it encodes before returning. + + if ( $rOpts->{'encode-output-strings'} && $decoded_input_as ) { + my $encoded_buffer; + eval { + $encoded_buffer = + Encode::encode( "UTF-8", $destination_buffer, + Encode::FB_CROAK | Encode::LEAVE_SRC ); + }; + if ($@) { + + Warn( +"Error attempting to encode output string ref; encoding not done\n" + ); + } + else { + $destination_buffer = $encoded_buffer; + } + } + + # Final string storage + if ( ref($destination_stream) eq 'SCALAR' ) { + ${$destination_stream} = $destination_buffer; + } + else { + my @lines = split /^/, $destination_buffer; + @{$destination_stream} = @lines; + } + } + + # Save names of the input and output files my $ifname = $input_file; my $ofname = $output_file; @@ -1782,21 +1850,6 @@ EOM } } - #--------------------------------------------------------------- - # Do syntax check if requested and possible - # This is permanently deactivated but the code remains for reference - #--------------------------------------------------------------- - my $infile_syntax_ok = 0; # -1 no 0=don't know 1 yes - if ( 0 - && $logger_object - && $rOpts->{'check-syntax'} - && $ifname - && $ofname ) - { - $infile_syntax_ok = - check_syntax( $ifname, $ofname, $logger_object, $rOpts ); - } - #--------------------------------------------------------------- # remove the original file for in-place modify as follows: # $delete_backup=0 never @@ -1828,9 +1881,9 @@ EOM } } - $logger_object->finish( $infile_syntax_ok, $formatter ) + $logger_object->finish($formatter) if $logger_object; - } # end of main loop to process all files + } ## end of main loop to process all files # Fix for RT #130297: return a true value if anything was written to the # standard error output, even non-fatal warning messages, otherwise return @@ -2007,8 +2060,8 @@ sub get_stream_as_named_file { # $fname = name of file if possible, or undef # $if_tmpfile = true if temp file, undef if not temp file # - # This routine is needed for passing actual files to Perl for - # a syntax check. + # NOTE: This routine was previously needed for passing actual files to Perl + # for a syntax check. It is not currently used. my ($stream) = @_; my $is_tmpfile; my $fname; @@ -2125,7 +2178,6 @@ sub generate_options { # which is mainly for debugging # scl --> short-concatenation-item-length # helps break at '.' # recombine # for debugging line breaks - # valign # for debugging vertical alignment # I --> DIAGNOSTICS # for debugging [**DEACTIVATED**] ###################################################################### @@ -2181,7 +2233,6 @@ sub generate_options { no-profile npro recombine! - valign! notidy ); @@ -2220,6 +2271,7 @@ sub generate_options { $expansion{$nshort_name} = [$nolong_name]; } } + return; }; # Install long option names which have a simple abbreviation. @@ -2271,26 +2323,32 @@ sub generate_options { $add_option->( 'extended-syntax', 'xs', '!' ); $add_option->( 'assert-tidy', 'ast', '!' ); $add_option->( 'assert-untidy', 'asu', '!' ); + $add_option->( 'encode-output-strings', 'eos', '!' ); $add_option->( 'sub-alias-list', 'sal', '=s' ); + $add_option->( 'grep-alias-list', 'gal', '=s' ); + $add_option->( 'grep-alias-exclusion-list', 'gaxl', '=s' ); ######################################## $category = 2; # Code indentation control ######################################## - $add_option->( 'continuation-indentation', 'ci', '=i' ); - $add_option->( 'extended-continuation-indentation', 'xci', '!' ); - $add_option->( 'line-up-parentheses', 'lp', '!' ); - $add_option->( 'line-up-parentheses-exclusion-list', 'lpxl', '=s' ); - $add_option->( 'outdent-keyword-list', 'okwl', '=s' ); - $add_option->( 'outdent-keywords', 'okw', '!' ); - $add_option->( 'outdent-labels', 'ola', '!' ); - $add_option->( 'outdent-long-quotes', 'olq', '!' ); - $add_option->( 'indent-closing-brace', 'icb', '!' ); - $add_option->( 'closing-token-indentation', 'cti', '=i' ); - $add_option->( 'closing-paren-indentation', 'cpi', '=i' ); - $add_option->( 'closing-brace-indentation', 'cbi', '=i' ); - $add_option->( 'closing-square-bracket-indentation', 'csbi', '=i' ); - $add_option->( 'brace-left-and-indent', 'bli', '!' ); - $add_option->( 'brace-left-and-indent-list', 'blil', '=s' ); + $add_option->( 'continuation-indentation', 'ci', '=i' ); + $add_option->( 'extended-continuation-indentation', 'xci', '!' ); + $add_option->( 'line-up-parentheses', 'lp', '!' ); + $add_option->( 'extended-line-up-parentheses', 'xlp', '!' ); + $add_option->( 'line-up-parentheses-exclusion-list', 'lpxl', '=s' ); + $add_option->( 'line-up-parentheses-inclusion-list', 'lpil', '=s' ); + $add_option->( 'outdent-keyword-list', 'okwl', '=s' ); + $add_option->( 'outdent-keywords', 'okw', '!' ); + $add_option->( 'outdent-labels', 'ola', '!' ); + $add_option->( 'outdent-long-quotes', 'olq', '!' ); + $add_option->( 'indent-closing-brace', 'icb', '!' ); + $add_option->( 'closing-token-indentation', 'cti', '=i' ); + $add_option->( 'closing-paren-indentation', 'cpi', '=i' ); + $add_option->( 'closing-brace-indentation', 'cbi', '=i' ); + $add_option->( 'closing-square-bracket-indentation', 'csbi', '=i' ); + $add_option->( 'brace-left-and-indent', 'bli', '!' ); + $add_option->( 'brace-left-and-indent-list', 'blil', '=s' ); + $add_option->( 'brace-left-and-indent-exclusion-list', 'blixl', '=s' ); ######################################## $category = 3; # Whitespace control @@ -2323,6 +2381,11 @@ sub generate_options { $add_option->( 'want-left-space', 'wls', '=s' ); $add_option->( 'want-right-space', 'wrs', '=s' ); $add_option->( 'space-prototype-paren', 'spp', '=i' ); + $add_option->( 'valign-code', 'vc', '!' ); + $add_option->( 'valign-block-comments', 'vbc', '!' ); + $add_option->( 'valign-side-comments', 'vsc', '!' ); + $add_option->( 'valign-exclusion-list', 'vxl', '=s' ); + $add_option->( 'valign-inclusion-list', 'vil', '=s' ); ######################################## $category = 4; # Comment controls @@ -2403,6 +2466,14 @@ sub generate_options { $add_option->( 'break-before-square-bracket-and-indent', 'bbsbi', '=i' ); $add_option->( 'break-before-paren', 'bbp', '=i' ); $add_option->( 'break-before-paren-and-indent', 'bbpi', '=i' ); + $add_option->( 'brace-left-list', 'bll', '=s' ); + $add_option->( 'brace-left-exclusion-list', 'blxl', '=s' ); + $add_option->( 'break-after-labels', 'bal', '=i' ); + + ## This was an experiment mentioned in git #78. It works, but it does not + ## look very useful. Instead, I expanded the functionality of the + ## --keep-old-breakpoint-xxx flags. + ##$add_option->( 'break-open-paren-list', 'bopl', '=s' ); ######################################## $category = 6; # Controlling list formatting @@ -2559,13 +2630,14 @@ sub generate_options { 'keyword-group-blanks-after' => [ 0, 2 ], 'space-prototype-paren' => [ 0, 2 ], + 'break-after-labels' => [ 0, 2 ], ); # Note: we could actually allow negative ci if someone really wants it: # $option_range{'continuation-indentation'} = [ undef, undef ]; #--------------------------------------------------------------- - # Assign default values to the above options here, except + # DEFAULTS: Assign default values to the above options here, except # for 'outfile' and 'help'. # These settings should approximate the perlstyle(1) suggestions. #--------------------------------------------------------------- @@ -2591,6 +2663,7 @@ sub generate_options { brace-tightness=1 brace-vertical-tightness-closing=0 brace-vertical-tightness=0 + break-after-labels=0 break-at-old-logical-breakpoints break-at-old-ternary-breakpoints break-at-old-attribute-breakpoints @@ -2660,7 +2733,9 @@ sub generate_options { noweld-nested-containers recombine nouse-unicode-gcstring - valign + valign-code + valign-block-comments + valign-side-comments short-concatenation-item-length=8 space-for-semicolon space-backslash-quote=1 @@ -2722,6 +2797,8 @@ sub generate_options { 'nhtml' => [qw(format=tidy)], 'tidy' => [qw(format=tidy)], + 'brace-left' => [qw(opening-brace-on-new-line)], + # -cb is now a synonym for -ce 'cb' => [qw(cuddled-else)], 'cuddled-blocks' => [qw(cuddled-else)], @@ -2817,6 +2894,9 @@ sub generate_options { 'conv' => [qw(it=4)], 'nconv' => [qw(it=1)], + 'valign' => [qw(vc vsc vbc)], + 'novalign' => [qw(nvc nvsc nvbc)], + # NOTE: This is a possible future shortcut. But it will remain # deactivated until the -lpxl flag is no longer experimental. # 'line-up-function-parentheses' => [ qw(lp), q#lpxl=[ { F(2# ], @@ -2905,7 +2985,7 @@ q(wbb=% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= \%option_category, \%option_range ); -} # end of generate_options +} ## end of generate_options # Memoize process_command_line. Given same @ARGV passed in, return same # values and same @ARGV back. @@ -3204,7 +3284,67 @@ EOM return ( \%Opts, $config_file, \@raw_options, $roption_string, $rexpansion, $roption_category, $roption_range ); -} # end of _process_command_line +} ## end of _process_command_line + +sub make_grep_alias_string { + my ($rOpts) = @_; + + # Defaults: list operators in List::Util + # Possible future additions: pairfirst pairgrep pairmap + my $default_string = join ' ', qw( + all + any + first + none + notall + reduce + reductions + ); + + # make a hash of any excluded words + my %is_excluded_word; + my $exclude_string = $rOpts->{'grep-alias-exclusion-list'}; + if ($exclude_string) { + $exclude_string =~ s/,/ /g; # allow commas + $exclude_string =~ s/^\s+//; + $exclude_string =~ s/\s+$//; + my @q = split /\s+/, $exclude_string; + @is_excluded_word{@q} = (1) x scalar(@q); + } + + # The special option -gaxl='*' removes all defaults + if ( $is_excluded_word{'*'} ) { $default_string = "" } + + # combine the defaults and any input list + my $input_string = $rOpts->{'grep-alias-list'}; + if ($input_string) { $input_string .= " " . $default_string } + else { $input_string = $default_string } + + # Now make the final list of unique grep alias words + $input_string =~ s/,/ /g; # allow commas + $input_string =~ s/^\s+//; + $input_string =~ s/\s+$//; + my @word_list = split /\s+/, $input_string; + my @filtered_word_list; + my %seen; + + foreach my $word (@word_list) { + if ($word) { + if ( $word !~ /^\w[\w\d]*$/ ) { + Warn( + "unexpected word in --grep-alias-list: '$word' - ignoring\n" + ); + } + if ( !$seen{$word} && !$is_excluded_word{$word} ) { + $seen{$word}++; + push @filtered_word_list, $word; + } + } + } + my $joined_words = join ' ', @filtered_word_list; + $rOpts->{'grep-alias-list'} = $joined_words; + return; +} sub check_options { @@ -3214,6 +3354,15 @@ sub check_options { # check and handle any interactions among the basic options.. #--------------------------------------------------------------- + # Since perltidy only encodes in utf8, problems can occur if we let it + # decode anything else. See discussions for issue git #83. + my $encoding = $rOpts->{'character-encoding'}; + if ( $encoding !~ /^\s*(guess|none|utf8|utf-8)\s*$/i ) { + Die(<{$key} = 100; } } + return; }; # check for reasonable number of blank lines and fix to avoid problems @@ -3321,22 +3471,11 @@ EOM } } - # -bli flag implies -bl - if ( $rOpts->{'brace-left-and-indent'} ) { - $rOpts->{'opening-brace-on-new-line'} = 1; - } - # it simplifies things if -bl is 0 rather than undefined if ( !defined( $rOpts->{'opening-brace-on-new-line'} ) ) { $rOpts->{'opening-brace-on-new-line'} = 0; } - # -sbl defaults to -bl if not defined - if ( !defined( $rOpts->{'opening-sub-brace-on-new-line'} ) ) { - $rOpts->{'opening-sub-brace-on-new-line'} = - $rOpts->{'opening-brace-on-new-line'}; - } - if ( $rOpts->{'entab-leading-whitespace'} ) { if ( $rOpts->{'entab-leading-whitespace'} < 0 ) { Warn("-et=n must use a positive integer; ignoring -et\n"); @@ -3387,10 +3526,11 @@ EOM } } } - my $joined_words = join ' ', @filtered_word_list; $rOpts->{'sub-alias-list'} = join ' ', @filtered_word_list; } + make_grep_alias_string($rOpts); + # Turn on fuzzy-line-length unless this is an extrude run, as determined # by the -i and -ci settings. Otherwise blinkers can form (case b935) if ( !$rOpts->{'fuzzy-line-length'} ) { @@ -3512,7 +3652,7 @@ sub expand_command_abbreviations { else { push( @new_argv, $word ); } - } # end of this pass + } ## end of this pass # update parameter list @ARGV to the new one @ARGV = @new_argv; @@ -3551,8 +3691,8 @@ Program bug - circular-references in the %expansion hash, probably due to a recent program change. DIE } - } # end of check for circular references - } # end of loop over all passes + } ## end of check for circular references + } ## end of loop over all passes return; } @@ -4208,7 +4348,7 @@ sub show_version { print STDOUT <<"EOM"; This is perltidy, v$VERSION -Copyright 2000-2021, Steve Hancock +Copyright 2000-2022, Steve Hancock Perltidy is free software and may be copied under the terms of the GNU General Public License, which is included in the distribution files. @@ -4243,7 +4383,6 @@ I/O control -bext=s change default backup extension from 'bak' to s -q deactivate error messages (for running under editor) -w include non-critical warning messages in the .ERR error output - -syn run perl -c to check syntax (default under unix systems) -log save .LOG file, which has useful diagnostics -f force perltidy to read a binary file -g like -log but writes more detailed .LOG file, for debugging scripts @@ -4437,110 +4576,4 @@ sub process_this_file { return; } - -sub check_syntax { - - # Use 'perl -c' to make sure that we did not create bad syntax - # This is a very good independent check for programming errors - # - # Given names of the input and output files, ($istream, $ostream), - # we do the following: - # - check syntax of the input file - # - if bad, all done (could be an incomplete code snippet) - # - if infile syntax ok, then check syntax of the output file; - # - if outfile syntax bad, issue warning; this implies a code bug! - # - set and return flag "infile_syntax_ok" : =-1 bad 0 unknown 1 good - - my ( $istream, $ostream, $logger_object, $rOpts ) = @_; - my $infile_syntax_ok = 0; - my $line_of_dashes = '-' x 42 . "\n"; - - my $flags = $rOpts->{'perl-syntax-check-flags'}; - - # be sure we invoke perl with -c - # note: perl will accept repeated flags like '-c -c'. It is safest - # to append another -c than try to find an interior bundled c, as - # in -Tc, because such a 'c' might be in a quoted string, for example. - if ( $flags !~ /(^-c|\s+-c)/ ) { $flags .= " -c" } - - # be sure we invoke perl with -x if requested - # same comments about repeated parameters applies - if ( $rOpts->{'look-for-hash-bang'} ) { - if ( $flags !~ /(^-x|\s+-x)/ ) { $flags .= " -x" } - } - - # this shouldn't happen unless a temporary file couldn't be made - if ( $istream eq '-' ) { - $logger_object->write_logfile_entry( - "Cannot run perl -c on STDIN and STDOUT\n"); - return $infile_syntax_ok; - } - - $logger_object->write_logfile_entry( - "checking input file syntax with perl $flags\n"); - - # Not all operating systems/shells support redirection of the standard - # error output. - my $error_redirection = ( $^O eq 'VMS' ) ? "" : '2>&1'; - - my ( $istream_filename, $perl_output ) = - do_syntax_check( $istream, $flags, $error_redirection ); - $logger_object->write_logfile_entry( - "Input stream passed to Perl as file $istream_filename\n"); - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry("$perl_output\n"); - - if ( $perl_output =~ /syntax\s*OK/ ) { - $infile_syntax_ok = 1; - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry( - "checking output file syntax with perl $flags ...\n"); - my ( $ostream_filename, $perl_output ) = - do_syntax_check( $ostream, $flags, $error_redirection ); - $logger_object->write_logfile_entry( - "Output stream passed to Perl as file $ostream_filename\n"); - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry("$perl_output\n"); - - unless ( $perl_output =~ /syntax\s*OK/ ) { - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->warning( -"The output file has a syntax error when tested with perl $flags $ostream !\n" - ); - $logger_object->warning( - "This implies an error in perltidy; the file $ostream is bad\n" - ); - $logger_object->report_definite_bug(); - - # the perl version number will be helpful for diagnosing the problem - $logger_object->write_logfile_entry( $^V . "\n" ); - } - } - else { - - # Only warn of perl -c syntax errors. Other messages, - # such as missing modules, are too common. They can be - # seen by running with perltidy -w - $logger_object->complain("A syntax check using perl $flags\n"); - $logger_object->complain( - "for the output in file $istream_filename gives:\n"); - $logger_object->complain($line_of_dashes); - $logger_object->complain("$perl_output\n"); - $logger_object->complain($line_of_dashes); - $infile_syntax_ok = -1; - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry( -"The output file will not be checked because of input file problems\n" - ); - } - return $infile_syntax_ok; -} - -sub do_syntax_check { - - # This should not be called; the syntax check is deactivated - Die("Unexpected call for syntax check-shouldn't happen\n"); - return; -} - 1;