use Perl::Tidy::VerticalAligner;
local $OUTPUT_AUTOFLUSH = 1;
-# this can be turned on for extra checking during development
-use constant DEVEL_MODE => 0;
+# DEVEL_MODE can be turned on for extra checking during development
+use constant DEVEL_MODE => 0;
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
use vars qw{
$VERSION
my $rstatus = {
file_count => 0,
- opt_format => "",
- opt_encoding => "",
- opt_encode_output => "",
- opt_max_iterations => "",
+ opt_format => EMPTY_STRING,
+ opt_encoding => EMPTY_STRING,
+ opt_encode_output => EMPTY_STRING,
+ opt_max_iterations => EMPTY_STRING,
- input_name => "",
- output_name => "",
+ input_name => EMPTY_STRING,
+ output_name => EMPTY_STRING,
char_mode_source => 0,
char_mode_used => 0,
- input_decoded_as => "",
- output_encoded_as => "",
+ input_decoded_as => EMPTY_STRING,
+ output_encoded_as => EMPTY_STRING,
gcs_used => 0,
iteration_count => 0,
converged => 0,
}
}
else {
- $dump_options_type = "";
+ $dump_options_type = EMPTY_STRING;
}
if ($user_formatter) {
}
my $rpending_complaint;
- ${$rpending_complaint} = "";
+ ${$rpending_complaint} = EMPTY_STRING;
my $rpending_logfile_message;
- ${$rpending_logfile_message} = "";
+ ${$rpending_logfile_message} = EMPTY_STRING;
my ( $is_Windows, $Windows_type ) = look_for_Windows($rpending_complaint);
$quit_now = 1;
foreach my $op ( @{$roption_string} ) {
my $opt = $op;
- my $flag = "";
+ my $flag = EMPTY_STRING;
# Examples:
# some-option=s
my %default_file_extension = (
tidy => 'tdy',
html => 'html',
- user => '',
+ user => EMPTY_STRING,
);
$rstatus->{'opt_format'} = $rOpts->{'format'};
# be sure we have a valid output format
unless ( exists $default_file_extension{ $rOpts->{'format'} } ) {
- my $formats = join ' ',
+ my $formats = join SPACE,
sort map { "'" . $_ . "'" } keys %default_file_extension;
my $fmt = $rOpts->{'format'};
Die("-format='$fmt' but must be one of: $formats\n");
my %saw_md5;
my $digest_input = 0;
- my $buf = '';
+ my $buf = EMPTY_STRING;
while ( my $line = $source_object->get_line() ) {
$buf .= $line;
}
!$rOpts->{'add-terminal-newline'} && substr( $buf, -1, 1 ) !~ /\n/;
# Decode the input stream if necessary or requested
- my $encoding_in = "";
+ my $encoding_in = EMPTY_STRING;
my $rOpts_character_encoding = $rOpts->{'character-encoding'};
my $encoding_log_message;
- my $decoded_input_as = "";
+ my $decoded_input_as = EMPTY_STRING;
$rstatus->{'char_mode_source'} = 0;
# Case 1: If Perl is already in a character-oriented mode for this
if ( ref($decoder) ) {
$encoding_in = $decoder->name;
if ( $encoding_in ne 'UTF-8' && $encoding_in ne 'utf8' ) {
- $encoding_in = "";
+ $encoding_in = EMPTY_STRING;
$buf = $buf_in;
$encoding_log_message .= <<EOM;
Guessed encoding '$encoding_in' is not utf8; no encoding will be used
Warn(
"file: $input_file: bad guess to decode source as $encoding_in\n"
);
- $encoding_in = "";
+ $encoding_in = EMPTY_STRING;
$buf = $buf_in;
}
else {
# read and write it as encoded data, and we will normalize these
# operations with utf8. If we have not decoded the data, then
# we must not treat it as encoded data.
- my $is_encoded_data = $encoding_in ? 'utf8' : "";
+ my $is_encoded_data = $encoding_in ? 'utf8' : EMPTY_STRING;
$rstatus->{'input_name'} = $display_name;
$rstatus->{'opt_encoding'} = $rOpts_character_encoding;
# prepare the output stream
#---------------------------------------------------------------
my $output_file = undef;
- my $output_name = "";
+ my $output_name = EMPTY_STRING;
my $actual_output_extension;
if ( $rOpts->{'outfile'} ) {
# -eos flag set: If perltidy decodes a string, regardless of
# source, it encodes before returning.
- $rstatus->{'output_encoded_as'} = '';
+ $rstatus->{'output_encoded_as'} = EMPTY_STRING;
if ($encode_destination_buffer) {
my $encoded_buffer;
# have same common characters so non-null characters indicate character
# differences.
my ( $s1, $s2 ) = @_;
- my $diff_marker = "";
+ my $diff_marker = EMPTY_STRING;
my $pos = -1;
my $pos1 = $pos;
if ( defined($s1) && defined($s2) ) {
my $pos_last = $pos;
$pos = $LAST_MATCH_START[0];
if ( $count == 1 ) { $pos1 = $pos; }
- $diff_marker .= ' ' x ( $pos - $pos_last - 1 ) . '^';
+ $diff_marker .= SPACE x ( $pos - $pos_last - 1 ) . '^';
# we could continue to mark all differences, but there is no point
last;
my ( $fhi, $fnamei ) = streamhandle( \$bufi, 'r', $is_encoded_data );
my ( $fho, $fnameo ) = streamhandle( \$bufo, 'r', $is_encoded_data );
return $msg unless ( $fho && $fhi ); # for safety, shouldn't happen
- my ( $linei, $lineo );
- my ( $counti, $counto ) = ( 0, 0 );
- my ( $last_nonblank_line, $last_nonblank_count ) = ( "", 0 );
+ my ( $linei, $lineo );
+ my ( $counti, $counto ) = ( 0, 0 );
+ my ( $last_nonblank_line, $last_nonblank_count ) = ( EMPTY_STRING, 0 );
my $truncate = sub {
my ( $str, $lenmax ) = @_;
if ( length($str) > $lenmax ) {
my ( $line_diff, $pos1 ) = line_diff( $linei, $lineo );
my $reason = "Files first differ at character $pos1 of line $counti";
- my ( $leading_ws_i, $leading_ws_o ) = ( "", "" );
+ my ( $leading_ws_i, $leading_ws_o ) = ( EMPTY_STRING, EMPTY_STRING );
if ( $linei =~ /^(\s+)/ ) { $leading_ws_i = $1; }
if ( $lineo =~ /^(\s+)/ ) { $leading_ws_o = $1; }
if ( $leading_ws_i ne $leading_ws_o ) {
}
}
else {
- my ( $trailing_ws_i, $trailing_ws_o ) = ( "", "" );
+ my ( $trailing_ws_i, $trailing_ws_o ) =
+ ( EMPTY_STRING, EMPTY_STRING );
if ( $linei =~ /(\s+)$/ ) { $trailing_ws_i = $1; }
if ( $lineo =~ /(\s+)$/ ) { $trailing_ws_o = $1; }
if ( $trailing_ws_i ne $trailing_ws_o ) {
# limit string display length
if ( $pos1 > 60 ) {
my $drop = $pos1 - 40;
- $linei = "..." . substr( $linei, $drop );
- $lineo = "..." . substr( $lineo, $drop );
- $line_diff = " " . substr( $line_diff, $drop );
+ $linei = "..." . substr( $linei, $drop );
+ $lineo = "..." . substr( $lineo, $drop );
+ $line_diff = SPACE x 3 . substr( $line_diff, $drop );
}
$linei = $truncate->( $linei, 72 );
$lineo = $truncate->( $lineo, 72 );
$last_nonblank_count:$last_nonblank_line
EOM
}
- $line_diff = ' ' x ( 2 + length($counto) ) . $line_diff;
+ $line_diff = SPACE x ( 2 + length($counto) ) . $line_diff;
$msg .= <<EOM;
<$counti:$linei
>$counto:$lineo
if ($Windows_type) {
$logger_object->write_logfile_entry("Windows type is $Windows_type\n");
}
- my $options_string = join( ' ', @{$rraw_options} );
+ my $options_string = join( SPACE, @{$rraw_options} );
if ($config_file) {
$logger_object->write_logfile_entry(
$add_option->( 'dump-want-left-space', 'dwls', '!' );
$add_option->( 'dump-want-right-space', 'dwrs', '!' );
$add_option->( 'fuzzy-line-length', 'fll', '!' );
- $add_option->( 'help', 'h', '' );
+ $add_option->( 'help', 'h', EMPTY_STRING );
$add_option->( 'short-concatenation-item-length', 'scl', '=i' );
$add_option->( 'show-options', 'opt', '!' );
$add_option->( 'timestamp', 'ts', '!' );
- $add_option->( 'version', 'v', '' );
+ $add_option->( 'version', 'v', EMPTY_STRING );
$add_option->( 'memoize', 'mem', '!' );
$add_option->( 'file-size-order', 'fso', '!' );
$add_option->( 'maximum-file-size-mb', 'maxfs', '=i' );
my $word;
my @raw_options = ();
- my $config_file = "";
+ my $config_file = EMPTY_STRING;
my $saw_ignore_profile = 0;
my $saw_dump_profile = 0;
}
unless ( -e $config_file ) {
Warn("cannot find file given with -pro=$config_file: $ERRNO\n");
- $config_file = "";
+ $config_file = EMPTY_STRING;
}
}
elsif ( $i =~ /^-(pro|profile)=?$/ ) {
# look for a config file if we don't have one yet
my $rconfig_file_chatter;
- ${$rconfig_file_chatter} = "";
+ ${$rconfig_file_chatter} = EMPTY_STRING;
$config_file =
find_config_file( $is_Windows, $Windows_type, $rconfig_file_chatter,
$rpending_complaint )
# Defaults: list operators in List::Util
# Possible future additions: pairfirst pairgrep pairmap
- my $default_string = join ' ', qw(
+ my $default_string = join SPACE, qw(
all
any
first
}
# The special option -gaxl='*' removes all defaults
- if ( $is_excluded_word{'*'} ) { $default_string = "" }
+ if ( $is_excluded_word{'*'} ) { $default_string = EMPTY_STRING }
# combine the defaults and any input list
my $input_string = $rOpts->{'grep-alias-list'};
- if ($input_string) { $input_string .= " " . $default_string }
+ if ($input_string) { $input_string .= SPACE . $default_string }
else { $input_string = $default_string }
# Now make the final list of unique grep alias words
}
}
}
- my $joined_words = join ' ', @filtered_word_list;
+ my $joined_words = join SPACE, @filtered_word_list;
$rOpts->{'grep-alias-list'} = $joined_words;
return;
}
}
}
}
- $rOpts->{'sub-alias-list'} = join ' ', @filtered_word_list;
+ $rOpts->{'sub-alias-list'} = join SPACE, @filtered_word_list;
}
make_grep_alias_string($rOpts);
# to allow abbreviations with arguments such as '-vt=1'
if ( $rexpansion->{ $abr . $flags } ) {
$abr = $abr . $flags;
- $flags = "";
+ $flags = EMPTY_STRING;
}
# if we see this dash item in the expansion hash..
$base .= '.' unless $base =~ /(?:^|[^^])\./;
# if we don't already have an extension then we just append the extension
- my $separator = ( $base =~ /\.$/ ) ? "" : "_";
+ my $separator = ( $base =~ /\.$/ ) ? EMPTY_STRING : "_";
return ( $path . $base, $separator );
}
# We need to know this to decide where to look for config files
my $rpending_complaint = shift;
- my $os = "";
+ my $os = EMPTY_STRING;
return $os unless $OSNAME =~ /win32|dos/i; # is it a MS box?
# Systems built from Perl source may not have Win32.pm
# If $os is undefined, the above code is out of date. Suggested updates
# are welcome.
unless ( defined $os ) {
- $os = "";
+ $os = EMPTY_STRING;
# Deactivated this message 20180322 because it was needlessly
# causing some test scripts to fail. Need help from someone
return unless $os;
- my $system = "";
- my $allusers = "";
+ my $system = EMPTY_STRING;
+ my $allusers = EMPTY_STRING;
if ( $os =~ /9[58]|Me/ ) {
$system = "C:/Windows";
my @config_list = ();
# file is bad if non-empty $death_message is returned
- my $death_message = "";
+ my $death_message = EMPTY_STRING;
my $name = undef;
my $line_no;
# Strip any comment from a command line
my ( $instr, $config_file, $line_no ) = @_;
- my $msg = "";
+ my $msg = EMPTY_STRING;
# check for full-line comment
if ( $instr =~ /^\s*#/ ) {
- return ( "", $msg );
+ return ( EMPTY_STRING, $msg );
}
# nothing to do if no comments
}
# handle comments and quotes
- my $outstr = "";
- my $quote_char = "";
+ my $outstr = EMPTY_STRING;
+ my $quote_char = EMPTY_STRING;
while (1) {
# looking for ending quote character
if ($quote_char) {
if ( $instr =~ /\G($quote_char)/gc ) {
- $quote_char = "";
+ $quote_char = EMPTY_STRING;
$outstr .= $1;
}
elsif ( $instr =~ /\G(.)/gc ) {
my ($body) = @_;
my @body_parts = ();
- my $quote_char = "";
- my $part = "";
- my $msg = "";
+ my $quote_char = EMPTY_STRING;
+ my $part = EMPTY_STRING;
+ my $msg = EMPTY_STRING;
# Check for external call with undefined $body - added to fix
# github issue Perl-Tidy-Sweetened issue #23
- if ( !defined($body) ) { $body = "" }
+ if ( !defined($body) ) { $body = EMPTY_STRING }
while (1) {
# looking for ending quote character
if ($quote_char) {
if ( $body =~ /\G($quote_char)/gc ) {
- $quote_char = "";
+ $quote_char = EMPTY_STRING;
}
elsif ( $body =~ /\G(.)/gc ) {
$part .= $1;
}
elsif ( $body =~ /\G(\s+)/gc ) {
if ( length($part) ) { push @body_parts, $part; }
- $part = "";
+ $part = EMPTY_STRING;
}
elsif ( $body =~ /\G(.)/gc ) {
$part .= $1;
$readable_options .=
"# See utility 'perltidyrc_dump.pl' for nicer formatting.\n";
foreach my $opt ( @{$roption_string} ) {
- my $flag = "";
+ my $flag = EMPTY_STRING;
if ( $opt =~ /(.*)(!|=.*)$/ ) {
$opt = $1;
$flag = $2;
my $flag = $rGetopt_flags->{$key};
my $value = $rOpts->{$key};
my $prefix = '--';
- my $suffix = "";
+ my $suffix = EMPTY_STRING;
if ($flag) {
if ( $flag =~ /^=/ ) {
if ( $value !~ /^\d+$/ ) { $value = '"' . $value . '"' }
use English qw( -no_match_vars );
our $VERSION = '20220217.04';
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
+
sub new {
my ( $class, $filename, $is_encoded_data ) = @_;
my $reconstructed_original = "$input_line_number: ";
my $block_str = "$input_line_number: ";
- my $pattern = "";
+ my $pattern = EMPTY_STRING;
my @next_char = ( '"', '"' );
my $i_next = 0;
unless ( $self->{_debug_file_opened} ) { $self->really_open_debug_file() }
# be sure there are no blank tokens (shouldn't happen)
# This can only happen if a programming error has been made
# because all valid tokens are non-blank
- if ( $type_str eq ' ' ) {
+ if ( $type_str eq SPACE ) {
$fh->print("BLANK TOKEN on the next line\n");
$type_str = $next_char[$i_next];
$i_next = 1 - $i_next;
use English qw( -no_match_vars );
our $VERSION = '20220217.04';
+use constant EMPTY_STRING => q{};
+
sub AUTOLOAD {
# Catch any undefined sub calls so that we are sure to get
my $class = shift;
return bless {
_write_diagnostics_count => 0,
- _last_diagnostic_file => "",
- _input_file => "",
+ _last_diagnostic_file => EMPTY_STRING,
+ _input_file => EMPTY_STRING,
_fh => undef,
}, $class;
}
use warnings;
our $VERSION = '20220217.04';
-use constant DEVEL_MODE => 0;
+use constant DEVEL_MODE => 0;
+use constant EMPTY_STRING => q{};
sub AUTOLOAD {
# required to avoid call to AUTOLOAD in some versions of perl
}
-my $input_stream_name = "";
+my $input_stream_name = EMPTY_STRING;
# Maximum number of little messages; probably need not be changed.
-my $MAX_NAG_MESSAGES = 6;
+use constant MAX_NAG_MESSAGES => 6;
BEGIN {
$self->[_max_output_line_length_at_] = 0;
$self->[_rK_checklist_] = [];
$self->[_K_arrival_order_matches_] = 0;
- $self->[_K_sequence_error_msg_] = "";
+ $self->[_K_sequence_error_msg_] = EMPTY_STRING;
$self->[_K_last_arrival_] = -1;
# save input stream name for local error messages
- $input_stream_name = "";
+ $input_stream_name = EMPTY_STRING;
if ($logger_object) {
$input_stream_name = $logger_object->get_input_stream_name();
}
$self->[_rK_checklist_] = \@list;
}
$self->[_K_arrival_order_matches_] = 1;
- $self->[_K_sequence_error_msg_] = "";
+ $self->[_K_sequence_error_msg_] = EMPTY_STRING;
$self->[_K_last_arrival_] = -1;
return;
}
return;
}
+use constant MAX_PRINTED_CHARS => 80;
+
sub write_code_line {
my ( $self, $str, $K ) = @_;
my $K_prev = $self->[_K_last_arrival_];
if ( $K < $K_prev ) {
chomp $str;
- if ( length($str) > 80 ) {
- $str = substr( $str, 0, 80 ) . "...";
+ if ( length($str) > MAX_PRINTED_CHARS ) {
+ $str = substr( $str, 0, MAX_PRINTED_CHARS ) . "...";
}
my $msg = <<EOM;
$self->[_max_line_length_error_at_] = $output_line_number - 1;
}
- if ( $self->[_line_length_error_count_] < $MAX_NAG_MESSAGES ) {
+ if ( $self->[_line_length_error_count_] < MAX_NAG_MESSAGES ) {
$self->write_logfile_entry(
"Line length exceeded by $exceed characters\n");
}
}
else {
- my $word = ( $line_length_error_count > 1 ) ? "s" : "";
+ my $word = ( $line_length_error_count > 1 ) ? "s" : EMPTY_STRING;
$self->write_logfile_entry(
"$line_length_error_count output line$word exceeded $rOpts->{'maximum-line-length'} characters:\n"
);
- $word = ( $line_length_error_count > 1 ) ? "First" : "";
+ $word = ( $line_length_error_count > 1 ) ? "First" : EMPTY_STRING;
my $first_line_length_error = $self->[_first_line_length_error_];
my $first_line_length_error_at = $self->[_first_line_length_error_at_];
$self->write_logfile_entry(
use strict;
use warnings;
-# This flag gets switched on during automated testing for extra checking
-use constant DEVEL_MODE => 0;
+# DEVEL_MODE gets switched on during automated testing for extra checking
+use constant DEVEL_MODE => 0;
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
{ #<<< A non-indenting brace to contain all lexical variables
diagnostics_object => undef,
logger_object => undef,
length_function => sub { return length( $_[0] ) },
- is_encoded_data => "",
+ is_encoded_data => EMPTY_STRING,
fh_tee => undef,
);
my %args = ( %defaults, @args );
# by making calls to this routine at different locations in
# sub 'finish_formatting'.
$Klimit = 'undef' if ( !defined($Klimit) );
- $msg = "" unless $msg;
+ $msg = EMPTY_STRING unless $msg;
Fault("$msg ERROR: rLL has num=$num but Klimit='$Klimit'\n");
}
return;
}
sub get_input_stream_name {
- my $input_stream_name = "";
+ my $input_stream_name = EMPTY_STRING;
if ($logger_object) {
$input_stream_name = $logger_object->get_input_stream_name();
}
}
# Coordinate ?/: breaks, which must be similar
+ # The small strength 0.01 which is added is 1% of the strength of one
+ # indentation level and seems to work okay.
if ( !$want_break_before{':'} ) {
$want_break_before{'?'} = $want_break_before{':'};
$right_bond_strength{'?'} = $right_bond_strength{':'} + 0.01;
$right_bond_strength{'{'} = WEAK;
$left_bond_strength{'{'} = VERY_STRONG;
- # make -l=0 equal to -l=infinite
+ # make -l=0 equal to -l=infinite
if ( !$rOpts->{'maximum-line-length'} ) {
$rOpts->{'maximum-line-length'} = 1_000_000;
}
- # make -lbl=0 equal to -lbl=infinite
+ # make -lbl=0 equal to -lbl=infinite
if ( !$rOpts->{'long-block-line-count'} ) {
$rOpts->{'long-block-line-count'} = 1_000_000;
}
else {
$ole = lc $ole;
unless ( $rOpts->{'output-line-ending'} = $endings{$ole} ) {
- my $str = join " ", keys %endings;
+ my $str = join SPACE, keys %endings;
Die(<<EOM);
Unrecognized line ending '$ole'; expecting one of: $str
EOM
push @conflicts, '--break-at-old-semicolon-breakpoints (-bos)';
}
if ( $rOpts->{'keep-old-breakpoints-before'} ) {
- $rOpts->{'keep-old-breakpoints-before'} = "";
+ $rOpts->{'keep-old-breakpoints-before'} = EMPTY_STRING;
push @conflicts, '--keep-old-breakpoints-before (-kbb)';
}
if ( $rOpts->{'keep-old-breakpoints-after'} ) {
- $rOpts->{'keep-old-breakpoints-after'} = "";
+ $rOpts->{'keep-old-breakpoints-after'} = EMPTY_STRING;
push @conflicts, '--keep-old-breakpoints-after (-kba)';
}
# level only. If a line has continuation indentation, then that space must
# be subtracted from the table value. This table is used for preliminary
# estimates in welding, extended_ci, BBX, and marking short blocks.
- my $level_max = 1000;
+ use constant LEVEL_TABLE_MAX => 1000;
# The basic scheme:
- foreach my $level ( 0 .. $level_max ) {
+ foreach my $level ( 0 .. LEVEL_TABLE_MAX ) {
my $indent = $level * $rOpts_indent_columns;
$maximum_line_length_at_level[$level] = $rOpts_maximum_line_length;
$maximum_text_length_at_level[$level] =
$rOpts_whitespace_cycle = $rOpts->{'whitespace-cycle'};
if ($rOpts_whitespace_cycle) {
if ( $rOpts_whitespace_cycle > 0 ) {
- foreach my $level ( 0 .. $level_max ) {
+ foreach my $level ( 0 .. LEVEL_TABLE_MAX ) {
my $level_mod = $level % $rOpts_whitespace_cycle;
my $indent = $level_mod * $rOpts_indent_columns;
$maximum_text_length_at_level[$level] =
# Correct the tables if the -vmll flag is used. These values override the
# previous values.
if ($rOpts_variable_maximum_line_length) {
- foreach my $level ( 0 .. $level_max ) {
+ foreach my $level ( 0 .. LEVEL_TABLE_MAX ) {
$maximum_text_length_at_level[$level] = $rOpts_maximum_line_length;
$maximum_line_length_at_level[$level] =
$rOpts_maximum_line_length + $level * $rOpts_indent_columns;
# formatting features.
# Put a reasonable upper limit on stress level (say 100) in case the
# whitespace-cycle variable is used.
- my $stress_level_limit = min( 100, $level_max );
+ my $stress_level_limit = min( 100, LEVEL_TABLE_MAX );
# Find stress_level_alpha, targeted at very short maximum line lengths.
$stress_level_alpha = $stress_level_limit + 1;
}
}
if ($all_off) {
- $rOpts->{'line-up-parentheses'} = "";
+ $rOpts->{'line-up-parentheses'} = EMPTY_STRING;
}
}
my %flags = ();
my @list = split_words($str);
if ( DEBUG_KB && @list ) {
- local $LIST_SEPARATOR = ' ';
+ local $LIST_SEPARATOR = SPACE;
print <<EOM;
DEBUG_KB entering for '$short_name' with str=$str\n";
list is: @list;
if (@unknown_types) {
my $num = @unknown_types;
- local $LIST_SEPARATOR = ' ';
+ local $LIST_SEPARATOR = SPACE;
Warn(<<EOM);
$num unrecognized token types were input with --$short_name :
@unknown_types
if ( DEBUG_KB && @list ) {
my @tmp = %flags;
- local $LIST_SEPARATOR = ' ';
+ local $LIST_SEPARATOR = SPACE;
print <<EOM;
DEBUG_KB -$short_name flag: $str
my $rtokh_last = $rLL->[0];
my $rtokh_last_last = $rtokh_last;
- my $last_type = '';
- my $last_token = '';
+ my $last_type = EMPTY_STRING;
+ my $last_token = EMPTY_STRING;
my $j_tight_closing_paren = -1;
$rtokh = [ @{ $rLL->[0] } ];
- $token = ' ';
+ $token = SPACE;
$type = 'b';
$rtokh->[_TOKEN_] = $token;
$rtokh->[_TYPE_] = $type;
- $rtokh->[_TYPE_SEQUENCE_] = '';
+ $rtokh->[_TYPE_SEQUENCE_] = EMPTY_STRING;
$rtokh->[_LINE_INDEX_] = 0;
# This is some logic moved to a sub to avoid deep nesting of if stmts
if (DEBUG_WHITE) {
my $str = substr( $last_token, 0, 15 );
- $str .= ' ' x ( 16 - length($str) );
+ $str .= SPACE x ( 16 - length($str) );
if ( !defined($ws_1) ) { $ws_1 = "*" }
if ( !defined($ws_2) ) { $ws_2 = "*" }
if ( !defined($ws_3) ) { $ws_3 = "*" }
my $code_bias = -.01; # bias for closing block braces
my $type = 'b';
- my $token = ' ';
+ my $token = SPACE;
my $token_length = 1;
my $last_type;
my $last_nonblank_type = $type;
DEBUG_BOND && do {
my $str = substr( $token, 0, 15 );
- $str .= ' ' x ( 16 - length($str) );
+ $str .= SPACE x ( 16 - length($str) );
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";
# Include keywords here which should not be cuddled
- my $cuddled_string = "";
+ my $cuddled_string = EMPTY_STRING;
if ( $rOpts->{'cuddled-else'} ) {
# set the default
# Add users other blocks to be cuddled
my $cuddled_block_list = $rOpts->{'cuddled-block-list'};
if ($cuddled_block_list) {
- $cuddled_string .= " " . $cuddled_block_list;
+ $cuddled_string .= SPACE . $cuddled_block_list;
}
}
# easier to manage.
my $cuddled_string = $rOpts->{'cuddled-block-list'};
- $cuddled_string = '' unless $cuddled_string;
+ $cuddled_string = EMPTY_STRING unless $cuddled_string;
- my $flags = "";
+ my $flags = EMPTY_STRING;
$flags .= "-ce" if ( $rOpts->{'cuddled-else'} );
$flags .= " -cbl='$cuddled_string'";
# default list of block types for which -bli would apply
my $bli_list_string = 'if else elsif unless while for foreach do : sub';
- my $bli_exclusion_list_string = ' ';
+ my $bli_exclusion_list_string = SPACE;
if ( defined( $rOpts->{'brace-left-and-indent-list'} )
&& $rOpts->{'brace-left-and-indent-list'} )
# turn any input list into a regex for recognizing selected block types.
# Here are the defaults:
$keyword_group_list_pattern = '^(our|local|my|use|require|)$';
- $keyword_group_list_comment_pattern = '';
+ $keyword_group_list_comment_pattern = EMPTY_STRING;
if ( defined( $rOpts->{'keyword-group-blanks-list'} )
&& $rOpts->{'keyword-group-blanks-list'} )
{
$keyword_group_list_pattern =
make_block_pattern( '-kgbl', $rOpts->{'keyword-group-blanks-list'} );
$keyword_group_list_comment_pattern =
- make_block_pattern( '-kgbl', join( ' ', @comment_list ) );
+ make_block_pattern( '-kgbl', join( SPACE, @comment_list ) );
}
return;
}
if ( !@words ) { push @words, "1 " }
my $pattern = '(' . join( '|', @words ) . ')$';
- my $sub_patterns = "";
+ my $sub_patterns = EMPTY_STRING;
if ( $seen{'sub'} ) {
$sub_patterns .= '|' . $SUB_PATTERN;
}
my $seqno = $rtype_sequence->[$j];
my $token = $rtokens->[$j];
my $type = $rtoken_type->[$j];
- $seqno = "" unless ( defined($seqno) );
+ $seqno = EMPTY_STRING unless ( defined($seqno) );
my $err_msg =
"Error at j=$j, line number $input_line_no, seqno='$seqno', type='$type', tok='$token':\n";
# Data needed by Logger
$line_of_tokens->{_level_0} = 0;
$line_of_tokens->{_ci_level_0} = 0;
- $line_of_tokens->{_nesting_blocks_0} = "";
- $line_of_tokens->{_nesting_tokens_0} = "";
+ $line_of_tokens->{_nesting_blocks_0} = EMPTY_STRING;
+ $line_of_tokens->{_nesting_tokens_0} = EMPTY_STRING;
# Needed to avoid trimming quotes
$line_of_tokens->{_ended_in_blank_token} = undef;
my $line_type = $line_of_tokens_old->{_line_type};
my $line_number = $line_of_tokens_old->{_line_number};
- my $CODE_type = "";
+ my $CODE_type = EMPTY_STRING;
my $tee_output;
# Handle line of non-code
}
else {
- $seqno = "" unless ( defined($seqno) );
+ $seqno = EMPTY_STRING unless ( defined($seqno) );
}
my @tokary;
( $Kfirst, $Klast ) = @{$rK_range};
my $last_CODE_type = $CODE_type;
- $CODE_type = "";
+ $CODE_type = EMPTY_STRING;
my $input_line = $line_of_tokens->{_line_text};
my $jmax = defined($Kfirst) ? $Klast - $Kfirst : -1;
&& ( substr( $rLL->[$Kfirst]->[_TOKEN_], 0, 4 ) eq '#>>>'
|| $rOpts_format_skipping_end )
- && ( $rLL->[$Kfirst]->[_TOKEN_] . " " ) =~
+ && ( $rLL->[$Kfirst]->[_TOKEN_] . SPACE ) =~
/$format_skipping_pattern_end/
)
{
|| $rOpts_format_skipping_begin )
&& $rOpts_format_skipping
- && ( $rLL->[$Kfirst]->[_TOKEN_] . " " ) =~
+ && ( $rLL->[$Kfirst]->[_TOKEN_] . SPACE ) =~
/$format_skipping_pattern_begin/
)
{
# This may produce multiple blanks in a row, but sub respace_tokens
# will check for this and fix it.
$rLL->[$Klast]->[_TYPE_] = 'b';
- $rLL->[$Klast]->[_TOKEN_] = ' ';
+ $rLL->[$Klast]->[_TOKEN_] = SPACE;
# The -io option outputs the line text, so we have to update
# the line text so that the comment does not reappear.
if ( $CODE_type eq 'IO' ) {
- my $line = "";
+ my $line = EMPTY_STRING;
foreach my $KK ( $Kfirst .. $Klast - 1 ) {
$line .= $rLL->[$KK]->[_TOKEN_];
}
my $Klast_old_code; # K of last token if side comment
my $Kmax = @{$rLL} - 1;
- my $CODE_type = "";
- my $line_type = "";
+ my $CODE_type = EMPTY_STRING;
+ my $line_type = EMPTY_STRING;
# Set the whitespace flags, which indicate the token spacing preference.
my $rwhitespace_flags = $self->set_whitespace_flags();
my $last_nonblank_code_type = ';';
my $last_nonblank_code_token = ';';
- my $last_nonblank_block_type = '';
+ my $last_nonblank_block_type = EMPTY_STRING;
my $last_last_nonblank_code_type = ';';
my $last_last_nonblank_code_token = ';';
my $type = $item->[_TYPE_];
my $is_blank = $type eq 'b';
- my $block_type = "";
+ my $block_type = EMPTY_STRING;
# Do not output consecutive blanks. This situation should have been
# prevented earlier, but it is worth checking because later routines
{
my $rcopy = [ @{$item} ];
$rcopy->[_TYPE_] = 'b';
- $rcopy->[_TOKEN_] = ' ';
- $rcopy->[_TYPE_SEQUENCE_] = '';
+ $rcopy->[_TOKEN_] = SPACE;
+ $rcopy->[_TYPE_SEQUENCE_] = EMPTY_STRING;
$rcopy->[_LINE_INDEX_] =
$rLL_new->[-1]->[_LINE_INDEX_];
# convert the blank into a semicolon..
# be careful: we are working on the new stack top
# on a token which has been stored.
- my $rcopy = copy_token_as_type( $rLL_new->[$Ktop], 'b', ' ' );
+ my $rcopy = copy_token_as_type( $rLL_new->[$Ktop], 'b', SPACE );
# Convert the existing blank to:
# a phantom semicolon for one_line_block option = 0 or 1
# a real semicolon for one_line_block option = 2
- my $tok = '';
+ my $tok = EMPTY_STRING;
my $len_tok = 0;
if ( $rOpts_one_line_block_semicolons == 2 ) {
$tok = ';';
}
}
- my $rcopy = copy_token_as_type( $rLL_new->[$Kp], ';', '' );
+ my $rcopy =
+ copy_token_as_type( $rLL_new->[$Kp], ';', EMPTY_STRING );
$store_token->($rcopy);
push @{$rK_phantom_semicolons}, @{$rLL_new} - 1;
}
my $previous_nonblank_token = $rLL_new->[$Kp]->[_TOKEN_];
my $previous_nonblank_type_2 = 'b';
- my $previous_nonblank_token_2 = "";
+ my $previous_nonblank_token_2 = EMPTY_STRING;
my $Kpp = $self->K_previous_nonblank( $Kp, $rLL_new );
if ( defined($Kpp) ) {
$previous_nonblank_type_2 = $rLL_new->[$Kpp]->[_TYPE_];
$previous_nonblank_token_2 = $rLL_new->[$Kpp]->[_TOKEN_];
}
- my $next_nonblank_token = "";
+ my $next_nonblank_token = EMPTY_STRING;
my $Kn = $KK + 1;
if ( $Kn <= $Kmax && $rLL->[$Kn]->[_TYPE_] eq 'b' ) { $Kn += 1 }
if ( $Kn <= $Kmax ) {
# hanging side comment from getting converted to a block
# comment if whitespace gets deleted, as for example with
# the -extrude and -mangle options.
- my $rcopy = copy_token_as_type( $rvars_Kfirst, 'q', '' );
+ my $rcopy =
+ copy_token_as_type( $rvars_Kfirst, 'q', EMPTY_STRING );
$store_token->($rcopy);
- $rcopy = copy_token_as_type( $rvars_Kfirst, 'b', ' ' );
+ $rcopy = copy_token_as_type( $rvars_Kfirst, 'b', SPACE );
$store_token->($rcopy);
$store_token->($rvars_Kfirst);
next;
"Program bug. A hanging side comment has been mismarked"
) if (DEVEL_MODE);
- $CODE_type = "";
+ $CODE_type = EMPTY_STRING;
$line_of_tokens->{_code_type} = $CODE_type;
}
}
{
# Copy this first token as blank, but use previous line number
- my $rcopy = copy_token_as_type( $rLL->[$Kfirst], 'b', ' ' );
+ my $rcopy = copy_token_as_type( $rLL->[$Kfirst], 'b', SPACE );
$rcopy->[_LINE_INDEX_] =
$rLL_new->[-1]->[_LINE_INDEX_];
}
# make it just one character
- $rtoken_vars->[_TOKEN_] = ' ';
+ $rtoken_vars->[_TOKEN_] = SPACE;
$store_token->($rtoken_vars);
next;
}
&& $want_left_space{'->'} == WS_YES )
{
my $rcopy =
- copy_token_as_type( $rtoken_vars, 'b', ' ' );
+ copy_token_as_type( $rtoken_vars, 'b', SPACE );
$store_token->($rcopy);
}
# added for issue git #33
if ( $want_right_space{'->'} == WS_YES ) {
my $rcopy_b =
- copy_token_as_type( $rtoken_vars, 'b', ' ' );
+ copy_token_as_type( $rtoken_vars, 'b', SPACE );
$store_token->($rcopy_b);
}
# container. This fixes case b1085. To find the corresponding code in
# Tokenizer.pm search for 'b1085' with an editor.
my $block_type = $rblock_type_of_seqno->{$seqno};
- if ( $block_type && substr( $block_type, -1, 1 ) eq ' ' ) {
+ if ( $block_type && substr( $block_type, -1, 1 ) eq SPACE ) {
# Always remove the trailing space
$block_type =~ s/\s+$//;
# Convert to a hash brace if it looks like it holds a list
if ($is_list) {
- $block_type = "";
+ $block_type = EMPTY_STRING;
$rLL_new->[$K_opening]->[_CI_LEVEL_] = 1;
$rLL_new->[$K_closing]->[_CI_LEVEL_] = 1;
# slightly modifying an existing token.
my ( $rold_token, $type, $token ) = @_;
if ( $type eq 'b' ) {
- $token = " " unless defined($token);
+ $token = SPACE unless defined($token);
}
elsif ( $type eq 'q' ) {
- $token = '' unless defined($token);
+ $token = EMPTY_STRING unless defined($token);
}
elsif ( $type eq '->' ) {
$token = '->' unless defined($token);
my @rnew_token = @{$rold_token};
$rnew_token[_TYPE_] = $type;
$rnew_token[_TOKEN_] = $token;
- $rnew_token[_TYPE_SEQUENCE_] = '';
+ $rnew_token[_TYPE_SEQUENCE_] = EMPTY_STRING;
return \@rnew_token;
}
my $starting_ci;
my $starting_lentot;
my $maximum_text_length;
- my $msg = "";
+ my $msg = EMPTY_STRING;
my $iline_oo = $rLL->[$Kouter_opening]->[_LINE_INDEX_];
my $rK_range = $rlines->[$iline_oo]->{_rK_range};
$previous_pair = $item;
my $do_not_weld_rule = 0;
- my $Msg = "";
+ my $Msg = EMPTY_STRING;
my $is_one_line_weld;
my $iline_oo = $outer_opening->[_LINE_INDEX_];
);
# OK: This is a candidate for welding
- my $Msg = "";
+ my $Msg = EMPTY_STRING;
my $do_not_weld;
my $Kouter_opening = $K_opening_container->{$outer_seqno};
}
if (DEBUG_WELD) {
- if ( !$is_old_weld ) { $is_old_weld = "" }
+ if ( !$is_old_weld ) { $is_old_weld = EMPTY_STRING }
$Msg .=
"excess=$excess>=$excess_max, multiline_tol=$multiline_tol, is_old_weld='$is_old_weld'\n";
}
my $whitespace_last_level = -1;
my @whitespace_level_stack = ();
my $last_nonblank_type = 'b';
- my $last_nonblank_token = '';
+ my $last_nonblank_token = EMPTY_STRING;
foreach my $KK ( 0 .. $Kmax ) {
my $level_abs = $radjusted_levels->[$KK];
my $level = $level_abs;
# break if this list contains a broken list with line-ending comma
my $ok_to_break;
- my $Msg = "";
+ my $Msg = EMPTY_STRING;
if ($has_list_with_lec) {
$ok_to_break = 1;
DEBUG_BBX && do { $Msg = "has list with lec;" };
# set locations for blanks around long runs of keywords
my $rwant_blank_line_after = $self->keyword_group_scan();
- my $line_type = "";
+ my $line_type = EMPTY_STRING;
my $i_last_POD_END = -10;
my $i = -1;
foreach my $line_of_tokens ( @{$rlines} ) {
# Turn this option off so that this message does not keep repeating
# during iterations and other files.
- $rOpts->{'keyword-group-blanks-size'} = "";
+ $rOpts->{'keyword-group-blanks-size'} = EMPTY_STRING;
return $rhash_of_desires;
}
$Opt_size_min = 1 unless ($Opt_size_min);
if ( $Opt_repeat_count > 0
&& $number_of_groups_seen >= $Opt_repeat_count );
- $CODE_type = "";
+ $CODE_type = EMPTY_STRING;
$K_first = undef;
$K_last = undef;
$line_type = $line_of_tokens->{_line_type};
# Initialize some sequence-dependent variables to their normal values
$parent_seqno_to_go[$max_index_to_go] = $next_parent_seqno;
$nesting_depth_to_go[$max_index_to_go] = $next_slevel;
- $block_type_to_go[$max_index_to_go] = "";
+ $block_type_to_go[$max_index_to_go] = EMPTY_STRING;
# Then fix them at container tokens:
if ($seqno) {
# Add interline blank if any
my $last_old_nonblank_type = "b";
- my $first_new_nonblank_token = "";
+ my $first_new_nonblank_token = EMPTY_STRING;
my $K_first_true = $K_first;
if ( $max_index_to_go >= 0 ) {
$last_old_nonblank_type = $types_to_go[$max_index_to_go];
if ( $type eq ';' ) {
my $next_nonblank_token_type = 'b';
- my $next_nonblank_token = '';
+ my $next_nonblank_token = EMPTY_STRING;
if ( $Ktoken_vars < $K_last ) {
my $Knnb = $Ktoken_vars + 1;
$Knnb++ if ( $rLL->[$Knnb]->[_TYPE_] eq 'b' );
elsif ($is_closing_BLOCK) {
my $next_nonblank_token_type = 'b';
- my $next_nonblank_token = '';
+ my $next_nonblank_token = EMPTY_STRING;
my $Knnb;
if ( $Ktoken_vars < $K_last ) {
$Knnb = $Ktoken_vars + 1;
my $is_bli = $ris_bli_container->{$type_sequence_j};
my $block_type = $rblock_type_of_seqno->{$type_sequence_j};
- $block_type = "" unless ( defined($block_type) );
+ $block_type = EMPTY_STRING unless ( defined($block_type) );
- my $previous_nonblank_token = '';
+ my $previous_nonblank_token = EMPTY_STRING;
my $i_last_nonblank = -1;
if ( defined($K_last_nonblank) ) {
$i_last_nonblank = $K_last_nonblank - $K_to_go[0];
my $msg =
"FORCE $forced_breakpoint_count after call from $a $c with i=$i max=$max_index_to_go";
if ( !defined($i_nonblank) ) {
- $i = "" unless defined($i);
+ $i = EMPTY_STRING unless defined($i);
$msg .= " but could not set break after i='$i'\n";
}
else {
# This routine is only called from sub flush_batch_of_code, so that
# routine is a better spot for debugging.
DEBUG_GRIND && do {
- my $token = my $type = "";
+ my $token = my $type = EMPTY_STRING;
if ( $max_index_to_go >= 0 ) {
$token = $tokens_to_go[$max_index_to_go];
$type = $types_to_go[$max_index_to_go];
}
- my $output_str = "";
+ my $output_str = EMPTY_STRING;
if ( $max_index_to_go > 20 ) {
my $mm = $max_index_to_go - 10;
- $output_str = join( "", @tokens_to_go[ 0 .. 10 ] ) . " ... "
- . join( "", @tokens_to_go[ $mm .. $max_index_to_go ] );
+ $output_str =
+ join( EMPTY_STRING, @tokens_to_go[ 0 .. 10 ] ) . " ... "
+ . join( EMPTY_STRING,
+ @tokens_to_go[ $mm .. $max_index_to_go ] );
}
else {
- $output_str = join "", @tokens_to_go[ 0 .. $max_index_to_go ];
+ $output_str = join EMPTY_STRING,
+ @tokens_to_go[ 0 .. $max_index_to_go ];
}
print STDERR <<EOM;
grind got batch number $batch_count with $max_index_to_go tokens, last type '$type' tok='$token', text:
if ( $imin > $imax ) {
if (DEVEL_MODE) {
my $K0 = $K_to_go[0];
- my $lno = "";
+ my $lno = EMPTY_STRING;
if ( defined($K0) ) { $lno = $rLL->[$K0]->[_LINE_INDEX_] + 1 }
Fault(<<EOM);
Strange: received batch containing only blanks near input line $lno: after trimming imin=$imin, imax=$imax
# some undef's to help guard against using invalid data.
my ($self) = @_;
$K_to_go[ $max_index_to_go + 1 ] = undef;
- $tokens_to_go[ $max_index_to_go + 1 ] = '';
- $tokens_to_go[ $max_index_to_go + 2 ] = '';
+ $tokens_to_go[ $max_index_to_go + 1 ] = EMPTY_STRING;
+ $tokens_to_go[ $max_index_to_go + 2 ] = EMPTY_STRING;
$tokens_to_go[ $max_index_to_go + 3 ] = undef;
$types_to_go[ $max_index_to_go + 1 ] = 'b';
$types_to_go[ $max_index_to_go + 2 ] = 'b';
return unless ( $nmax >= 2 );
# scan the left ends of first two lines
- my $tokbeg = "";
+ my $tokbeg = EMPTY_STRING;
my $depth_beg;
for my $n ( 1 .. 2 ) {
my $il = $ri_left->[$n];
for my $n ( 0 .. @{$ri_end} - 1 ) {
my $ibeg = $ri_beg->[$n];
my $iend = $ri_end->[$n];
- my $text = "";
+ my $text = EMPTY_STRING;
foreach my $i ( $ibeg .. $iend ) {
$text .= $tokens_to_go[$i];
}
# ...ok, then make the semicolon invisible
my $len = $token_lengths_to_go[$i_semicolon];
- $tokens_to_go[$i_semicolon] = "";
+ $tokens_to_go[$i_semicolon] = EMPTY_STRING;
$token_lengths_to_go[$i_semicolon] = 0;
- $rLL->[$K_semicolon]->[_TOKEN_] = "";
+ $rLL->[$K_semicolon]->[_TOKEN_] = EMPTY_STRING;
$rLL->[$K_semicolon]->[_TOKEN_LENGTH_] = 0;
foreach ( $i_semicolon .. $max_index_to_go ) {
$summed_lengths_to_go[ $_ + 1 ] -= $len;
my $i_last_break = -1;
my $max_bias = 0.001;
my $tiny_bias = 0.0001;
- my $leading_alignment_token = "";
- my $leading_alignment_type = "";
+ my $leading_alignment_token = EMPTY_STRING;
+ my $leading_alignment_type = EMPTY_STRING;
# see if any ?/:'s are in order
my $colons_in_order = 1;
- my $last_tok = "";
+ my $last_tok = EMPTY_STRING;
foreach ( @{$rcolon_list} ) {
if ( $_ eq $last_tok ) { $colons_in_order = 0; last }
$last_tok = $_;
# This is a sufficient but not necessary condition for colon chain
my $is_colon_chain = ( $colons_in_order && @{$rcolon_list} > 2 );
- my $Msg = "";
+ my $Msg = EMPTY_STRING;
#-------------------------------------------------------
# BEGINNING of main loop to set continuation breakpoints
my $starting_sum = $summed_lengths_to_go[$i_begin];
my $i_lowest = -1;
my $i_test = -1;
- my $lowest_next_token = '';
+ my $lowest_next_token = EMPTY_STRING;
my $lowest_next_type = 'b';
my $i_lowest_next_nonblank = -1;
my $maximum_line_length =
}
DEBUG_BREAK_LINES && do {
- my $ltok = $token;
- my $rtok = $next_nonblank_token ? $next_nonblank_token : "";
+ my $ltok = $token;
+ my $rtok =
+ $next_nonblank_token ? $next_nonblank_token : EMPTY_STRING;
my $i_testp2 = $i_test + 2;
if ( $i_testp2 > $max_index_to_go + 1 ) {
$i_testp2 = $max_index_to_go + 1;
DEBUG_BREAK_LINES
&& print STDOUT
"BREAK: best is i = $i_lowest strength = $lowest_strength;\nReason>> $Msg\n";
- $Msg = "";
+ $Msg = EMPTY_STRING;
#-------------------------------------------------------
# ?/: rule 2 : if we break at a '?', then break at its ':'
$i_begin = $i_lowest + 1;
$last_break_strength = $lowest_strength;
$i_last_break = $i_lowest;
- $leading_alignment_token = "";
- $leading_alignment_type = "";
- $lowest_next_token = '';
+ $leading_alignment_token = EMPTY_STRING;
+ $leading_alignment_type = EMPTY_STRING;
+ $lowest_next_token = EMPTY_STRING;
$lowest_next_type = 'b';
if ( ( $i_begin <= $imax ) && ( $types_to_go[$i_begin] eq 'b' ) ) {
$override_cab3[$depth_t] = undef;
$breakpoint_stack[$depth_t] = $starting_breakpoint_count;
- $container_type[$depth_t] = "";
+ $container_type[$depth_t] = EMPTY_STRING;
$identifier_count_stack[$depth_t] = 0;
$index_before_arrow[$depth_t] = -1;
$interrupted_list[$depth_t] = 1;
$item_count_stack[$depth_t] = 0;
- $last_nonblank_type[$depth_t] = "";
+ $last_nonblank_type[$depth_t] = EMPTY_STRING;
$opening_structure_index_stack[$depth_t] = -1;
$breakpoint_undo_stack[$depth_t] = undef;
$starting_depth = $nesting_depth_to_go[0];
- $block_type = ' ';
+ $block_type = SPACE;
$current_depth = $starting_depth;
$i = -1;
$last_nonblank_token = ';';
$last_nonblank_type = ';';
- $last_nonblank_block_type = ' ';
+ $last_nonblank_block_type = SPACE;
$last_old_breakpoint_count = 0;
$minimum_depth = $current_depth + 1; # forces update in check below
$old_breakpoint_count = 0;
$starting_breakpoint_count = $forced_breakpoint_count;
$token = ';';
$type = ';';
- $type_sequence = '';
+ $type_sequence = EMPTY_STRING;
my $total_depth_variation = 0;
my $i_old_assignment_break;
# k => && || ? : .
$is_container_label_type{$last_nonblank_type}
? $last_nonblank_token
- : "";
+ : EMPTY_STRING;
$identifier_count_stack[$depth] = 0;
$index_before_arrow[$depth] = -1;
$interrupted_list[$depth] = 0;
$dont_align[$depth] =
# code BLOCKS are handled at a higher level
- ( $block_type ne "" )
+ ( $block_type ne EMPTY_STRING )
# certain paren lists
|| ( $type eq '(' ) && (
$K_last_nonblank = $Kpnb;
}
- my $last_nonblank_token = '';
- my $last_nonblank_type = '';
- my $last_last_nonblank_type = '';
+ my $last_nonblank_token = EMPTY_STRING;
+ my $last_nonblank_type = EMPTY_STRING;
+ my $last_last_nonblank_type = EMPTY_STRING;
if ( defined($K_last_nonblank) ) {
$last_nonblank_token = $rLL->[$K_last_nonblank]->[_TOKEN_];
# or is a single token followed by opening token.
# Note that sub identifiers have blanks like 'sub doit'
# $token_beg !~ /\s+/
- || ( $Kend - $Kbeg <= 2 && index( $token_beg, ' ' ) < 0 )
+ || ( $Kend - $Kbeg <= 2 && index( $token_beg, SPACE ) < 0 )
)
# and limit total to 10 character widths
sub check_batch_summed_lengths {
my ( $self, $msg ) = @_;
- $msg = "" unless defined($msg);
+ $msg = EMPTY_STRING unless defined($msg);
my $rLL = $self->[_rLL_];
# Verify that the summed lengths are correct. We want to be sure that
my $type = $types_to_go[$i];
my $token = $tokens_to_go[$i];
- my $alignment_type = '';
+ my $alignment_type = EMPTY_STRING;
# ----------------------------------------------
# Check for 'paren patch' : Remove excess parens
&& $imate > $i_good_paren )
{
if ( $ralignment_type_to_go->[$imate] ) {
- $ralignment_type_to_go->[$imate] = '';
+ $ralignment_type_to_go->[$imate] = EMPTY_STRING;
$ralignment_counts->[$line]--;
delete $ralignment_hash_by_line->[$line]->{$imate};
}
# (2) doing so may prevent other good alignments.
# Current exceptions are && and || and =>
if ( $i == $iend ) {
- $alignment_type = ""
+ $alignment_type = EMPTY_STRING
unless ( $is_terminal_alignment_type{$type} );
}
&& $i == $ibeg + 2
&& $types_to_go[ $i - 1 ] eq 'b' )
{
- $alignment_type = "";
+ $alignment_type = EMPTY_STRING;
}
# Certain tokens only align at the same level as the
if ( $is_low_level_alignment_token{$token}
&& $levels_to_go[$i] != $level_beg )
{
- $alignment_type = "";
+ $alignment_type = EMPTY_STRING;
}
# For a paren after keyword, only align something like this:
if ( $token eq '(' ) {
if ( $vert_last_nonblank_type eq 'k' ) {
- $alignment_type = ""
+ $alignment_type = EMPTY_STRING
unless
$is_if_unless_elsif{$vert_last_nonblank_token};
##unless $vert_last_nonblank_token =~ /^(if|unless|elsif)$/;
if ( !$rOpts_function_paren_vertical_alignment ) {
my $seqno = $type_sequence_to_go[$i];
if ( $ris_function_call_paren->{$seqno} ) {
- $alignment_type = "";
+ $alignment_type = EMPTY_STRING;
}
}
# and ignore any tokens which have leading padded spaces
# example: perl527/lop.t
- elsif ( substr( $alignment_type, 0, 1 ) eq ' ' ) {
+ elsif ( substr( $alignment_type, 0, 1 ) eq SPACE ) {
}
my $tok_len = $rLL->[$KK]->[_TOKEN_LENGTH_];
if ( $pad_spaces > 0 ) {
- $tok = ' ' x $pad_spaces . $tok;
+ $tok = SPACE x $pad_spaces . $tok;
$tok_len += $pad_spaces;
}
- elsif ( $pad_spaces == -1 && $tokens_to_go[$ipad] eq ' ' ) {
- $tok = "";
+ elsif ( $pad_spaces == -1 && $tokens_to_go[$ipad] eq SPACE ) {
+ $tok = EMPTY_STRING;
$tok_len = 0;
}
else {
$rpatterns = [ $types_to_go[$ibeg] ];
}
else {
- $rfields = [ join( '', @tokens_to_go[ $ibeg .. $iend ] ) ];
- $rpatterns = [ join( '', @types_to_go[ $ibeg .. $iend ] ) ];
+ $rfields =
+ [ join( EMPTY_STRING, @tokens_to_go[ $ibeg .. $iend ] ) ];
+ $rpatterns =
+ [ join( EMPTY_STRING, @types_to_go[ $ibeg .. $iend ] ) ];
}
return [ $rtokens, $rfields, $rpatterns, $rfield_lengths ];
}
my $i_start = $ibeg;
my $depth = 0;
- my %container_name = ( 0 => "" );
+ my %container_name = ( 0 => EMPTY_STRING );
my @tokens = ();
my @fields = ();
# Make a container name by combining all leading barewords,
# keywords and functions.
- my $name = "";
+ my $name = EMPTY_STRING;
my $count = 0;
my $count_max;
my $iname_end;
|| $is_binary_type{$type}
|| $type eq 'k' && $is_binary_keyword{$token} )
{
- $name = "";
+ $name = EMPTY_STRING;
last;
}
$token = $name_map{$token};
}
- $name .= ' ' . $token;
+ $name .= SPACE . $token;
$iname_end = $_;
$count++;
}
# --------------------
my $j = 0; # field index
- $patterns[0] = "";
+ $patterns[0] = EMPTY_STRING;
my %token_count;
for my $i ( $ibeg .. $iend ) {
# concatenate the text of the consecutive tokens to form
# the field
push( @fields,
- join( '', @tokens_to_go[ $i_start .. $i - 1 ] ) );
+ join( EMPTY_STRING, @tokens_to_go[ $i_start .. $i - 1 ] ) );
push @field_lengths,
$summed_lengths_to_go[$i] - $summed_lengths_to_go[$i_start];
# get ready for the next batch
$i_start = $i;
$j++;
- $patterns[$j] = "";
+ $patterns[$j] = EMPTY_STRING;
} ## end if ( new synchronization token
# continue accumulating tokens
# so that we can align things like this:
# Button => "Print letter \"~$_\"",
# -command => [ sub { print "$_[0]\n" }, $_ ],
- if ( $patterns[$j] eq 'm' ) { $patterns[$j] = "" }
+ if ( $patterns[$j] eq 'm' ) {
+ $patterns[$j] = EMPTY_STRING;
+ }
}
}
# remove any zero-level name at first fat comma
if ( $depth == 0 && $type eq '=>' ) {
- $container_name{$depth} = "";
+ $container_name{$depth} = EMPTY_STRING;
}
} ## end for my $i ( $ibeg .. $iend)
# done with this line .. join text of tokens to make the last field
- push( @fields, join( '', @tokens_to_go[ $i_start .. $iend ] ) );
+ push( @fields,
+ join( EMPTY_STRING, @tokens_to_go[ $i_start .. $iend ] ) );
push @field_lengths,
$summed_lengths_to_go[ $iend + 1 ] - $summed_lengths_to_go[$i_start];
# Create an alignment name for it to avoid incorrect alignments.
# Start with the name of the previous nonblank token...
- my $name = "";
+ my $name = EMPTY_STRING;
my $im = $i - 1;
- return "" if ( $im < 0 );
+ return EMPTY_STRING if ( $im < 0 );
if ( $types_to_go[$im] eq 'b' ) { $im--; }
- return "" if ( $im < 0 );
+ return EMPTY_STRING if ( $im < 0 );
$name = $tokens_to_go[$im];
# Prepend any sub name to an isolated -> to avoid unwanted alignments
sub initialize_final_indentation_adjustment {
$last_indentation_written = 0;
$last_unadjusted_indentation = 0;
- $last_leading_token = "";
+ $last_leading_token = EMPTY_STRING;
return;
}
my $ok = 0;
if ( $cvt == 2 || $iend_next == $ibeg_next ) { $ok = 1 }
else {
- my $str = join( '',
+ my $str = join( EMPTY_STRING,
@types_to_go[ $ibeg_next + 1 .. $ibeg_next + 2 ] );
# append closing token if followed by comment or ';'
%block_leading_text = ();
%block_opening_line_number = ();
$csc_new_statement_ok = 1;
- $csc_last_label = "";
+ $csc_last_label = EMPTY_STRING;
%csc_block_label = ();
$rleading_block_if_elsif_text = [];
- $accumulating_text_for_block = "";
+ $accumulating_text_for_block = EMPTY_STRING;
reset_block_text_accumulator();
return;
}
push @{$rleading_block_if_elsif_text}, $leading_block_text;
}
}
- $accumulating_text_for_block = "";
- $leading_block_text = "";
+ $accumulating_text_for_block = EMPTY_STRING;
+ $leading_block_text = EMPTY_STRING;
$leading_block_text_level = 0;
$leading_block_text_length_exceeded = 0;
$leading_block_text_line_number = 0;
if ( $accumulating_text_for_block !~ /^els/ ) {
$rleading_block_if_elsif_text = [];
}
- $leading_block_text = "";
+ $leading_block_text = EMPTY_STRING;
$leading_block_text_level = $levels_to_go[$i];
$leading_block_text_line_number = $self->get_output_line_number();
$leading_block_text_length_exceeded = 0;
# add an extra space at each newline
if ( $i == 0 && $types_to_go[$i] ne 'b' ) {
- $leading_block_text .= ' ';
+ $leading_block_text .= SPACE;
}
# add the token text
# the text placed after certain closing block braces.
# Defines and returns the following for this buffer:
- my $block_leading_text = ""; # the leading text of the last '}'
+ my $block_leading_text =
+ EMPTY_STRING; # the leading text of the last '}'
my $rblock_leading_if_elsif_text;
my $i_block_leading_text =
- -1; # index of token owning block_leading_text
- my $block_line_count = 100; # how many lines the block spans
- my $terminal_type = 'b'; # type of last nonblank token
- my $i_terminal = 0; # index of last nonblank token
- my $terminal_block_type = "";
+ -1; # index of token owning block_leading_text
+ my $block_line_count = 100; # how many lines the block spans
+ my $terminal_type = 'b'; # type of last nonblank token
+ my $i_terminal = 0; # index of last nonblank token
+ my $terminal_block_type = EMPTY_STRING;
# update most recent statement label
- $csc_last_label = "" unless ($csc_last_label);
+ $csc_last_label = EMPTY_STRING unless ($csc_last_label);
if ( $types_to_go[0] eq 'J' ) { $csc_last_label = $tokens_to_go[0] }
my $block_label = $csc_last_label;
# set a label for this block, except for
# a bare block which already has the label
# A label can only be used on the next {
- if ( $block_type =~ /:$/ ) { $csc_last_label = "" }
+ if ( $block_type =~ /:$/ ) {
+ $csc_last_label = EMPTY_STRING;
+ }
$csc_block_label{$type_sequence} = $csc_last_label;
- $csc_last_label = "";
+ $csc_last_label = EMPTY_STRING;
if ( $accumulating_text_for_block
&& $levels_to_go[$i] == $leading_block_text_level )
}
# if this line ends in a label then remember it for the next pass
- $csc_last_label = "";
+ $csc_last_label = EMPTY_STRING;
if ( $terminal_type eq 'J' ) {
$csc_last_label = $tokens_to_go[$i_terminal];
}
return $csc_text;
}
- my $last_elsif_text = "";
+ my $last_elsif_text = EMPTY_STRING;
if ( $count > 1 ) {
$last_elsif_text = ' [elsif' . $rif_elsif_text->[ $count - 1 ];
if ( $count > 2 ) { $last_elsif_text = ' [...' . $last_elsif_text; }
$csc_text .= $last_elsif_text;
}
else {
- $csc_text .= ' ' . $if_text;
+ $csc_text .= SPACE . $if_text;
}
# all done if no length checks requested
{
# then make the closing side comment text
- if ($block_label) { $block_label .= " " }
+ if ($block_label) { $block_label .= SPACE }
my $token =
"$rOpts->{'closing-side-comment-prefix'} $block_label$block_type_to_go[$i_terminal]";
# save the old side comment in a new trailing block
# comment
- my $timestamp = "";
+ my $timestamp = EMPTY_STRING;
if ( $rOpts->{'timestamp'} ) {
my ( $day, $month, $year ) = (localtime)[ 3, 4, 5 ];
$year += 1900;
my $last_added_semicolon_at = $self->[_last_added_semicolon_at_];
if ( $added_semicolon_count > 0 ) {
- my $first = ( $added_semicolon_count > 1 ) ? "First" : "";
+ my $first = ( $added_semicolon_count > 1 ) ? "First" : EMPTY_STRING;
my $what =
( $added_semicolon_count > 1 ) ? "semicolons were" : "semicolon was";
write_logfile_entry("$added_semicolon_count $what added:\n");
my $first_deleted_semicolon_at = $self->[_first_deleted_semicolon_at_];
my $last_deleted_semicolon_at = $self->[_last_deleted_semicolon_at_];
if ( $deleted_semicolon_count > 0 ) {
- my $first = ( $deleted_semicolon_count > 1 ) ? "First" : "";
+ my $first = ( $deleted_semicolon_count > 1 ) ? "First" : EMPTY_STRING;
my $what =
( $deleted_semicolon_count > 1 )
? "semicolons were"
my $first_embedded_tab_at = $self->[_first_embedded_tab_at_];
my $last_embedded_tab_at = $self->[_last_embedded_tab_at_];
if ( $embedded_tab_count > 0 ) {
- my $first = ( $embedded_tab_count > 1 ) ? "First" : "";
+ my $first = ( $embedded_tab_count > 1 ) ? "First" : EMPTY_STRING;
my $what =
( $embedded_tab_count > 1 )
? "quotes or patterns"
use English qw( -no_match_vars );
use File::Basename;
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
+
# class variables
use vars qw{
%html_color
( $title, my $path ) = fileparse($input_file);
}
my $toc_item_count = 0;
- my $in_toc_package = "";
+ my $in_toc_package = EMPTY_STRING;
my $last_level = 0;
return bless {
_input_file => $input_file, # name of input file
my $end_package_list = sub {
if ( ${$rin_toc_package} ) {
$html_toc_fh->print("</ul>\n</li>\n");
- ${$rin_toc_package} = "";
+ ${$rin_toc_package} = EMPTY_STRING;
}
return;
};
my $long_name = $short_to_long_names{$short_name};
my $abbrev = '.' . $short_name;
- if ( length($short_name) == 1 ) { $abbrev .= ' ' } # for alignment
+ if ( length($short_name) == 1 ) { $abbrev .= SPACE } # for alignment
my $color = $html_color{$short_name};
if ( !defined($color) ) { $color = $text_color }
$fh->print("$abbrev \{ color: $color;");
# the necessary perltidy html sections
my ( $saw_body, $saw_index, $saw_body_end );
- my $timestamp = "";
+ my $timestamp = EMPTY_STRING;
if ( $rOpts->{'timestamp'} ) {
my $date = localtime;
$timestamp = "on $date";
my @toc_st = map { $_ . "\n" } split /\n/, $toc_string;
$html_print->(@toc_st);
}
- $in_toc = "";
+ $in_toc = EMPTY_STRING;
$no_print = 0;
}
my @toc_st = map { $_ . "\n" } split /\n/, $toc_string;
$html_print->(@toc_st);
}
- $in_toc = "";
+ $in_toc = EMPTY_STRING;
$ul_level = 0;
$no_print = 0;
}
$title = escape_html($title);
# FUTURE input parameter:
- my $top_basename = "";
+ my $top_basename = EMPTY_STRING;
# We need to produce 3 html files:
# 1. - the table of contents
my $first_anchor =
change_anchor_names( $rtoc, $src_basename, "$src_frame_name" );
- $fh->print( join "", @{$rtoc} );
+ $fh->print( join EMPTY_STRING, @{$rtoc} );
$fh->print(<<EOM);
</body>
# --------------------------------------------------
my $input_file = $self->{_input_file};
my $title = escape_html($input_file);
- my $timestamp = "";
+ my $timestamp = EMPTY_STRING;
if ( $rOpts->{'timestamp'} ) {
my $date = localtime;
$timestamp = "on $date";
# but don't include sub declarations in the toc;
# these wlll have leading token types 'i;'
- my $signature = join "", @{$rtoken_type};
+ my $signature = join EMPTY_STRING, @{$rtoken_type};
unless ( $signature =~ /^i;/ ) {
my $subname = $token;
$subname =~ s/[\s\(].*$//; # remove any attributes and prototype
$html_line = $1;
}
else {
- $html_line = "";
+ $html_line = EMPTY_STRING;
}
my ($rcolored_tokens) =
$self->markup_tokens( $rtokens, $rtoken_type, $rlevels );
- $html_line .= join '', @{$rcolored_tokens};
+ $html_line .= join EMPTY_STRING, @{$rcolored_tokens};
}
# markup line of non-code..
# otherwise, just clear the current string and start
# over
else {
- ${$rpre_string} = "";
+ ${$rpre_string} = EMPTY_STRING;
$html_pod_fh->print("\n");
}
}
# add the line number if requested
if ( $rOpts->{'html-line-numbers'} ) {
my $extra_space =
- ( $line_number < 10 ) ? " "
- : ( $line_number < 100 ) ? " "
- : ( $line_number < 1000 ) ? " "
- : "";
- $html_line = $extra_space . $line_number . " " . $html_line;
+ ( $line_number < 10 ) ? SPACE x 3
+ : ( $line_number < 100 ) ? SPACE x 2
+ : ( $line_number < 1000 ) ? SPACE
+ : EMPTY_STRING;
+ $html_line = $extra_space . $line_number . SPACE . $html_line;
}
# write the line
use Carp;
our $VERSION = '20220217.04';
+use constant EMPTY_STRING => q{};
+
sub AUTOLOAD {
# Catch any undefined sub calls so that we are sure to get
}
if ( $mode eq 'w' ) {
- ${$rscalar} = "";
+ ${$rscalar} = EMPTY_STRING;
return bless [ $rscalar, $mode ], $package;
}
elsif ( $mode eq 'r' ) {
use warnings;
our $VERSION = '20220217.04';
use English qw( -no_match_vars );
+
use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
sub AUTOLOAD {
}
use constant DEFAULT_LOGFILE_GAP => 50;
+
sub new {
my ( $class, @args ) = @_;
# record some stuff in case we go down in flames
use constant MAX_PRINTED_CHARS => 35;
+
sub black_box {
my ( $self, $line_of_tokens, $output_line_number ) = @_;
my $input_line = $line_of_tokens->{_line_text};
# for longer scripts it doesn't really matter
my $extra_space = EMPTY_STRING;
$extra_space .=
- ( $input_line_number < 10 ) ? " "
- : ( $input_line_number < 100 ) ? " "
+ ( $input_line_number < 10 ) ? SPACE x 2
+ : ( $input_line_number < 100 ) ? SPACE
: EMPTY_STRING;
$extra_space .=
- ( $output_line_number < 10 ) ? " "
- : ( $output_line_number < 100 ) ? " "
+ ( $output_line_number < 10 ) ? SPACE x 2
+ : ( $output_line_number < 100 ) ? SPACE
: EMPTY_STRING;
# there are 2 possible nesting strings:
if ( length($nesting_string_new) <= 8 ) {
$nesting_string =
- $nesting_string_new . " " x ( 8 - length($nesting_string_new) );
+ $nesting_string_new . SPACE x ( 8 - length($nesting_string_new) );
}
$line_information_string =
"L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
# add prefix 'filename: ' to message lines
if ($filename_stamp) {
- my $pre_string = $filename_stamp . " ";
+ my $pre_string = $filename_stamp . SPACE;
chomp $msg;
$msg =~ s/\n/\n$pre_string/g;
$msg = $pre_string . $msg . "\n";
our $VERSION = '20220217.04';
-# this can be turned on for extra checking during development
-use constant DEVEL_MODE => 0;
+use constant DEVEL_MODE => 0;
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
use Perl::Tidy::LineBuffer;
use Carp;
my $self = [];
$self->[_rhere_target_list_] = [];
$self->[_in_here_doc_] = 0;
- $self->[_here_doc_target_] = "";
- $self->[_here_quote_character_] = "";
+ $self->[_here_doc_target_] = EMPTY_STRING;
+ $self->[_here_quote_character_] = EMPTY_STRING;
$self->[_in_data_] = 0;
$self->[_in_end_] = 0;
$self->[_in_format_] = 0;
$self->[_in_skipped_] = 0;
$self->[_in_attribute_list_] = 0;
$self->[_in_quote_] = 0;
- $self->[_quote_target_] = "";
+ $self->[_quote_target_] = EMPTY_STRING;
$self->[_line_start_quote_] = -1;
$self->[_starting_level_] = $args{starting_level};
$self->[_know_starting_level_] = defined( $args{starting_level} );
$self->[_unexpected_error_count_] = 0;
$self->[_started_looking_for_here_target_at_] = 0;
$self->[_nearly_matched_here_target_at_] = undef;
- $self->[_line_of_text_] = "";
+ $self->[_line_of_text_] = EMPTY_STRING;
$self->[_rlower_case_labels_at_] = undef;
$self->[_extended_syntax_] = $args{extended_syntax};
$self->[_maximum_level_] = 0;
}
sub get_input_stream_name {
- my $input_stream_name = "";
+ my $input_stream_name = EMPTY_STRING;
my $logger_object = $tokenizer_self->[_logger_object_];
if ($logger_object) {
$input_stream_name = $logger_object->get_input_stream_name();
# Find and remove what characters terminate this line, including any
# control r
- my $input_line_separator = "";
+ my $input_line_separator = EMPTY_STRING;
if ( chomp($input_line) ) {
$input_line_separator = $INPUT_RECORD_SEPARATOR;
}
_curly_brace_depth => $brace_depth,
_square_bracket_depth => $square_bracket_depth,
_paren_depth => $paren_depth,
- _quote_character => '',
+ _quote_character => EMPTY_STRING,
## _rtoken_type => undef,
## _rtokens => undef,
## _rlevels => undef,
}
else {
$tokenizer_self->[_in_here_doc_] = 0;
- $tokenizer_self->[_here_doc_target_] = "";
- $tokenizer_self->[_here_quote_character_] = "";
+ $tokenizer_self->[_here_doc_target_] = EMPTY_STRING;
+ $tokenizer_self->[_here_quote_character_] = EMPTY_STRING;
}
}
my $i = 0;
# keep looking at lines until we find a hash bang or piece of code
- my $msg = "";
+ my $msg = EMPTY_STRING;
while ( $line =
$tokenizer_self->[_line_buffer_object_]->peek_ahead( $i++ ) )
{
$fh->print("\nnon-constant subs in package $pkg\n");
foreach my $sub ( keys %{ $is_user_function{$pkg} } ) {
- my $msg = "";
+ my $msg = EMPTY_STRING;
if ( $is_block_list_function{$pkg}{$sub} ) {
$msg = 'block_list';
}
# previous tokens needed to determine what to expect next
$last_nonblank_token = ';'; # the only possible starting state which
$last_nonblank_type = ';'; # will make a leading brace a code block
- $last_nonblank_block_type = '';
+ $last_nonblank_block_type = EMPTY_STRING;
# scalars for remembering statement types across multiple lines
- $statement_type = ''; # '' or 'use' or 'sub..' or 'case..'
+ $statement_type = EMPTY_STRING; # '' or 'use' or 'sub..' or 'case..'
$in_attribute_list = 0;
# scalars for remembering where we are in the file
$context = UNKNOWN_CONTEXT;
# hashes used to remember function information
- %is_constant = (); # user-defined constants
- %is_user_function = (); # user-defined functions
- %user_function_prototype = (); # their prototypes
+ %is_constant = (); # user-defined constants
+ %is_user_function = (); # user-defined functions
+ %user_function_prototype = (); # their prototypes
%is_block_function = ();
%is_block_list_function = ();
%saw_function_definition = ();
@nested_statement_type = ();
@starting_line_of_current_depth = ();
- $paren_type[$paren_depth] = '';
+ $paren_type[$paren_depth] = EMPTY_STRING;
$paren_semicolon_count[$paren_depth] = 0;
- $paren_structural_type[$brace_depth] = '';
+ $paren_structural_type[$brace_depth] = EMPTY_STRING;
$brace_type[$brace_depth] = ';'; # identify opening brace as code block
- $brace_structural_type[$brace_depth] = '';
+ $brace_structural_type[$brace_depth] = EMPTY_STRING;
$brace_context[$brace_depth] = UNKNOWN_CONTEXT;
$brace_package[$paren_depth] = $current_package;
- $square_bracket_type[$square_bracket_depth] = '';
- $square_bracket_structural_type[$square_bracket_depth] = '';
+ $square_bracket_type[$square_bracket_depth] = EMPTY_STRING;
+ $square_bracket_structural_type[$square_bracket_depth] = EMPTY_STRING;
initialize_tokenizer_state();
return;
# TV3:
$in_quote = 0;
$quote_type = 'Q';
- $quote_character = "";
+ $quote_character = EMPTY_STRING;
$quote_pos = 0;
$quote_depth = 0;
- $quoted_string_1 = "";
- $quoted_string_2 = "";
- $allowed_quote_modifiers = "";
+ $quoted_string_1 = EMPTY_STRING;
+ $quoted_string_2 = EMPTY_STRING;
+ $allowed_quote_modifiers = EMPTY_STRING;
# TV4:
- $id_scan_state = '';
- $identifier = '';
- $want_paren = "";
+ $id_scan_state = EMPTY_STRING;
+ $identifier = EMPTY_STRING;
+ $want_paren = EMPTY_STRING;
$indented_if_level = 0;
# TV5:
- $nesting_token_string = "";
- $nesting_type_string = "";
- $nesting_block_string = '1'; # initially in a block
- $nesting_block_flag = 1;
- $nesting_list_string = '0'; # initially not in a list
- $nesting_list_flag = 0; # initially not in a list
- $ci_string_in_tokenizer = "";
+ $nesting_token_string = EMPTY_STRING;
+ $nesting_type_string = EMPTY_STRING;
+ $nesting_block_string = '1'; # initially in a block
+ $nesting_block_flag = 1;
+ $nesting_list_string = '0'; # initially not in a list
+ $nesting_list_flag = 0; # initially not in a list
+ $ci_string_in_tokenizer = EMPTY_STRING;
$continuation_string_in_tokenizer = "0";
$in_statement_continuation = 0;
$level_in_tokenizer = 0;
$rslevel_stack = [];
# TV6:
- $last_nonblank_container_type = '';
- $last_nonblank_type_sequence = '';
+ $last_nonblank_container_type = EMPTY_STRING;
+ $last_nonblank_type_sequence = EMPTY_STRING;
$last_last_nonblank_token = ';';
$last_last_nonblank_type = ';';
- $last_last_nonblank_block_type = '';
- $last_last_nonblank_container_type = '';
- $last_last_nonblank_type_sequence = '';
- $last_nonblank_prototype = "";
+ $last_last_nonblank_block_type = EMPTY_STRING;
+ $last_last_nonblank_container_type = EMPTY_STRING;
+ $last_last_nonblank_type_sequence = EMPTY_STRING;
+ $last_nonblank_prototype = EMPTY_STRING;
return;
}
# Split $tok into up to 3 tokens:
my $tok_0 = substr( $pretoken, 0, $numc );
- my $tok_1 = defined($1) ? $1 : "";
- my $tok_2 = defined($2) ? $2 : "";
+ my $tok_1 = defined($1) ? $1 : EMPTY_STRING;
+ my $tok_2 = defined($2) ? $2 : EMPTY_STRING;
my $len_0 = length($tok_0);
my $len_1 = length($tok_1);
EOM
resume_logfile();
}
- $id_scan_state = "";
+ $id_scan_state = EMPTY_STRING;
}
return;
}
# look for $var, @var, ...
if ( $rtoken_type->[ $i + 1 ] eq 'w' ) {
- my $pretype_next = "";
+ my $pretype_next = EMPTY_STRING;
my $i_next = $i + 2;
if ( $i_next <= $max_token_index ) {
if ( $rtoken_type->[$i_next] eq 'b'
my $typ_d = $rtoken_type->[$i_d];
# check for signed integer
- my $sign = "";
+ my $sign = EMPTY_STRING;
if ( $typ_d ne 'd'
&& ( $typ_d eq '+' || $typ_d eq '-' )
&& $i_d < $max_token_index )
$paren_semicolon_count[$paren_depth] = 0;
if ($want_paren) {
$container_type = $want_paren;
- $want_paren = "";
+ $want_paren = EMPTY_STRING;
}
elsif ( $statement_type =~ /^sub\b/ ) {
$container_type = $statement_type;
},
';' => sub {
$context = UNKNOWN_CONTEXT;
- $statement_type = '';
- $want_paren = "";
+ $statement_type = EMPTY_STRING;
+ $want_paren = EMPTY_STRING;
# /^(for|foreach)$/
if ( $is_for_foreach{ $paren_type[$paren_depth] } )
if ( $expecting == OPERATOR );
$in_quote = 1;
$type = 'Q';
- $allowed_quote_modifiers = "";
+ $allowed_quote_modifiers = EMPTY_STRING;
},
"'" => sub {
error_if_expecting_OPERATOR("String")
if ( $expecting == OPERATOR );
$in_quote = 1;
$type = 'Q';
- $allowed_quote_modifiers = "";
+ $allowed_quote_modifiers = EMPTY_STRING;
},
'`' => sub {
error_if_expecting_OPERATOR("String")
if ( $expecting == OPERATOR );
$in_quote = 1;
$type = 'Q';
- $allowed_quote_modifiers = "";
+ $allowed_quote_modifiers = EMPTY_STRING;
},
'/' => sub {
my $is_pattern;
# code block or anonymous hash. (The type of a paren
# pair is the preceding token, such as 'if', 'else',
# etc).
- $container_type = "";
+ $container_type = EMPTY_STRING;
# ATTRS: for a '{' following an attribute list, reset
# things to look like we just saw the sub name
if ( $statement_type =~ /^sub\b/ ) {
$last_nonblank_token = $statement_type;
$last_nonblank_type = 'i';
- $statement_type = "";
+ $statement_type = EMPTY_STRING;
}
# patch for SWITCH/CASE: hide these keywords from an immediately
}
else {
my $list =
- join( ' ', sort keys %is_blocktype_with_paren );
+ join( SPACE, sort keys %is_blocktype_with_paren );
warning(
"syntax error at ') {', didn't see one of: <<$list>>; If this code is okay try using the -xs flag\n"
);
);
}
- $want_paren = "";
+ $want_paren = EMPTY_STRING;
}
# now identify which of the three possible types of
},
'}' => sub {
$block_type = $brace_type[$brace_depth];
- if ($block_type) { $statement_type = '' }
+ if ($block_type) { $statement_type = EMPTY_STRING }
if ( defined( $brace_package[$brace_depth] ) ) {
$current_package = $brace_package[$brace_depth];
}
# Note that we put a leading space on the here quote
# character indicate that it may be preceded by spaces
- $here_quote_character = " " . $here_quote_character;
+ $here_quote_character = SPACE . $here_quote_character;
push @{$rhere_target_list},
[ $here_doc_target, $here_quote_character ];
$type = 'h';
'tr' => '[cdsr]',
'm' => '[msixpodualngc]',
'qr' => '[msixpodualn]',
- 'q' => "",
- 'qq' => "",
- 'qw' => "",
- 'qx' => "",
+ 'q' => EMPTY_STRING,
+ 'qq' => EMPTY_STRING,
+ 'qw' => EMPTY_STRING,
+ 'qx' => EMPTY_STRING,
);
# table showing how many quoted things to look for after quote operator..
pre_tokenize( $input_line, $max_tokens_wanted );
$max_token_index = scalar( @{$rtokens} ) - 1;
- push( @{$rtokens}, ' ', ' ', ' ' ); # extra whitespace simplifies logic
+ push( @{$rtokens}, SPACE, SPACE, SPACE )
+ ; # extra whitespace simplifies logic
push( @{$rtoken_map}, 0, 0, 0 ); # shouldn't be referenced
push( @{$rtoken_type}, 'b', 'b', 'b' );
# initialize for main loop
if (0) { #<<< this is not necessary
foreach my $ii ( 0 .. $max_token_index + 3 ) {
- $routput_token_type->[$ii] = "";
- $routput_block_type->[$ii] = "";
- $routput_container_type->[$ii] = "";
- $routput_type_sequence->[$ii] = "";
+ $routput_token_type->[$ii] = EMPTY_STRING;
+ $routput_block_type->[$ii] = EMPTY_STRING;
+ $routput_container_type->[$ii] = EMPTY_STRING;
+ $routput_type_sequence->[$ii] = EMPTY_STRING;
$routput_indent_flag->[$ii] = 0;
}
}
my $qs2 = $quoted_string_2;
# re-initialize for next search
- $quote_character = '';
+ $quote_character = EMPTY_STRING;
$quote_pos = 0;
$quote_type = 'Q';
- $quoted_string_1 = "";
- $quoted_string_2 = "";
+ $quoted_string_1 = EMPTY_STRING;
+ $quoted_string_2 = EMPTY_STRING;
last if ( ++$i > $max_token_index );
# look for any modifiers
}
# re-initialize
- $allowed_quote_modifiers = "";
+ $allowed_quote_modifiers = EMPTY_STRING;
}
}
$i_tok = $i;
# re-initialize various flags for the next output token
- $block_type &&= "";
- $container_type &&= "";
- $type_sequence &&= "";
+ $block_type &&= EMPTY_STRING;
+ $container_type &&= EMPTY_STRING;
+ $type_sequence &&= EMPTY_STRING;
$indent_flag &&= 0;
- $prototype &&= "";
+ $prototype &&= EMPTY_STRING;
# this pre-token will start an output token
push( @{$routput_token_list}, $i_tok );
# handle whitespace tokens..
next if ( $type eq 'b' );
- my $prev_tok = $i > 0 ? $rtokens->[ $i - 1 ] : ' ';
+ my $prev_tok = $i > 0 ? $rtokens->[ $i - 1 ] : SPACE;
my $prev_type = $i > 0 ? $rtoken_type->[ $i - 1 ] : 'b';
# Build larger tokens where possible, since we are not in a quote.
my @nesting_blocks = (); # string of block types leading to this depth
my @nesting_lists = (); # string of list types leading to this depth
my @ci_string = (); # string needed to compute continuation indentation
- my @container_environment = (); # BLOCK or LIST
- my $container_environment = '';
- my $im = -1; # previous $i value
+ my @container_environment = (); # BLOCK or LIST
+ my $container_environment = EMPTY_STRING;
+ my $im = -1; # previous $i value
my $num;
# Count the number of '1's in the string (previously sub ones_count)
$container_environment =
$nesting_block_flag ? 'BLOCK'
: $nesting_list_flag ? 'LIST'
- : "";
+ : EMPTY_STRING;
# if the difference between total nesting levels is not 1,
# there are intervening non-structural nesting types between
$container_environment =
$nesting_block_flag ? 'BLOCK'
: $nesting_list_flag ? 'LIST'
- : "";
+ : EMPTY_STRING;
$ci_string_i = $ci_string_sum + $in_statement_continuation;
$nesting_block_string_i = $nesting_block_string;
$nesting_list_string_i = $nesting_list_string;
$container_environment =
$nesting_block_flag ? 'BLOCK'
: $nesting_list_flag ? 'LIST'
- : "";
+ : EMPTY_STRING;
# zero the continuation indentation at certain tokens so
# that they will be at the same level as its container. For
$tokenizer_self->[_in_attribute_list_] = $in_attribute_list;
$tokenizer_self->[_in_quote_] = $in_quote;
$tokenizer_self->[_quote_target_] =
- $in_quote ? matching_end_token($quote_character) : "";
+ $in_quote ? matching_end_token($quote_character) : EMPTY_STRING;
$tokenizer_self->[_rhere_target_list_] = $rhere_target_list;
$line_of_tokens->{_rtoken_type} = \@token_type;
my ($rarg) = @_;
- my $msg = "";
+ my $msg = EMPTY_STRING;
##############
# Table lookup
# cannot start a code block within an anonymous hash
else {
- return "";
+ return EMPTY_STRING;
}
}
|| $last_nonblank_token eq 'unless' )
)
{
- return "";
+ return EMPTY_STRING;
}
else {
return $last_nonblank_token;
# check for syntax 'use MODULE LIST'
# This fixes b1022 b1025 b1027 b1028 b1029 b1030 b1031
- return "" if ( $statement_type eq 'use' );
+ return EMPTY_STRING if ( $statement_type eq 'use' );
return decide_if_code_block( $i, $rtokens, $rtoken_type,
$max_token_index );
return 't'; # (Not $paren_type)
}
else {
- return "";
+ return EMPTY_STRING;
}
}
# anything else must be anonymous hash reference
else {
- return "";
+ return EMPTY_STRING;
}
}
# Check for the common case of an empty anonymous hash reference:
# Maybe something like sub { { } }
if ( $next_nonblank_token eq '}' ) {
- $code_block_type = "";
+ $code_block_type = EMPTY_STRING;
}
else {
|| ( $pre_types[$j] eq '=' && $pre_types[ ++$j ] eq '>' )
)
{
- $code_block_type = "";
+ $code_block_type = EMPTY_STRING;
}
}
# If this brace follows a bareword, then append a space as a signal
# to the formatter that this may not be a block brace. To find the
# corresponding code in Formatter.pm search for 'b1085'.
- $code_block_type .= " " if ( $code_block_type =~ /^\w/ );
+ $code_block_type .= SPACE if ( $code_block_type =~ /^\w/ );
}
}
make_numbered_line( $input_line_number, $input_line, $pos );
$underline = write_on_underline( $underline, $pos - $offset, '^' );
- my $trailer = "";
+ my $trailer = EMPTY_STRING;
if ( ( $i_tok > 0 ) && ( $last_nonblank_i >= 0 ) ) {
my $pos_prev = $rpretoken_map->[$last_nonblank_i];
my $num;
# Fix part #1 for git82: save last token type for propagation of type 'Z'
$nested_statement_type[$aa][ $current_depth[$aa] ] =
[ $statement_type, $last_nonblank_type, $last_nonblank_token ];
- $statement_type = "";
+ $statement_type = EMPTY_STRING;
return ( $seqno, $indent );
}
my ($ess);
if ( $diff == 1 || $diff == -1 ) {
- $ess = '';
+ $ess = EMPTY_STRING;
}
else {
$ess = 's';
# look for a possible ending ? on this line..
my $in_quote = 1;
my $quote_depth = 0;
- my $quote_character = '';
+ my $quote_character = EMPTY_STRING;
my $quote_pos = 0;
my $quoted_string;
(
# look for a possible ending / on this line..
my $in_quote = 1;
my $quote_depth = 0;
- my $quote_character = '';
+ my $quote_character = EMPTY_STRING;
my $quote_pos = 0;
my $quoted_string;
(
# ($,%,@,*) including something like abc::def::ghi
$type = 'w';
- my $sub_name = "";
+ my $sub_name = EMPTY_STRING;
if ( defined($2) ) { $sub_name = $2; }
if ( defined($1) ) {
$package = $1;
$max_token_index )
= @_;
use constant DEBUG_NSCAN => 0;
- my $type = '';
+ my $type = EMPTY_STRING;
my ( $i_beg, $pos_beg );
#print "NSCAN:entering i=$i, tok=$tok, type=$type, state=$id_scan_state\n";
# on re-entry, start scanning at first token on the line
if ($id_scan_state) {
$i_beg = $i;
- $type = '';
+ $type = EMPTY_STRING;
}
# on initial entry, start scanning just after type token
( $i, $tok, $type ) =
do_scan_package( $input_line, $i, $i_beg, $tok, $type, $rtokens,
$rtoken_map, $max_token_index );
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
}
else {
warning("invalid token in scan_id: $tok\n");
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
}
}
= @_;
use constant DEBUG_SCAN_ID => 0;
my $i_begin = $i;
- my $type = '';
+ my $type = EMPTY_STRING;
my $tok_begin = $rtokens->[$i_begin];
if ( $tok_begin eq ':' ) { $tok_begin = '::' }
my $id_scan_state_begin = $id_scan_state;
my $identifier_begin = $identifier;
my $tok = $tok_begin;
- my $message = "";
+ my $message = EMPTY_STRING;
my $tok_is_blank; # a flag to speed things up
my $in_prototype_or_signature =
elsif ( $tok eq 'sub' or $tok eq 'package' ) {
$saw_alpha = 0; # 'sub' is considered type info here
$id_scan_state = '$';
- $identifier .= ' '; # need a space to separate sub from sub name
+ $identifier .= SPACE; # need a space to separate sub from sub name
}
elsif ( $tok eq '::' ) {
$id_scan_state = 'A';
warning($msg);
$tokenizer_self->[_in_error_] = 1;
}
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
goto RETURN;
}
$saw_type = !$saw_alpha;
# we've got a punctuation variable if end of line (punct.t)
if ( $i == $max_token_index ) {
$type = 'i';
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
last;
}
}
elsif ( $id_scan_state eq '$' ) { $type = 't' }
else { $type = 'i' }
$i = $i_save;
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
last;
}
}
my $next1 = $rtokens->[ $i + 1 ];
$identifier .= $tok . $next1 . $next2;
$i += 2;
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
last;
}
# skip something like ${xxx} or ->{
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
# if this is the first token of a line, any tokens for this
# identifier have already been accumulated
- if ( $identifier eq '$' || $i == 0 ) { $identifier = ''; }
+ if ( $identifier eq '$' || $i == 0 ) {
+ $identifier = EMPTY_STRING;
+ }
$i = $i_save;
last;
}
if ( $identifier =~ /^[\$\%\*\&\@]/ ) {
if ( length($identifier) > 1 ) {
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
$i = $i_save;
$type = 'i'; # probably punctuation variable
last;
# If pretoken $next1 is more than one character long,
# set a flag indicating that it needs to be split.
- $id_scan_state = ( length($next1) > 1 ) ? '^' : "";
+ $id_scan_state =
+ ( length($next1) > 1 ) ? '^' : EMPTY_STRING;
last;
}
else {
# it is just $^
# Simple test case (c065): '$aa=$^if($bb)';
- $id_scan_state = "";
+ $id_scan_state = EMPTY_STRING;
last;
}
}
else {
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
$i = $i_save;
last; # c106
}
# '$' which will have been previously marked type 't'
# rather than 'i'.
if ( $i == $i_begin ) {
- $identifier = "";
- $type = "";
+ $identifier = EMPTY_STRING;
+ $type = EMPTY_STRING;
}
# at a # we have to mark as type 't' because more may
}
$i = $i_save;
}
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
last;
}
}
else {
$i = $i_save;
- if ( length($identifier) == 1 ) { $identifier = ''; }
+ if ( length($identifier) == 1 ) {
+ $identifier = EMPTY_STRING;
+ }
}
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
last;
}
}
$identifier .= $tok;
}
else {
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
$i = $i_save;
last;
}
elsif ( $tok eq "'" && $allow_tick ) { # tick
if ( $is_keyword{$identifier} ) {
- $id_scan_state = ''; # that's all
+ $id_scan_state = EMPTY_STRING; # that's all
$i = $i_save;
}
else {
$identifier .= $tok;
}
else {
- $id_scan_state = ''; # that's all
+ $id_scan_state = EMPTY_STRING; # that's all
$i = $i_save;
last;
}
$tok_is_blank = 1;
}
else {
- $id_scan_state = ''; # that's all - no prototype
+ $id_scan_state = EMPTY_STRING; # that's all - no prototype
$i = $i_save;
last;
}
if ( $tok eq ')' ) { # got it
$identifier .= $tok;
- $id_scan_state = ''; # all done
+ $id_scan_state = EMPTY_STRING; # all done
last;
}
elsif ( $tok =~ /^[\s\$\%\\\*\@\&\;]/ ) {
$identifier .= $tok;
}
elsif ( $tok eq '{' ) {
- if ( $identifier eq '&' || $i == 0 ) { $identifier = ''; }
+ if ( $identifier eq '&' || $i == 0 ) {
+ $identifier = EMPTY_STRING;
+ }
$i = $i_save;
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
last;
}
elsif ( $tok eq '^' ) {
# If pretoken $next1 is more than one character long,
# set a flag indicating that it needs to be split.
- $id_scan_state = ( length($next1) > 1 ) ? '^' : "";
+ $id_scan_state =
+ ( length($next1) > 1 ) ? '^' : EMPTY_STRING;
}
else {
# it is &^
- $id_scan_state = "";
+ $id_scan_state = EMPTY_STRING;
}
last;
}
else {
- $identifier = '';
+ $identifier = EMPTY_STRING;
$i = $i_save;
}
last;
$identifier .= $tok;
}
else {
- $identifier = '';
+ $identifier = EMPTY_STRING;
$i = $i_save;
$type = '&';
}
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
last;
}
}
######################
else { # can get here due to error in initialization
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
$i = $i_save;
last;
}
# once we enter the actual identifier, it may not extend beyond
# the end of the current line
if ( $id_scan_state =~ /^[A\:\(\)]/ ) {
- $id_scan_state = '';
+ $id_scan_state = EMPTY_STRING;
}
# Patch: the deprecated variable $# does not combine with anything on the
# next line.
- if ( $identifier eq '$#' ) { $id_scan_state = '' }
+ if ( $identifier eq '$#' ) { $id_scan_state = EMPTY_STRING }
if ( $i < 0 ) { $i = 0 }
}
}
else {
- $type = '';
+ $type = EMPTY_STRING;
} # this can happen on a restart
}
# initialize subname each time a new 'sub' keyword is encountered
sub initialize_subname {
- $package_saved = "";
- $subname_saved = "";
+ $package_saved = EMPTY_STRING;
+ $subname_saved = EMPTY_STRING;
return;
}
: $tok eq '(' ? PAREN_CALL
: SUB_CALL;
- $id_scan_state = ""; # normally we get everything in one call
+ $id_scan_state = EMPTY_STRING; # normally we get everything in one call
my $subname = $subname_saved;
my $package = $package_saved;
my $proto = undef;
}
}
elsif ($next_nonblank_token) { # EOF technically ok
- $subname = "" unless defined($subname);
+ $subname = EMPTY_STRING unless defined($subname);
warning(
"expecting ':' or ';' or '{' after definition or declaration of sub '$subname' but saw '$next_nonblank_token'\n"
);
}
my $next_nonblank_token = $rtokens->[ ++$i ];
- return ( " ", $i ) unless defined($next_nonblank_token);
+ return ( SPACE, $i ) unless defined($next_nonblank_token);
if ( $next_nonblank_token =~ /^\s*$/ ) {
$next_nonblank_token = $rtokens->[ ++$i ];
- return ( " ", $i ) unless defined($next_nonblank_token);
+ return ( SPACE, $i ) unless defined($next_nonblank_token);
}
return ( $next_nonblank_token, $i );
}
find_next_nonblank_token( $i_next, $rtokens, $max_token_index );
}
- goto RETURN if ( !$next_nonblank_token || $next_nonblank_token eq " " );
+ goto RETURN if ( !$next_nonblank_token || $next_nonblank_token eq SPACE );
# check for possible a digraph
goto RETURN if ( !defined( $rtokens->[ $i_next + 1 ] ) );
}
}
else {
- $next_nonblank_token = "";
+ $next_nonblank_token = EMPTY_STRING;
}
return ( $next_nonblank_token, $i );
}
my ( $expecting, $i, $rtokens, $rtoken_map, $max_token_index ) = @_;
my $ibeg = $i;
my $found_target = 0;
- my $here_doc_target = '';
- my $here_quote_character = '';
+ my $here_doc_target = EMPTY_STRING;
+ my $here_quote_character = EMPTY_STRING;
my $saw_error = 0;
my ( $next_nonblank_token, $i_next_nonblank, $next_token );
$next_token = $rtokens->[ $i + 1 ];
$quoted_string_2 .= $quoted_string;
if ( $in_quote == 1 ) {
if ( $quote_character =~ /[\{\[\<\(]/ ) { $i++; }
- $quote_character = '';
+ $quote_character = EMPTY_STRING;
}
else {
$quoted_string_2 .= "\n";
= @_;
my ( $tok, $end_tok );
my $i = $i_beg - 1;
- my $quoted_string = "";
+ my $quoted_string = EMPTY_STRING;
0 && do {
print STDOUT
my $numbered_line = sprintf( "%d: ", $lineno );
$offset -= length($numbered_line);
$numbered_line .= $str;
- my $underline = " " x length($numbered_line);
+ my $underline = SPACE x length($numbered_line);
return ( $offset, $numbered_line, $underline );
}
use Perl::Tidy::VerticalAligner::Alignment;
use Perl::Tidy::VerticalAligner::Line;
-use constant DEVEL_MODE => 0;
+use constant DEVEL_MODE => 0;
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
# The Perl::Tidy::VerticalAligner package collects output lines and
# attempts to line up certain common tokens, such as => and #, which are
# Batch of lines being collected
$self->[_rgroup_lines_] = [];
$self->[_group_level_] = 0;
- $self->[_group_type_] = "";
+ $self->[_group_type_] = EMPTY_STRING;
$self->[_group_maximum_line_length_] = undef;
$self->[_zero_count_] = 0;
$self->[_comment_leading_space_count_] = 0;
my ($self) = @_;
$self->[_rgroup_lines_] = [];
- $self->[_group_type_] = "";
+ $self->[_group_type_] = EMPTY_STRING;
$self->[_zero_count_] = 0;
$self->[_comment_leading_space_count_] = 0;
$self->[_last_leading_space_count_] = 0;
}
sub get_input_stream_name {
- my $input_stream_name = "";
+ my $input_stream_name = EMPTY_STRING;
if ($logger_object) {
$input_stream_name = $logger_object->get_input_stream_name();
}
# --------------------------------------------------------------------
# Collect outdentable block COMMENTS
# --------------------------------------------------------------------
- my $is_blank_line = "";
+ my $is_blank_line = EMPTY_STRING;
if ( $self->[_group_type_] eq 'COMMENT' ) {
if (
(
if ( ( $jmax == 0 ) || ( $rtokens->[ $jmax - 1 ] ne '#' ) ) {
$jmax += 1;
$rtokens->[ $jmax - 1 ] = '#';
- $rfields->[$jmax] = '';
+ $rfields->[$jmax] = EMPTY_STRING;
$rfield_lengths->[$jmax] = 0;
$rpatterns->[$jmax] = '#';
}
leading_space_count => $leading_space_count,
outdent_long_lines => $outdent_long_lines,
list_seqno => $list_seqno,
- list_type => "",
+ list_type => EMPTY_STRING,
is_hanging_side_comment => $is_hanging_side_comment,
rvertical_tightness_flags => $rvertical_tightness_flags,
is_terminal_ternary => $is_terminal_ternary,
$rtokens->[ $jmax - 1 ] = $rtokens->[0];
$rpatterns->[ $jmax - 1 ] = $rpatterns->[0];
foreach my $j ( 1 .. $jmax - 1 ) {
- $rfields->[$j] = '';
+ $rfields->[$j] = EMPTY_STRING;
$rfield_lengths->[$j] = 0;
- $rtokens->[ $j - 1 ] = "";
- $rpatterns->[ $j - 1 ] = "";
+ $rtokens->[ $j - 1 ] = EMPTY_STRING;
+ $rpatterns->[ $j - 1 ] = EMPTY_STRING;
}
return 1;
}
( $raw_tok, $lev, $tag, $tok_count ) =
decode_alignment_token( $rtokens->[$_] );
if ( !$is_comma_token{$raw_tok} ) {
- $list_type = "";
+ $list_type = EMPTY_STRING;
last;
}
}
# look for the question mark after the :
my ($jquestion);
my $depth_question;
- my $pad = "";
+ my $pad = EMPTY_STRING;
my $pad_length = 0;
foreach my $j ( 0 .. $maximum_field_index - 1 ) {
my $tok = $rtokens_old->[$j];
$jquestion = $j;
if ( $rfields_old->[ $j + 1 ] =~ /^(\?\s*)/ ) {
$pad_length = length($1);
- $pad = " " x $pad_length;
+ $pad = SPACE x $pad_length;
}
else {
return; # shouldn't happen
unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );
# insert appropriate number of empty fields
- splice( @fields, 1, 0, ('') x $jadd ) if $jadd;
- splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
+ splice( @fields, 1, 0, (EMPTY_STRING) x $jadd ) if $jadd;
+ splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
}
# handle sub-case of first field just equal to leading colon.
# leading token and inserting appropriate number of empty fields
splice( @tokens, 0, 1, @{$rtokens_old}[ 0 .. $jquestion ] );
splice( @patterns, 1, 0, @{$rpatterns_old}[ 1 .. $jquestion ] );
- splice( @fields, 1, 0, ('') x $jadd ) if $jadd;
- splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
+ splice( @fields, 1, 0, (EMPTY_STRING) x $jadd ) if $jadd;
+ splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
}
}
$jadd = $jquestion + 1;
$fields[0] = $pad . $fields[0];
$field_lengths[0] = $pad_length + $field_lengths[0];
- splice( @fields, 0, 0, ('') x $jadd ) if $jadd;
- splice( @field_lengths, 0, 0, (0) x $jadd ) if $jadd;
+ splice( @fields, 0, 0, (EMPTY_STRING) x $jadd ) if $jadd;
+ splice( @field_lengths, 0, 0, (0) x $jadd ) if $jadd;
}
EXPLAIN_TERNARY && do {
my $jadd = $jbrace - $jparen;
splice( @{$rtokens}, 0, 0, @{$rtokens_old}[ $jparen .. $jbrace - 1 ] );
splice( @{$rpatterns}, 1, 0, @{$rpatterns_old}[ $jparen + 1 .. $jbrace ] );
- splice( @{$rfields}, 1, 0, ('') x $jadd );
+ splice( @{$rfields}, 1, 0, (EMPTY_STRING) x $jadd );
splice( @{$rfield_lengths}, 1, 0, (0) x $jadd );
# force a flush after this line if it does not follow a case
my $imax_align = -1;
# variable $GoToMsg explains reason for no match, for debugging
- my $GoToMsg = "";
+ my $GoToMsg = EMPTY_STRING;
use constant EXPLAIN_CHECK_MATCH => 0;
# This is a flag for testing alignment by sub sweep_left_to_right only.
# An existing list will still be a list but with possibly different
# leading token
my $old_list_type = $line_obj->get_list_type();
- my $new_list_type = "";
+ my $new_list_type = EMPTY_STRING;
if ( $rtokens_new->[0] =~ /^(=>|,)/ ) {
$new_list_type = $rtokens_new->[0];
}
return @{ $decoded_token{$tok} };
}
- my ( $raw_tok, $lev, $tag, $tok_count ) = ( $tok, 0, "", 1 );
+ my ( $raw_tok, $lev, $tag, $tok_count ) = ( $tok, 0, EMPTY_STRING, 1 );
if ( $tok =~ /^(\D+)(\d+)([^\.]*)(\.(\d+))?$/ ) {
$raw_tok = $1;
$lev = $2;
my $delete_above_level;
my $deleted_assignment_token;
- my $saw_dividing_token = "";
+ my $saw_dividing_token = EMPTY_STRING;
$saw_large_group ||= $nlines > 2 && $imax > 1;
# Loop over all alignment tokens
# 2 = no match, and lines do not match at all
my ( $tok, $tok_m, $pat, $pat_m, $pad ) = @_;
- my $GoToMsg = "";
+ my $GoToMsg = EMPTY_STRING;
my $return_code = 1;
my ( $alignment_token, $lev, $tag, $tok_count ) =
my $rtokens = $line->get_rtokens();
my $i = -1;
my ( $lev_min, $lev_max );
- my $token_pattern_max = "";
+ my $token_pattern_max = EMPTY_STRING;
my %saw_level;
my $is_monotonic = 1;
$lev_min = -1;
$lev_max = -1;
$levs[0] = -1;
- $rtoken_patterns->{$lev_min} = "";
+ $rtoken_patterns->{$lev_min} = EMPTY_STRING;
$rtoken_indexes->{$lev_min} = [];
}
# it seems that the an alignment would look bad.
my $max_pad = 0;
my $saw_good_alignment = 0;
- my $saw_if_or; # if we saw an 'if' or 'or' at group level
- my $raw_tokb = ""; # first token seen at group level
+ my $saw_if_or; # if we saw an 'if' or 'or' at group level
+ my $raw_tokb = EMPTY_STRING; # first token seen at group level
my $jfirst_bad;
my $line_ending_fat_comma; # is last token just a '=>' ?
my $j0_eq_pad;
# only add padding when we have a finite field;
# this avoids extra terminal spaces if we have empty fields
if ( $rfield_lengths->[$j] > 0 ) {
- $str .= ' ' x $total_pad_count;
+ $str .= SPACE x $total_pad_count;
$str_len += $total_pad_count;
$total_pad_count = 0;
$str .= $rfields->[$j];
sub initialize_step_B_cache {
# valign_output_step_B cache:
- $cached_line_text = "";
+ $cached_line_text = EMPTY_STRING;
$cached_line_text_length = 0;
$cached_line_type = 0;
$cached_line_opening_flag = 0;
$cached_seqno = 0;
$cached_line_valid = 0;
$cached_line_leading_space_count = 0;
- $cached_seqno_string = "";
+ $cached_seqno_string = EMPTY_STRING;
$cached_line_Kend = undef;
$cached_line_maximum_length = undef;
# These vars hold a string of sequence numbers joined together used by
# the cache
- $seqno_string = "";
- $last_nonblank_seqno_string = "";
+ $seqno_string = EMPTY_STRING;
+ $last_nonblank_seqno_string = EMPTY_STRING;
return;
}
$cached_line_Kend,
);
$cached_line_type = 0;
- $cached_line_text = "";
+ $cached_line_text = EMPTY_STRING;
$cached_line_text_length = 0;
- $cached_seqno_string = "";
+ $cached_seqno_string = EMPTY_STRING;
$cached_line_Kend = undef;
$cached_line_maximum_length = undef;
}
# later by entabbing, so we have to keep track of any changes
# to the leading_space_count from here on.
my $leading_string =
- $leading_space_count > 0 ? ( ' ' x $leading_space_count ) : "";
+ $leading_space_count > 0
+ ? ( SPACE x $leading_space_count )
+ : EMPTY_STRING;
my $leading_string_length = length($leading_string);
# Unpack any recombination data; it was packed by
if ( $gap >= 0 && defined($seqno_beg) ) {
$maximum_line_length = $cached_line_maximum_length;
- $leading_string = $cached_line_text . ' ' x $gap;
+ $leading_string = $cached_line_text . SPACE x $gap;
$leading_string_length = $cached_line_text_length + $gap;
$leading_space_count = $cached_line_leading_space_count;
$seqno_string = $cached_seqno_string . ':' . $seqno_beg;
# Handle cached line ending in CLOSING tokens
else {
my $test_line =
- $cached_line_text . ' ' x $cached_line_closing_flag . $str;
+ $cached_line_text . SPACE x $cached_line_closing_flag . $str;
my $test_line_length =
$cached_line_text_length +
$cached_line_closing_flag +
# Change the args to look like we received the combined line
$str = $test_line;
$str_length = $test_line_length;
- $leading_string = "";
+ $leading_string = EMPTY_STRING;
$leading_string_length = 0;
$leading_space_count = $cached_line_leading_space_count;
$level = $last_level_written;
}
}
$cached_line_type = 0;
- $cached_line_text = "";
+ $cached_line_text = EMPTY_STRING;
$cached_line_text_length = 0;
$cached_line_Kend = undef;
$cached_line_maximum_length = undef;
sub initialize_valign_buffer {
@valign_buffer = ();
- $valign_buffer_filling = "";
+ $valign_buffer_filling = EMPTY_STRING;
return;
}
}
@valign_buffer = ();
}
- $valign_buffer_filling = "";
+ $valign_buffer_filling = EMPTY_STRING;
return;
}
$leading_space_count % $rOpts_entab_leading_whitespace;
my $tab_count =
int( $leading_space_count / $rOpts_entab_leading_whitespace );
- my $leading_string = "\t" x $tab_count . ' ' x $space_count;
+ my $leading_string = "\t" x $tab_count . SPACE x $space_count;
if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
substr( $line, 0, $leading_space_count ) = $leading_string;
}
"Error entabbing in valign_output_step_D: for level=$level count=$leading_space_count\n"
);
}
- $leading_string = ( ' ' x $leading_space_count );
+ $leading_string = ( SPACE x $leading_space_count );
}
else {
- $leading_string .= ( ' ' x $space_count );
+ $leading_string .= ( SPACE x $space_count );
}
if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
substr( $line, 0, $leading_space_count ) = $leading_string;
# Handle case of zero whitespace, which includes multi-line quotes
# (which may have a finite level; this prevents tab problems)
if ( $leading_whitespace_count <= 0 ) {
- return "";
+ return EMPTY_STRING;
}
# look for previous result
if ( !( $rOpts_tabs || $rOpts_entab_leading_whitespace )
|| $rOpts_indent_columns <= 0 )
{
- $leading_string = ( ' ' x $leading_whitespace_count );
+ $leading_string = ( SPACE x $leading_whitespace_count );
}
# Handle entab option
$leading_whitespace_count % $rOpts_entab_leading_whitespace;
my $tab_count = int(
$leading_whitespace_count / $rOpts_entab_leading_whitespace );
- $leading_string = "\t" x $tab_count . ' ' x $space_count;
+ $leading_string = "\t" x $tab_count . SPACE x $space_count;
}
# Handle option of one tab per level
);
# -- skip entabbing
- $leading_string = ( ' ' x $leading_whitespace_count );
+ $leading_string = ( SPACE x $leading_whitespace_count );
}
else {
- $leading_string .= ( ' ' x $space_count );
+ $leading_string .= ( SPACE x $space_count );
}
}
$leading_string_cache[$leading_whitespace_count] = $leading_string;
projects / perltidy.git / commitdiff