#
# 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
# Release version must be bumped, and it is probably past time for a
# release anyway.
- $VERSION = '20210717';
+ $VERSION = '20220217';
}
sub DESTROY {
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);
}
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.
$encoding_log_message .= <<EOM;
Guessed encoding '$encoding_in' successfully decoded
EOM
+ $decoded_input_as = $encoding_in;
}
}
}
+ $encoding_log_message .= <<EOM;
+Unable to guess a character encoding
+EOM
}
# Case 4. Decode with a specific encoding
$encoding_log_message .= <<EOM;
Specified encoding '$encoding_in' successfully decoded
EOM
+ $decoded_input_as = $encoding_in;
}
}
}
}
elsif ($destination_stream) {
+
$output_file = $destination_stream;
}
elsif ($source_stream) { # source but no destination goes to stdout
|| $rOpts->{'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,
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
$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;
}
}
- #---------------------------------------------------------------
- # 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
}
}
- $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
# $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;
# 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**]
######################################################################
no-profile
npro
recombine!
- valign!
notidy
);
$expansion{$nshort_name} = [$nolong_name];
}
}
+ return;
};
# Install long option names which have a simple abbreviation.
$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
$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
$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
'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.
#---------------------------------------------------------------
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
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
'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)],
'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# ],
\%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.
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 {
# 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(<<EOM);
+--character-encoding = '$encoding' is not allowed; the options are: 'none', 'guess', 'utf8'
+EOM
+ }
+
# Since -vt, -vtc, and -cti are abbreviations, but under
# msdos, an unquoted input parameter like vtc=1 will be
# seen as 2 parameters, vtc and 1, so the abbreviations
$rOpts->{$key} = 100;
}
}
+ return;
};
# check for reasonable number of blank lines and fix to avoid problems
}
}
- # -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");
}
}
}
- 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'} ) {
else {
push( @new_argv, $word );
}
- } # end of this pass
+ } ## end of this pass
# update parameter list @ARGV to the new one
@ARGV = @new_argv;
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;
}
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.
-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
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;
projects / perltidy.git / blobdiff