# it as a general rule:
[-NamingConventions::Capitalization]
-# It would be nice if this option were configurable to skip STDERR and STDOUT
-# which are used by perltidy almost exclusively for debug statements.
-# I may eventually convert to braced {*STDOUT}, but must skip it for now.
-[-InputOutput::RequireBracedFileHandleWithPrint]
-
# PerlCritic should not suggest this policy for complex sorts because it can
# change program behavior when a stable sort has been assumed. And it does not
# even make sense for sorts on multiple keys, like this one which got flagged
foreach
my $name
(
- param $query)
+ param
+ $query
+ )
__END__
our $AUTOLOAD;
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Unexpected call to Autoload looking for sub $AUTOLOAD
Called from package: '$pkg'
# dump from command line
if ( $rOpts->{'dump-options'} ) {
- print STDOUT $readable_options;
+ print {*STDOUT} $readable_options;
Exit(0);
}
EOM
$stopping_on_error ||= $convergence_log_message;
DEVEL_MODE
- && print STDERR $convergence_log_message;
+ && print {*STDERR} $convergence_log_message;
$diagnostics_object->write_diagnostics(
$convergence_log_message)
if $diagnostics_object;
# convergence test above is temporarily skipped for
# testing.
if ( $iteration_of_formatter_convergence < $iter - 1 ) {
- print STDERR
+ print {*STDERR}
"STRANGE Early conv in $display_name: Stopping on it=$iter, converged in formatter on $iteration_of_formatter_convergence\n";
}
}
elsif ( !$stopping_on_error ) {
- print STDERR
+ print {*STDERR}
"STRANGE no conv in $display_name: stopping on it=$iter, but not converged in formatter\n";
}
}
# Debug routine -- this will dump the expansion hash
sub dump_short_names {
my $rexpansion = shift;
- print STDOUT <<EOM;
+ print {*STDOUT} <<EOM;
List of short names. This list shows how all abbreviations are
translated into other abbreviations and, eventually, into long names.
New abbreviations may be defined in a .perltidyrc file.
EOM
foreach my $abbrev ( sort keys %{$rexpansion} ) {
my @list = @{ $rexpansion->{$abbrev} };
- print STDOUT "$abbrev --> @list\n";
+ print {*STDOUT} "$abbrev --> @list\n";
}
return;
} ## end sub dump_short_names
sub dump_config_file {
my ( $rconfig_string, $config_file, $rconfig_file_chatter ) = @_;
- print STDOUT "${$rconfig_file_chatter}";
+ print {*STDOUT} "${$rconfig_file_chatter}";
if ($rconfig_string) {
my @lines = split /^/, ${$rconfig_string};
- print STDOUT "# Dump of file: '$config_file'\n";
- while ( defined( my $line = shift @lines ) ) { print STDOUT $line }
+ print {*STDOUT} "# Dump of file: '$config_file'\n";
+ while ( defined( my $line = shift @lines ) ) { print {*STDOUT} $line }
}
else {
- print STDOUT "# ...no config file found\n";
+ print {*STDOUT} "# ...no config file found\n";
}
return;
} ## end sub dump_config_file
sub dump_long_names {
my @names = @_;
- print STDOUT <<EOM;
+ print {*STDOUT} <<EOM;
# Command line long names (passed to GetOptions)
#--------------------------------------------------
# here is a summary of the Getopt codes:
#--------------------------------------------------
EOM
- foreach my $name ( sort @names ) { print STDOUT "$name\n" }
+ foreach my $name ( sort @names ) { print {*STDOUT} "$name\n" }
return;
} ## end sub dump_long_names
sub dump_defaults {
my @defaults = @_;
- print STDOUT "Default command line options:\n";
- foreach my $line ( sort @defaults ) { print STDOUT "$line\n" }
+ print {*STDOUT} "Default command line options:\n";
+ foreach my $line ( sort @defaults ) { print {*STDOUT} "$line\n" }
return;
} ## end sub dump_defaults
} ## end sub readable_options
sub show_version {
- print STDOUT <<"EOM";
+ print {*STDOUT} <<"EOM";
This is perltidy, v$VERSION
Copyright 2000-2023, Steve Hancock
sub usage {
- print STDOUT <<EOF;
+ print {*STDOUT} <<EOF;
This is perltidy version $VERSION, a perl script indenter. Usage:
perltidy [ options ] file1 file2 file3 ...
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
if ( !defined($ws_2) ) { $ws_2 = "*" }
if ( !defined($ws_3) ) { $ws_3 = "*" }
if ( !defined($ws_4) ) { $ws_4 = "*" }
- print STDOUT
+ print {*STDOUT}
"NEW WHITE: i=$j $str $last_type_dbg $type $ws_1 : $ws_2 : $ws_3 : $ws_4 : $ws \n";
# reset for next pass
&& $bond_str_1 != $bond_str_2
&& $bond_str_2 != $tabulated_bond_str
&& do {
- print STDERR
+ print {*STDOUT}
"BOND_TABLES: ltype=$ltype rtype=$rtype $bond_str_1->$bond_str_2->$bond_str_3\n";
};
DEBUG_BOND && do {
my $str = substr( $token, 0, 15 );
$str .= SPACE x ( 16 - length($str) );
- print STDOUT
+ print {*STDOUT}
"BOND: i=$i $str $type $next_nonblank_type depth=$total_nesting_depth strength=$bond_str_1 -> $bond_str_2 -> $bond_str_3 -> $bond_str_4 $bond_str -> $strength \n";
# reset for next pass
# Sort blocks and packages on starting line number
my @sorted_lines = sort { $a->[1] <=> $b->[1] } @{$routput_lines};
- print STDOUT
+ print {*STDOUT}
"file,line,line_count,code_lines,type,name,level,max_change,block_count,mccabe_count\n";
foreach my $rline_vars (@sorted_lines) {
my $line = join( ",", @{$rline_vars} ) . "\n";
- print STDOUT $line;
+ print {*STDOUT} $line;
}
return;
} ## end sub dump_block_summary
EOM
foreach my $line (@output_lines) {
chomp $line;
- print STDERR $line, "\n";
+ print {*STDOUT} $line, "\n";
}
}
}
{
if (DEBUG_WELD) {
$Msg .= "RULE 0: Not welding due to sheared inner parens\n";
- print $Msg;
+ print {*STDOUT} $Msg;
}
next;
}
|| $iline_ic != $iline_oc )
)
{
- if (DEBUG_WELD) { print $msg}
+ if (DEBUG_WELD) { print {*STDOUT} $msg }
next;
}
if (DEBUG_WELD) {
$Msg .= "Not welding due to RULE $do_not_weld_rule\n";
- print $Msg;
+ print {*STDOUT} $Msg;
}
# Normally, a broken pair should not decrease indentation of
$weld_count_this_start++;
if (DEBUG_WELD) {
$Msg .= "Starting new weld\n";
- print $Msg;
+ print {*STDOUT} $Msg;
}
push @welds, $item;
$weld_count_this_start++;
if (DEBUG_WELD) {
$Msg .= "Extending current weld\n";
- print $Msg;
+ print {*STDOUT} $Msg;
}
unshift @{ $welds[-1] }, $inner_seqno;
$rK_weld_right->{$Kouter_opening} = $Kinner_opening;
= $self->setup_new_weld_measurements( $Kouter_opening,
$Kinner_opening );
if ( !$ok_to_weld ) {
- if (DEBUG_WELD) { print $msg}
+ if (DEBUG_WELD) { print {*STDOUT} $msg }
next;
}
if ($do_not_weld) {
if (DEBUG_WELD) {
$Msg .= "Not Welding QW\n";
- print $Msg;
+ print {*STDOUT} $Msg;
}
next;
}
# OK to weld
if (DEBUG_WELD) {
$Msg .= "Welding QW\n";
- print $Msg;
+ print {*STDOUT} $Msg;
}
$rK_weld_right->{$Kouter_opening} = $Kinner_opening;
&& $rlec_count_by_seqno->{$seqno};
DEBUG_BBX
- && print STDOUT
+ && print {*STDOUT}
"BBX: Looking at seqno=$seqno, token = $token with option=$break_option\n";
# -bbx=1 = stable, try to follow input
if ( !$ok_to_break ) {
DEBUG_BBX
- && print STDOUT "Not breaking at seqno=$seqno: $Msg\n";
+ && print {*STDOUT} "Not breaking at seqno=$seqno: $Msg\n";
next;
}
DEBUG_BBX
- && print STDOUT "OK to break at seqno=$seqno: $Msg\n";
+ && print {*STDOUT} "OK to break at seqno=$seqno: $Msg\n";
# Patch: turn off -xci if -bbx=2 and -lp
# This fixes cases b1090 b1095 b1101 b1116 b1118 b1121 b1122
# sub insert_breaks_before_list_opening_containers
$rbreak_before_container_by_seqno->{$seqno} = 1;
DEBUG_BBX
- && print STDOUT "BBX: ok to break at seqno=$seqno\n";
+ && print {*STDOUT} "BBX: ok to break at seqno=$seqno\n";
# -bbxi=0: Nothing more to do if the ci value remains unchanged
my $ci_flag = $container_indentation_options{$token};
next unless ($rtype_count);
my $fat_comma_count = $rtype_count->{'=>'};
DEBUG_BBX
- && print STDOUT "BBX: fat comma count=$fat_comma_count\n";
+ && print {*STDOUT} "BBX: fat comma count=$fat_comma_count\n";
if ( $fat_comma_count && $fat_comma_count >= 2 ) { $OK = 1 }
}
$self->cumulative_length_before_K($KK);
my $excess_length = $length - $maximum_text_length;
DEBUG_BBX
- && print STDOUT
+ && print {*STDOUT}
"BBX: excess=$excess_length: maximum_text_length=$maximum_text_length, length=$length, ci=$ci\n";
# OK if the net container definitely breaks on length
if ( $excess_length > $length_tol ) {
$OK = 1;
DEBUG_BBX
- && print STDOUT "BBX: excess_length=$excess_length\n";
+ && print {*STDOUT} "BBX: excess_length=$excess_length\n";
}
# Otherwise skip it
# Part 3: Looks OK: apply -bbx=n and any related -bbxi=n flag
#------------------------------------------------------------
- DEBUG_BBX && print STDOUT "BBX: OK to break\n";
+ DEBUG_BBX && print {*STDOUT} "BBX: OK to break\n";
# -bbhbi=n
# -bbsbi=n
# shouldn't happen
if ( $type ne 'q' ) {
- DEVEL_MODE && print STDERR <<EOM;
+ DEVEL_MODE && print {*STDERR} <<EOM;
STRANGE: started multiline qw at K=$K_start_multiline_qw but didn't see q qw at K=$Kfirst\n";
EOM
$K_start_multiline_qw = undef;
DEBUG_STORE && do {
my ( $a, $b, $c ) = caller();
- print STDOUT
+ print {*STDOUT}
"STORE: from $a $c: storing token $token type $type lev=$level at $max_index_to_go\n";
};
return;
" Also set closing breakpoint corresponding to this token\n";
}
}
- print STDOUT $msg;
+ print {*STDOUT} $msg;
};
return $i_nonblank;
DEBUG_UNDOBP && do {
my ( $a, $b, $c ) = caller();
- print STDOUT
+ print {*STDOUT}
"UNDOBP: undo forced_breakpoint i=$i $forced_breakpoint_undo_count from $a $c max=$max_index_to_go\n";
};
}
$output_str = join EMPTY_STRING,
@tokens_to_go[ 0 .. $max_index_to_go ];
}
- print STDERR <<EOM;
+ print {*STDOUT} <<EOM;
grind got batch number $batch_count with $max_index_to_go tokens, last type '$type' tok='$token', text:
$output_str
EOM
# $ri_beg = ref to array of BEGinning indexes of each line
# $ri_end = ref to array of ENDing indexes of each line
my ( $self, $ri_beg, $ri_end, $msg ) = @_;
- print STDERR "----Dumping breakpoints from: $msg----\n";
+ print {*STDOUT} "----Dumping breakpoints from: $msg----\n";
for my $n ( 0 .. @{$ri_end} - 1 ) {
my $ibeg = $ri_beg->[$n];
my $iend = $ri_end->[$n];
foreach my $i ( $ibeg .. $iend ) {
$text .= $tokens_to_go[$i];
}
- print STDERR "$n ($ibeg:$iend) $text\n";
+ print {*STDOUT} "$n ($ibeg:$iend) $text\n";
}
- print STDERR "----\n";
+ print {*STDOUT} "----\n";
return;
} ## end sub Debug_dump_breakpoints
my $num_sections = @{$rsections};
if ( DEBUG_RECOMBINE > 1 ) {
- print STDERR <<EOM;
+ print {*STDOUT} <<EOM;
sections=$num_sections; nmax_sec=$nmax_section
EOM
}
if ( DEBUG_RECOMBINE > 0 ) {
my $max = 0;
- print STDERR
+ print {*STDOUT}
"-----\n$num_sections sections found for nmax=$nmax_start\n";
foreach my $sect ( @{$rsections} ) {
my ( $nbeg, $nend ) = @{$sect};
my $num = $nend - $nbeg;
if ( $num > $max ) { $max = $num }
- print STDERR "$nbeg $nend\n";
+ print {*STDOUT} "$nbeg $nend\n";
}
- print STDERR "max size=$max of $nmax_start lines\n";
+ print {*STDOUT} "max size=$max of $nmax_start lines\n";
}
# Loop over all sub-sections. Note that we have to work backwards
if (DEBUG_RECOMBINE) {
my $ratio = sprintf "%0.3f", $rhash->{_num_compares} / $num_pairs;
- print STDERR
+ print {*STDOUT}
"exiting recombine_inner_loop with $nmax_last lines, opt=$rhash->{_optimization_on}, starting pairs=$num_pairs, num_compares=$rhash->{_num_compares}, ratio=$ratio\n";
}
my $type_ibeg_2 = $types_to_go[$ibeg_2];
DEBUG_RECOMBINE > 1 && do {
- print STDERR
+ print {*STDOUT}
"RECOMBINE: ix=$ix iend1=$iend_1 iend2=$iend_2 n=$n nmax=$nmax if=$ibeg_1 type=$type_ibeg_1 =$tokens_to_go[$ibeg_1] next_type=$type_ibeg_2 next_tok=$tokens_to_go[$ibeg_2]\n";
};
if (DEBUG_RECOMBINE) {
my $num_compares = $rhash->{_num_compares};
my $pair_count = @ix_list;
- print STDERR
+ print {*STDOUT}
"Entering optimization phase at $num_compares compares, pair count = $pair_count\n";
}
}
}
DEBUG_BREAK_LINES
- && print STDOUT
+ && print {*STDOUT}
"BREAK: best is i = $i_lowest strength = $lowest_strength;\nReason>> $Msg\n";
$line_count++;
}
if ( length($ltok) > 6 ) { $ltok = substr( $ltok, 0, 8 ) }
if ( length($rtok) > 6 ) { $rtok = substr( $rtok, 0, 8 ) }
- print STDOUT
+ print {*STDOUT}
"BREAK: i=$i_test imax=$imax $types_to_go[$i_test] $next_nonblank_type sp=($leading_spaces) lnext= $summed_lengths_to_go[$i_testp2] str=$strength $ltok $rtok\n";
};
( int $number_of_fields / 2 ) * $pair_width +
( $number_of_fields % 2 ) * $max_width;
- print STDOUT
+ print {*STDOUT}
"SPARSE:cols=$columns commas=$comma_count items:$item_count ids=$identifier_count pairwidth=$pair_width fields=$number_of_fields lines packed: $packed_lines packed_cols=$packed_columns fmtd:$formatted_lines cols /line:$columns_per_line unused:$unused_columns fmtd:$formatted_columns sparsity=$sparsity allow=$max_allowed_sparsity\n";
};
0 && do {
my ( $a, $b, $c ) = caller();
- print STDOUT
+ print {*STDOUT}
"NOBREAK: forced_breakpoint $forced_breakpoint_count from $a $c with i=$i max=$max_index_to_go type=$types_to_go[$i]\n";
};
DEBUG_LP && do {
my $tok_beg = $rLL->[$K_begin_line]->[_TOKEN_];
my $token = $tokens_to_go[$ii];
- print STDERR <<EOM;
+ print {*STDOUT} <<EOM;
DEBUG_LP: Created object at tok=$token type=$type for seqno $align_seqno level=$level ci=$ci_level spaces=$space_count avail=$available_spaces kbeg=$K_begin_line tokbeg=$tok_beg lp=$lp_position_predictor
EOM
};
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
|| $id_scan_state
|| $context ne $context_simple )
{
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
scan_simple_identifier differs from scan_identifier:
simple: i=$i_simple, tok=$tok_simple, type=$fast_scan_type, ident=$identifier_simple, context='$context_simple
full: i=$i, tok=$tok, type=$type, ident=$identifier, context='$context state=$id_scan_state
|| ( $i != $i_simple && $i <= $max_token_index )
|| $number ne $number_simple )
{
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
scan_number_fast differs from scan_number:
simple: i=$i_simple, type=$type_simple, number=$number_simple
full: i=$i, type=$type, number=$number
my %Z_test_hash;
BEGIN {
- my @q = qw#
+ my @qZ = qw#
-> ; } ) ]
=> =~ = == !~ || >= != *= .. && |= .= -= += <= %=
^= &&= ||= //= <=>
#;
- push @q, ',';
- @{Z_test_hash}{@q} = (1) x scalar(@q);
+ push @qZ, ',';
+ @{Z_test_hash}{@qZ} = (1) x scalar(@qZ);
}
sub do_DOLLAR_SIGN {
# An identifier followed by '->' is not indirect object;
# fixes b1175, b1176. Fix c257: Likewise for other tokens like
- # comma, semicolon, closing brace, ...
+ # comma, semicolon, closing brace, and single space.
my ( $next_nonblank_token, $i_next ) =
$self->find_next_noncomment_token( $i, $rtokens,
$max_token_index );
$rbrace_type->[$brace_depth], $paren_depth,
$rparen_type->[$paren_depth],
);
- print STDOUT "TOKENIZE:(@debug_list)\n";
+ print {*STDOUT} "TOKENIZE:(@debug_list)\n";
};
# We have the next token, $tok.
my $op_expected = $op_expected_table{$last_nonblank_type};
if ( defined($op_expected) ) {
DEBUG_OPERATOR_EXPECTED
- && print STDOUT
+ && print {*STDOUT}
"OPERATOR_EXPECTED: Table Lookup; returns $op_expected for last type $last_nonblank_type token $last_nonblank_token\n";
return $op_expected;
}
}
DEBUG_OPERATOR_EXPECTED
- && print STDOUT
+ && print {*STDOUT}
"OPERATOR_EXPECTED: returns $op_expected for last type $last_nonblank_type token $last_nonblank_token\n";
return $op_expected;
}
DEBUG_NSCAN && do {
- print STDOUT
+ print {*STDOUT}
"NSCAN: returns i=$i, tok=$tok, type=$type, state=$id_scan_state\n";
};
return ( $i, $tok, $type, $id_scan_state );
DEBUG_SCAN_ID && do {
my ( $a, $b, $c ) = caller;
- print STDOUT
+ print {*STDOUT}
"SCANID: called from $a $b $c with tok, i, state, identifier =$tok_begin, $i_begin, $id_scan_state_begin, $identifier_begin\n";
- print STDOUT
+ print {*STDOUT}
"SCANID: returned with tok, i, state, identifier =$tok, $i, $id_scan_state, $identifier\n";
};
return ( $i, $tok, $type, $id_scan_state, $identifier,
my $quoted_string = EMPTY_STRING;
0 && do {
- print STDOUT
+ print {*STDOUT}
"QUOTE entering with quote_pos = $quote_pos i=$i beginning_tok =$beginning_tok\n";
};
foreach my $i ( 0 .. $num - 1 ) {
my $len = length( $rtokens->[$i] );
- print STDOUT "$i:$len:$rtoken_map->[$i]:$rtokens->[$i]:\n";
+ print {*STDOUT} "$i:$len:$rtoken_map->[$i]:$rtokens->[$i]:\n";
}
return;
} ## end sub show_tokens
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
use constant DEBUG_TABS => 0;
my $debug_warning = sub {
- print STDOUT "VALIGN_DEBUGGING with key $_[0]\n";
+ print {*STDOUT} "VALIGN_DEBUGGING with key $_[0]\n";
return;
};
DEBUG_VALIGN && do {
my $nlines = $self->group_line_count();
- print STDOUT
+ print {*STDOUT}
"Entering valign_input: lines=$nlines new #fields= $jmax, leading_count=$leading_space_count, level=$level, group_level=$group_level, level_end=$level_end\n";
};
# Some old debugging stuff
# --------------------------------------------------------------------
DEBUG_VALIGN && do {
- print STDOUT "exiting valign_input fields:";
+ print {*STDOUT} "exiting valign_input fields:";
dump_array( @{$rfields} );
- print STDOUT "exiting valign_input tokens:";
+ print {*STDOUT} "exiting valign_input tokens:";
dump_array( @{$rtokens} );
- print STDOUT "exiting valign_input patterns:";
+ print {*STDOUT} "exiting valign_input patterns:";
dump_array( @{$rpatterns} );
};
EXPLAIN_TERNARY && do {
local $LIST_SEPARATOR = '><';
- print STDOUT "CURRENT FIELDS=<@{$rfields_old}>\n";
- print STDOUT "CURRENT TOKENS=<@{$rtokens_old}>\n";
- print STDOUT "CURRENT PATTERNS=<@{$rpatterns_old}>\n";
- print STDOUT "UNMODIFIED FIELDS=<@{$rfields}>\n";
- print STDOUT "UNMODIFIED TOKENS=<@{$rtokens}>\n";
- print STDOUT "UNMODIFIED PATTERNS=<@{$rpatterns}>\n";
+ print {*STDOUT} "CURRENT FIELDS=<@{$rfields_old}>\n";
+ print {*STDOUT} "CURRENT TOKENS=<@{$rtokens_old}>\n";
+ print {*STDOUT} "CURRENT PATTERNS=<@{$rpatterns_old}>\n";
+ print {*STDOUT} "UNMODIFIED FIELDS=<@{$rfields}>\n";
+ print {*STDOUT} "UNMODIFIED TOKENS=<@{$rtokens}>\n";
+ print {*STDOUT} "UNMODIFIED PATTERNS=<@{$rpatterns}>\n";
};
# handle cases of leading colon on this line
EXPLAIN_TERNARY && do {
local $LIST_SEPARATOR = '><';
- print STDOUT "MODIFIED TOKENS=<@tokens>\n";
- print STDOUT "MODIFIED PATTERNS=<@patterns>\n";
- print STDOUT "MODIFIED FIELDS=<@fields>\n";
+ print {*STDOUT} "MODIFIED TOKENS=<@tokens>\n";
+ print {*STDOUT} "MODIFIED PATTERNS=<@patterns>\n";
+ print {*STDOUT} "MODIFIED FIELDS=<@fields>\n";
};
# all ok .. update the arrays
# debug routine to dump array contents
local $LIST_SEPARATOR = ')(';
- print STDOUT "(@_)\n";
+ print {*STDOUT} "(@_)\n";
return;
} ## end sub dump_array
0 && do {
my ( $a, $b, $c ) = caller();
my $nlines = @{$rgroup_lines};
- print STDOUT
+ print {*STDOUT}
"APPEND0: _flush_group_lines called from $a $b $c lines=$nlines, type=$group_type \n";
};
EXPLAIN_COMPARE_PATTERNS
&& $return_code
- && print STDERR "no match because $GoToMsg\n";
+ && print {*STDOUT} "no match because $GoToMsg\n";
return ( $return_code, \$GoToMsg );
return if ( $AUTOLOAD =~ /\bDESTROY$/ );
my ( $pkg, $fname, $lno ) = caller();
my $my_package = __PACKAGE__;
- print STDERR <<EOM;
+ print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
projects / perltidy.git / commitdiff