1 #####################################################################
3 # The Perl::Tidy::Logger class writes the .LOG and .ERR files
5 #####################################################################
7 package Perl::Tidy::Logger;
10 our $VERSION = '20220217';
14 # Catch any undefined sub calls so that we are sure to get
15 # some diagnostic information. This sub should never be called
16 # except for a programming error.
18 return if ( $AUTOLOAD =~ /\bDESTROY$/ );
19 my ( $pkg, $fname, $lno ) = caller();
20 my $my_package = __PACKAGE__;
22 ======================================================================
23 Error detected in package '$my_package', version $VERSION
24 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
25 Called from package: '$pkg'
26 Called from File '$fname' at line '$lno'
27 This error is probably due to a recent programming change
28 ======================================================================
35 # required to avoid call to AUTOLOAD in some versions of perl
40 my ( $class, @args ) = @_;
45 warning_file => undef,
48 display_name => undef,
49 is_encoded_data => undef,
52 my %args = ( %defaults, @args );
54 my $rOpts = $args{rOpts};
55 my $log_file = $args{log_file};
56 my $warning_file = $args{warning_file};
57 my $fh_stderr = $args{fh_stderr};
58 my $saw_extrude = $args{saw_extrude};
59 my $display_name = $args{display_name};
60 my $is_encoded_data = $args{is_encoded_data};
62 my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
64 # remove any old error output file if we might write a new one
65 unless ( $fh_warnings || ref($warning_file) ) {
66 if ( -e $warning_file ) {
69 "couldn't unlink warning file $warning_file: $!\n");
74 defined( $rOpts->{'logfile-gap'} )
75 ? $rOpts->{'logfile-gap'}
77 if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
79 my $filename_stamp = $display_name ? $display_name . ':' : "??";
80 my $input_stream_name = $display_name ? $display_name : "??";
82 _log_file => $log_file,
83 _logfile_gap => $logfile_gap,
85 _fh_warnings => $fh_warnings,
86 _last_input_line_written => 0,
89 _block_log_output => 0,
90 _line_of_tokens => undef,
91 _output_line_number => undef,
92 _wrote_line_information_string => 0,
93 _wrote_column_headings => 0,
94 _warning_file => $warning_file,
96 _complaint_count => 0,
97 _is_encoded_data => $is_encoded_data,
98 _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
99 _saw_brace_error => 0,
100 _saw_extrude => $saw_extrude,
102 _input_stream_name => $input_stream_name,
103 _filename_stamp => $filename_stamp,
107 sub get_input_stream_name {
109 return $self->{_input_stream_name};
112 sub get_warning_count {
114 return $self->{_warning_count};
119 return $self->{_use_prefix};
122 sub block_log_output {
124 $self->{_block_log_output} = 1;
128 sub unblock_log_output {
130 $self->{_block_log_output} = 0;
134 sub interrupt_logfile {
136 $self->{_use_prefix} = 0;
137 $self->warning("\n");
138 $self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
144 $self->write_logfile_entry( '#' x 60 . "\n" );
145 $self->{_use_prefix} = 1;
149 sub we_are_at_the_last_line {
151 unless ( $self->{_wrote_line_information_string} ) {
152 $self->write_logfile_entry("Last line\n\n");
154 $self->{_at_end_of_file} = 1;
158 # record some stuff in case we go down in flames
160 my ( $self, $line_of_tokens, $output_line_number ) = @_;
161 my $input_line = $line_of_tokens->{_line_text};
162 my $input_line_number = $line_of_tokens->{_line_number};
164 # save line information in case we have to write a logfile message
165 $self->{_line_of_tokens} = $line_of_tokens;
166 $self->{_output_line_number} = $output_line_number;
167 $self->{_wrote_line_information_string} = 0;
169 my $last_input_line_written = $self->{_last_input_line_written};
172 ( $input_line_number - $last_input_line_written ) >=
173 $self->{_logfile_gap}
175 || ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ )
178 my $structural_indentation_level = $line_of_tokens->{_level_0};
179 $structural_indentation_level = 0
180 if ( $structural_indentation_level < 0 );
181 $self->{_last_input_line_written} = $input_line_number;
182 ( my $out_str = $input_line ) =~ s/^\s*//;
185 $out_str = ( '.' x $structural_indentation_level ) . $out_str;
187 if ( length($out_str) > 35 ) {
188 $out_str = substr( $out_str, 0, 35 ) . " ....";
190 $self->logfile_output( "", "$out_str\n" );
195 sub write_logfile_entry {
197 my ( $self, @msg ) = @_;
199 # add leading >>> to avoid confusing error messages and code
200 $self->logfile_output( ">>>", "@msg" );
204 sub write_column_headings {
207 $self->{_wrote_column_headings} = 1;
208 my $routput_array = $self->{_output_array};
209 push @{$routput_array}, <<EOM;
211 Starting formatting pass...
212 The nesting depths in the table below are at the start of the lines.
213 The indicated output line numbers are not always exact.
214 ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
216 in:out indent c b nesting code + messages; (messages begin with >>>)
217 lines levels i k (code begins with one '.' per indent level)
218 ------ ----- - - -------- -------------------------------------------
223 sub make_line_information_string {
225 # make columns of information when a logfile message needs to go out
227 my $line_of_tokens = $self->{_line_of_tokens};
228 my $input_line_number = $line_of_tokens->{_line_number};
229 my $line_information_string = "";
230 if ($input_line_number) {
232 my $output_line_number = $self->{_output_line_number};
233 my $brace_depth = $line_of_tokens->{_curly_brace_depth};
234 my $paren_depth = $line_of_tokens->{_paren_depth};
235 my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
236 my $guessed_indentation_level =
237 $line_of_tokens->{_guessed_indentation_level};
239 my $structural_indentation_level = $line_of_tokens->{_level_0};
241 $self->write_column_headings() unless $self->{_wrote_column_headings};
243 # keep logfile columns aligned for scripts up to 999 lines;
244 # for longer scripts it doesn't really matter
245 my $extra_space = "";
247 ( $input_line_number < 10 ) ? " "
248 : ( $input_line_number < 100 ) ? " "
251 ( $output_line_number < 10 ) ? " "
252 : ( $output_line_number < 100 ) ? " "
255 # there are 2 possible nesting strings:
256 # the original which looks like this: (0 [1 {2
257 # the new one, which looks like this: {{[
258 # the new one is easier to read, and shows the order, but
259 # could be arbitrarily long, so we use it unless it is too long
261 "($paren_depth [$square_bracket_depth {$brace_depth";
262 my $nesting_string_new = $line_of_tokens->{_nesting_tokens_0};
263 my $ci_level = $line_of_tokens->{_ci_level_0};
264 if ( $ci_level > 9 ) { $ci_level = '*' }
265 my $bk = ( $line_of_tokens->{_nesting_blocks_0} =~ /1$/ ) ? '1' : '0';
267 if ( length($nesting_string_new) <= 8 ) {
269 $nesting_string_new . " " x ( 8 - length($nesting_string_new) );
271 $line_information_string =
272 "L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
274 return $line_information_string;
278 my ( $self, $prompt, $msg ) = @_;
279 return if ( $self->{_block_log_output} );
281 my $routput_array = $self->{_output_array};
282 if ( $self->{_at_end_of_file} || !$self->{_use_prefix} ) {
283 push @{$routput_array}, "$msg";
286 my $line_information_string = $self->make_line_information_string();
287 $self->{_wrote_line_information_string} = 1;
289 if ($line_information_string) {
290 push @{$routput_array}, "$line_information_string $prompt$msg";
293 push @{$routput_array}, "$msg";
299 sub get_saw_brace_error {
301 return $self->{_saw_brace_error};
304 sub increment_brace_error {
306 $self->{_saw_brace_error}++;
311 my ( $self, $msg ) = @_;
313 #use constant BRACE_WARNING_LIMIT => 10;
314 my $BRACE_WARNING_LIMIT = 10;
315 my $saw_brace_error = $self->{_saw_brace_error};
317 if ( $saw_brace_error < $BRACE_WARNING_LIMIT ) {
318 $self->warning($msg);
321 $self->{_saw_brace_error} = $saw_brace_error;
323 if ( $saw_brace_error == $BRACE_WARNING_LIMIT ) {
324 $self->warning("No further warnings of this type will be given\n");
331 # handle non-critical warning messages based on input flag
332 my ( $self, $msg ) = @_;
333 my $rOpts = $self->{_rOpts};
335 # these appear in .ERR output only if -w flag is used
336 if ( $rOpts->{'warning-output'} ) {
337 $self->warning($msg);
340 # otherwise, they go to the .LOG file
342 $self->{_complaint_count}++;
343 $self->write_logfile_entry($msg);
350 # report errors to .ERR file (or stdout)
351 my ( $self, $msg ) = @_;
353 #use constant WARNING_LIMIT => 50;
354 my $WARNING_LIMIT = 50;
356 # Always bump the warn count, even if no message goes out
357 Perl::Tidy::Warn_count_bump();
359 my $rOpts = $self->{_rOpts};
360 unless ( $rOpts->{'quiet'} ) {
362 my $warning_count = $self->{_warning_count};
363 my $fh_warnings = $self->{_fh_warnings};
364 my $is_encoded_data = $self->{_is_encoded_data};
365 if ( !$fh_warnings ) {
366 my $warning_file = $self->{_warning_file};
367 ( $fh_warnings, my $filename ) =
368 Perl::Tidy::streamhandle( $warning_file, 'w', $is_encoded_data );
369 $fh_warnings or Perl::Tidy::Die("couldn't open $filename $!\n");
370 Perl::Tidy::Warn_msg("## Please see file $filename\n")
371 unless ref($warning_file);
372 $self->{_fh_warnings} = $fh_warnings;
373 $fh_warnings->print("Perltidy version is $Perl::Tidy::VERSION\n");
376 my $filename_stamp = $self->{_filename_stamp};
378 if ( $warning_count < $WARNING_LIMIT ) {
380 if ( !$warning_count ) {
382 # On first error always write a line with the filename. Note
383 # that the filename will be 'perltidy' if input is from stdin
384 # or from a data structure.
385 if ($filename_stamp) {
387 "\n$filename_stamp Begin Error Output Stream\n");
390 # Turn off filename stamping unless error output is directed
391 # to the standard error output (with -se flag)
392 if ( !$rOpts->{'standard-error-output'} ) {
393 $filename_stamp = "";
394 $self->{_filename_stamp} = $filename_stamp;
398 if ( $self->get_use_prefix() > 0 ) {
399 $self->write_logfile_entry("WARNING: $msg");
401 # add prefix 'filename:line_no: ' to message lines
402 my $input_line_number =
403 Perl::Tidy::Tokenizer::get_input_line_number();
404 if ( !defined($input_line_number) ) { $input_line_number = -1 }
405 my $pre_string = $filename_stamp . $input_line_number . ': ';
407 $msg =~ s/\n/\n$pre_string/g;
408 $msg = $pre_string . $msg . "\n";
410 $fh_warnings->print($msg);
414 $self->write_logfile_entry($msg);
416 # add prefix 'filename: ' to message lines
417 if ($filename_stamp) {
418 my $pre_string = $filename_stamp . " ";
420 $msg =~ s/\n/\n$pre_string/g;
421 $msg = $pre_string . $msg . "\n";
424 $fh_warnings->print($msg);
428 $self->{_warning_count} = $warning_count;
430 if ( $warning_count == $WARNING_LIMIT ) {
432 $filename_stamp . "No further warnings will be given\n" );
438 sub report_definite_bug {
440 $self->{_saw_code_bug} = 1;
444 sub get_save_logfile {
446 # To be called after tokenizer has finished to make formatting more
449 my $saw_code_bug = $self->{_saw_code_bug};
450 my $rOpts = $self->{_rOpts};
451 return $saw_code_bug == 1 || $rOpts->{'logfile'};
456 # called after all formatting to summarize errors
457 my ( $self, $formatter ) = @_;
459 my $rOpts = $self->{_rOpts};
460 my $warning_count = $self->{_warning_count};
461 my $saw_code_bug = $self->{_saw_code_bug};
463 my $save_logfile = $saw_code_bug == 1
464 || $rOpts->{'logfile'};
465 my $log_file = $self->{_log_file};
466 if ($warning_count) {
468 $self->block_log_output(); # avoid echoing this to the logfile
470 "The logfile $log_file may contain useful information\n");
471 $self->unblock_log_output();
474 if ( $self->{_complaint_count} > 0 ) {
476 "To see $self->{_complaint_count} non-critical warnings rerun with -w\n"
480 if ( $self->{_saw_brace_error}
481 && ( $self->{_logfile_gap} > 1 || !$save_logfile ) )
483 $self->warning("To save a full .LOG file rerun with -g\n");
488 my $log_file = $self->{_log_file};
489 my $is_encoded_data = $self->{_is_encoded_data};
490 my ( $fh, $filename ) =
491 Perl::Tidy::streamhandle( $log_file, 'w', $is_encoded_data );
493 my $routput_array = $self->{_output_array};
494 foreach ( @{$routput_array} ) { $fh->print($_) }
495 if ( $log_file ne '-' && !ref $log_file ) {
496 eval { $fh->close() };