+ }
+ $K_start_multiline_qw = undef;
+
+ # Find the terminal token, before any side comment
+ my $K_terminal = $K_last;
+ if ($has_comment) {
+ $K_terminal -= 1;
+ $K_terminal -= 1
+ if ( $rLL->[$K_terminal]->[_TYPE_] eq 'b'
+ && $K_terminal > $K_first );
+ }
+
+ # Use length to terminal comma if interrupded list rule applies
+ if ( @stack && $stack[-1]->[_interrupted_list_rule_] ) {
+ my $K_c = $stack[-1]->[_K_c_];
+ if (
+ defined($K_c)
+ && $rLL->[$K_terminal]->[_TYPE_] eq ','
+
+ # Ignore a terminal comma, causes instability (b1297)
+ && ( $K_c - $K_terminal > 2
+ || $rLL->[ $K_terminal + 1 ]->[_TYPE_] eq 'b' )
+ )
+ {
+ my $Kend = $K_terminal;
+
+ # This caused an instability in b1311 by making the result
+ # dependent on input. It is not really necessary because the
+ # comment length is added at the end of the loop.
+ ##if ( $has_comment
+ ## && !$rOpts_ignore_side_comment_lengths )
+ ##{
+ ## $Kend = $K_last;
+ ##}
+
+ $len = $rLL->[$Kend]->[_CUMULATIVE_LENGTH_] -
+ $rLL->[ $K_first - 1 ]->[_CUMULATIVE_LENGTH_];
+
+ if ( $len > $max_prong_len ) { $max_prong_len = $len }
+ }
+ }
+
+ # Loop over tokens on this line ...
+ foreach my $KK ( $K_begin_loop .. $K_terminal ) {
+
+ my $type = $rLL->[$KK]->[_TYPE_];
+ next if ( $type eq 'b' );
+
+ #------------------------
+ # Handle sequenced tokens
+ #------------------------
+ my $seqno = $rLL->[$KK]->[_TYPE_SEQUENCE_];
+ if ($seqno) {
+
+ my $token = $rLL->[$KK]->[_TOKEN_];
+
+ #----------------------------
+ # Entering a new container...
+ #----------------------------
+ if ( $is_opening_token{$token} ) {
+
+ # save current prong length
+ $stack[-1]->[_max_prong_len_] = $max_prong_len;
+ $max_prong_len = 0;
+
+ # Start new prong one level deeper
+ my $handle_len = 0;
+ if ( $rblock_type_of_seqno->{$seqno} ) {
+
+ # code blocks do not use -lp indentation, but behave as
+ # if they had a handle of one indentation length
+ $handle_len = $rOpts_indent_columns;
+
+ }
+ elsif ( $is_handle_type{$last_nonblank_type} ) {
+ $handle_len = $len;
+ $handle_len += 1
+ if ( $KK > 0 && $rLL->[ $KK - 1 ]->[_TYPE_] eq 'b' );
+ }
+
+ # Set a flag if the 'Interrupted List Rule' will be applied
+ # (see sub copy_old_breakpoints).
+ # - Added check on has_broken_list to fix issue b1298
+
+ my $interrupted_list_rule =
+ $ris_permanently_broken->{$seqno}
+ && $ris_list_by_seqno->{$seqno}
+ && !$rhas_broken_list->{$seqno}
+ && !$rOpts_ignore_old_breakpoints;
+
+ # NOTES: Since we are looking at old line numbers we have
+ # to be very careful not to introduce an instability.
+
+ # This following causes instability (b1288-b1296):
+ # $interrupted_list_rule ||=
+ # $rOpts_break_at_old_comma_breakpoints;
+
+ # - We could turn off the interrupted list rule if there is
+ # a broken sublist, to follow 'Compound List Rule 1'.
+ # - We could use the _rhas_broken_list_ flag for this.
+ # - But it seems safer not to do this, to avoid
+ # instability, since the broken sublist could be
+ # temporary. It seems better to let the formatting
+ # stabilize by itself after one or two iterations.
+ # - So, not doing this for now
+
+ # Include length to a comma ending this line
+ if ( $interrupted_list_rule
+ && $rLL->[$K_terminal]->[_TYPE_] eq ',' )
+ {
+ my $Kend = $K_terminal;
+ if ( $Kend < $K_last
+ && !$rOpts_ignore_side_comment_lengths )
+ {
+ $Kend = $K_last;
+ }
+
+ # Measure from the next blank if any (fixes b1301)
+ my $Kbeg = $KK;
+ if ( $rLL->[ $Kbeg + 1 ]->[_TYPE_] eq 'b'
+ && $Kbeg < $Kend )
+ {
+ $Kbeg++;
+ }
+
+ my $len = $rLL->[$Kend]->[_CUMULATIVE_LENGTH_] -
+ $rLL->[$Kbeg]->[_CUMULATIVE_LENGTH_];
+ if ( $len > $max_prong_len ) { $max_prong_len = $len }
+ }
+
+ my $K_c = $K_closing_container->{$seqno};
+
+ push @stack,
+ [
+ $max_prong_len, $handle_len,
+ $seqno, $iline,
+ $KK, $K_c,
+ $interrupted_list_rule
+ ];
+ }
+
+ #--------------------
+ # Exiting a container
+ #--------------------
+ elsif ( $is_closing_token{$token} ) {
+ if (@stack) {
+
+ # The current prong ends - get its handle
+ my $item = pop @stack;
+ my $handle_len = $item->[_handle_len_];
+ my $seqno_o = $item->[_seqno_o_];
+ my $iline_o = $item->[_iline_o_];
+ my $K_o = $item->[_K_o_];
+ my $K_c_expect = $item->[_K_c_];
+ my $collapsed_len = $max_prong_len;
+
+ if ( $seqno_o ne $seqno ) {
+
+ # Shouldn't happen - must have skipped some lines.
+ # Not fatal but -lp formatting could get messed up.
+ if (DEVEL_MODE) {
+ Fault(<<EOM);
+sequence numbers differ; at CLOSING line $iline, seq=$seqno, Kc=$KK .. at OPENING line $iline_o, seq=$seqno_o, Ko=$K_o, expecting Kc=$K_c_expect
+EOM
+ }
+ }
+
+ #------------------------------------------
+ # Rules to avoid scrunching code blocks ...
+ #------------------------------------------
+ # Some test cases:
+ # c098/x107 x108 x110 x112 x114 x115 x117 x118 x119
+ if ( $rblock_type_of_seqno->{$seqno} ) {
+
+ my $K_c = $KK;
+ my $block_length = MIN_BLOCK_LEN;
+ my $is_one_line_block;
+ my $level = $rLL->[$K_o]->[_LEVEL_];
+ if ( defined($K_o) && defined($K_c) ) {
+ my $block_length =
+ $rLL->[ $K_c - 1 ]->[_CUMULATIVE_LENGTH_] -
+ $rLL->[$K_o]->[_CUMULATIVE_LENGTH_];
+ $is_one_line_block = $iline == $iline_o;
+ }
+
+ # Code block rule 1: Use the total block length if
+ # it is less than the minimum.
+ if ( $block_length < MIN_BLOCK_LEN ) {
+ $collapsed_len = $block_length;
+ }
+
+ # Code block rule 2: Use the full length of a
+ # one-line block to avoid breaking it, unless
+ # extremely long. We do not need to do a precise
+ # check here, because if it breaks then it will
+ # stay broken on later iterations.
+ elsif ($is_one_line_block
+ && $block_length <
+ $maximum_line_length_at_level[$level] )
+ {
+ $collapsed_len = $block_length;
+ }
+
+ # Code block rule 3: Otherwise the length should be
+ # at least MIN_BLOCK_LEN to avoid scrunching code
+ # blocks.
+ elsif ( $collapsed_len < MIN_BLOCK_LEN ) {
+ $collapsed_len = MIN_BLOCK_LEN;
+ }
+ }
+
+ # Store the result. Some extra space, '2', allows for
+ # length of an opening token, inside space, comma, ...
+ # This constant has been tuned to give good overall
+ # results.
+ $collapsed_len += 2;
+ $rcollapsed_length_by_seqno->{$seqno} = $collapsed_len;
+
+ # Restart scanning the lower level prong
+ if (@stack) {
+ $max_prong_len = $stack[-1]->[_max_prong_len_];
+ $collapsed_len += $handle_len;
+ if ( $collapsed_len > $max_prong_len ) {
+ $max_prong_len = $collapsed_len;
+ }
+ }
+ }
+ }
+
+ # it is a ternary - no special processing for these yet
+ else {
+
+ }
+
+ $len = 0;
+ $last_nonblank_type = $type;
+ next;
+ }
+
+ #----------------------------
+ # Handle non-container tokens
+ #----------------------------
+ my $token_length = $rLL->[$KK]->[_TOKEN_LENGTH_];
+
+ # Count lengths of things like 'xx => yy' as a single item
+ if ( $type eq '=>' ) {
+ $len += $token_length + 1;
+ if ( $len > $max_prong_len ) { $max_prong_len = $len }
+ }
+ elsif ( $last_nonblank_type eq '=>' ) {
+ $len += $token_length;
+ if ( $len > $max_prong_len ) { $max_prong_len = $len }
+
+ # but only include one => per item
+ if ( $last_nonblank_type eq '=>' ) { $len = $token_length }
+ }
+
+ # include everthing to end of line after a here target
+ elsif ( $type eq 'h' ) {
+ $len = $rLL->[$K_last]->[_CUMULATIVE_LENGTH_] -
+ $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
+ if ( $len > $max_prong_len ) { $max_prong_len = $len }
+ }
+
+ # for everything else just use the token length
+ else {
+ $len = $token_length;
+ if ( $len > $max_prong_len ) { $max_prong_len = $len }
+ }
+ $last_nonblank_type = $type;
+
+ } ## end loop over tokens on this line
+
+ # Now take care of any side comment
+ if ($has_comment) {
+ if ($rOpts_ignore_side_comment_lengths) {
+ $len = 0;
+ }
+ else {
+
+ # For a side comment when -iscl is not set, measure length from
+ # the start of the previous nonblank token
+ my $len0 =
+ $K_terminal > 0
+ ? $rLL->[ $K_terminal - 1 ]->[_CUMULATIVE_LENGTH_]
+ : 0;
+ $len = $rLL->[$K_last]->[_CUMULATIVE_LENGTH_] - $len0;
+ if ( $len > $max_prong_len ) { $max_prong_len = $len }
+ }
+ }
+
+ } ## end loop over lines
+
+ if (DEBUG_COLLAPSED_LENGTHS) {
+ print "\nCollapsed lengths--\n";
+ foreach
+ my $key ( sort { $a <=> $b } keys %{$rcollapsed_length_by_seqno} )
+ {
+ my $clen = $rcollapsed_length_by_seqno->{$key};
+ print "$key -> $clen\n";
+ }
+ }
+
+ return;
+}
+
+sub is_excluded_lp {
+
+ # Decide if this container is excluded by user request:
+ # returns true if this token is excluded (i.e., may not use -lp)
+ # returns false otherwise
+
+ # The control hash can either describe:
+ # what to exclude: $line_up_parentheses_control_is_lxpl = 1, or
+ # what to include: $line_up_parentheses_control_is_lxpl = 0
+
+ my ( $self, $KK ) = @_;
+ my $rLL = $self->[_rLL_];
+ my $rtoken_vars = $rLL->[$KK];
+ my $token = $rtoken_vars->[_TOKEN_];
+ my $rflags = $line_up_parentheses_control_hash{$token};
+
+ #-----------------------------------------------
+ # TEST #1: check match to listed container types
+ #-----------------------------------------------
+ if ( !defined($rflags) ) {
+
+ # There is no entry for this container, so we are done
+ return !$line_up_parentheses_control_is_lxpl;
+ }
+
+ my ( $flag1, $flag2 ) = @{$rflags};
+
+ #-----------------------------------------------------------
+ # TEST #2: check match to flag1, the preceding nonblank word
+ #-----------------------------------------------------------
+ my $match_flag1 = !defined($flag1) || $flag1 eq '*';
+ if ( !$match_flag1 ) {
+
+ # Find the previous token
+ my ( $is_f, $is_k, $is_w );
+ my $Kp = $self->K_previous_nonblank($KK);
+ if ( defined($Kp) ) {
+ my $type_p = $rLL->[$Kp]->[_TYPE_];
+ my $seqno = $rtoken_vars->[_TYPE_SEQUENCE_];
+
+ # keyword?
+ $is_k = $type_p eq 'k';
+
+ # function call?
+ $is_f = $self->[_ris_function_call_paren_]->{$seqno};
+
+ # either keyword or function call?
+ $is_w = $is_k || $is_f;
+ }
+
+ # Check for match based on flag1 and the previous token:
+ if ( $flag1 eq 'k' ) { $match_flag1 = $is_k }
+ elsif ( $flag1 eq 'K' ) { $match_flag1 = !$is_k }
+ elsif ( $flag1 eq 'f' ) { $match_flag1 = $is_f }
+ elsif ( $flag1 eq 'F' ) { $match_flag1 = !$is_f }
+ elsif ( $flag1 eq 'w' ) { $match_flag1 = $is_w }
+ elsif ( $flag1 eq 'W' ) { $match_flag1 = !$is_w }
+ }
+
+ # See if we can exclude this based on the flag1 test...
+ if ($line_up_parentheses_control_is_lxpl) {
+ return 1 if ($match_flag1);
+ }
+ else {
+ return 1 if ( !$match_flag1 );
+ }
+
+ #-------------------------------------------------------------
+ # TEST #3: exclusion based on flag2 and the container contents
+ #-------------------------------------------------------------
+
+ # Note that this is an exclusion test for both -lpxl or -lpil input methods
+ # The options are:
+ # 0 or blank: ignore container contents
+ # 1 exclude non-lists or lists with sublists
+ # 2 same as 1 but also exclude lists with code blocks
+
+ my $match_flag2;
+ if ($flag2) {
+
+ my $seqno = $rtoken_vars->[_TYPE_SEQUENCE_];
+
+ my $is_list = $self->[_ris_list_by_seqno_]->{$seqno};
+ my $has_list = $self->[_rhas_list_]->{$seqno};
+ my $has_code_block = $self->[_rhas_code_block_]->{$seqno};
+ my $has_ternary = $self->[_rhas_ternary_]->{$seqno};
+
+ if ( !$is_list
+ || $has_list
+ || $flag2 eq '2' && ( $has_code_block || $has_ternary ) )
+ {
+ $match_flag2 = 1;
+ }
+ }
+ return $match_flag2;
+}
+
+sub set_excluded_lp_containers {
+
+ my ($self) = @_;
+ return unless ($rOpts_line_up_parentheses);
+ my $rLL = $self->[_rLL_];
+ return unless ( defined($rLL) && @{$rLL} );
+
+ my $K_opening_container = $self->[_K_opening_container_];
+ my $ris_excluded_lp_container = $self->[_ris_excluded_lp_container_];
+ my $rblock_type_of_seqno = $self->[_rblock_type_of_seqno_];
+
+ foreach my $seqno ( keys %{$K_opening_container} ) {
+
+ # code blocks are always excluded by the -lp coding so we can skip them
+ next if ( $rblock_type_of_seqno->{$seqno} );
+
+ my $KK = $K_opening_container->{$seqno};
+ next unless defined($KK);
+
+ # see if a user exclusion rule turns off -lp for this container
+ if ( $self->is_excluded_lp($KK) ) {
+ $ris_excluded_lp_container->{$seqno} = 1;
+ }
+ }
+ return;
+}
+
+######################################
+# CODE SECTION 6: Process line-by-line
+######################################
+
+sub process_all_lines {
+
+ #----------------------------------------------------------
+ # Main loop to format all lines of a file according to type
+ #----------------------------------------------------------
+
+ my $self = shift;
+ my $rlines = $self->[_rlines_];
+ my $sink_object = $self->[_sink_object_];
+ my $fh_tee = $self->[_fh_tee_];
+ my $rOpts_keep_old_blank_lines = $rOpts->{'keep-old-blank-lines'};
+ my $file_writer_object = $self->[_file_writer_object_];
+ my $logger_object = $self->[_logger_object_];
+ my $vertical_aligner_object = $self->[_vertical_aligner_object_];
+ my $save_logfile = $self->[_save_logfile_];
+
+ # Note for RT#118553, leave only one newline at the end of a file.
+ # Example code to do this is in comments below:
+ # my $Opt_trim_ending_blank_lines = 0;
+ # if ($Opt_trim_ending_blank_lines) {
+ # while ( my $line_of_tokens = pop @{$rlines} ) {
+ # my $line_type = $line_of_tokens->{_line_type};
+ # if ( $line_type eq 'CODE' ) {
+ # my $CODE_type = $line_of_tokens->{_code_type};
+ # next if ( $CODE_type eq 'BL' );
+ # }
+ # push @{$rlines}, $line_of_tokens;
+ # last;
+ # }
+ # }
+
+ # But while this would be a trivial update, it would have very undesirable
+ # side effects when perltidy is run from within an editor on a small snippet.
+ # So this is best done with a separate filter, such
+ # as 'delete_ending_blank_lines.pl' in the examples folder.
+
+ # Flag to prevent blank lines when POD occurs in a format skipping sect.
+ my $in_format_skipping_section;
+
+ # set locations for blanks around long runs of keywords
+ my $rwant_blank_line_after = $self->keyword_group_scan();
+
+ my $line_type = "";
+ my $i_last_POD_END = -10;
+ my $i = -1;
+ foreach my $line_of_tokens ( @{$rlines} ) {
+ $i++;
+
+ # insert blank lines requested for keyword sequences
+ if ( $i > 0
+ && defined( $rwant_blank_line_after->{ $i - 1 } )
+ && $rwant_blank_line_after->{ $i - 1 } == 1 )
+ {
+ $self->want_blank_line();