1 #####################################################################
3 # The Perl::Tidy::Logger class writes the .LOG and .ERR files
5 #####################################################################
7 package Perl::Tidy::Logger;
10 our $VERSION = '20221112';
11 use English qw( -no_match_vars );
13 use constant DEVEL_MODE => 0;
14 use constant EMPTY_STRING => q{};
15 use constant SPACE => q{ };
19 # Catch any undefined sub calls so that we are sure to get
20 # some diagnostic information. This sub should never be called
21 # except for a programming error.
23 return if ( $AUTOLOAD =~ /\bDESTROY$/ );
24 my ( $pkg, $fname, $lno ) = caller();
25 my $my_package = __PACKAGE__;
27 ======================================================================
28 Error detected in package '$my_package', version $VERSION
29 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
30 Called from package: '$pkg'
31 Called from File '$fname' at line '$lno'
32 This error is probably due to a recent programming change
33 ======================================================================
40 # required to avoid call to AUTOLOAD in some versions of perl
43 use constant DEFAULT_LOGFILE_GAP => 50;
47 my ( $class, @args ) = @_;
52 warning_file => undef,
54 display_name => undef,
55 is_encoded_data => undef,
58 my %args = ( %defaults, @args );
60 my $rOpts = $args{rOpts};
61 my $log_file = $args{log_file};
62 my $warning_file = $args{warning_file};
63 my $fh_stderr = $args{fh_stderr};
64 my $display_name = $args{display_name};
65 my $is_encoded_data = $args{is_encoded_data};
67 my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
69 # remove any old error output file if we might write a new one
70 unless ( $fh_warnings || ref($warning_file) ) {
71 if ( -e $warning_file ) {
74 "couldn't unlink warning file $warning_file: $ERRNO\n");
79 defined( $rOpts->{'logfile-gap'} )
80 ? $rOpts->{'logfile-gap'}
81 : DEFAULT_LOGFILE_GAP;
82 if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
84 my $filename_stamp = $display_name ? $display_name . ':' : "??";
85 my $input_stream_name = $display_name ? $display_name : "??";
87 _log_file => $log_file,
88 _logfile_gap => $logfile_gap,
90 _fh_warnings => $fh_warnings,
91 _last_input_line_written => 0,
94 _block_log_output => 0,
95 _line_of_tokens => undef,
96 _output_line_number => undef,
97 _wrote_line_information_string => 0,
98 _wrote_column_headings => 0,
99 _warning_file => $warning_file,
101 _complaint_count => 0,
102 _is_encoded_data => $is_encoded_data,
103 _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
104 _saw_brace_error => 0,
106 _input_stream_name => $input_stream_name,
107 _filename_stamp => $filename_stamp,
111 sub get_input_stream_name {
113 return $self->{_input_stream_name};
116 sub get_warning_count {
118 return $self->{_warning_count};
123 return $self->{_use_prefix};
126 sub block_log_output {
128 $self->{_block_log_output} = 1;
132 sub unblock_log_output {
134 $self->{_block_log_output} = 0;
138 sub interrupt_logfile {
140 $self->{_use_prefix} = 0;
141 $self->warning("\n");
142 $self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
148 $self->write_logfile_entry( '#' x 60 . "\n" );
149 $self->{_use_prefix} = 1;
153 sub we_are_at_the_last_line {
155 unless ( $self->{_wrote_line_information_string} ) {
156 $self->write_logfile_entry("Last line\n\n");
158 $self->{_at_end_of_file} = 1;
162 # record some stuff in case we go down in flames
163 use constant MAX_PRINTED_CHARS => 35;
166 my ( $self, $line_of_tokens, $output_line_number ) = @_;
167 my $input_line = $line_of_tokens->{_line_text};
168 my $input_line_number = $line_of_tokens->{_line_number};
170 # save line information in case we have to write a logfile message
171 $self->{_line_of_tokens} = $line_of_tokens;
172 $self->{_output_line_number} = $output_line_number;
173 $self->{_wrote_line_information_string} = 0;
175 my $last_input_line_written = $self->{_last_input_line_written};
178 ( $input_line_number - $last_input_line_written ) >=
179 $self->{_logfile_gap}
181 || ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ )
184 my $structural_indentation_level = $line_of_tokens->{_level_0};
185 $structural_indentation_level = 0
186 if ( $structural_indentation_level < 0 );
187 $self->{_last_input_line_written} = $input_line_number;
188 ( my $out_str = $input_line ) =~ s/^\s*//;
191 $out_str = ( '.' x $structural_indentation_level ) . $out_str;
193 if ( length($out_str) > MAX_PRINTED_CHARS ) {
194 $out_str = substr( $out_str, 0, MAX_PRINTED_CHARS ) . " ....";
196 $self->logfile_output( EMPTY_STRING, "$out_str\n" );
201 sub write_logfile_entry {
203 my ( $self, @msg ) = @_;
205 # add leading >>> to avoid confusing error messages and code
206 $self->logfile_output( ">>>", "@msg" );
210 sub write_column_headings {
213 $self->{_wrote_column_headings} = 1;
214 my $routput_array = $self->{_output_array};
215 push @{$routput_array}, <<EOM;
217 Starting formatting pass...
218 The nesting depths in the table below are at the start of the lines.
219 The indicated output line numbers are not always exact.
220 ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
222 in:out indent c b nesting code + messages; (messages begin with >>>)
223 lines levels i k (code begins with one '.' per indent level)
224 ------ ----- - - -------- -------------------------------------------
229 sub make_line_information_string {
231 # make columns of information when a logfile message needs to go out
233 my $line_of_tokens = $self->{_line_of_tokens};
234 my $input_line_number = $line_of_tokens->{_line_number};
235 my $line_information_string = EMPTY_STRING;
236 if ($input_line_number) {
238 my $output_line_number = $self->{_output_line_number};
239 my $brace_depth = $line_of_tokens->{_curly_brace_depth};
240 my $paren_depth = $line_of_tokens->{_paren_depth};
241 my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
242 my $guessed_indentation_level =
243 $line_of_tokens->{_guessed_indentation_level};
245 my $structural_indentation_level = $line_of_tokens->{_level_0};
247 $self->write_column_headings() unless $self->{_wrote_column_headings};
249 # keep logfile columns aligned for scripts up to 999 lines;
250 # for longer scripts it doesn't really matter
251 my $extra_space = EMPTY_STRING;
253 ( $input_line_number < 10 ) ? SPACE x 2
254 : ( $input_line_number < 100 ) ? SPACE
257 ( $output_line_number < 10 ) ? SPACE x 2
258 : ( $output_line_number < 100 ) ? SPACE
261 # there are 2 possible nesting strings:
262 # the original which looks like this: (0 [1 {2
263 # the new one, which looks like this: {{[
264 # the new one is easier to read, and shows the order, but
265 # could be arbitrarily long, so we use it unless it is too long
267 "($paren_depth [$square_bracket_depth {$brace_depth";
268 my $nesting_string_new = $line_of_tokens->{_nesting_tokens_0};
269 my $ci_level = $line_of_tokens->{_ci_level_0};
270 if ( $ci_level > 9 ) { $ci_level = '*' }
271 my $bk = ( $line_of_tokens->{_nesting_blocks_0} =~ /1$/ ) ? '1' : '0';
273 if ( length($nesting_string_new) <= 8 ) {
275 $nesting_string_new . SPACE x ( 8 - length($nesting_string_new) );
277 $line_information_string =
278 "L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
280 return $line_information_string;
284 my ( $self, $prompt, $msg ) = @_;
285 return if ( $self->{_block_log_output} );
287 my $routput_array = $self->{_output_array};
288 if ( $self->{_at_end_of_file} || !$self->{_use_prefix} ) {
289 push @{$routput_array}, "$msg";
292 my $line_information_string = $self->make_line_information_string();
293 $self->{_wrote_line_information_string} = 1;
295 if ($line_information_string) {
296 push @{$routput_array}, "$line_information_string $prompt$msg";
299 push @{$routput_array}, "$msg";
305 sub get_saw_brace_error {
307 return $self->{_saw_brace_error};
310 sub increment_brace_error {
312 $self->{_saw_brace_error}++;
317 my ( $self, $msg ) = @_;
319 use constant BRACE_WARNING_LIMIT => 10;
320 my $saw_brace_error = $self->{_saw_brace_error};
322 if ( $saw_brace_error < BRACE_WARNING_LIMIT ) {
323 $self->warning($msg);
326 $self->{_saw_brace_error} = $saw_brace_error;
328 if ( $saw_brace_error == BRACE_WARNING_LIMIT ) {
329 $self->warning("No further warnings of this type will be given\n");
336 # handle non-critical warning messages based on input flag
337 my ( $self, $msg ) = @_;
338 my $rOpts = $self->{_rOpts};
340 # these appear in .ERR output only if -w flag is used
341 if ( $rOpts->{'warning-output'} ) {
342 $self->warning($msg);
345 # otherwise, they go to the .LOG file
347 $self->{_complaint_count}++;
348 $self->write_logfile_entry($msg);
355 # report errors to .ERR file (or stdout)
356 my ( $self, $msg ) = @_;
358 use constant WARNING_LIMIT => 50;
360 # Always bump the warn count, even if no message goes out
361 Perl::Tidy::Warn_count_bump();
363 my $rOpts = $self->{_rOpts};
364 unless ( $rOpts->{'quiet'} ) {
366 my $warning_count = $self->{_warning_count};
367 my $fh_warnings = $self->{_fh_warnings};
368 my $is_encoded_data = $self->{_is_encoded_data};
369 if ( !$fh_warnings ) {
370 my $warning_file = $self->{_warning_file};
371 ( $fh_warnings, my $filename ) =
372 Perl::Tidy::streamhandle( $warning_file, 'w', $is_encoded_data );
374 or Perl::Tidy::Die("couldn't open $filename: $ERRNO\n");
375 Perl::Tidy::Warn_msg("## Please see file $filename\n")
376 unless ref($warning_file);
377 $self->{_fh_warnings} = $fh_warnings;
378 $fh_warnings->print("Perltidy version is $Perl::Tidy::VERSION\n");
381 my $filename_stamp = $self->{_filename_stamp};
383 if ( $warning_count < WARNING_LIMIT ) {
385 if ( !$warning_count ) {
387 # On first error always write a line with the filename. Note
388 # that the filename will be 'perltidy' if input is from stdin
389 # or from a data structure.
390 if ($filename_stamp) {
392 "\n$filename_stamp Begin Error Output Stream\n");
395 # Turn off filename stamping unless error output is directed
396 # to the standard error output (with -se flag)
397 if ( !$rOpts->{'standard-error-output'} ) {
398 $filename_stamp = EMPTY_STRING;
399 $self->{_filename_stamp} = $filename_stamp;
403 if ( $self->get_use_prefix() > 0 ) {
404 $self->write_logfile_entry("WARNING: $msg");
406 # add prefix 'filename:line_no: ' to message lines
407 my $input_line_number =
408 Perl::Tidy::Tokenizer::get_input_line_number();
409 if ( !defined($input_line_number) ) { $input_line_number = -1 }
410 my $pre_string = $filename_stamp . $input_line_number . ': ';
412 $msg =~ s/\n/\n$pre_string/g;
413 $msg = $pre_string . $msg . "\n";
415 $fh_warnings->print($msg);
419 $self->write_logfile_entry($msg);
421 # add prefix 'filename: ' to message lines
422 if ($filename_stamp) {
423 my $pre_string = $filename_stamp . SPACE;
425 $msg =~ s/\n/\n$pre_string/g;
426 $msg = $pre_string . $msg . "\n";
429 $fh_warnings->print($msg);
433 $self->{_warning_count} = $warning_count;
435 if ( $warning_count == WARNING_LIMIT ) {
437 $filename_stamp . "No further warnings will be given\n" );
443 sub report_definite_bug {
445 $self->{_saw_code_bug} = 1;
449 sub get_save_logfile {
451 # To be called after tokenizer has finished to make formatting more
454 my $saw_code_bug = $self->{_saw_code_bug};
455 my $rOpts = $self->{_rOpts};
456 return $saw_code_bug == 1 || $rOpts->{'logfile'};
461 # called after all formatting to summarize errors
464 my $rOpts = $self->{_rOpts};
465 my $warning_count = $self->{_warning_count};
466 my $saw_code_bug = $self->{_saw_code_bug};
468 my $save_logfile = $saw_code_bug == 1
469 || $rOpts->{'logfile'};
470 my $log_file = $self->{_log_file};
471 if ($warning_count) {
473 $self->block_log_output(); # avoid echoing this to the logfile
475 "The logfile $log_file may contain useful information\n");
476 $self->unblock_log_output();
479 if ( $self->{_complaint_count} > 0 ) {
481 "To see $self->{_complaint_count} non-critical warnings rerun with -w\n"
485 if ( $self->{_saw_brace_error}
486 && ( $self->{_logfile_gap} > 1 || !$save_logfile ) )
488 $self->warning("To save a full .LOG file rerun with -g\n");
493 my $is_encoded_data = $self->{_is_encoded_data};
494 my ( $fh, $filename ) =
495 Perl::Tidy::streamhandle( $log_file, 'w', $is_encoded_data );
497 my $routput_array = $self->{_output_array};
498 foreach my $line ( @{$routput_array} ) { $fh->print($line) }
499 if ( $log_file ne '-' && !ref $log_file ) {
500 my $ok = eval { $fh->close(); 1 };
501 if ( !$ok && DEVEL_MODE ) {
502 Fault("Could not close file handle(): $EVAL_ERROR\n");