From: Steve Hancock Date: Sat, 26 Aug 2023 18:33:46 +0000 (-0700) Subject: eliminate dummy sub close from IOScalar & IOScalarArray X-Git-Tag: 20230701.04~18 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=a17822daf66d2a9f7e79cb74bffe1b47876f9a86;p=perltidy.git eliminate dummy sub close from IOScalar & IOScalarArray --- diff --git a/.perlcriticrc b/.perlcriticrc index 38ad7418..9660b98a 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -32,18 +32,16 @@ verbose = %f: [%p] %m at line %l, column %c.\n [-Variables::RequireInitializationForLocalVars] # There is a stringy eval in Formatter.pm and Tokenizer.pm which is essential -# for checking user input. So we have to skip this. I would have liked -# to mark it with a nocritic side comment, but see note above for the trouble -# this causes. +# for checking user input. So we have to skip this. [-BuiltinFunctions::ProhibitStringyEval] # Tidy.pm exports 'perltidy'. Changing this could break existing scripts. [-Modules::ProhibitAutomaticExportation] -# 'print' and 'close' homonyms are appropriate where they are used. +# IOScalar and IOScalarArray need to define a 'print' function [-Subroutines::ProhibitBuiltinHomonyms] -# Nested subs are used for error handling in Tidy.pm. +# Nested subs are needed for error handling in Tidy.pm. [-Subroutines::ProhibitNestedSubs] # Don't require arg unpacking for very short (possibly time-critical) subs. @@ -66,7 +64,7 @@ short_subroutine_statements = 2 # instead of GetOptions, but that is not available before perl 5.10, and # we want to continue supporting Perl 5.8. So we have to skip this for now. # When the time comes to make perl 5.10 the earliest version supported, -# this can be fixed. +# this restriction can be deleted [-Variables::RequireLocalizedPunctuationVars] # sub 'backup_method_copy' in Perl::Tidy.pm has about 25 lines between open @@ -83,8 +81,8 @@ lines=30 [-ClassHierarchies::ProhibitAutoloading] # This policy is very useful in locating complex code which might benefit from -# simplification. The max value has to be set rather high here because there -# are some critical loops in Formatter.pm whose high mccabe values cannot +# simplification. But the max value has to be set rather high here because +# there are some critical loops in Formatter.pm whose high mccabe values cannot # be reduced without significantly increasing run time. [Subroutines::ProhibitExcessComplexity] max_mccabe=180 @@ -106,15 +104,13 @@ max_nests=9 [-ClassHierarchies::ProhibitExplicitISA] -# These are okay where used -[-NamingConventions::ProhibitAmbiguousNames] - # I find that using lvalue substr much clearer than adding another arg to # substr. So skip this one. [-BuiltinFunctions::ProhibitLvalueSubstr] -# There is one complex regex in Tokenizer.pm that should be simplified. Then -# this line can be removed. +# There is one complex regex in Tokenizer.pm for scanning numbers. It is +# well commented and easy to read, and any changes would make it harder +# to read. So we have to skip this. [-RegularExpressions::ProhibitComplexRegexes] # A problem with ReqireExtendedFormatting is that it makes things needlessly @@ -165,7 +161,6 @@ max_nests=9 # Sometimes an unless statement is clearer than an if block, so why not use # it? For example, I might prefer the first of these: - # return unless ($everything_is_ok); # vs. # return if (!$everything_is_ok); @@ -197,7 +192,7 @@ max_nests=9 # There are too many of these in perltidy to change, and they seem fine. [-RegularExpressions::ProhibitEscapedMetacharacters] -# As the documentation says, this policy is not for everyone! +# As the documentation says, this policy is not for everyone [-RegularExpressions::ProhibitEnumeratedClasses] # Disagree. Double quotes are easier to read than single quotes and allow a @@ -207,7 +202,8 @@ max_nests=9 # So skip this: [-ValuesAndExpressions::ProhibitInterpolationOfLiterals] -# These have been checked and are correct as written +# These have been checked and are correct as written. So this policy +# has to be turned off. [-ValuesAndExpressions::RequireInterpolationOfMetachars] # Disagree: parens can add clarity and may even be essential, for example in diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index cf348503..413c9aa1 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -240,7 +240,7 @@ EOM $fh = $New->( $filename, $mode ); if ( !$fh ) { - Warn("Couldn't open file:$filename in mode:$mode : $ERRNO\n"); + Warn("Couldn't open file:$filename in mode:$mode : $OS_ERROR\n"); } else { @@ -332,11 +332,11 @@ EOM if ( open( my $fh, '<', $filename ) ) { local $INPUT_RECORD_SEPARATOR = undef; my $buf = <$fh>; - $fh->close() || Warn("Cannot close $filename\n"); + $fh->close() or Warn("Cannot close $filename\n"); $rinput_string = \$buf; } else { - Warn("Cannot open $filename: $ERRNO\n"); + Warn("Cannot open $filename: $OS_ERROR\n"); return; } } @@ -1196,13 +1196,13 @@ sub backup_method_copy { if ( -f $backup_file ) { unlink($backup_file) or Die( -"unable to remove previous '$backup_file' for -b option; check permissions: $ERRNO\n" +"unable to remove previous '$backup_file' for -b option; check permissions: $OS_ERROR\n" ); } # Copy input file to backup File::Copy::copy( $input_file, $backup_file ) - or Die("File::Copy failed trying to backup source: $ERRNO"); + or Die("File::Copy failed trying to backup source: $OS_ERROR"); # set permissions of the backup file to match the input file my @input_file_stat = stat($input_file); @@ -1221,7 +1221,7 @@ sub backup_method_copy { # truncate the existing data. open( my $fout, ">", $input_file ) || Die( -"problem re-opening $input_file for write for -b option; check file and directory permissions: $ERRNO\n" +"problem re-opening $input_file for write for -b option; check file and directory permissions: $OS_ERROR\n" ); if ( $self->[_is_encoded_data_] ) { @@ -1289,7 +1289,7 @@ EOM else { unlink($backup_file) or Die( -"unable to remove backup file '$backup_file' for -b option; check permissions: $ERRNO\n" +"unable to remove backup file '$backup_file' for -b option; check permissions: $OS_ERROR\n" ); } } @@ -1338,7 +1338,7 @@ sub backup_method_move { if ( -f $backup_name ) { unlink($backup_name) or Die( -"unable to remove previous '$backup_name' for -b option; check permissions: $ERRNO\n" +"unable to remove previous '$backup_name' for -b option; check permissions: $OS_ERROR\n" ); } @@ -1348,12 +1348,12 @@ sub backup_method_move { # we use copy for symlinks, move for regular files if ( -l $input_file ) { File::Copy::copy( $input_file, $backup_name ) - or Die("File::Copy failed trying to backup source: $ERRNO"); + or Die("File::Copy failed trying to backup source: $OS_ERROR"); } else { rename( $input_file, $backup_name ) or Die( -"problem renaming $input_file to $backup_name for -b option: $ERRNO\n" +"problem renaming $input_file to $backup_name for -b option: $OS_ERROR\n" ); } @@ -1363,7 +1363,7 @@ sub backup_method_move { Perl::Tidy::streamhandle( $input_file, 'w', $is_encoded_data ); if ( !$fout ) { Die( -"problem re-opening $input_file for write for -b option; check file and directory permissions: $ERRNO\n" +"problem re-opening $input_file for write for -b option; check file and directory permissions: $OS_ERROR\n" ); } @@ -1428,7 +1428,7 @@ EOM else { unlink($backup_name) or Die( -"unable to remove previous '$backup_name' for -b option; check permissions: $ERRNO\n" +"unable to remove previous '$backup_name' for -b option; check permissions: $OS_ERROR\n" ); } } @@ -1999,7 +1999,8 @@ sub process_all_files { my $new_path = $rOpts->{'output-path'}; unless ( -d $new_path ) { unless ( mkdir $new_path, 0777 ) { - Die("unable to create directory $new_path: $ERRNO\n"); + Die("unable to create directory $new_path: $OS_ERROR\n" + ); } } my $path = $new_path; @@ -2303,10 +2304,10 @@ sub write_tidy_output { if ($is_encoded_data) { binmode $fh, ":raw:encoding(UTF-8)" } else { binmode $fh } $fh->print( ${$routput_string} ); - $fh->close() || Warn("Cannot close $output_file\n"); + $fh->close() or Die("Cannot close '$output_file': $OS_ERROR\n"); } else { - Die("Cannot open $output_file to write: $ERRNO\n"); + Die("Cannot open $output_file to write: $OS_ERROR\n"); } # set output file ownership and permissions if appropriate @@ -2576,16 +2577,17 @@ sub process_iteration_layer { # make a tee file handle if requested my $fh_tee; + my $tee_file; if ( $rOpts->{'tee-pod'} || $rOpts->{'tee-block-comments'} || $rOpts->{'tee-side-comments'} ) { - my $tee_file = $self->[_teefile_stream_] + $tee_file = $self->[_teefile_stream_] || $fileroot . $self->make_file_extension('TEE'); ( $fh_tee, my $tee_filename ) = Perl::Tidy::streamhandle( $tee_file, 'w', $is_encoded_data ); if ( !$fh_tee ) { - Warn("couldn't open TEE file $tee_file: $ERRNO\n"); + Warn("couldn't open TEE file $tee_file: $OS_ERROR\n"); } } @@ -2645,8 +2647,17 @@ sub process_iteration_layer { # being deleted. if ( $iter > 1 ) { - $debugger_object->close_debug_file() if ($debugger_object); - $fh_tee->close() if ($fh_tee); + $debugger_object->close_debug_file() + if ($debugger_object); + + if ( $fh_tee + && $fh_tee->can('close') + && !ref($tee_file) + && $tee_file ne '-' ) + { + $fh_tee->close() + or Warn("couldn't close TEE file $tee_file: $OS_ERROR\n"); + } $debugger_object = undef; $logger_object = undef; @@ -2831,8 +2842,17 @@ EOM } ## end if ( $iter < $max_iterations) } ## end loop over iterations for one source file - $debugger_object->close_debug_file() if $debugger_object; - $fh_tee->close() if $fh_tee; + $debugger_object->close_debug_file() + if $debugger_object; + + if ( $fh_tee + && $fh_tee->can('close') + && !ref($tee_file) + && $tee_file ne '-' ) + { + $fh_tee->close() + or Warn("couldn't close TEE file $tee_file: $OS_ERROR\n"); + } # leave logger object open for additional messages $logger_object = $logger_object_final; @@ -4131,7 +4151,9 @@ sub _process_command_line { } } unless ( -e $config_file ) { - Warn("cannot find file given with -pro=$config_file: $ERRNO\n"); + Warn( + "cannot find file given with -pro=$config_file: $OS_ERROR\n" + ); $config_file = EMPTY_STRING; } } diff --git a/lib/Perl/Tidy/Debugger.pm b/lib/Perl/Tidy/Debugger.pm index e7112993..9d955cf2 100644 --- a/lib/Perl/Tidy/Debugger.pm +++ b/lib/Perl/Tidy/Debugger.pm @@ -33,7 +33,7 @@ sub really_open_debug_file { my ( $fh, $filename ) = Perl::Tidy::streamhandle( $debug_file, 'w', $is_encoded_data ); if ( !$fh ) { - Perl::Tidy::Warn("can't open $debug_file: $ERRNO\n"); + Perl::Tidy::Warn("can't open $debug_file: $OS_ERROR\n"); } $self->{_debug_file_opened} = 1; $self->{_fh} = $fh; @@ -46,9 +46,16 @@ sub close_debug_file { my $self = shift; if ( $self->{_debug_file_opened} ) { - if ( !eval { $self->{_fh}->close(); 1 } ) { - - # ok, maybe no close function + my $fh = $self->{_fh}; + my $debug_file = $self->{_debug_file}; + if ( $fh + && $fh->can('close') + && $debug_file ne '-' + && !ref($debug_file) ) + { + $fh->close() + or Perl::Tidy::Warn( + "can't close DEBUG file '$debug_file': $OS_ERROR\n"); } } return; diff --git a/lib/Perl/Tidy/Diagnostics.pm b/lib/Perl/Tidy/Diagnostics.pm index 0a5b5760..8000c664 100644 --- a/lib/Perl/Tidy/Diagnostics.pm +++ b/lib/Perl/Tidy/Diagnostics.pm @@ -75,7 +75,7 @@ sub write_diagnostics { unless ( $self->{_write_diagnostics_count} ) { open( $self->{_fh}, ">", "DIAGNOSTICS" ) - or Perl::Tidy::Die("couldn't open DIAGNOSTICS: $ERRNO\n"); + or Perl::Tidy::Die("couldn't open DIAGNOSTICS: $OS_ERROR\n"); } if ( defined($line_number) ) { diff --git a/lib/Perl/Tidy/HtmlWriter.pm b/lib/Perl/Tidy/HtmlWriter.pm index db399042..e4e5a507 100644 --- a/lib/Perl/Tidy/HtmlWriter.pm +++ b/lib/Perl/Tidy/HtmlWriter.pm @@ -103,7 +103,7 @@ sub new { ( $html_fh, my $html_filename ) = Perl::Tidy::streamhandle( $html_file, 'w' ); unless ($html_fh) { - Perl::Tidy::Warn("can't open $html_file: $ERRNO\n"); + Perl::Tidy::Warn("can't open $html_file: $OS_ERROR\n"); return; } $html_file_opened = 1; @@ -209,14 +209,6 @@ PRE_END }, $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 { # Add an item to the html table of contents. @@ -606,10 +598,14 @@ sub write_style_sheet_file { my $filename = shift; my $fh; unless ( $fh = IO::File->new("> $filename") ) { - Perl::Tidy::Die("can't open $filename: $ERRNO\n"); + Perl::Tidy::Die("can't open $filename: $OS_ERROR\n"); } write_style_sheet_data($fh); - close_object($fh); + if ( $fh->can('close') && $filename ne '-' && !ref($filename) ) { + $fh->close() + or + Perl::Tidy::Warn("can't close style sheet '$filename' : $OS_ERROR\n"); + } return; } ## end sub write_style_sheet_file @@ -718,7 +714,12 @@ sub pod_to_html { # write the pod text to the temporary file $fh_tmp->print($pod_string); - $fh_tmp->close(); + + if ( !$fh_tmp->close() ) { + Perl::Tidy::Warn( + "unable to close temporary file $tmpfile; cannot use pod2html\n"); + return $success_flag; + } # Hand off the pod to pod2html. # Note that we can use the same temporary filename for input and output @@ -963,14 +964,16 @@ sub pod_to_html { $success_flag = 0; } - close_object($html_fh); + if ( $html_fh->can('close') ) { + $html_fh->close(); + } # note that we have to unlink tmpfile before making frames # because the tmpfile may be one of the names used for frames if ( -e $tmpfile ) { unless ( unlink($tmpfile) ) { Perl::Tidy::Warn( - "couldn't unlink temporary file $tmpfile: $ERRNO\n"); + "couldn't unlink temporary file $tmpfile: $OS_ERROR\n"); $success_flag = 0; } } @@ -1018,7 +1021,7 @@ sub make_frame { # 2. The current .html filename is renamed to be the contents panel rename( $html_filename, $src_filename ) or Perl::Tidy::Die( - "Cannot rename $html_filename to $src_filename: $ERRNO\n"); + "Cannot rename $html_filename to $src_filename: $OS_ERROR\n"); # 3. Then use the original html filename for the frame write_frame_html( @@ -1033,7 +1036,7 @@ 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 $fh = IO::File->new( $toc_filename, 'w' ) - or Perl::Tidy::Die("Cannot open $toc_filename: $ERRNO\n"); + or Perl::Tidy::Die("Cannot open $toc_filename: $OS_ERROR\n"); $fh->print(< @@ -1064,7 +1067,7 @@ sub write_frame_html { ) = @_; my $fh = IO::File->new( $frame_filename, 'w' ) - or Perl::Tidy::Die("Cannot open $toc_basename: $ERRNO\n"); + or Perl::Tidy::Die("Cannot open $toc_basename: $OS_ERROR\n"); $fh->print(<print( <<"PRE_END"); PRE_END - close_object($html_fh); + $html_fh->close() + if ( $html_fh->can('close') ); return; } @@ -1273,7 +1277,8 @@ END_PRE HTML_END - close_object($html_fh); + $html_fh->close() + if ( $html_fh->can('close') ); if ( $rOpts->{'frames'} ) { ##my @toc = map { $_ .= "\n" } split /\n/, ${$rtoc_string}; diff --git a/lib/Perl/Tidy/IOScalar.pm b/lib/Perl/Tidy/IOScalar.pm index d8f80b46..434c366d 100644 --- a/lib/Perl/Tidy/IOScalar.pm +++ b/lib/Perl/Tidy/IOScalar.pm @@ -12,6 +12,7 @@ use warnings; use Carp; our $VERSION = '20230701.03'; +use constant DEVEL_MODE => 0; use constant EMPTY_STRING => q{}; sub AUTOLOAD { @@ -21,6 +22,10 @@ sub AUTOLOAD { # except for a programming error. our $AUTOLOAD; return if ( $AUTOLOAD =~ /\bDESTROY$/ ); + + # Originally there was a dummy sub close. All calls to it should have been + # eliminated, but for safety we will check for them here. + return 1 if ( $AUTOLOAD =~ /\bclose$/ && !DEVEL_MODE ); my ( $pkg, $fname, $lno ) = caller(); my $my_package = __PACKAGE__; print {*STDERR} <[0] } .= $msg; return; } -sub close { return } 1; - diff --git a/lib/Perl/Tidy/IOScalarArray.pm b/lib/Perl/Tidy/IOScalarArray.pm index 197f1705..af262f4e 100644 --- a/lib/Perl/Tidy/IOScalarArray.pm +++ b/lib/Perl/Tidy/IOScalarArray.pm @@ -16,6 +16,8 @@ use warnings; use Carp; our $VERSION = '20230701.03'; +use constant DEVEL_MODE => 0; + sub AUTOLOAD { # Catch any undefined sub calls so that we are sure to get @@ -23,6 +25,10 @@ sub AUTOLOAD { # except for a programming error. our $AUTOLOAD; return if ( $AUTOLOAD =~ /\bDESTROY$/ ); + + # Originally there was a dummy sub close. All calls to it should have been + # eliminated, but for safety we will check for them here. + return 1 if ( $AUTOLOAD =~ /\bclose$/ && !DEVEL_MODE ); my ( $pkg, $fname, $lno ) = caller(); my $my_package = __PACKAGE__; print {*STDERR} <[0] }, $msg; return; } -sub close { return } 1; - diff --git a/lib/Perl/Tidy/Logger.pm b/lib/Perl/Tidy/Logger.pm index ef07c214..5f9651fc 100644 --- a/lib/Perl/Tidy/Logger.pm +++ b/lib/Perl/Tidy/Logger.pm @@ -72,7 +72,7 @@ sub new { if ( -e $warning_file ) { unlink($warning_file) or Perl::Tidy::Die( - "couldn't unlink warning file $warning_file: $ERRNO\n"); + "couldn't unlink warning file $warning_file: $OS_ERROR\n"); } } @@ -385,7 +385,7 @@ sub warning { ( $fh_warnings, my $filename ) = Perl::Tidy::streamhandle( $warning_file, 'w', $is_encoded_data ); $fh_warnings - or Perl::Tidy::Die("couldn't open $filename: $ERRNO\n"); + or Perl::Tidy::Die("couldn't open $filename: $OS_ERROR\n"); Perl::Tidy::Warn_msg("## Please see file $filename\n") unless ref($warning_file); $self->{_fh_warnings} = $fh_warnings; @@ -506,11 +506,13 @@ sub finish { if ($fh) { my $routput_array = $self->{_output_array}; foreach my $line ( @{$routput_array} ) { $fh->print($line) } - if ( $log_file ne '-' && !ref $log_file ) { - my $ok = eval { $fh->close(); 1 }; - if ( !$ok && DEVEL_MODE ) { - Fault("Could not close file handle(): $EVAL_ERROR\n"); - } + if ( $fh->can('close') + && !ref($log_file) ne '-' + && $log_file ne '-' ) + { + $fh->close() + or Perl::Tidy::Warn( + "Error closing LOG file '$log_file': $OS_ERROR\n"); } } }