return;
}
+my %valid_LINE_keys;
+
+BEGIN {
+
+ # define valid keys in a line object
+ my @q = qw(
+ jmax
+ rtokens
+ rfields
+ rfield_lengths
+ rpatterns
+ indentation
+ leading_space_count
+ outdent_long_lines
+ list_type
+ list_seqno
+ is_hanging_side_comment
+ maximum_line_length
+ rvertical_tightness_flags
+ is_terminal_ternary
+ j_terminal_match
+ end_group
+ Kend
+ ci_level
+ level
+ level_end
+ imax_pair
+
+ ralignments
+ );
+
+ @valid_LINE_keys{@q} = (1) x scalar(@q);
+}
+
BEGIN {
# Define the fixed indexes for variables in $self, which is an array
return;
}
+sub check_keys {
+ my ( $rtest, $rvalid, $msg, $exact_match ) = @_;
+
+ # Check the keys of a hash:
+ # $rtest = ref to hash to test
+ # $rvalid = ref to hash with valid keys
+
+ # $msg = a message to write in case of error
+ # $exact_match defines the type of check:
+ # = false: test hash must not have unknown key
+ # = true: test hash must have exactly same keys as known hash
+ my @unknown_keys =
+ grep { !exists $rvalid->{$_} } keys %{$rtest};
+ my @missing_keys =
+ grep { !exists $rtest->{$_} } keys %{$rvalid};
+ my $error = @unknown_keys;
+ if ($exact_match) { $error ||= @missing_keys }
+ if ($error) {
+ local $LIST_SEPARATOR = ')(';
+ my @expected_keys = sort keys %{$rvalid};
+ @unknown_keys = sort @unknown_keys;
+ Fault(<<EOM);
+------------------------------------------------------------------------
+Program error detected checking hash keys
+Message is: '$msg'
+Expected keys: (@expected_keys)
+Unknown key(s): (@unknown_keys)
+Missing key(s): (@missing_keys)
+------------------------------------------------------------------------
+EOM
+ }
+ return;
+} ## end sub check_keys
+
sub new {
my ( $class, @args ) = @_;
# side comments. Tabs in these fields can mess up the column counting.
# The log file warns the user if there are any such tabs.
- my ( $self, $rline_hash ) = @_;
-
- my $level = $rline_hash->{level};
- my $level_end = $rline_hash->{level_end};
- my $indentation = $rline_hash->{indentation};
- my $list_seqno = $rline_hash->{list_seqno};
- my $outdent_long_lines = $rline_hash->{outdent_long_lines};
- my $is_terminal_ternary = $rline_hash->{is_terminal_ternary};
- my $rvertical_tightness_flags = $rline_hash->{rvertical_tightness_flags};
- my $break_alignment_before = $rline_hash->{break_alignment_before};
- my $break_alignment_after = $rline_hash->{break_alignment_after};
- my $Kend = $rline_hash->{Kend};
- my $ci_level = $rline_hash->{ci_level};
- my $maximum_line_length = $rline_hash->{maximum_line_length};
- my $forget_side_comment = $rline_hash->{forget_side_comment};
- my $rline_alignment = $rline_hash->{rline_alignment};
+ my ( $self, $rcall_hash ) = @_;
+
+ # Unpack the call args. This form is significantly faster than getting them
+ # one-by-one.
+ my (
+
+ $Kend,
+ $break_alignment_after,
+ $break_alignment_before,
+ $ci_level,
+ $forget_side_comment,
+ $indentation,
+ $is_terminal_ternary,
+ $level,
+ $level_end,
+ $list_seqno,
+ $maximum_line_length,
+ $outdent_long_lines,
+ $rline_alignment,
+ $rvertical_tightness_flags,
+
+ ) =
+
+ @{$rcall_hash}{
+ qw(
+ Kend
+ break_alignment_after
+ break_alignment_before
+ ci_level
+ forget_side_comment
+ indentation
+ is_terminal_ternary
+ level
+ level_end
+ list_seqno
+ maximum_line_length
+ outdent_long_lines
+ rline_alignment
+ rvertical_tightness_flags
+ )
+ };
my ( $rtokens, $rfields, $rpatterns, $rfield_lengths ) =
@{$rline_alignment};
my $rgroup_lines = $self->[_rgroup_lines_];
if ( $break_alignment_before && @{$rgroup_lines} ) {
- $rgroup_lines->[-1]->set_end_group(1);
+ $rgroup_lines->[-1]->{'end_group'} = 1;
}
# --------------------------------------------------------------------
$self->[_zero_count_]++;
if ( @{$rgroup_lines}
- && !get_recoverable_spaces( $rgroup_lines->[0]->get_indentation() )
- )
+ && !get_recoverable_spaces( $rgroup_lines->[0]->{'indentation'} ) )
{
# flush the current group if it has some aligned columns..
# or we haven't seen a comment lately
- if ( $rgroup_lines->[0]->get_jmax() > 1
+ if ( $rgroup_lines->[0]->{'jmax'} > 1
|| $self->[_zero_count_] > 3 )
{
$self->_flush_group_lines();
+
+ # Update '$rgroup_lines' - it will become a ref to empty array.
+ # This allows avoiding a call to get_group_line_count below.
+ $rgroup_lines = $self->[_rgroup_lines_];
}
}
# start new COMMENT group if this comment may be outdented
if ( $is_block_comment
&& $outdent_long_lines
- && !$self->group_line_count() )
+ && !@{$rgroup_lines} )
{
$self->[_group_type_] = 'COMMENT';
$self->[_comment_leading_space_count_] = $leading_space_count;
# just write this line directly if no current group, no side comment,
# and no space recovery is needed.
- if ( !$self->group_line_count()
+ if ( !@{$rgroup_lines}
&& !get_recoverable_spaces($indentation) )
{
# --------------------------------------------------------------------
# create an object to hold this line
# --------------------------------------------------------------------
+
+ # The hash keys below must match the list of keys in %valid_LINE_keys.
+ # Values in this hash are accessed directly, except for 'ralignments',
+ # rather than with get/set calls for efficiency.
my $new_line = Perl::Tidy::VerticalAligner::Line->new(
{
jmax => $jmax,
level_end => $level_end,
imax_pair => -1,
maximum_line_length => $maximum_line_length,
+
+ ralignments => [],
}
);
+ DEVEL_MODE
+ && check_keys( $new_line, \%valid_LINE_keys,
+ "Checking line keys at line definition", 1 );
+
# --------------------------------------------------------------------
# Decide if this is a simple list of items.
# We use this to be less restrictive in deciding what to align.
# the coding.
my ( $new_line, $old_line ) = @_;
- my $jmax = $new_line->get_jmax();
+ my $jmax = $new_line->{'jmax'};
# must be 2 fields
return 0 unless $jmax == 1;
- my $rtokens = $new_line->get_rtokens();
+ my $rtokens = $new_line->{'rtokens'};
# the second field must be a comment
return 0 unless $rtokens->[0] eq '#';
- my $rfields = $new_line->get_rfields();
+ my $rfields = $new_line->{'rfields'};
# the first field must be empty
return 0 unless $rfields->[0] =~ /^\s*$/;
# the current line must have fewer fields
- my $maximum_field_index = $old_line->get_jmax();
+ my $maximum_field_index = $old_line->{'jmax'};
return 0
unless $maximum_field_index > $jmax;
# looks ok..
- my $rpatterns = $new_line->get_rpatterns();
- my $rfield_lengths = $new_line->get_rfield_lengths();
+ my $rpatterns = $new_line->{'rpatterns'};
+ my $rfield_lengths = $new_line->{'rfield_lengths'};
+
+ $new_line->{'is_hanging_side_comment'} = 1;
- $new_line->set_is_hanging_side_comment(1);
- $jmax = $maximum_field_index;
- $new_line->set_jmax($jmax);
+ $jmax = $maximum_field_index;
+ $new_line->{'jmax'} = $jmax;
$rfields->[$jmax] = $rfields->[1];
$rfield_lengths->[$jmax] = $rfield_lengths->[1];
$rtokens->[ $jmax - 1 ] = $rtokens->[0];
$rpatterns->[ $jmax - 1 ] = $rpatterns->[0];
+
foreach my $j ( 1 .. $jmax - 1 ) {
$rfields->[$j] = EMPTY_STRING;
$rfield_lengths->[$j] = 0;
# of the field separators are commas or comma-arrows (except for the
# trailing #)
- my $rtokens = $line->get_rtokens();
+ my $rtokens = $line->{'rtokens'};
my $test_token = $rtokens->[0];
my ( $raw_tok, $lev, $tag, $tok_count ) =
decode_alignment_token($test_token);
if ( $is_comma_token{$raw_tok} ) {
my $list_type = $test_token;
- my $jmax = $line->get_jmax();
+ my $jmax = $line->{'jmax'};
foreach ( 1 .. $jmax - 2 ) {
( $raw_tok, $lev, $tag, $tok_count ) =
last;
}
}
- $line->set_list_type($list_type);
+ $line->{'list_type'} = $list_type;
}
return;
}
}
my $jmax = @{$rfields} - 1;
- my $rfields_old = $old_line->get_rfields();
+ my $rfields_old = $old_line->{'rfields'};
- my $rpatterns_old = $old_line->get_rpatterns();
- my $rtokens_old = $old_line->get_rtokens();
- my $maximum_field_index = $old_line->get_jmax();
+ my $rpatterns_old = $old_line->{'rpatterns'};
+ my $rtokens_old = $old_line->{'rtokens'};
+ my $maximum_field_index = $old_line->{'jmax'};
# look for the question mark after the :
my ($jquestion);
}
# check for balanced else block following if/elsif/unless
- my $rfields_old = $old_line->get_rfields();
+ my $rfields_old = $old_line->{'rfields'};
# TBD: add handling for 'case'
return unless ( $rfields_old->[0] =~ /^(if|elsif|unless)\s*$/ );
# probably: "else # side_comment"
else { return }
- my $rpatterns_old = $old_line->get_rpatterns();
- my $rtokens_old = $old_line->get_rtokens();
- my $maximum_field_index = $old_line->get_jmax();
+ my $rpatterns_old = $old_line->{'rpatterns'};
+ my $rtokens_old = $old_line->{'rtokens'};
+ my $maximum_field_index = $old_line->{'jmax'};
# be sure the previous if/elsif is followed by an opening paren
my $jparen = 0;
# This flag should normally be zero.
use constant TEST_SWEEP_ONLY => 0;
- my $jmax = $new_line->get_jmax();
- my $maximum_field_index = $base_line->get_jmax();
+ my $jmax = $new_line->{'jmax'};
+ my $maximum_field_index = $base_line->{'jmax'};
my $jlimit = $jmax - 2;
if ( $jmax > $maximum_field_index ) {
$jlimit = $maximum_field_index - 2;
}
- if ( $new_line->get_is_hanging_side_comment() ) {
+ if ( $new_line->{'is_hanging_side_comment'} ) {
# HSC's can join the group if they fit
}
# A group with hanging side comments ends with the first non hanging
# side comment.
- if ( $base_line->get_is_hanging_side_comment() ) {
+ if ( $base_line->{'is_hanging_side_comment'} ) {
$GoToMsg = "end of hanging side comments";
goto NO_MATCH;
}
# The number of tokens that this line shares with the previous line
# has been stored with the previous line. This value was calculated
# and stored by sub 'match_line_pair'.
- $imax_align = $prev_line->get_imax_pair();
+ $imax_align = $prev_line->{'imax_pair'};
if ( $imax_align != $jlimit ) {
$GoToMsg = "Not all tokens match: $imax_align != $jlimit\n";
# return true if successful
# return false if not successful
- my $jmax = $new_line->get_jmax();
- my $leading_space_count = $new_line->get_leading_space_count();
- my $rfield_lengths = $new_line->get_rfield_lengths();
+ my $jmax = $new_line->{'jmax'};
+ my $leading_space_count = $new_line->{'leading_space_count'};
+ my $rfield_lengths = $new_line->{'rfield_lengths'};
my $padding_available = $old_line->get_available_space_on_right();
- my $jmax_old = $old_line->get_jmax();
- my $rtokens_old = $old_line->get_rtokens();
+ my $jmax_old = $old_line->{'jmax'};
+ my $rtokens_old = $old_line->{'rtokens'};
# Safety check ... only lines with equal array sizes should arrive here
# from sub check_match. So if this error occurs, look at recent changes in
$alignment->save_column();
}
- my $is_hanging_side_comment = $new_line->get_is_hanging_side_comment();
+ my $is_hanging_side_comment = $new_line->{'is_hanging_side_comment'};
# Loop over all alignments ...
- my $maximum_field_index = $old_line->get_jmax();
+ my $maximum_field_index = $old_line->{'jmax'};
for my $j ( 0 .. $jmax ) {
my $pad = $rfield_lengths->[$j] - $old_line->current_field_width($j);
my ($new_line) = @_;
- my $jmax = $new_line->get_jmax();
- my $rfield_lengths = $new_line->get_rfield_lengths();
- my $col = $new_line->get_leading_space_count();
+ my $jmax = $new_line->{'jmax'};
+ my $rfield_lengths = $new_line->{'rfield_lengths'};
+ my $col = $new_line->{'leading_space_count'};
for my $j ( 0 .. $jmax ) {
$col += $rfield_lengths->[$j];
# Otherwise, assume the next line has the level of the end of last line.
# This fixes case c008.
else {
- my $level_end = $rgroup_lines->[-1]->get_level_end();
+ my $level_end = $rgroup_lines->[-1]->{'level_end'};
$extra_indent_ok = $group_level > $level_end;
}
}
# STEP 6: Output the lines.
# All lines in this group have the same leading spacing and maximum line
# length
- my $group_leader_length = $rgroup_lines->[0]->get_leading_space_count();
- my $group_maximum_line_length =
- $rgroup_lines->[0]->get_maximum_line_length();
+ my $group_leader_length = $rgroup_lines->[0]->{'leading_space_count'};
+ my $group_maximum_line_length = $rgroup_lines->[0]->{'maximum_line_length'};
foreach my $line ( @{$rgroup_lines} ) {
$self->valign_output_step_A(
# Let the formatter know that this object has been processed and any
# recoverable spaces have been handled. This is needed for setting the
# closing paren location in -lp mode.
- my $object = $rgroup_lines->[0]->get_indentation();
+ my $object = $rgroup_lines->[0]->{'indentation'};
if ( ref($object) ) { $object->set_recoverable_spaces(0) }
$self->initialize_for_new_group();
my $line_0 = $rall_lines->[$jbeg];
my $line_1 = $rall_lines->[$jend];
- my $imax_pair = $line_1->get_imax_pair();
+ my $imax_pair = $line_1->{'imax_pair'};
if ( $imax_pair > $imax_align ) { $imax_align = $imax_pair }
## flag for possible future use:
## my $is_isolated_pair = $imax_pair < 0
## && ( $jbeg == 0
- ## || $rall_lines->[ $jbeg - 1 ]->get_imax_pair() < 0 );
+ ## || $rall_lines->[ $jbeg - 1 ]->{'imax_pair'} < 0 );
my $imax_prev =
- $jbeg > 0 ? $rall_lines->[ $jbeg - 1 ]->get_imax_pair() : -1;
+ $jbeg > 0 ? $rall_lines->[ $jbeg - 1 ]->{'imax_pair'} : -1;
my ( $is_marginal, $imax_align_fix ) =
is_marginal_match( $line_0, $line_1, $grp_level, $imax_align,
# Unset the _end_group flag for the last line if it it set because it
# is not needed and can causes problems for -lp formatting
- $rall_lines->[-1]->set_end_group(0);
+ $rall_lines->[-1]->{'end_group'} = 0;
# Loop over all lines ...
my $jline = -1;
# Start a new subgroup if necessary
if ( !$group_line_count ) {
add_to_rgroup($jline);
- if ( $new_line->get_end_group() ) {
+ if ( $new_line->{'end_group'} ) {
end_rgroup(-1);
}
next;
}
- my $j_terminal_match = $new_line->get_j_terminal_match();
+ my $j_terminal_match = $new_line->{'j_terminal_match'};
my ( $jbeg, $jend ) = get_rgroup_jrange();
if ( !defined($jbeg) ) {
#
# If this were not desired, the next step could be skipped.
# -------------------------------------------------------------
- if ( $new_line->get_is_hanging_side_comment() ) {
+ if ( $new_line->{'is_hanging_side_comment'} ) {
join_hanging_comment( $new_line, $base_line );
}
# BEFORE this line unless both it and the previous line have side
# comments. This prevents this line from pushing side comments out
# to the right.
- elsif ( $new_line->get_jmax() == 1 ) {
+ elsif ( $new_line->{'jmax'} == 1 ) {
# There are no matching tokens, so now check side comments.
# Programming note: accessing arrays with index -1 is
# risky in Perl, but we have verified there is at least one
# line in the group and that there is at least one field.
my $prev_comment =
- $rall_lines->[ $jline - 1 ]->get_rfields()->[-1];
- my $side_comment = $new_line->get_rfields()->[-1];
+ $rall_lines->[ $jline - 1 ]->{'rfields'}->[-1];
+ my $side_comment = $new_line->{'rfields'}->[-1];
end_rgroup(-1) unless ( $side_comment && $prev_comment );
}
}
# do not let sweep_left_to_right change an isolated 'else'
- if ( !$new_line->get_is_terminal_ternary() ) {
+ if ( !$new_line->{'is_terminal_ternary'} ) {
block_penultimate_match();
}
}
}
# end the group if we know we cannot match next line.
- elsif ( $new_line->get_end_group() ) {
+ elsif ( $new_line->{'end_group'} ) {
end_rgroup(-1);
}
} ## end loop over lines
# 'VARCHAR', DBI::SQL_VARCHAR, undef, "'", "'", undef, 0, 1,
# 1, 0, 0, 0, undef, 0, 0
# ];
- my $rfield_lengths = $line->get_rfield_lengths();
- my $rfield_lengths_m = $line_m->get_rfield_lengths();
+ my $rfield_lengths = $line->{'rfield_lengths'};
+ my $rfield_lengths_m = $line_m->{'rfield_lengths'};
# Safety check - shouldn't happen
return 0
$lensum >= $lensum_m ? ( $lensum_m, $lensum ) : ( $lensum, $lensum_m );
my $patterns_match;
- if ( $line_m->get_list_type() && $line->get_list_type() ) {
+ if ( $line_m->{'list_type'} && $line->{'list_type'} ) {
$patterns_match = 1;
- my $rpatterns_m = $line_m->get_rpatterns();
- my $rpatterns = $line->get_rpatterns();
+ my $rpatterns_m = $line_m->{'rpatterns'};
+ my $rpatterns = $line->{'rpatterns'};
foreach my $i ( 0 .. $imax_min ) {
my $pat = $rpatterns->[$i];
my $pat_m = $rpatterns_m->[$i];
( $jbeg, $jend, $istop ) = @{$item};
$line = $rlines->[$jbeg];
- $rtokens = $line->get_rtokens();
- $imax = $line->get_jmax() - 2;
+ $rtokens = $line->{'rtokens'};
+ $imax = $line->{'jmax'} - 2;
$istop = -1 unless ( defined($istop) );
$istop = $imax if ( $istop > $imax );
# Special treatment of two one-line groups isolated from other lines,
# unless they form a simple list or a terminal match. Otherwise the
# alignment can look strange in some cases.
- my $list_type = $rlines->[$jbeg]->get_list_type();
+ my $list_type = $rlines->[$jbeg]->{'list_type'};
if (
$jend == $jbeg
&& $jend_m == $jbeg_m
&& ( $ng == 1 || $istop_mm < 0 )
&& ( $ng == $ng_max || $istop < 0 )
- && !$line->get_j_terminal_match()
+ && !$line->{'j_terminal_match'}
# Only do this for imperfect matches. This is normally true except
# when two perfect matches cannot form a group because the line
# $blocking_level[$nj is the level at a match failure between groups
# $ng-1 and $ng
my @blocking_level;
- my $group_list_type = $rlines->[0]->get_list_type();
+ my $group_list_type = $rlines->[0]->{'list_type'};
my $move_to_common_column = sub {
# (the first line). All of the rest will be changed
# automatically.
my $line = $rlines->[$ix_beg];
- my $jmax = $line->get_jmax();
+ my $jmax = $line->{'jmax'};
# the maximum space without exceeding the line length:
my $avail = $line->get_available_space_on_right();
return unless ( defined($line_obj) && defined($ridel) && @{$ridel} );
- my $jmax_old = $line_obj->get_jmax();
- my $rfields_old = $line_obj->get_rfields();
- my $rfield_lengths_old = $line_obj->get_rfield_lengths();
- my $rpatterns_old = $line_obj->get_rpatterns();
- my $rtokens_old = $line_obj->get_rtokens();
- my $j_terminal_match = $line_obj->get_j_terminal_match();
+ my $jmax_old = $line_obj->{'jmax'};
+ my $rfields_old = $line_obj->{'rfields'};
+ my $rfield_lengths_old = $line_obj->{'rfield_lengths'};
+ my $rpatterns_old = $line_obj->{'rpatterns'};
+ my $rtokens_old = $line_obj->{'rtokens'};
+ my $j_terminal_match = $line_obj->{'j_terminal_match'};
use constant EXPLAIN_DELETE_SELECTED => 0;
#f 0 1 2 3 <- field and pattern
my $jmax_new = @{$rfields_new} - 1;
- $line_obj->set_rtokens($rtokens_new);
- $line_obj->set_rpatterns($rpatterns_new);
- $line_obj->set_rfields($rfields_new);
- $line_obj->set_rfield_lengths($rfield_lengths_new);
- $line_obj->set_jmax($jmax_new);
+ $line_obj->{'rtokens'} = $rtokens_new;
+ $line_obj->{'rpatterns'} = $rpatterns_new;
+ $line_obj->{'rfields'} = $rfields_new;
+ $line_obj->{'rfield_lengths'} = $rfield_lengths_new;
+ $line_obj->{'jmax'} = $jmax_new;
# The value of j_terminal_match will be incorrect if we delete tokens prior
# to it. We will have to give up on aligning the terminal tokens if this
# happens.
if ( defined($j_terminal_match) && $jmin_del <= $j_terminal_match ) {
- $line_obj->set_j_terminal_match(undef);
+ $line_obj->{'j_terminal_match'} = undef;
}
# update list type -
- if ( $line_obj->get_list_seqno() ) {
+ if ( $line_obj->{'list_seqno'} ) {
## This works, but for efficiency see if we need to make a change:
## decide_if_list($line_obj);
# An existing list will still be a list but with possibly different
# leading token
- my $old_list_type = $line_obj->get_list_type();
+ my $old_list_type = $line_obj->{'list_type'};
my $new_list_type = EMPTY_STRING;
if ( $rtokens_new->[0] =~ /^(=>|,)/ ) {
$new_list_type = $rtokens_new->[0];
# Handle a single line
if ( @{$rlines} == 1 ) {
my $line = $rlines->[0];
- my $jmax = $line->get_jmax();
- my $length = $line->get_rfield_lengths()->[$jmax];
+ my $jmax = $line->{'jmax'};
+ my $length = $line->{'rfield_lengths'}->[$jmax];
$saw_side_comment = $length > 0;
return ( $max_lev_diff, $saw_side_comment );
}
- my $has_terminal_match = $rlines->[-1]->get_j_terminal_match();
+ my $has_terminal_match = $rlines->[-1]->{'j_terminal_match'};
# ignore hanging side comments in these operations
- my @filtered = grep { !$_->get_is_hanging_side_comment() } @{$rlines};
+ my @filtered = grep { !$_->{'is_hanging_side_comment'} } @{$rlines};
my $rnew_lines = \@filtered;
$saw_side_comment = @filtered != @{$rlines};
my $rline_hashes = [];
foreach my $line ( @{$rnew_lines} ) {
my $rhash = {};
- my $rtokens = $line->get_rtokens();
- my $rpatterns = $line->get_rpatterns();
+ my $rtokens = $line->{'rtokens'};
+ my $rpatterns = $line->{'rpatterns'};
my $i = 0;
my ( $i_eq, $tok_eq, $pat_eq );
my ( $lev_min, $lev_max );
}
else {
if ( !$saw_side_comment ) {
- my $length = $line->get_rfield_lengths()->[ $i + 1 ];
+ my $length = $line->{'rfield_lengths'}->[ $i + 1 ];
$saw_side_comment ||= $length;
}
}
# Set a line break if no matching tokens between these lines
# (this is not strictly necessary now but does not hurt)
if ( $nr == 0 && $nl > 0 ) {
- $rnew_lines->[$jl]->set_end_group(1);
+ $rnew_lines->[$jl]->{'end_group'} = 1;
}
# Also set a line break if both lines have simple equals but with
if ( defined($i_eq_l) && defined($i_eq_r) ) {
# Also, do not align equals across a change in ci level
- my $ci_jump = $rnew_lines->[$jl]->get_ci_level() !=
- $rnew_lines->[$jr]->get_ci_level();
+ my $ci_jump = $rnew_lines->[$jl]->{'ci_level'} !=
+ $rnew_lines->[$jr]->{'ci_level'};
if (
$tok_eq_l eq $tok_eq_r
|| $ci_jump )
)
{
- $rnew_lines->[$jl]->set_end_group(1);
+ $rnew_lines->[$jl]->{'end_group'} = 1;
}
}
}
my @subgroups;
push @subgroups, [ 0, $jmax ];
foreach my $jl ( 0 .. $jmax - 1 ) {
- if ( $rnew_lines->[$jl]->get_end_group() ) {
+ if ( $rnew_lines->[$jl]->{'end_group'} ) {
$subgroups[-1]->[1] = $jl;
push @subgroups, [ $jl + 1, $jmax ];
}
foreach my $jj ( $jbeg .. $jend ) {
my %seen;
my $line = $rnew_lines->[$jj];
- my $rtokens = $line->get_rtokens();
+ my $rtokens = $line->{'rtokens'};
foreach my $tok ( @{$rtokens} ) {
if ( !$seen{$tok} ) {
$seen{$tok}++;
#####################################################
foreach my $jj ( $jbeg .. $jend ) {
my $line = $rnew_lines->[$jj];
- my $rtokens = $line->get_rtokens();
+ my $rtokens = $line->{'rtokens'};
my $rhash = $rline_hashes->[$jj];
my $i_eq = $equals_info[$jj]->[0];
my @idel;
unless (
(
$j_match_beg > $jbeg
- && $rnew_lines->[ $j_match_beg - 1 ]->get_rtokens()->[0] eq
- $tok0
+ && $rnew_lines->[ $j_match_beg - 1 ]->{'rtokens'}->[0] eq $tok0
)
|| ( $j_match_end < $jend
- && $rnew_lines->[ $j_match_end + 1 ]->get_rtokens()->[0] eq
+ && $rnew_lines->[ $j_match_end + 1 ]->{'rtokens'}->[0] eq
$tok0 )
);
foreach my $jj ( $jbeg .. $jend ) {
my $line = $rnew_lines->[$jj];
- $rtokens = $line->get_rtokens();
- $rfield_lengths = $line->get_rfield_lengths();
+ $rtokens = $line->{'rtokens'};
+ $rfield_lengths = $line->{'rfield_lengths'};
$imax = @{$rtokens} - 2;
# start a new match group
$ci_level_m = $ci_level;
$line = $rnew_lines->[$jj];
- $rtokens = $line->get_rtokens();
- $rpatterns = $line->get_rpatterns();
- $rfield_lengths = $line->get_rfield_lengths();
+ $rtokens = $line->{'rtokens'};
+ $rpatterns = $line->{'rpatterns'};
+ $rfield_lengths = $line->{'rfield_lengths'};
$imax = @{$rtokens} - 2;
- $list_type = $line->get_list_type();
- $ci_level = $line->get_ci_level();
+ $list_type = $line->{'list_type'};
+ $ci_level = $line->{'ci_level'};
# nothing to do for first line
next if ( $jj == $jbeg );
#################################
# No match to hanging side comment
#################################
- if ( $line->get_is_hanging_side_comment() ) {
+ if ( $line->{'is_hanging_side_comment'} ) {
# Should not get here; HSC's have been filtered out
$imax_align = -1;
$imax_align = $i_nomatch - 1;
}
- $line_m->set_imax_pair($imax_align);
+ $line_m->{'imax_pair'} = $imax_align;
} ## end loop over lines
# Put fence at end of subgroup
- $line->set_imax_pair(-1);
+ $line->{'imax_pair'} = -1;
} ## end loop over subgroups
if ( @{$rlines} > @{$rnew_lines} ) {
my $last_pair_info = -1;
foreach my $line ( @{$rlines} ) {
- if ( $line->get_is_hanging_side_comment() ) {
- $line->set_imax_pair($last_pair_info);
+ if ( $line->{'is_hanging_side_comment'} ) {
+ $line->{'imax_pair'} = $last_pair_info;
}
else {
- $last_pair_info = $line->get_imax_pair();
+ $last_pair_info = $line->{'imax_pair'};
}
}
}
my $all_monotonic = 1;
foreach my $jj ( 0 .. @{$rlines} - 1 ) {
my ($line) = $rlines->[$jj];
- my $rtokens = $line->get_rtokens();
+ my $rtokens = $line->{'rtokens'};
my $last_lev;
my $is_monotonic = 1;
my $i = -1;
foreach my $jj ( 0 .. @{$rlines} - 1 ) {
my ($line) = $rlines->[$jj];
- my $rtokens = $line->get_rtokens();
+ my $rtokens = $line->{'rtokens'};
my $i = -1;
my ( $lev_min, $lev_max );
my $token_pattern_max = EMPTY_STRING;
}
# End groups if a hard flag has been set
- elsif ( $rlines->[$jm]->get_end_group() ) {
+ elsif ( $rlines->[$jm]->{'end_group'} ) {
my $n_parent;
$end_node->( 0, $jm, $n_parent );
}
# Continue at hanging side comment
- elsif ( $rlines->[$jp]->get_is_hanging_side_comment() ) {
+ elsif ( $rlines->[$jp]->{'is_hanging_side_comment'} ) {
next;
}
foreach my $jj ( $jbeg .. $jend ) {
my $line = $rlines->[$jj];
my @idel;
- my $rtokens = $line->get_rtokens();
+ my $rtokens = $line->{'rtokens'};
my $imax = @{$rtokens} - 2;
foreach my $i ( 0 .. $imax ) {
my $tok = $rtokens->[$i];
my $is_marginal = 0;
# always keep alignments of a terminal else or ternary
- goto RETURN if ( defined( $line_1->get_j_terminal_match() ) );
+ goto RETURN if ( defined( $line_1->{'j_terminal_match'} ) );
# always align lists
- my $group_list_type = $line_0->get_list_type();
+ my $group_list_type = $line_0->{'list_type'};
goto RETURN if ($group_list_type);
# always align hanging side comments
- my $is_hanging_side_comment = $line_1->get_is_hanging_side_comment();
+ my $is_hanging_side_comment = $line_1->{'is_hanging_side_comment'};
goto RETURN if ($is_hanging_side_comment);
- my $jmax_0 = $line_0->get_jmax();
- my $jmax_1 = $line_1->get_jmax();
- my $rtokens_1 = $line_1->get_rtokens();
- my $rtokens_0 = $line_0->get_rtokens();
- my $rfield_lengths_0 = $line_0->get_rfield_lengths();
- my $rfield_lengths_1 = $line_1->get_rfield_lengths();
- my $rpatterns_0 = $line_0->get_rpatterns();
- my $rpatterns_1 = $line_1->get_rpatterns();
- my $imax_next = $line_1->get_imax_pair();
+ my $jmax_0 = $line_0->{'jmax'};
+ my $jmax_1 = $line_1->{'jmax'};
+ my $rtokens_1 = $line_1->{'rtokens'};
+ my $rtokens_0 = $line_0->{'rtokens'};
+ my $rfield_lengths_0 = $line_0->{'rfield_lengths'};
+ my $rfield_lengths_1 = $line_1->{'rfield_lengths'};
+ my $rpatterns_0 = $line_0->{'rpatterns'};
+ my $rpatterns_1 = $line_1->{'rpatterns'};
+ my $imax_next = $line_1->{'imax_pair'};
# We will scan the alignment tokens and set a flag '$is_marginal' if
# it seems that the an alignment would look bad.
my $pad = $rfield_lengths_1->[$j] - $rfield_lengths_0->[$j];
if ( $j == 0 ) {
- $pad += $line_1->get_leading_space_count() -
- $line_0->get_leading_space_count();
+ $pad += $line_1->{'leading_space_count'} -
+ $line_0->{'leading_space_count'};
# Remember the pad at a leading equals
if ( $raw_tok eq '=' && $lev == $group_level ) {
return 0 unless ( @{$rlines} && @{$rgroups} );
- my $object = $rlines->[0]->get_indentation();
+ my $object = $rlines->[0]->{'indentation'};
return 0 unless ( ref($object) );
my $extra_leading_spaces = 0;
my $extra_indentation_spaces_wanted = get_recoverable_spaces($object);
next if ( $j == 0 );
# all indentation objects must be the same
- if ( $object != $rlines->[$j]->get_indentation() ) {
+ if ( $object != $rlines->[$j]->{'indentation'} ) {
return 0;
}
}
# Return true to keep old comment location
# Return false to forget old comment location
- my $rfields = $line->get_rfields();
- my $is_hanging_side_comment = $line->get_is_hanging_side_comment();
+ my $rfields = $line->{'rfields'};
+ my $is_hanging_side_comment = $line->{'is_hanging_side_comment'};
# RULE1: Never forget comment before a hanging side comment
goto KEEP if ($is_hanging_side_comment);
my ( $jbeg, $jend ) = @{$item};
foreach my $j ( $jbeg .. $jend ) {
my $line = $rlines->[$j];
- my $jmax = $line->get_jmax();
- if ( $line->get_rfield_lengths()->[$jmax] ) {
+ my $jmax = $line->{'jmax'};
+ if ( $line->{'rfield_lengths'}->[$jmax] ) {
# this group has a line with a side comment
push @todo, $ng;
my $ldiff = $jj - $j_sc_beg;
last if ( $ldiff > 5 );
my $line = $rlines->[$jj];
- my $jmax = $line->get_jmax();
- my $sc_len = $line->get_rfield_lengths()->[$jmax];
+ my $jmax = $line->{'jmax'};
+ my $sc_len = $line->{'rfield_lengths'}->[$jmax];
next unless ($sc_len);
$num5++;
}
# Note that since all lines in a group have common alignments, we
# just have to work on one of the lines (the first line).
my $line = $rlines->[$jbeg];
- my $jmax = $line->get_jmax();
- my $is_hanging_side_comment = $line->get_is_hanging_side_comment();
+ my $jmax = $line->{'jmax'};
+ my $is_hanging_side_comment = $line->{'is_hanging_side_comment'};
last
if ( $PASS < $MAX_PASS && $is_hanging_side_comment );
my ( $jbeg, $jend ) = @{ $rgroups->[$ng_last] };
foreach my $jj ( reverse( $jbeg .. $jend ) ) {
my $line = $rlines->[$jj];
- my $jmax = $line->get_jmax();
- if ( $line->get_rfield_lengths()->[$jmax] ) {
+ my $jmax = $line->{'jmax'};
+ if ( $line->{'rfield_lengths'}->[$jmax] ) {
$j_sc_last = $jj;
last;
}
my $level = $rinput_hash->{level};
my $maximum_line_length = $rinput_hash->{maximum_line_length};
- my $rfields = $line->get_rfields();
- my $rfield_lengths = $line->get_rfield_lengths();
- my $leading_space_count = $line->get_leading_space_count();
- my $outdent_long_lines = $line->get_outdent_long_lines();
- my $maximum_field_index = $line->get_jmax();
- my $rvertical_tightness_flags = $line->get_rvertical_tightness_flags();
- my $Kend = $line->get_Kend();
- my $level_end = $line->get_level_end();
+ my $rfields = $line->{'rfields'};
+ my $rfield_lengths = $line->{'rfield_lengths'};
+ my $leading_space_count = $line->{'leading_space_count'};
+ my $outdent_long_lines = $line->{'outdent_long_lines'};
+ my $maximum_field_index = $line->{'jmax'};
+ my $rvertical_tightness_flags = $line->{'rvertical_tightness_flags'};
+ my $Kend = $line->{'Kend'};
+ my $level_end = $line->{'level_end'};
+
+ # Check for valid hash keys at end of lifetime of $line during development
+ DEVEL_MODE
+ && check_keys( $line, \%valid_LINE_keys,
+ "Checking line keys at valign_output_step_A", 1 );
# add any extra spaces
if ( $leading_space_count > $group_leader_length ) {
if ( !defined($imax_align) ) { $imax_align = -1 }
# First delete the unwanted tokens
- my $jmax_old = $line_0->get_jmax();
+ my $jmax_old = $line_0->{'jmax'};
my @old_alignments = $line_0->get_alignments();
my @idel = ( $imax_align + 1 .. $jmax_old - 2 );
@old_alignments[ 0 .. $imax_align ];
}
- my $jmax_new = $line_0->get_jmax();
+ my $jmax_new = $line_0->{'jmax'};
$new_alignments[ $jmax_new - 1 ] = $old_alignments[ $jmax_old - 1 ];
$new_alignments[$jmax_new] = $old_alignments[$jmax_old];
return;
}
1;
-
#####################################################################
#
-# the Perl::Tidy::VerticalAligner::Line class supplies an object to
-# contain a single output line
+# The Perl::Tidy::VerticalAligner::Line class supplies an object to
+# contain a single output line. It allows manipulation of the
+# alignment columns on that line.
#
#####################################################################
package Perl::Tidy::VerticalAligner::Line;
use strict;
use warnings;
+use English qw( -no_match_vars );
our $VERSION = '20220613.02';
-BEGIN {
-
- # Indexes for variables in $self.
- # Do not combine with other BEGIN blocks (c101).
- my $i = 0;
- use constant {
- _jmax_ => $i++,
- _rtokens_ => $i++,
- _rfields_ => $i++,
- _rfield_lengths_ => $i++,
- _rpatterns_ => $i++,
- _indentation_ => $i++,
- _leading_space_count_ => $i++,
- _outdent_long_lines_ => $i++,
- _list_seqno_ => $i++,
- _list_type_ => $i++,
- _is_hanging_side_comment_ => $i++,
- _ralignments_ => $i++,
- _maximum_line_length_ => $i++,
- _rvertical_tightness_flags_ => $i++,
- _is_terminal_ternary_ => $i++,
- _j_terminal_match_ => $i++,
- _end_group_ => $i++,
- _Kend_ => $i++,
- _ci_level_ => $i++,
- _level_ => $i++,
- _level_end_ => $i++,
- _imax_pair_ => $i++,
- };
-}
-
sub AUTOLOAD {
# Catch any undefined sub calls so that we are sure to get
{
- ##use Carp;
-
# Constructor may be called as a class method
sub new {
my ( $class, $ri ) = @_;
- my $self = bless [], $class;
-
- $self->[_jmax_] = $ri->{jmax};
- $self->[_rtokens_] = $ri->{rtokens};
- $self->[_rfields_] = $ri->{rfields};
- $self->[_rfield_lengths_] = $ri->{rfield_lengths};
- $self->[_rpatterns_] = $ri->{rpatterns};
- $self->[_indentation_] = $ri->{indentation};
- $self->[_leading_space_count_] = $ri->{leading_space_count};
- $self->[_outdent_long_lines_] = $ri->{outdent_long_lines};
- $self->[_list_type_] = $ri->{list_type};
- $self->[_list_seqno_] = $ri->{list_seqno};
- $self->[_is_hanging_side_comment_] = $ri->{is_hanging_side_comment};
- $self->[_maximum_line_length_] = $ri->{maximum_line_length};
- $self->[_rvertical_tightness_flags_] = $ri->{rvertical_tightness_flags};
- $self->[_is_terminal_ternary_] = $ri->{is_terminal_ternary};
- $self->[_j_terminal_match_] = $ri->{j_terminal_match};
- $self->[_end_group_] = $ri->{end_group};
- $self->[_Kend_] = $ri->{Kend};
- $self->[_ci_level_] = $ri->{ci_level};
- $self->[_level_] = $ri->{level};
- $self->[_level_end_] = $ri->{level_end};
- $self->[_imax_pair_] = $ri->{imax_pair};
-
- $self->[_ralignments_] = [];
-
+ my $self = bless $ri, $class;
return $self;
}
- sub get_jmax { return $_[0]->[_jmax_] }
-
- sub get_rtokens { return $_[0]->[_rtokens_] }
- sub get_rfields { return $_[0]->[_rfields_] }
- sub get_rfield_lengths { return $_[0]->[_rfield_lengths_] }
- sub get_rpatterns { return $_[0]->[_rpatterns_] }
- sub get_indentation { return $_[0]->[_indentation_] }
- sub get_Kend { return $_[0]->[_Kend_] }
- sub get_ci_level { return $_[0]->[_ci_level_] }
- sub get_level { return $_[0]->[_level_] }
- sub get_level_end { return $_[0]->[_level_end_] }
- sub get_list_seqno { return $_[0]->[_list_seqno_] }
-
- sub get_imax_pair { return $_[0]->[_imax_pair_] }
-
- sub set_imax_pair {
- my ( $self, $val ) = @_;
- $self->[_imax_pair_] = $val;
- return;
- }
-
- sub get_j_terminal_match {
- return $_[0]->[_j_terminal_match_];
- }
-
- sub set_j_terminal_match {
- my ( $self, $val ) = @_;
- $self->[_j_terminal_match_] = $val;
+ sub set_alignment {
+ my ( $self, $j, $val ) = @_;
+ $self->{ralignments}->[$j] = $val;
return;
}
- sub get_is_terminal_ternary {
- return $_[0]->[_is_terminal_ternary_];
- }
-
- sub get_leading_space_count {
- return $_[0]->[_leading_space_count_];
- }
-
- sub get_outdent_long_lines {
- return $_[0]->[_outdent_long_lines_];
- }
- sub get_list_type { return $_[0]->[_list_type_] }
-
- sub get_is_hanging_side_comment {
- return $_[0]->[_is_hanging_side_comment_];
- }
-
- sub get_maximum_line_length {
- return $_[0]->[_maximum_line_length_];
- }
-
- sub get_rvertical_tightness_flags {
- return $_[0]->[_rvertical_tightness_flags_];
- }
-
- sub get_alignment {
- my ( $self, $j ) = @_;
- return $self->[_ralignments_]->[$j];
- }
- sub get_alignments { return @{ $_[0]->[_ralignments_] } }
+ sub get_alignments { return @{ $_[0]->{ralignments} } }
+ # This sub is called many times and has been optimized a bit
sub get_column {
##my ( $self, $j ) = @_;
- my $alignment = $_[0]->[_ralignments_]->[ $_[1] ];
+ my $alignment = $_[0]->{ralignments}->[ $_[1] ];
return unless defined($alignment);
return $alignment->get_column();
}
sub set_alignments {
my ( $self, @args ) = @_;
- @{ $self->[_ralignments_] } = @args;
+ @{ $self->{ralignments} } = @args;
return;
}
my $col_j = 0;
my $col_jm = 0;
- my $alignment_j = $self->[_ralignments_]->[$j];
+ my $alignment_j = $self->{ralignments}->[$j];
$col_j = $alignment_j->get_column() if defined($alignment_j);
if ( $j > 0 ) {
- my $alignment_jm = $self->[_ralignments_]->[ $j - 1 ];
+ my $alignment_jm = $self->{ralignments}->[ $j - 1 ];
$col_jm = $alignment_jm->get_column() if defined($alignment_jm);
}
return $col_j - $col_jm;
sub increase_field_width {
my ( $self, $j, $pad ) = @_;
- my $jmax = $self->[_jmax_];
+ my $jmax = $self->{jmax};
foreach ( $j .. $jmax ) {
- my $alignment = $self->[_ralignments_]->[$_];
+ my $alignment = $self->{ralignments}->[$_];
if ( defined($alignment) ) {
$alignment->increment_column($pad);
}
}
sub get_available_space_on_right {
- my $jmax = $_[0]->[_jmax_];
- return $_[0]->[_maximum_line_length_] - $_[0]->get_column($jmax);
- }
-
- sub set_jmax { my ( $self, $val ) = @_; $self->[_jmax_] = $val; return }
-
- sub set_rtokens {
- my ( $self, $val ) = @_;
- $self->[_rtokens_] = $val;
- return;
- }
-
- sub set_rfields {
- my ( $self, $val ) = @_;
- $self->[_rfields_] = $val;
- return;
- }
-
- sub set_rfield_lengths {
- my ( $self, $val ) = @_;
- $self->[_rfield_lengths_] = $val;
- return;
- }
-
- sub set_rpatterns {
- my ( $self, $val ) = @_;
- $self->[_rpatterns_] = $val;
- return;
- }
-
- sub set_list_type {
- my ( $self, $val ) = @_;
- $self->[_list_type_] = $val;
- return;
- }
-
- sub set_is_hanging_side_comment {
- my ( $self, $val ) = @_;
- $self->[_is_hanging_side_comment_] = $val;
- return;
- }
-
- sub set_alignment {
- my ( $self, $j, $val ) = @_;
- $self->[_ralignments_]->[$j] = $val;
- return;
- }
-
- sub get_end_group { return $_[0]->[_end_group_] }
-
- sub set_end_group {
- my ( $self, $val ) = @_;
- $self->[_end_group_] = $val;
- return;
+ my $jmax = $_[0]->{jmax};
+ return $_[0]->{maximum_line_length} - $_[0]->get_column($jmax);
}
}
projects / perltidy.git / commitdiff