# a release anyway.
$VERSION = '20221112.05';
-}
+} ## end BEGIN
sub DESTROY {
_input_copied_verbatim_ => $i++,
_input_output_difference_ => $i++,
};
-}
+} ## end BEGIN
sub perltidy {
if ($flag) { goto ERROR_EXIT }
else { goto NORMAL_EXIT }
croak "unexpectd return to Exit";
- }
+ } ## end sub Exit
sub Die {
my $msg = shift;
Warn($msg);
Exit(1);
croak "unexpected return to Die";
- }
+ } ## end sub Die
sub Fault {
my ($msg) = @_;
# This return is to keep Perl-Critic from complaining.
return;
- }
+ } ## end sub Fault
# extract various dump parameters
my $dump_options_type = $input_hash{'dump_options_type'};
}
return ( $in_place_modify, $backup_extension, $delete_backup );
-}
+} ## end sub check_in_place_modify
sub backup_method_copy {
$x =~ s#\*#.*#g; # '*' -> '.*'
$x =~ s#\?#.#g; # '?' -> '.'
return "^$x\\z"; # match whole word
-}
+} ## end sub fileglob_to_re
sub make_logfile_header {
my ( $rOpts, $config_file, $rraw_options, $Windows_type, $readable_options )
}
$rOpts->{$option_name} = join SPACE, @filtered_word_list;
return \%seen;
-}
+} ## end sub cleanup_word_list
sub check_options {
&& ( $OSNAME ne 'VMS' )
&& ( $OSNAME ne 'OS2' )
&& ( $OSNAME ne 'MacOS' );
-}
+} ## end sub is_unix
sub look_for_Windows {
print STDOUT "Default command line options:\n";
foreach my $line ( sort @defaults ) { print STDOUT "$line\n" }
return;
-}
+} ## end sub dump_defaults
sub readable_options {
_fh => undef,
_is_encoded_data => $is_encoded_data,
}, $class;
-}
+} ## end sub new
sub really_open_debug_file {
$fh->print(
"Use -dump-token-types (-dtt) to get a list of token type codes\n");
return;
-}
+} ## end sub really_open_debug_file
sub close_debug_file {
}
}
return;
-}
+} ## end sub close_debug_file
sub write_debug_entry {
$fh->print("$token_str\n");
return;
-}
+} ## end sub write_debug_entry
1;
======================================================================
EOM
exit 1;
-}
+} ## end sub AUTOLOAD
sub DESTROY {
_K_last_arrival_ => $i++,
_save_logfile_ => $i++,
};
-}
+} ## end BEGIN
sub Die {
my ($msg) = @_;
# This return is to keep Perl-Critic from complaining.
return;
-}
+} ## end sub Fault
sub warning {
my ( $self, $msg ) = @_;
my $logger_object = $self->[_logger_object_];
if ($logger_object) { $logger_object->warning($msg); }
return;
-}
+} ## end sub warning
sub write_logfile_entry {
my ( $self, $msg ) = @_;
$logger_object->write_logfile_entry($msg);
}
return;
-}
+} ## end sub write_logfile_entry
sub new {
my ( $class, $line_sink_object, $rOpts, $logger_object ) = @_;
bless $self, $class;
return $self;
-}
+} ## end sub new
sub setup_convergence_test {
my ( $self, $rlist ) = @_;
$self->[_K_sequence_error_msg_] = EMPTY_STRING;
$self->[_K_last_arrival_] = -1;
return;
-}
+} ## end sub setup_convergence_test
sub get_convergence_check {
my ($self) = @_;
# converged if all K arrived and in correct order
return $self->[_K_arrival_order_matches_] && !@{$rlist};
-}
+} ## end sub get_convergence_check
sub get_output_line_number {
return $_[0]->[_output_line_number_];
$self->write_blank_code_line();
}
return;
-}
+} ## end sub want_blank_line
sub require_blank_code_lines {
$self->write_blank_code_line($forced);
}
return;
-}
+} ## end sub require_blank_code_lines
sub write_blank_code_line {
my ( $self, $forced ) = @_;
$self->[_consecutive_new_blank_lines_]++ if ($forced);
return;
-}
+} ## end sub write_blank_code_line
use constant MAX_PRINTED_CHARS => 80;
$self->[_K_last_arrival_] = $K;
}
return;
-}
+} ## end sub write_code_line
sub write_line {
my ( $self, $str ) = @_;
if ( $self->[_save_logfile_] ) { $self->check_line_lengths($str) }
return;
-}
+} ## end sub write_line
sub check_line_lengths {
my ( $self, $str ) = @_;
$self->[_line_length_error_count_]++;
}
return;
-}
+} ## end sub check_line_lengths
sub report_line_length_errors {
my $self = shift;
}
}
return;
-}
+} ## end sub report_line_length_errors
1;
# Number of token variables; must be last in list:
_NVARS => $i++,
};
-}
+} ## end BEGIN
BEGIN {
_LAST_SELF_INDEX_ => $i - 1,
};
-}
+} ## end BEGIN
BEGIN {
_ri_starting_one_line_block_ => $i++,
_runmatched_opening_indexes_ => $i++,
};
-}
+} ## end BEGIN
BEGIN {
push @obf, ',';
@is_other_brace_follower{@obf} = (1) x scalar(@obf);
-}
+} ## end BEGIN
{ ## begin closure to count instances
);
@valid_line_hash{@valid_line_keys} = (1) x scalar(@valid_line_keys);
- }
+ } ## end BEGIN
sub check_line_hashes {
my $self = shift;
$input_stream_name = $logger_object->get_input_stream_name();
}
return $input_stream_name;
- }
+ } ## end sub get_input_stream_name
# interface to Perl::Tidy::Logger routines
sub warning {
$logger_object->complain($msg);
}
return;
- }
+ } ## end sub complain
sub write_logfile_entry {
my @msg = @_;
$logger_object->write_logfile_entry(@msg);
}
return;
- }
+ } ## end sub write_logfile_entry
sub get_saw_brace_error {
if ($logger_object) {
return $logger_object->get_saw_brace_error();
}
return;
- }
+ } ## end sub get_saw_brace_error
sub we_are_at_the_last_line {
if ($logger_object) {
$logger_object->we_are_at_the_last_line();
}
return;
- }
+ } ## end sub we_are_at_the_last_line
} ## end closure for logger routines
$diagnostics_object->write_diagnostics($msg);
}
return;
- }
+ } ## end sub write_diagnostics
} ## end closure for diagnostics routines
sub get_convergence_check {
my $file_writer_object = $self->[_file_writer_object_];
$file_writer_object->want_blank_line();
return;
-}
+} ## end sub want_blank_line
sub write_unindented_line {
my ( $self, $line ) = @_;
my $file_writer_object = $self->[_file_writer_object_];
$file_writer_object->write_line($line);
return;
-}
+} ## end sub write_unindented_line
sub consecutive_nonblank_lines {
my ($self) = @_;
my $vao = $self->[_vertical_aligner_object_];
return $file_writer_object->get_consecutive_nonblank_lines() +
$vao->get_cached_line_count();
-}
+} ## end sub consecutive_nonblank_lines
sub split_words {
}
return;
-}
+} ## end sub initialize_space_after_keyword
sub initialize_token_break_preferences {
@q = qw( w i );
@is_wi{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
use constant DEBUG_WHITE => 0;
qw{ ? A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ };
@{is_special_variable_char}{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub is_essential_whitespace {
my $tok = $value->[0];
push @{ $is_leading_secret_token{$tok} }, $value;
}
- }
+ } ## end BEGIN
sub new_secret_operator_whitespace {
my ($pattern) = @_;
my $ok = eval "'##'=~/$pattern/";
return !defined($ok) || $EVAL_ERROR;
-}
+} ## end sub bad_pattern
{ ## begin closure prepare_cuddled_block_types
@q = (qw( and or xor if else elsif unless until while for foreach ));
@is_mccabe_logic_keyword{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub find_mccabe_count {
my ($self) = @_;
$self->write_unindented_line($input_line);
}
return;
-}
+} ## end sub dump_verbatim
my %wU;
my %wiq;
@q = qw( = == != );
@is_unexpected_equals{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
{ #<<< begin clousure respace_tokens
}
return;
-} ## end sub delete_trailing_comma
+} ## end sub delete_weld_interfering_comma
sub unstore_last_nonblank_token {
}
}
return 1;
-}
+} ## end sub unstore_last_nonblank_token
sub match_trailing_comma_rule {
}
}
return $match;
-}
+} ## end sub match_trailing_comma_rule
sub store_new_token {
my $parent_seqno = $self->parent_seqno_by_K($KK);
return unless defined($parent_seqno);
return $self->[_ris_list_by_seqno_]->{$parent_seqno};
-}
+} ## end sub is_list_by_K
sub is_list_by_seqno {
my ( $self, $seqno ) = @_;
return unless defined($seqno);
return $self->[_ris_list_by_seqno_]->{$seqno};
-}
+} ## end sub is_list_by_seqno
sub resync_lines_and_tokens {
}
}
return;
-}
+} ## end sub check_for_old_break
sub keep_old_line_breaks {
# these types do not 'like' to be separated from a following paren
@q = qw(w i q Q G C Z U);
@{has_tight_paren}{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
use constant DEBUG_WELD => 0;
_K_c_ => $i++,
_interrupted_list_rule_ => $i++,
};
-}
+} ## end BEGIN
sub is_fragile_block_type {
my ( $self, $block_type, $seqno ) = @_;
];
return;
- }
+ } ## end sub xlp_collapsed_lengths_initialize
sub cumulative_length_to_comma {
my ( $self, $KK, $K_comma, $K_closing ) = @_;
$next_parent_seqno = SEQ_ROOT;
$next_slevel = undef;
return;
- }
+ } ## end sub initialize_process_line_of_CODE
# Batch variables: these describe the current batch of code being formed
# and sent down the pipeline. They are initialized in the next
# call with no args to delete the current one-line block
($index_start_one_line_block) = @_;
return;
- }
+ } ## end sub create_one_line_block
# Routine to place the current token into the output stream.
# Called once per output token.
my $vao = $self->[_vertical_aligner_object_];
$vao->flush();
return;
- }
+ } ## end sub flush_vertical_aligner
# flush is called to output any tokens in the pipeline, so that
# an alternate source of lines can be written in the correct order
push @q, ',';
@break_before_or_after_token{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub set_fake_breakpoint {
# where to make them.
$forced_breakpoint_count++;
return;
- }
+ } ## end sub set_fake_breakpoint
use constant DEBUG_FORCE => 0;
$batch_count = 0;
%saved_opening_indentation = ();
return;
- }
+ } ## end sub initialize_grind_batch_of_CODE
# sub grind_batch_of_CODE receives sections of code which are the longest
# possible lines without a break. In other words, it receives what is left
$summed_lengths_to_go[ $_ + 1 ] += $tok_len;
}
return;
- }
+ } ## end sub unmask_phantom_token
sub save_opening_indentation {
# : "<A HREF=\"#item_" . htmlify( 0, $s2 ) . "\">$str</A>"
push @q, qw( or || ? : );
@{$ris_break_token}{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub in_same_container_i {
@q = qw( * / );
@is_mult_div{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub Debug_dump_breakpoints {
return if ( $tv > 2 );
}
return 1;
- }
+ } ## end sub simple_rhs
sub recombine_section_3 {
$self->insert_additional_breaks( \@insert_list, $ri_first, $ri_last );
}
return;
-}
+} ## end sub do_colon_breaks
###########################################
# CODE SECTION 11: Code to break long lists
my @q = qw< k R } ) ] Y Z U w i q Q .
= **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=>;
@is_uncontained_comma_break_included_type{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub do_uncontained_comma_breaks {
push @q, ',';
push @q, 'f'; # added for ';' for issue c154
@quick_filter{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub set_for_semicolon_breakpoints {
my ( $self, $dd ) = @_;
$self->set_forced_breakpoint($_);
}
return;
- }
+ } ## end sub set_for_semicolon_breakpoints
sub set_logical_breakpoints {
my ( $self, $dd ) = @_;
# because bad things can happen (map1.t)
my $dd = shift;
return $is_sort_map_grep{ $container_type[$dd] };
- }
+ } ## end sub is_unbreakable_container
sub break_lists {
@q = qw(eq ne le ge lt gt);
@{poor_keywords}{@q} = (1) x scalar(@q);
@{poor_next_keywords}{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub examine_old_breakpoint {
@q = qw<( [ { L R } ] ) = b>;
push @q, ',';
@is_key_type{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
use constant DEBUG_FIND_START => 0;
unshift
);
@is_keyword_with_special_leading_term{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
use constant DEBUG_SPARSE => 0;
$self->set_forced_breakpoint($i_true_last_comma);
}
return;
- }
+ } ## end sub apply_broken_sublist_rule
sub set_emergency_comma_breakpoints {
# let breaks be defined by default bond strength logic
}
return;
- }
+ } ## end sub set_emergency_comma_breakpoints
sub break_multiline_list {
my ( $self, $rhash_IN, $rhash_A, $i_opening_minus ) = @_;
}
}
return;
-}
+} ## end sub copy_old_breakpoints
sub set_nobreaks {
my ( $self, $i, $j ) = @_;
# with a get_spaces method.
my $indentation = shift;
return ref($indentation) ? $indentation->get_spaces() : $indentation;
-}
+} ## end sub get_spaces
sub get_recoverable_spaces {
# to get them to line up with their opening parens
my $indentation = shift;
return ref($indentation) ? $indentation->get_recoverable_spaces() : 0;
-}
+} ## end sub get_recoverable_spaces
sub get_available_spaces_to_go {
_lp_container_seqno_ => $i++,
_lp_space_count_ => $i++,
};
- }
+ } ## end BEGIN
sub initialize_lp_vars {
@hash_test2{@q} = (1) x scalar(@q);
@q = qw( . || && );
@hash_test3{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
# shared variables, re-initialized for each batch
my $rlp_object_list;
# eq and ne were removed from this list to improve alignment chances
@q = qw(if unless and or err for foreach while until);
@is_vertical_alignment_keyword{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
my $ralignment_type_to_go;
my $ralignment_counts;
}
return;
-}
+} ## end sub xlp_tweak
{ ## begin closure make_alignment_patterns
##'is_deeply' => 'is', # poor; names lengths too different
);
- }
+ } ## end BEGIN
sub make_alignment_patterns {
$last_unadjusted_indentation = 0;
$last_leading_token = EMPTY_STRING;
return;
- }
+ } ## end sub initialize_get_final_indentation
sub get_final_indentation {
$opening_exists,
);
- }
+ } ## end sub get_closing_token_indentation
} ## end closure get_final_indentation
sub get_opening_indentation {
# we can skip all calls to sub set_vertical_tightness_flags
$self->[_no_vertical_tightness_flags_] = 1;
return;
-}
+} ## end sub examine_vertical_tightness_flags
sub set_vertical_tightness_flags {
')' => '(',
']' => '[',
);
- }
+ } ## end BEGIN
sub balance_csc_text {
if ( !eval { require Pod::Html; 1 } ) {
$missing_pod_html = $EVAL_ERROR ? $EVAL_ERROR : 1;
}
-}
+} ## end BEGIN
sub AUTOLOAD {
======================================================================
EOM
exit 1;
-}
+} ## end sub AUTOLOAD
sub DESTROY {
# name changes
_rlast_level => \$last_level, # brace indentation level
}, $class;
-}
+} ## end sub new
sub close_object {
my ($object) = @_;
# returns true if close works, false if not
# failure probably means there is no close method
return eval { $object->close(); 1 };
-}
+} ## end sub close_object
sub add_toc_item {
TOC_END
}
return;
-}
+} ## end sub add_toc_item
BEGIN {
# my @list = qw" .. -> <> ... \ ? ";
# @token_long_names{@list} = ('misc-operators') x scalar(@list);
-}
+} ## end BEGIN
sub make_getopt_long_names {
my ( $class, $rgetopt_names ) = @_;
push @{$rgetopt_names}, "podheader!";
push @{$rgetopt_names}, "podindex!";
return;
-}
+} ## end sub make_getopt_long_names
sub make_abbreviated_names {
${$rexpansion}{"text"} = ["html-toc-extension"];
${$rexpansion}{"sext"} = ["html-src-extension"];
return;
-}
+} ## end sub make_abbreviated_names
sub check_options {
}
$missing_html_entities = 1 unless $rOpts->{'html-entities'};
return;
-}
+} ## end sub check_options
sub write_style_sheet_file {
write_style_sheet_data($fh);
close_object($fh);
return;
-}
+} ## end sub write_style_sheet_file
sub write_style_sheet_data {
$fh->print("} /* $long_name */\n");
}
return;
-}
+} ## end sub write_style_sheet_data
sub set_default_color {
if ( $rOpts->{$key} ) { $color = $rOpts->{$key} }
$rOpts->{$key} = check_RGB($color);
return;
-}
+} ## end sub set_default_color
sub check_RGB {
my ($color) = @_;
if ( $color =~ /^[0-9a-fA-F]{6,6}$/ ) { $color = "#$color" }
return $color;
-}
+} ## end sub check_RGB
sub set_default_properties {
my ( $short_name, $color, $bold, $italic ) = @_;
$key = "html-italic-$short_to_long_names{$short_name}";
$rOpts->{$key} = ( defined $rOpts->{$key} ) ? $rOpts->{$key} : $italic;
return;
-}
+} ## end sub set_default_properties
sub pod_to_html {
$self->make_frame( \@toc );
}
return $success_flag;
-}
+} ## end sub pod_to_html
sub make_frame {
$toc_basename, $src_basename, $src_frame_name
);
return;
-}
+} ## end sub make_frame
sub write_toc_html {
EOM
return;
-}
+} ## end sub write_toc_html
sub write_frame_html {
</html>
EOM
return;
-}
+} ## end sub write_frame_html
sub change_anchor_names {
}
}
return $first_anchor;
-}
+} ## end sub change_anchor_names
sub close_html_file {
my $self = shift;
$self->make_frame( \@toc );
}
return;
-}
+} ## end sub close_html_file
sub markup_tokens {
my ( $self, $rtokens, $rtoken_type, $rlevels ) = @_;
push @colored_tokens, $token;
}
return ( \@colored_tokens );
-}
+} ## end sub markup_tokens
sub markup_html_element {
my ( $self, $token, $type ) = @_;
if ( $html_bold{$short_name} ) { $token = "<b>$token</b>" }
}
return $token;
-}
+} ## end sub markup_html_element
sub escape_html {
HTML::Entities::encode_entities($token);
}
return $token;
-}
+} ## end sub escape_html
sub finish_formatting {
my $self = shift;
$self->close_html_file();
return;
-}
+} ## end sub finish_formatting
sub write_line {
# write the line
$html_pre_fh->print("$html_line\n");
return;
-}
+} ## end sub write_line
1;
#####################################################################
#
-# the Perl::Tidy::IndentationItem class supplies items which contain
+# The Perl::Tidy::IndentationItem class supplies items which contain
# how much whitespace should be used at the start of a line
#
#####################################################################
_standard_spaces_ => $i++,
_K_extra_space_ => $i++,
};
-}
+} ## end BEGIN
sub AUTOLOAD {
======================================================================
EOM
exit 1;
-}
+} ## end sub AUTOLOAD
sub DESTROY {
bless $self, $class;
return $self;
-}
+} ## end sub new
sub permanently_decrease_available_spaces {
$item->set_recoverable_spaces(0);
return $deleted_spaces;
-}
+} ## end sub permanently_decrease_available_spaces
sub tentatively_decrease_available_spaces {
$item->decrease_SPACES($deleted_spaces);
$item->increase_recoverable_spaces($deleted_spaces);
return $deleted_spaces;
-}
+} ## end sub tentatively_decrease_available_spaces
sub get_stack_depth {
return $_[0]->[_stack_depth_];
$self->[_marked_] = $value;
}
return $self->[_marked_];
-}
+} ## end sub set_marked
sub get_available_spaces {
return $_[0]->[_available_spaces_];
$self->[_spaces_] -= $value;
}
return $self->[_spaces_];
-}
+} ## end sub decrease_SPACES
sub decrease_available_spaces {
my ( $self, $value ) = @_;
$self->[_available_spaces_] -= $value;
}
return $self->[_available_spaces_];
-}
+} ## end sub decrease_available_spaces
sub get_align_seqno {
return $_[0]->[_align_seqno_];
$self->[_recoverable_spaces_] = $value;
}
return $self->[_recoverable_spaces_];
-}
+} ## end sub set_recoverable_spaces
sub increase_recoverable_spaces {
my ( $self, $value ) = @_;
$self->[_recoverable_spaces_] += $value;
}
return $self->[_recoverable_spaces_];
-}
+} ## end sub increase_recoverable_spaces
sub get_ci_level {
return $_[0]->[_ci_level_];
$self->[_have_child_] = $value;
}
return $self->[_have_child_];
-}
+} ## end sub set_have_child
sub get_have_child {
return $_[0]->[_have_child_];
$self->[_arrow_count_] = $value;
}
return $self->[_arrow_count_];
-}
+} ## end sub set_arrow_count
sub get_arrow_count {
return $_[0]->[_arrow_count_];
$self->[_comma_count_] = $value;
}
return $self->[_comma_count_];
-}
+} ## end sub set_comma_count
sub get_comma_count {
return $_[0]->[_comma_count_];
$self->[_closed_] = $value;
}
return $self->[_closed_];
-}
+} ## end sub set_closed
sub get_closed {
return $_[0]->[_closed_];
======================================================================
EOM
exit 1;
-}
+} ## end sub AUTOLOAD
sub DESTROY {
_filename_stamp => $filename_stamp,
_save_logfile => $rOpts->{'logfile'},
}, $class;
-}
+} ## end sub new
sub get_input_stream_name {
my $self = shift;
$self->warning("\n");
$self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
return;
-}
+} ## end sub interrupt_logfile
sub resume_logfile {
my $self = shift;
$self->write_logfile_entry( '#' x 60 . "\n" );
$self->{_use_prefix} = 1;
return;
-}
+} ## end sub resume_logfile
sub we_are_at_the_last_line {
my $self = shift;
}
$self->{_at_end_of_file} = 1;
return;
-}
+} ## end sub we_are_at_the_last_line
# record some stuff in case we go down in flames
use constant MAX_PRINTED_CHARS => 35;
$self->logfile_output( EMPTY_STRING, "$out_str\n" );
}
return;
-}
+} ## end sub black_box
sub write_logfile_entry {
# add leading >>> to avoid confusing error messages and code
$self->logfile_output( ">>>", "@msg" );
return;
-}
+} ## end sub write_logfile_entry
sub write_column_headings {
my $self = shift;
------ ----- - - -------- -------------------------------------------
EOM
return;
-}
+} ## end sub write_column_headings
sub make_line_information_string {
"L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
}
return $line_information_string;
-}
+} ## end sub make_line_information_string
sub logfile_output {
my ( $self, $prompt, $msg ) = @_;
}
}
return;
-}
+} ## end sub logfile_output
sub get_saw_brace_error {
my $self = shift;
$self->warning("No further warnings of this type will be given\n");
}
return;
-}
+} ## end sub brace_warning
sub complain {
$self->write_logfile_entry($msg);
}
return;
-}
+} ## end sub complain
sub warning {
}
}
return;
-}
+} ## end sub warning
sub report_definite_bug {
my $self = shift;
# the logfile will be saved.
my $self = shift;
return $self->{_save_logfile};
-}
+} ## end sub get_save_logfile
sub finish {
}
}
return;
-}
+} ## end sub finish
1;
_rOpts_logfile_ => $i++,
_rOpts_ => $i++,
};
-}
+} ## end BEGIN
{ ## closure for subs to count instances
my ($pattern) = @_;
my $ok = eval "'##'=~/$pattern/";
return !defined($ok) || $EVAL_ERROR;
-}
+} ## end sub bad_pattern
sub make_code_skipping_pattern {
my ( $rOpts, $opt_name, $default ) = @_;
$logger_object->warning($msg);
}
return;
-}
+} ## end sub warning
sub get_input_stream_name {
my $input_stream_name = EMPTY_STRING;
$input_stream_name = $logger_object->get_input_stream_name();
}
return $input_stream_name;
-}
+} ## end sub get_input_stream_name
sub complain {
my $msg = shift;
$logger_object->write_logfile_entry($msg);
}
return;
-}
+} ## end sub write_logfile_entry
sub interrupt_logfile {
my $logger_object = $tokenizer_self->[_logger_object_];
$logger_object->interrupt_logfile();
}
return;
-}
+} ## end sub interrupt_logfile
sub resume_logfile {
my $logger_object = $tokenizer_self->[_logger_object_];
$logger_object->resume_logfile();
}
return;
-}
+} ## end sub resume_logfile
sub increment_brace_error {
my $logger_object = $tokenizer_self->[_logger_object_];
$logger_object->increment_brace_error();
}
return;
-}
+} ## end sub increment_brace_error
sub report_definite_bug {
$tokenizer_self->[_hit_bug_] = 1;
$logger_object->report_definite_bug();
}
return;
-}
+} ## end sub report_definite_bug
sub brace_warning {
my $msg = shift;
$logger_object->brace_warning($msg);
}
return;
-}
+} ## end sub brace_warning
sub get_saw_brace_error {
my $logger_object = $tokenizer_self->[_logger_object_];
else {
return 0;
}
-}
+} ## end sub get_saw_brace_error
sub get_unexpected_error_count {
my ($self) = @_;
$tokenizer_self->[_diagnostics_object_]->write_diagnostics($msg);
}
return;
-}
+} ## end sub write_diagnostics
sub get_maximum_level {
return $tokenizer_self->[_maximum_level_];
my $input_line_number = $self->[_last_line_number_];
write_logfile_entry("Line $input_line_number: $msg");
return;
-}
+} ## end sub log_numbered_msg
# returns the next tokenized line
sub get_line {
scan_bare_identifier_do( $input_line, $i, $tok, $type, $prototype,
$rtoken_map, $max_token_index );
return;
- }
+ } ## end sub scan_bare_identifier
sub scan_identifier {
(
'%' => LIST_CONTEXT,
'&' => UNKNOWN_CONTEXT,
);
- }
+ } ## end BEGIN
sub scan_simple_identifier {
# We will stop here and assume that this is valid syntax for
# use feature 'class'.
return 1;
- }
+ } ## end sub method_ok_here
sub class_ok_here {
# We will stop here and assume that this is valid syntax for
# use feature 'class'.
return 1;
- }
+ } ## end sub class_ok_here
sub scan_id {
( $i, $tok, $type, $id_scan_state ) =
scan_id_do( $input_line, $i, $tok, $rtokens, $rtoken_map,
$id_scan_state, $max_token_index );
return;
- }
+ } ## end sub scan_id
sub scan_number {
my $number;
scan_number_do( $input_line, $i, $rtoken_map, $type,
$max_token_index );
return $number;
- }
+ } ## end sub scan_number
use constant VERIFY_FASTNUM => 0;
error_if_expecting_TERM()
if ( $expecting == TERM );
return;
- }
+ } ## end sub do_GREATER_THAN_SIGN
sub do_VERTICAL_LINE {
error_if_expecting_TERM()
if ( $expecting == TERM );
return;
- }
+ } ## end sub do_VERTICAL_LINE
sub do_DOLLAR_SIGN {
if ( $expecting == OPERATOR );
scan_simple_identifier();
return;
- }
+ } ## end sub do_AT_SIGN
sub do_PERCENT_SIGN {
# '::' = probably a sub call
scan_bare_identifier();
return;
- }
+ } ## end sub do_DOUBLE_COLON
sub do_LEFT_SHIFT {
# '->'
return;
- } ## end sub do_POINTER
+ }
sub do_PLUS_PLUS {
error_if_expecting_TERM()
if ( $expecting == TERM && $last_nonblank_token ne ',' ); #c015
return;
- }
+ } ## end sub do_LOGICAL_AND
sub do_LOGICAL_OR {
error_if_expecting_TERM()
if ( $expecting == TERM && $last_nonblank_token ne ',' ); #c015
return;
- }
+ } ## end sub do_LOGICAL_OR
sub do_SLASH_SLASH {
error_if_expecting_TERM()
if ( $expecting == TERM );
return;
- }
+ } ## end sub do_SLASH_SLASH
sub do_DIGITS {
@q = qw( n v );
@{is_n_v}{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
use constant DEBUG_OPERATOR_EXPECTED => 0;
@q = qw(R ]);
@{is_R_closing_sb}{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
sub is_non_structural_brace {
# parenless calls of 'ok' are common
@q = qw( ok );
@{is_known_function}{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
sub guess_if_pattern_or_division {
my @q =
qw{ ? A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ };
@{is_special_variable_char}{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
{ ## begin closure for sub scan_complex_identifier
# lexical subs with these names can cause parsing errors in this version
my @q = qw( m q qq qr qw qx s tr y );
@{warn_if_lexical}{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
# saved package and subnames in case prototype is on separate line
my ( $package_saved, $subname_saved );
my @q = qw( & && | || ? : + - * and or while if unless);
push @q, ')', '}', ']', '>', ',', ';';
@{pattern_test}{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub pattern_expected {
write_error_indicator_pair( $line_number, $input_line, $pos, $carrat );
resume_logfile();
return;
-}
+} ## end sub indicate_error
sub write_error_indicator_pair {
my ( $line_number, $input_line, $pos, $carrat ) = @_;
'[' => ']',
'<' => '>',
);
- }
+ } ## end BEGIN
sub matching_end_token {
return $matching_end_token{$beginning_token};
}
return ($beginning_token);
- }
+ } ## end sub matching_end_token
}
sub dump_token_types {
# __DATA__ __END__
@is_keyword{@Keywords} = (1) x scalar(@Keywords);
-}
+} ## end BEGIN
1;
======================================================================
EOM
exit 1;
-}
+} ## end sub AUTOLOAD
sub DESTROY {
# We shouldn't get here, but this return is to keep Perl-Critic from
# complaining.
return;
-}
+} ## end sub Fault
my %valid_LINE_keys;
);
@valid_LINE_keys{@q} = (1) x scalar(@q);
-}
+} ## end BEGIN
BEGIN {
};
DEBUG_TABS && $debug_warning->('TABS');
-}
+} ## end BEGIN
# GLOBAL variables
my (
}
return;
-}
+} ## end sub check_options
sub check_keys {
my ( $rtest, $rvalid, $msg, $exact_match ) = @_;
bless $self, $class;
return $self;
-}
+} ## end sub new
#################################
# CODE SECTION 2: Basic Utilities
$self->dump_valign_buffer();
return;
-}
+} ## end sub flush
sub initialize_for_new_group {
my ($self) = @_;
# Note that the value for _group_level_ is
# handled separately in sub valign_input
return;
-}
+} ## end sub initialize_for_new_group
sub group_line_count {
return +@{ $_[0]->[_rgroup_lines_] };
$diagnostics_object->write_diagnostics($msg);
}
return;
-}
+} ## end sub write_diagnostics
{ ## begin closure for logger routines
my $logger_object;
$input_stream_name = $logger_object->get_input_stream_name();
}
return $input_stream_name;
- }
+ } ## end sub get_input_stream_name
sub warning {
my ($msg) = @_;
$logger_object->warning($msg);
}
return;
- }
+ } ## end sub warning
sub write_logfile_entry {
my ($msg) = @_;
$logger_object->write_logfile_entry($msg);
}
return;
- }
+ } ## end sub write_logfile_entry
}
sub get_cached_line_count {
# to get them to line up with their opening parens
my $indentation = shift;
return ref($indentation) ? $indentation->get_recoverable_spaces() : 0;
-}
+} ## end sub get_recoverable_spaces
######################################################
# CODE SECTION 3: Code to accept input and form groups
};
return;
-}
+} ## end sub valign_input
sub join_hanging_comment {
$rpatterns->[ $j - 1 ] = EMPTY_STRING;
}
return 1;
-}
+} ## end sub join_hanging_comment
{ ## closure for sub decide_if_list
my @q = qw( => );
push @q, ',';
@is_comma_token{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub decide_if_list {
$line->{'list_type'} = $list_type;
}
return;
- }
+ } ## end sub decide_if_list
}
sub fix_terminal_ternary {
# force a flush after this line
return $jquestion;
-}
+} ## end sub fix_terminal_ternary
sub fix_terminal_else {
# force a flush after this line if it does not follow a case
if ( $rfields_old->[0] =~ /^case\s*$/ ) { return }
else { return $jbrace }
-}
+} ## end sub fix_terminal_else
my %is_closing_block_type;
"returning $return_value because $GoToMsg, max match index =i $imax_align, jmax=$jmax\n";
return ( $return_value, $imax_align );
-}
+} ## end sub check_match
sub check_fit {
#-------------------------------------
return 1;
-}
+} ## end sub check_fit
sub install_new_alignments {
}
$new_line->{'ralignments'} = \@alignments;
return;
-}
+} ## end sub install_new_alignments
sub copy_old_alignments {
my ( $new_line, $old_line ) = @_;
my @new_alignments = @{ $old_line->{'ralignments'} };
$new_line->{'ralignments'} = \@new_alignments;
return;
-}
+} ## end sub copy_old_alignments
sub dump_array {
local $LIST_SEPARATOR = ')(';
print STDOUT "(@_)\n";
return;
-}
+} ## end sub dump_array
sub level_change {
if ( $level < 0 ) { $level = 0 }
}
return $level;
-}
+} ## end sub level_change
###############################################
# CODE SECTION 4: Code to process comment lines
$self->initialize_for_new_group();
return;
-}
+} ## end sub _flush_comment_lines
######################################################
# CODE SECTION 5: Code to process groups of code lines
$self->initialize_for_new_group();
return;
-}
+} ## end sub _flush_group_lines
{ ## closure for sub sweep_top_down
push @{$rgroups}, [ $jbeg, $jend, undef ];
$group_line_count++;
return;
- }
+ } ## end sub add_to_rgroup
sub get_rgroup_jrange {
return unless ( $group_line_count > 0 );
my ( $jbeg, $jend ) = @{ $rgroups->[-1] };
return ( $jbeg, $jend );
- }
+ } ## end sub get_rgroup_jrange
sub end_rgroup {
initialize_for_new_rgroup();
return;
- }
+ } ## end sub end_rgroup
sub block_penultimate_match {
return unless @{$rgroups} > 1;
$rgroups->[-2]->[2] = -1;
return;
- }
+ } ## end sub block_penultimate_match
sub sweep_top_down {
my ( $self, $rlines, $group_level ) = @_;
end_rgroup(-1);
return ($rgroups);
- }
+ } ## end sub sweep_top_down
}
sub two_line_pad {
if ( !$patterns_match && $lenmax > 2 * $lenmin ) { $pad_max = 0 }
return $pad_max;
-}
+} ## end sub two_line_pad
sub sweep_left_to_right {
do_left_to_right_sweep( $rlines, $rgroups, \@todo, \%max_move, $short_pad,
$group_level );
return;
-}
+} ## end sub sweep_left_to_right
{ ## closure for sub do_left_to_right_sweep
# if ($is_good_alignment_token{$raw_tok}) => best
# if defined ($is_good_alignment_token{$raw_tok}) => good or best
- }
+ } ## end BEGIN
sub move_to_common_column {
}
}
return;
- }
+ } ## end sub move_to_common_column
sub do_left_to_right_sweep {
my ( $rlines, $rgroups, $rtodo, $rmax_move, $short_pad, $group_level )
} ## end loop over tasks
return;
- }
+ } ## end sub do_left_to_right_sweep
}
sub delete_selected_tokens {
new fields: <@{$rfields_new}>
EOM
return;
-}
+} ## end sub delete_selected_tokens
{ ## closure for sub decode_alignment_token
# number of files is processed at once.
%decoded_token = ();
return;
- }
+ } ## end sub initialize_decode
sub decode_alignment_token {
my @vals = ( $raw_tok, $lev, $tag, $tok_count );
$decoded_token{$tok} = \@vals;
return @vals;
- }
+ } ## end sub decode_alignment_token
}
{ ## closure for sub delete_unmatched_tokens
);
@keep_after_deleted_assignment{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub delete_unmatched_tokens {
my ( $rlines, $group_level ) = @_;
match_line_pairs( $rlines, $rnew_lines, \@subgroups, $group_level );
return ( $max_lev_diff, $saw_side_comment );
- }
+ } ## end sub delete_unmatched_tokens
sub make_alignment_info {
}
}
return;
-}
+} ## end sub match_line_pairs
sub compare_patterns {
# For example, we will change '=>2+{-3.2' into ',2+{-3'
if ( $str =~ /^=>([^\.]*)/ ) { $str = ',' . $1 }
return $str;
-}
+} ## end sub fat_comma_to_comma
sub get_line_token_info {
};
} ## end loop over lines
return ( $rline_values, $all_monotonic );
-}
+} ## end sub get_line_token_info
sub prune_alignment_tree {
my ($rlines) = @_;
print "(@fix)\n";
}
return;
-}
+} ## end sub Dump_tree_groups
{ ## closure for sub is_marginal_match
@q = qw( { ? => = );
push @q, (',');
@is_good_alignment{@q} = (1) x scalar(@q);
- }
+ } ## end BEGIN
sub is_marginal_match {
}
return ( $is_marginal, $imax_align );
- }
+ } ## end sub is_marginal_match
} ## end closure for sub is_marginal_match
sub get_extra_leading_spaces {
# ');' will use the same adjustment.
$object->permanently_decrease_available_spaces( -$extra_leading_spaces );
return $extra_leading_spaces;
-}
+} ## end sub get_extra_leading_spaces
sub forget_side_comment {
my ($self) = @_;
# Otherwise, keep it alive
return $KEEP;
-}
+} ## end sub is_good_side_comment_column
sub align_side_comments {
$self->[_last_side_comment_level_] = $group_level;
}
return;
-}
+} ## end sub align_side_comments
###############################
# CODE SECTION 6: Output Step A
}
);
return;
-}
+} ## end sub valign_output_step_A
sub combine_fields {
$line_0->{'ralignments'} = \@new_alignments;
$line_1->{'ralignments'} = \@new_alignments;
return;
-}
+} ## end sub combine_fields
sub get_output_line_number {
# the number of items written.
return $_[0]->group_line_count() +
$_[0]->[_file_writer_object_]->get_output_line_number();
-}
+} ## end sub get_output_line_number
###############################
# CODE SECTION 7: Output Step B
$seqno_string = EMPTY_STRING;
$last_nonblank_seqno_string = EMPTY_STRING;
return;
- }
+ } ## end sub initialize_step_B_cache
sub _flush_step_B_cache {
my ($self) = @_;
$cached_line_maximum_length = undef;
}
return;
- }
+ } ## end sub _flush_step_B_cache
sub handle_cached_line {
$self->[_last_level_written_] = $level;
$self->[_last_side_comment_length_] = $side_comment_length;
return;
- }
+ } ## end sub valign_output_step_B
}
###############################
}
$valign_buffer_filling = EMPTY_STRING;
return;
- }
+ } ## end sub dump_valign_buffer
sub reduce_valign_buffer_indentation {
}
}
return;
- }
+ } ## end sub reduce_valign_buffer_indentation
sub valign_output_step_C {
}
}
return;
- }
+ } ## end sub valign_output_step_C
}
###############################
$file_writer_object->write_code_line( $line . "\n", $Kend );
return;
-}
+} ## end sub valign_output_step_D
{ ## closure for sub get_leading_string
}
$leading_string_cache[$leading_whitespace_count] = $leading_string;
return $leading_string;
- }
+ } ## end sub get_leading_string
} ## end get_leading_string
##########################
write_logfile_entry("\n");
}
return;
-}
+} ## end sub report_anything_unusual
1;
======================================================================
EOM
exit 1;
-}
+} ## end sub AUTOLOAD
{
my $alignment = $self->{ralignments}->[$j];
return unless defined($alignment);
return $alignment->get_column();
- }
+ } ## end sub get_column
sub current_field_width {
my ( $self, $j ) = @_;
$col_jm = $alignment_jm->get_column() if defined($alignment_jm);
}
return $col_j - $col_jm;
- }
+ } ## end sub current_field_width
sub increase_field_width {
}
}
return;
- }
+ } ## end sub increase_field_width
sub get_available_space_on_right {
my $jmax = $_[0]->{jmax};
projects / perltidy.git / commitdiff