# loop to process all files
#--------------------------
$self->process_all_files(
-
- \%input_hash,
- \@Arg_files,
-
- # filename stuff...
- $source_stream,
- $output_extension,
- $forbidden_file_extensions,
- $in_place_modify,
- $backup_extension,
- $delete_backup,
-
- # logfile stuff...
- $logfile_header,
- $rpending_complaint,
- $rpending_logfile_message,
-
+ {
+ rinput_hash => \%input_hash,
+ rfiles => \@Arg_files,
+
+ # filename stuff...
+ source_stream => $source_stream,
+ output_extension => $output_extension,
+ forbidden_file_extensions => $forbidden_file_extensions,
+ in_place_modify => $in_place_modify,
+ backup_extension => $backup_extension,
+ delete_backup => $delete_backup,
+
+ # logfile stuff...
+ logfile_header => $logfile_header,
+ rpending_complaint => $rpending_complaint,
+ rpending_logfile_message => $rpending_logfile_message,
+ }
);
#-----
sub process_all_files {
- my (
-
- $self,
- $rinput_hash,
- $rfiles,
-
- $source_stream,
- $output_extension,
- $forbidden_file_extensions,
- $in_place_modify,
- $backup_extension,
- $delete_backup,
+ my ( $self, $rcall_hash ) = @_;
- $logfile_header,
- $rpending_complaint,
- $rpending_logfile_message,
-
- ) = @_;
+ my $rinput_hash = $rcall_hash->{rinput_hash};
+ my $rfiles = $rcall_hash->{rfiles};
+ my $source_stream = $rcall_hash->{source_stream};
+ my $output_extension = $rcall_hash->{output_extension};
+ my $forbidden_file_extensions = $rcall_hash->{forbidden_file_extensions};
+ my $in_place_modify = $rcall_hash->{in_place_modify};
+ my $backup_extension = $rcall_hash->{backup_extension};
+ my $delete_backup = $rcall_hash->{delete_backup};
+ my $logfile_header = $rcall_hash->{logfile_header};
+ my $rpending_complaint = $rcall_hash->{rpending_complaint};
+ my $rpending_logfile_message = $rcall_hash->{rpending_logfile_message};
# This routine is the main loop to process all files.
# Total formatting is done with these layers of subroutines:
if ( $rOpts->{'format'} eq 'tidy' && defined($routput_string) ) {
$self->write_tidy_output(
-
- $routput_string,
-
- \@input_file_stat,
- $in_place_modify,
- $input_file,
- $backup_extension,
- $delete_backup,
+ {
+ routput_string => $routput_string,
+ rinput_file_stat => \@input_file_stat,
+ in_place_modify => $in_place_modify,
+ input_file => $input_file,
+ backup_extension => $backup_extension,
+ delete_backup => $delete_backup,
+ }
);
}
# Write tidied output in '$routput_string' to its final destination
- my (
- $self,
-
- $routput_string,
+ my ( $self, $rcall_hash ) = @_;
- $rinput_file_stat,
- $in_place_modify,
- $input_file,
- $backup_extension,
- $delete_backup,
- ) = @_;
+ my $routput_string = $rcall_hash->{routput_string};
+ my $rinput_file_stat = $rcall_hash->{rinput_file_stat};
+ my $in_place_modify = $rcall_hash->{in_place_modify};
+ my $input_file = $rcall_hash->{input_file};
+ my $backup_extension = $rcall_hash->{backup_extension};
+ my $delete_backup = $rcall_hash->{delete_backup};
my $rOpts = $self->[_rOpts_];
my $is_encoded_data = $self->[_is_encoded_data_];
my ( $self, $rinput_string ) = @_;
# This is the iteration layer of processing.
- # Do all formatting, iterating if requested, on the source string $buf.
+ # Do all formatting, iterating if requested, on the source $rinput_string
# Output depends on format type:
# For 'tidy' formatting, output goes to sink object
# For 'html' formatting, output goes to the ultimate destination
while ( defined( my $line = $fh_tmp->getline() ) ) {
if ( $line =~ /^\s*<html>\s*$/i ) {
- ##my $date = localtime;
- ##$html_print->("<!-- Generated by perltidy on $date -->\n");
$html_print->("<!-- Generated by perltidy $timestamp -->\n");
$html_print->($line);
}
# 1. Make the table of contents panel, with appropriate changes
# to the anchor names
my $src_frame_name = 'SRC';
- my $first_anchor =
- write_toc_html( $title, $toc_filename, $src_basename, $rtoc,
- $src_frame_name );
+ my $first_anchor = write_toc_html(
+ {
+ title => $title,
+ toc_filename => $toc_filename,
+ src_basename => $src_basename,
+ rtoc => $rtoc,
+ src_frame_name => $src_frame_name,
+ }
+ );
# 2. The current .html filename is renamed to be the contents panel
rename( $html_filename, $src_filename )
# 3. Then use the original html filename for the frame
write_frame_html(
- $title, $html_filename, $top_basename,
- $toc_basename, $src_basename, $src_frame_name
+ {
+ title => $title,
+ frame_filename => $html_filename,
+ top_basename => $top_basename,
+ toc_basename => $toc_basename,
+ src_basename => $src_basename,
+ src_frame_name => $src_frame_name,
+ }
);
return;
} ## end sub make_frame
sub write_toc_html {
# write a separate html table of contents file for frames
- my ( $title, $toc_filename, $src_basename, $rtoc, $src_frame_name ) = @_;
+ my ($rarg_hash) = @_;
+
+ my $title = $rarg_hash->{title};
+ my $toc_filename = $rarg_hash->{toc_filename};
+ my $src_basename = $rarg_hash->{src_basename};
+ my $rtoc = $rarg_hash->{rtoc};
+ my $src_frame_name = $rarg_hash->{src_frame_name};
+
my $fh = IO::File->new( $toc_filename, 'w' )
or Perl::Tidy::Die("Cannot open $toc_filename: $OS_ERROR\n");
$fh->print(<<EOM);
sub write_frame_html {
# write an html file to be the table of contents frame
- my (
- $title, $frame_filename, $top_basename,
- $toc_basename, $src_basename, $src_frame_name
- ) = @_;
+
+ my ($rarg_hash) = @_;
+
+ my $title = $rarg_hash->{title};
+ my $frame_filename = $rarg_hash->{frame_filename};
+ my $top_basename = $rarg_hash->{top_basename};
+ my $toc_basename = $rarg_hash->{toc_basename};
+ my $src_basename = $rarg_hash->{src_basename};
+ my $src_frame_name = $rarg_hash->{src_frame_name};
my $fh = IO::File->new( $frame_filename, 'w' )
or Perl::Tidy::Die("Cannot open $toc_basename: $OS_ERROR\n");
my $j_terminal_match;
if ( $is_terminal_ternary && @{$rgroup_lines} ) {
- $j_terminal_match =
- fix_terminal_ternary( $rgroup_lines->[-1], $rfields, $rtokens,
- $rpatterns, $rfield_lengths, $group_level, );
+ $j_terminal_match = fix_terminal_ternary(
+ {
+ old_line => $rgroup_lines->[-1],
+ rfields => $rfields,
+ rtokens => $rtokens,
+ rpatterns => $rpatterns,
+ rfield_lengths => $rfield_lengths,
+ group_level => $group_level,
+ }
+ );
$jmax = @{$rfields} - 1;
}
&& @{$rgroup_lines}
&& $is_balanced_line )
{
-
- $j_terminal_match =
- fix_terminal_else( $rgroup_lines->[-1], $rfields, $rtokens,
- $rpatterns, $rfield_lengths );
+ $j_terminal_match = fix_terminal_else(
+ {
+ old_line => $rgroup_lines->[-1],
+ rfields => $rfields,
+ rtokens => $rtokens,
+ rpatterns => $rpatterns,
+ rfield_lengths => $rfield_lengths,
+ }
+ );
$jmax = @{$rfields} - 1;
}
#
# returns the index of the terminal question token, if any
- my ( $old_line, $rfields, $rtokens, $rpatterns, $rfield_lengths,
- $group_level )
- = @_;
+ my ($rcall_hash) = @_;
+
+ my $old_line = $rcall_hash->{old_line};
+ my $rfields = $rcall_hash->{rfields};
+ my $rtokens = $rcall_hash->{rtokens};
+ my $rpatterns = $rcall_hash->{rpatterns};
+ my $rfield_lengths = $rcall_hash->{rfield_lengths};
+ my $group_level = $rcall_hash->{group_level};
return if ( !$old_line );
use constant EXPLAIN_TERNARY => 0;
#
# returns a positive value if the else block should be indented
#
- my ( $old_line, $rfields, $rtokens, $rpatterns, $rfield_lengths ) = @_;
+ my ($rcall_hash) = @_;
+
+ my $old_line = $rcall_hash->{old_line};
+ my $rfields = $rcall_hash->{rfields};
+ my $rtokens = $rcall_hash->{rtokens};
+ my $rpatterns = $rcall_hash->{rpatterns};
+ my $rfield_lengths = $rcall_hash->{rfield_lengths};
return if ( !$old_line );
my $jmax = @{$rfields} - 1;
#------------------------------
# Step 3: Execute the task list
#------------------------------
- do_left_to_right_sweep( $rlines, $rgroups, \@todo, \%max_move, $short_pad,
- $group_level );
+ do_left_to_right_sweep(
+ {
+ rlines => $rlines,
+ rgroups => $rgroups,
+ rtodo => \@todo,
+ rmax_move => \%max_move,
+ short_pad => $short_pad,
+ group_level => $group_level
+ }
+ );
return;
} ## end sub sweep_left_to_right
# This is a sub called by sub do_left_to_right_sweep to
# move the alignment column of token $itok to $col_want for a
# sequence of groups.
- my ( $rlines, $rgroups, $rmax_move, $ngb, $nge, $itok, $col_want,
- $raw_tok )
- = @_;
+ my ($rcall_hash) = @_;
+
+ my $rlines = $rcall_hash->{rlines};
+ my $rgroups = $rcall_hash->{rgroups};
+ my $rmax_move = $rcall_hash->{rmax_move};
+ my $ngb = $rcall_hash->{ngb};
+ my $nge = $rcall_hash->{nge};
+ my $itok = $rcall_hash->{itok};
+ my $col_want = $rcall_hash->{col_want};
+ my $raw_tok = $rcall_hash->{raw_tok};
+
return if ( !defined($ngb) || $nge <= $ngb );
foreach my $ng ( $ngb .. $nge ) {
} ## end sub move_to_common_column
sub do_left_to_right_sweep {
- my ( $rlines, $rgroups, $rtodo, $rmax_move, $short_pad, $group_level )
- = @_;
+
+ my ($rcall_hash) = @_;
+
+ my $rlines = $rcall_hash->{rlines};
+ my $rgroups = $rcall_hash->{rgroups};
+ my $rtodo = $rcall_hash->{rtodo};
+ my $rmax_move = $rcall_hash->{rmax_move};
+ my $short_pad = $rcall_hash->{short_pad};
+ my $group_level = $rcall_hash->{group_level};
# $blocking_level[$nj is the level at a match failure between groups
# $ng-1 and $ng
}
move_to_common_column(
- $rlines, $rgroups, $rmax_move, $ng_first,
- $ng - 1, $itok, $col_want, $raw_tok
+ {
+ rlines => $rlines,
+ rgroups => $rgroups,
+ rmax_move => $rmax_move,
+ ngb => $ng_first,
+ nge => $ng - 1,
+ itok => $itok,
+ col_want => $col_want,
+ raw_tok => $raw_tok,
+ }
);
$ng_first = $ng;
$col_want = $col;
if ( $ng_end > $ng_first ) {
move_to_common_column(
- $rlines, $rgroups, $rmax_move, $ng_first,
- $ng_end, $itok, $col_want, $raw_tok
+ {
+ rlines => $rlines,
+ rgroups => $rgroups,
+ rmax_move => $rmax_move,
+ ngb => $ng_first,
+ nge => $ng_end,
+ itok => $itok,
+ col_want => $col_want,
+ raw_tok => $raw_tok,
+ }
);
- } ## end loop over groups for one task
+ }
} ## end loop over tasks
return;
if ( $pat_m ne $pat ) {
my $pad =
$rfield_lengths->[$i] - $rfield_lengths_m->[$i];
- my ( $match_code, $rmsg ) =
- compare_patterns( $group_level,
- $tok, $tok_m, $pat, $pat_m, $pad );
+ my ( $match_code, $rmsg ) = compare_patterns(
+ {
+ group_level => $group_level,
+ tok => $tok,
+ tok_m => $tok_m,
+ pat => $pat,
+ pat_m => $pat_m,
+ pad => $pad
+ }
+ );
if ($match_code) {
if ( $match_code == 1 ) { $i_nomatch = $i }
elsif ( $match_code == 2 ) { $i_nomatch = 0 }
sub compare_patterns {
- my ( $group_level, $tok, $tok_m, $pat, $pat_m, $pad ) = @_;
+ my ($rcall_hash) = @_;
+
+ my $group_level = $rcall_hash->{group_level};
+ my $tok = $rcall_hash->{tok};
+ my $tok_m = $rcall_hash->{tok_m};
+ my $pat = $rcall_hash->{pat};
+ my $pat_m = $rcall_hash->{pat_m};
+ my $pad = $rcall_hash->{pad};
# helper routine for sub match_line_pairs to decide if patterns in two
# lines match well enough..Given
projects / perltidy.git / commitdiff