package Perl::Tidy::Logger;
use strict;
use warnings;
-our $VERSION = '20190601';
+our $VERSION = '20220217';
+
+sub AUTOLOAD {
+
+ # Catch any undefined sub calls so that we are sure to get
+ # some diagnostic information. This sub should never be called
+ # except for a programming error.
+ our $AUTOLOAD;
+ return if ( $AUTOLOAD =~ /\bDESTROY$/ );
+ my ( $pkg, $fname, $lno ) = caller();
+ my $my_package = __PACKAGE__;
+ print STDERR <<EOM;
+======================================================================
+Error detected in package '$my_package', version $VERSION
+Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
+Called from package: '$pkg'
+Called from File '$fname' at line '$lno'
+This error is probably due to a recent programming change
+======================================================================
+EOM
+ exit 1;
+}
+
+sub DESTROY {
+
+ # required to avoid call to AUTOLOAD in some versions of perl
+}
sub new {
- my ( $class, $rOpts, $log_file, $warning_file, $fh_stderr, $saw_extrude ) =
- @_;
+ my ( $class, @args ) = @_;
+
+ my %defaults = (
+ rOpts => undef,
+ log_file => undef,
+ warning_file => undef,
+ fh_stderr => undef,
+ saw_extruce => undef,
+ display_name => undef,
+ is_encoded_data => undef,
+ );
+
+ my %args = ( %defaults, @args );
+
+ my $rOpts = $args{rOpts};
+ my $log_file = $args{log_file};
+ my $warning_file = $args{warning_file};
+ my $fh_stderr = $args{fh_stderr};
+ my $saw_extrude = $args{saw_extrude};
+ my $display_name = $args{display_name};
+ my $is_encoded_data = $args{is_encoded_data};
my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
: 50;
if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
+ my $filename_stamp = $display_name ? $display_name . ':' : "??";
+ my $input_stream_name = $display_name ? $display_name : "??";
return bless {
_log_file => $log_file,
_logfile_gap => $logfile_gap,
_warning_file => $warning_file,
_warning_count => 0,
_complaint_count => 0,
- _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
- _saw_brace_error => 0,
- _saw_extrude => $saw_extrude,
- _output_array => [],
+ _is_encoded_data => $is_encoded_data,
+ _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
+ _saw_brace_error => 0,
+ _saw_extrude => $saw_extrude,
+ _output_array => [],
+ _input_stream_name => $input_stream_name,
+ _filename_stamp => $filename_stamp,
}, $class;
}
+sub get_input_stream_name {
+ my $self = shift;
+ return $self->{_input_stream_name};
+}
+
sub get_warning_count {
my $self = shift;
return $self->{_warning_count};
$self->{_wrote_line_information_string} = 0;
my $last_input_line_written = $self->{_last_input_line_written};
- my $rOpts = $self->{_rOpts};
if (
(
( $input_line_number - $last_input_line_written ) >=
$self->{_wrote_column_headings} = 1;
my $routput_array = $self->{_output_array};
push @{$routput_array}, <<EOM;
+
+Starting formatting pass...
The nesting depths in the table below are at the start of the lines.
The indicated output line numbers are not always exact.
ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
my $guessed_indentation_level =
$line_of_tokens->{_guessed_indentation_level};
- ##my $rtoken_array = $line_of_tokens->{_rtoken_array};
my $structural_indentation_level = $line_of_tokens->{_level_0};
#use constant WARNING_LIMIT => 50;
my $WARNING_LIMIT = 50;
+ # Always bump the warn count, even if no message goes out
+ Perl::Tidy::Warn_count_bump();
+
my $rOpts = $self->{_rOpts};
unless ( $rOpts->{'quiet'} ) {
- my $warning_count = $self->{_warning_count};
- my $fh_warnings = $self->{_fh_warnings};
+ my $warning_count = $self->{_warning_count};
+ my $fh_warnings = $self->{_fh_warnings};
+ my $is_encoded_data = $self->{_is_encoded_data};
if ( !$fh_warnings ) {
my $warning_file = $self->{_warning_file};
( $fh_warnings, my $filename ) =
- Perl::Tidy::streamhandle( $warning_file, 'w' );
+ Perl::Tidy::streamhandle( $warning_file, 'w', $is_encoded_data );
$fh_warnings or Perl::Tidy::Die("couldn't open $filename $!\n");
- Perl::Tidy::Warn("## Please see file $filename\n")
+ Perl::Tidy::Warn_msg("## Please see file $filename\n")
unless ref($warning_file);
$self->{_fh_warnings} = $fh_warnings;
$fh_warnings->print("Perltidy version is $Perl::Tidy::VERSION\n");
}
+ my $filename_stamp = $self->{_filename_stamp};
+
if ( $warning_count < $WARNING_LIMIT ) {
+
+ if ( !$warning_count ) {
+
+ # On first error always write a line with the filename. Note
+ # that the filename will be 'perltidy' if input is from stdin
+ # or from a data structure.
+ if ($filename_stamp) {
+ $fh_warnings->print(
+ "\n$filename_stamp Begin Error Output Stream\n");
+ }
+
+ # Turn off filename stamping unless error output is directed
+ # to the standard error output (with -se flag)
+ if ( !$rOpts->{'standard-error-output'} ) {
+ $filename_stamp = "";
+ $self->{_filename_stamp} = $filename_stamp;
+ }
+ }
+
if ( $self->get_use_prefix() > 0 ) {
+ $self->write_logfile_entry("WARNING: $msg");
+
+ # add prefix 'filename:line_no: ' to message lines
my $input_line_number =
Perl::Tidy::Tokenizer::get_input_line_number();
if ( !defined($input_line_number) ) { $input_line_number = -1 }
- $fh_warnings->print("$input_line_number:\t$msg");
- $self->write_logfile_entry("WARNING: $msg");
+ my $pre_string = $filename_stamp . $input_line_number . ': ';
+ chomp $msg;
+ $msg =~ s/\n/\n$pre_string/g;
+ $msg = $pre_string . $msg . "\n";
+
+ $fh_warnings->print($msg);
+
}
else {
- $fh_warnings->print($msg);
$self->write_logfile_entry($msg);
+
+ # add prefix 'filename: ' to message lines
+ if ($filename_stamp) {
+ my $pre_string = $filename_stamp . " ";
+ chomp $msg;
+ $msg =~ s/\n/\n$pre_string/g;
+ $msg = $pre_string . $msg . "\n";
+ }
+
+ $fh_warnings->print($msg);
}
}
$warning_count++;
$self->{_warning_count} = $warning_count;
if ( $warning_count == $WARNING_LIMIT ) {
- $fh_warnings->print("No further warnings will be given\n");
+ $fh_warnings->print(
+ $filename_stamp . "No further warnings will be given\n" );
}
}
return;
}
-# programming bug codes:
-# -1 = no bug
-# 0 = maybe, not sure.
-# 1 = definitely
-sub report_possible_bug {
- my $self = shift;
- my $saw_code_bug = $self->{_saw_code_bug};
- $self->{_saw_code_bug} = ( $saw_code_bug < 0 ) ? 0 : $saw_code_bug;
- return;
-}
-
sub report_definite_bug {
my $self = shift;
$self->{_saw_code_bug} = 1;
return;
}
-sub ask_user_for_bug_report {
+sub get_save_logfile {
- my ( $self, $infile_syntax_ok, $formatter ) = @_;
+ # To be called after tokenizer has finished to make formatting more
+ # efficient.
+ my $self = shift;
my $saw_code_bug = $self->{_saw_code_bug};
- if ( ( $saw_code_bug == 0 ) && ( $infile_syntax_ok == 1 ) ) {
- $self->warning(<<EOM);
-
-You may have encountered a code bug in perltidy. If you think so, and
-the problem is not listed in the BUGS file at
-http://perltidy.sourceforge.net, please report it so that it can be
-corrected. Include the smallest possible script which has the problem,
-along with the .LOG file. See the manual pages for contact information.
-Thank you!
-EOM
-
- }
- elsif ( $saw_code_bug == 1 ) {
- if ( $self->{_saw_extrude} ) {
- $self->warning(<<EOM);
-
-You may have encountered a bug in perltidy. However, since you are using the
--extrude option, the problem may be with perl or one of its modules, which have
-occasional problems with this type of file. If you believe that the
-problem is with perltidy, and the problem is not listed in the BUGS file at
-http://perltidy.sourceforge.net, please report it so that it can be corrected.
-Include the smallest possible script which has the problem, along with the .LOG
-file. See the manual pages for contact information.
-Thank you!
-EOM
- }
- else {
- $self->warning(<<EOM);
-
-Oops, you seem to have encountered a bug in perltidy. Please check the
-BUGS file at http://perltidy.sourceforge.net. If the problem is not
-listed there, please report it so that it can be corrected. Include the
-smallest possible script which produces this message, along with the
-.LOG file if appropriate. See the manual pages for contact information.
-Your efforts are appreciated.
-Thank you!
-EOM
- my $added_semicolon_count = 0;
- eval {
- $added_semicolon_count =
- $formatter->get_added_semicolon_count();
- };
- if ( $added_semicolon_count > 0 ) {
- $self->warning(<<EOM);
-
-The log file shows that perltidy added $added_semicolon_count semicolons.
-Please rerun with -nasc to see if that is the cause of the syntax error. Even
-if that is the problem, please report it so that it can be fixed.
-EOM
-
- }
- }
- }
- return;
+ my $rOpts = $self->{_rOpts};
+ return $saw_code_bug == 1 || $rOpts->{'logfile'};
}
sub finish {
# called after all formatting to summarize errors
- my ( $self, $infile_syntax_ok, $formatter ) = @_;
+ my ( $self, $formatter ) = @_;
my $rOpts = $self->{_rOpts};
my $warning_count = $self->{_warning_count};
my $saw_code_bug = $self->{_saw_code_bug};
- my $save_logfile =
- ( $saw_code_bug == 0 && $infile_syntax_ok == 1 )
- || $saw_code_bug == 1
+ my $save_logfile = $saw_code_bug == 1
|| $rOpts->{'logfile'};
my $log_file = $self->{_log_file};
if ($warning_count) {
$self->warning("To save a full .LOG file rerun with -g\n");
}
}
- $self->ask_user_for_bug_report( $infile_syntax_ok, $formatter );
if ($save_logfile) {
- my $log_file = $self->{_log_file};
- my ( $fh, $filename ) = Perl::Tidy::streamhandle( $log_file, 'w' );
+ my $log_file = $self->{_log_file};
+ my $is_encoded_data = $self->{_is_encoded_data};
+ my ( $fh, $filename ) =
+ Perl::Tidy::streamhandle( $log_file, 'w', $is_encoded_data );
if ($fh) {
my $routput_array = $self->{_output_array};
foreach ( @{$routput_array} ) { $fh->print($_) }
projects / perltidy.git / blobdiff