[-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.
# 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
[-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
[-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
# 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);
# 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
# 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
$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 {
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;
}
}
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);
# 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_] ) {
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"
);
}
}
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"
);
}
# 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"
);
}
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"
);
}
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"
);
}
}
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;
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
# 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");
}
}
# 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;
} ## 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;
}
}
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;
}
}
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;
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;
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) ) {
( $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;
}, $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.
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
# 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
$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;
}
}
# 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(
# 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(<<EOM);
<html>
<head>
) = @_;
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(<<EOM);
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
$html_fh->print( <<"PRE_END");
</pre>
PRE_END
- close_object($html_fh);
+ $html_fh->close()
+ if ( $html_fh->can('close') );
return;
}
</body>
</html>
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};
use Carp;
our $VERSION = '20230701.03';
+use constant DEVEL_MODE => 0;
use constant EMPTY_STRING => q{};
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} <<EOM;
${ $self->[0] } .= $msg;
return;
}
-sub close { return }
1;
-
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
# 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} <<EOM;
push @{ $self->[0] }, $msg;
return;
}
-sub close { return }
1;
-
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");
}
}
( $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;
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");
}
}
}
projects / perltidy.git / commitdiff