sub streamhandle {
- # given filename and mode (r or w), create an object which:
+ my ( $filename, $mode, $is_encoded_data ) = @_;
+
+ # Given:
+ # $filename
+ # $mode = 'r' or 'w' (only 'w' is used now, see note below)
+ # $is_encoded_data (optional flag)
+
+ # Create an object which:
# has a 'getline' method if mode='r', and
# has a 'print' method if mode='w'.
# The objects also need a 'close' method.
# - false: unencoded binary data is being transferred,
# set binary mode for files and for stdin.
- my ( $filename, $mode, $is_encoded_data ) = @_;
-
- # Note: mode 'r' works but is no longer used.
- # Use sub stream_slurp instead for mode 'r' (for efficiency).
+ # NOTE: mode 'r' works but is no longer used.
+ # Use sub stream_slurp instead for mode 'r', for efficiency.
if ( $mode ne 'w' && $mode ne 'W' ) {
if ( DEVEL_MODE || ( $mode ne 'r' && $mode ne 'R' ) ) {
Fault("streamhandle called in unexpected mode '$mode'\n");
my ( $filename, $timeout_in_seconds ) = @_;
+ # Given:
+ # $filename
+ # $timeout_in_seconds (optional timeout, in seconds)
+
# Read the text in $filename and
# return:
# undef if read error, or
my $md5_hex = sub {
my ($buf) = @_;
- # Evaluate the MD5 sum for a string
+ # Evaluate the MD5 sum for a string:
+ # Given:
+ # $buf = a string
+ # Return:
+ # $digest = its MD5 sum
+
# Patch for [rt.cpan.org #88020]
# Use utf8::encode since md5_hex() only operates on bytes.
# my $digest = md5_hex( utf8::encode($sink_buffer) );
# These options can take filenames, so we will ignore them here
my %is_option_with_file_parameter;
- my @qf = qw(outfile profile);
+ my @qf = qw( outfile profile );
@is_option_with_file_parameter{@qf} = (1) x scalar(@qf);
# Expand an abbreviation into a long name
# (the '.' may actually be an '_' under VMS).
my ( $self, $extension, $default ) = @_;
- # '$extension' is the first choice (usually a user entry)
- # '$default' is an optional backup extension
+ # Given:
+ # $extension = the first choice (usually a user entry)
+ # $default = an optional backup extension
+ # Return:
+ # $extension = the actual file extension
$extension = EMPTY_STRING unless defined($extension);
$extension =~ s/^\s+//;
$extension =~ s/\s+$//;
# Use default extension if nothing remains of the first choice
- #
if ( length($extension) == 0 ) {
$extension = $default;
$extension = EMPTY_STRING unless defined($extension);
my ( $self, $source_stream, $destination_stream ) = @_;
- # get parameters associated with the -b option
+ # See if --backup-and-modify-in-place (-b) is set, and if so,
+ # return its associated parameters
my $rOpts = $self->[_rOpts_];
# check for -b option;
my ( $self, $output_file, $rinput_file_stat, $in_place_modify ) = @_;
+ # Set the permissions for the output file
+
# Given:
# $output_file = the file whose permissions we will set
# $rinput_file_stat = the result of stat($input_file)
sub get_decoded_string_buffer {
my ( $self, $input_file, $display_name ) = @_;
- # Decode the input buffer if necessary or requested
+ # Decode the input buffer from utf8 if necessary or requested
# Given:
# $input_file = the input file or stream
my ( $self, $rcall_hash ) = @_;
+ # This routine is the main loop to process all files.
+ # Total formatting is done with these layers of subroutines:
+ # perltidy - main routine; checks run parameters
+ # *process_all_files - main loop to process all files; *THIS LAYER
+ # process_filter_layer - do any pre and post processing;
+ # process_iteration_layer - handle any iterations on formatting
+ # process_single_case - solves one formatting problem
+
my $rinput_hash = $rcall_hash->{rinput_hash};
my $rfiles = $rcall_hash->{rfiles};
my $source_stream = $rcall_hash->{source_stream};
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:
- # perltidy - main routine; checks run parameters
- # *process_all_files - main loop to process all files; *THIS LAYER
- # process_filter_layer - do any pre and post processing;
- # process_iteration_layer - handle any iterations on formatting
- # process_single_case - solves one formatting problem
-
my $rOpts = $self->[_rOpts_];
my $dot = $self->[_file_extension_separator_];
my $diagnostics_object = $self->[_diagnostics_object_];
sub write_tidy_output {
- # Write tidied output in '$routput_string' to its final destination
-
my ( $self, $rcall_hash ) = @_;
+ # Write tidied output in '$routput_string' to its final destination
+
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};
sub process_single_case {
- # run the formatter on a single defined case
my ( $self, $tokenizer, $formatter ) = @_;
+ # Run the formatter on a single defined case
+
# Total formatting is done with these layers of subroutines:
# perltidy - main routine; checks run parameters
# process_all_files - main loop to process all files;
$rpending_complaint_uu, $dump_options_type
) = @q;
+ # This is the outer sub which handles memoization
+
my $use_cache = !defined($perltidyrc_stream) && !$dump_options_type;
if ($use_cache) {
my $cache_key = join( chr(28), @ARGV );
$rpending_complaint, $dump_options_type
) = @_;
+ # This is the inner sub which actually processes the command line
+
use Getopt::Long;
# Save any current Getopt::Long configuration
sub find_file_upwards {
my ( $search_dir, $search_file ) = @_;
+ # This implements the ... upward search for a file
+
$search_dir =~ s{/+$}{};
$search_file =~ s{^/+}{};
sub expand_command_abbreviations {
# go through @ARGV and expand any abbreviations
+ # note that @ARGV has been localized
my ( $rexpansion, $rraw_options, $config_file ) = @_;
}
# Default environment vars.
- my @envs = qw(PERLTIDY HOME);
+ my @envs = qw( PERLTIDY HOME );
# Check the NT/2k/XP locations, first a local machine def, then a
# network def
- push @envs, qw(USERPROFILE HOMESHARE) if $OSNAME =~ /win32/i;
+ push @envs, qw( USERPROFILE HOMESHARE ) if $OSNAME =~ /win32/i;
# Now go through the environment ...
foreach my $var (@envs) {
sub setup_convergence_test {
my ( $self, $rlist ) = @_;
- # $rlist is a reference to a list of line-ending token indexes 'K' of
- # the input stream. We will compare these with the line-ending token
- # indexes of the output stream. If they are identical, then we have
- # convergence.
+ # Setup the convergence test,
+
+ # Given:
+ # $rlist = a reference to a list of line-ending token indexes 'K' of
+ # the input stream. We will compare these with the line-ending token
+ # indexes of the output stream. If they are identical, then we have
+ # convergence.
if ( @{$rlist} ) {
- # We are going to destroy the list, so make a copy
- # and put in reverse order so we can pop values
+ # We are going to destroy the list, so make a copy and put in
+ # reverse order so we can pop values as they arrive
my @list = @{$rlist};
if ( $list[0] < $list[-1] ) {
@list = reverse @list;
}
$self->[_rK_checklist_] = \@list;
}
+
+ # We will zero this flag on any error in arrival order:
$self->[_K_arrival_order_matches_] = 1;
$self->[_K_sequence_error_msg_] = EMPTY_STRING;
$self->[_K_last_arrival_] = -1;
sub get_convergence_check {
my ($self) = @_;
- my $rlist = $self->[_rK_checklist_];
- # converged if all K arrived and in correct order
- return $self->[_K_arrival_order_matches_] && !@{$rlist};
+ # converged if:
+ # - all expected indexes arrived
+ # - and in correct order
+ return !@{ $self->[_rK_checklist_] }
+ && $self->[_K_arrival_order_matches_];
+
} ## end sub get_convergence_check
sub get_output_line_number {
sub require_blank_code_lines {
my ( $self, $count ) = @_;
- # write out the requested number of blanks regardless of the value of -mbl
+ # Given:
+ # $count = number of blank lines to write
+ # Write out $count blank lines regardless of the value of -mbl
# unless -mbl=0. This allows extra blank lines to be written for subs and
# packages even with the default -mbl=1
my $need = $count - $self->[_consecutive_blank_lines_];
# Write a line directly to the output, without any counting of blank or
# non-blank lines.
+ # Given:
+ # $str = line of text to write
+
${ $self->[_routput_string_] } .= $str;
if ( chomp $str ) { $self->[_output_line_number_]++; }
sub check_line_lengths {
my ( $self, $str ) = @_;
- # collect info on line lengths for logfile
+ # Collect info on line lengths for logfile
+ # Given:
+ # $str = line of text being written
# This calculation of excess line length ignores any internal tabs
my $rOpts = $self->[_rOpts_];
projects / perltidy.git / commitdiff