1 #####################################################################
3 # The Perl::Tidy::Logger class writes any .LOG and .ERR files
4 # and supplies some basic run information for error handling.
6 #####################################################################
8 package Perl::Tidy::Logger;
11 our $VERSION = '20230309';
12 use English qw( -no_match_vars );
14 use constant DEVEL_MODE => 0;
15 use constant EMPTY_STRING => q{};
16 use constant SPACE => q{ };
20 # Catch any undefined sub calls so that we are sure to get
21 # some diagnostic information. This sub should never be called
22 # except for a programming error.
24 return if ( $AUTOLOAD =~ /\bDESTROY$/ );
25 my ( $pkg, $fname, $lno ) = caller();
26 my $my_package = __PACKAGE__;
28 ======================================================================
29 Error detected in package '$my_package', version $VERSION
30 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
31 Called from package: '$pkg'
32 Called from File '$fname' at line '$lno'
33 This error is probably due to a recent programming change
34 ======================================================================
41 # required to avoid call to AUTOLOAD in some versions of perl
44 use constant DEFAULT_LOGFILE_GAP => 50;
48 my ( $class, @args ) = @_;
53 warning_file => undef,
55 display_name => undef,
56 is_encoded_data => undef,
59 my %args = ( %defaults, @args );
61 my $rOpts = $args{rOpts};
62 my $log_file = $args{log_file};
63 my $warning_file = $args{warning_file};
64 my $fh_stderr = $args{fh_stderr};
65 my $display_name = $args{display_name};
66 my $is_encoded_data = $args{is_encoded_data};
68 my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
70 # remove any old error output file if we might write a new one
71 unless ( $fh_warnings || ref($warning_file) ) {
72 if ( -e $warning_file ) {
75 "couldn't unlink warning file $warning_file: $ERRNO\n");
80 defined( $rOpts->{'logfile-gap'} )
81 ? $rOpts->{'logfile-gap'}
82 : DEFAULT_LOGFILE_GAP;
83 if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
85 my $filename_stamp = $display_name ? $display_name . ':' : "??";
86 my $input_stream_name = $display_name ? $display_name : "??";
88 _log_file => $log_file,
89 _logfile_gap => $logfile_gap,
91 _fh_warnings => $fh_warnings,
92 _last_input_line_written => 0,
95 _block_log_output => 0,
96 _line_of_tokens => undef,
97 _output_line_number => undef,
98 _wrote_line_information_string => 0,
99 _wrote_column_headings => 0,
100 _warning_file => $warning_file,
102 _complaint_count => 0,
103 _is_encoded_data => $is_encoded_data,
104 _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
105 _saw_brace_error => 0,
107 _input_stream_name => $input_stream_name,
108 _filename_stamp => $filename_stamp,
109 _save_logfile => $rOpts->{'logfile'},
113 sub get_input_stream_name {
115 return $self->{_input_stream_name};
118 sub get_warning_count {
120 return $self->{_warning_count};
125 return $self->{_use_prefix};
128 sub block_log_output {
130 $self->{_block_log_output} = 1;
134 sub unblock_log_output {
136 $self->{_block_log_output} = 0;
140 sub interrupt_logfile {
142 $self->{_use_prefix} = 0;
143 $self->warning("\n");
144 $self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
146 } ## end sub interrupt_logfile
150 $self->write_logfile_entry( '#' x 60 . "\n" );
151 $self->{_use_prefix} = 1;
153 } ## end sub resume_logfile
155 sub we_are_at_the_last_line {
157 unless ( $self->{_wrote_line_information_string} ) {
158 $self->write_logfile_entry("Last line\n\n");
160 $self->{_at_end_of_file} = 1;
162 } ## end sub we_are_at_the_last_line
164 # record some stuff in case we go down in flames
165 use constant MAX_PRINTED_CHARS => 35;
168 my ( $self, $line_of_tokens, $output_line_number ) = @_;
169 my $input_line = $line_of_tokens->{_line_text};
170 my $input_line_number = $line_of_tokens->{_line_number};
172 # save line information in case we have to write a logfile message
173 $self->{_line_of_tokens} = $line_of_tokens;
174 $self->{_output_line_number} = $output_line_number;
175 $self->{_wrote_line_information_string} = 0;
177 my $last_input_line_written = $self->{_last_input_line_written};
180 ( $input_line_number - $last_input_line_written ) >=
181 $self->{_logfile_gap}
183 || ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ )
186 my $structural_indentation_level = $line_of_tokens->{_level_0};
187 $structural_indentation_level = 0
188 if ( $structural_indentation_level < 0 );
189 $self->{_last_input_line_written} = $input_line_number;
190 ( my $out_str = $input_line ) =~ s/^\s*//;
193 $out_str = ( '.' x $structural_indentation_level ) . $out_str;
195 if ( length($out_str) > MAX_PRINTED_CHARS ) {
196 $out_str = substr( $out_str, 0, MAX_PRINTED_CHARS ) . " ....";
198 $self->logfile_output( EMPTY_STRING, "$out_str\n" );
201 } ## end sub black_box
203 sub write_logfile_entry {
205 my ( $self, @msg ) = @_;
207 # add leading >>> to avoid confusing error messages and code
208 $self->logfile_output( ">>>", "@msg" );
210 } ## end sub write_logfile_entry
212 sub write_column_headings {
215 $self->{_wrote_column_headings} = 1;
216 my $routput_array = $self->{_output_array};
217 push @{$routput_array}, <<EOM;
219 Starting formatting pass...
220 The nesting depths in the table below are at the start of the lines.
221 The indicated output line numbers are not always exact.
222 ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
224 in:out indent c b nesting code + messages; (messages begin with >>>)
225 lines levels i k (code begins with one '.' per indent level)
226 ------ ----- - - -------- -------------------------------------------
229 } ## end sub write_column_headings
231 sub make_line_information_string {
233 # make columns of information when a logfile message needs to go out
235 my $line_of_tokens = $self->{_line_of_tokens};
236 my $input_line_number = $line_of_tokens->{_line_number};
237 my $line_information_string = EMPTY_STRING;
238 if ($input_line_number) {
240 my $output_line_number = $self->{_output_line_number};
241 my $brace_depth = $line_of_tokens->{_curly_brace_depth};
242 my $paren_depth = $line_of_tokens->{_paren_depth};
243 my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
244 my $guessed_indentation_level =
245 $line_of_tokens->{_guessed_indentation_level};
247 my $structural_indentation_level = $line_of_tokens->{_level_0};
249 $self->write_column_headings() unless $self->{_wrote_column_headings};
251 # keep logfile columns aligned for scripts up to 999 lines;
252 # for longer scripts it doesn't really matter
253 my $extra_space = EMPTY_STRING;
255 ( $input_line_number < 10 ) ? SPACE x 2
256 : ( $input_line_number < 100 ) ? SPACE
259 ( $output_line_number < 10 ) ? SPACE x 2
260 : ( $output_line_number < 100 ) ? SPACE
263 # there are 2 possible nesting strings:
264 # the original which looks like this: (0 [1 {2
265 # the new one, which looks like this: {{[
266 # the new one is easier to read, and shows the order, but
267 # could be arbitrarily long, so we use it unless it is too long
269 "($paren_depth [$square_bracket_depth {$brace_depth";
270 my $nesting_string_new = $line_of_tokens->{_nesting_tokens_0};
271 my $ci_level = $line_of_tokens->{_ci_level_0};
272 if ( $ci_level > 9 ) { $ci_level = '*' }
273 my $bk = ( $line_of_tokens->{_nesting_blocks_0} =~ /1$/ ) ? '1' : '0';
275 if ( length($nesting_string_new) <= 8 ) {
277 $nesting_string_new . SPACE x ( 8 - length($nesting_string_new) );
279 $line_information_string =
280 "L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
282 return $line_information_string;
283 } ## end sub make_line_information_string
286 my ( $self, $prompt, $msg ) = @_;
287 return if ( $self->{_block_log_output} );
289 my $routput_array = $self->{_output_array};
290 if ( $self->{_at_end_of_file} || !$self->{_use_prefix} ) {
291 push @{$routput_array}, "$msg";
294 my $line_information_string = $self->make_line_information_string();
295 $self->{_wrote_line_information_string} = 1;
297 if ($line_information_string) {
298 push @{$routput_array}, "$line_information_string $prompt$msg";
301 push @{$routput_array}, "$msg";
305 } ## end sub logfile_output
307 sub get_saw_brace_error {
309 return $self->{_saw_brace_error};
312 sub increment_brace_error {
314 $self->{_saw_brace_error}++;
319 my ( $self, $msg ) = @_;
321 use constant BRACE_WARNING_LIMIT => 10;
322 my $saw_brace_error = $self->{_saw_brace_error};
324 if ( $saw_brace_error < BRACE_WARNING_LIMIT ) {
325 $self->warning($msg);
328 $self->{_saw_brace_error} = $saw_brace_error;
330 if ( $saw_brace_error == BRACE_WARNING_LIMIT ) {
331 $self->warning("No further warnings of this type will be given\n");
334 } ## end sub brace_warning
338 # handle non-critical warning messages based on input flag
339 my ( $self, $msg ) = @_;
340 my $rOpts = $self->{_rOpts};
342 # these appear in .ERR output only if -w flag is used
343 if ( $rOpts->{'warning-output'} ) {
344 $self->warning($msg);
347 # otherwise, they go to the .LOG file
349 $self->{_complaint_count}++;
350 $self->write_logfile_entry($msg);
353 } ## end sub complain
357 # report errors to .ERR file (or stdout)
358 my ( $self, $msg ) = @_;
360 use constant WARNING_LIMIT => 50;
362 # Always bump the warn count, even if no message goes out
363 Perl::Tidy::Warn_count_bump();
365 my $rOpts = $self->{_rOpts};
366 unless ( $rOpts->{'quiet'} ) {
368 my $warning_count = $self->{_warning_count};
369 my $fh_warnings = $self->{_fh_warnings};
370 my $is_encoded_data = $self->{_is_encoded_data};
371 if ( !$fh_warnings ) {
372 my $warning_file = $self->{_warning_file};
373 ( $fh_warnings, my $filename ) =
374 Perl::Tidy::streamhandle( $warning_file, 'w', $is_encoded_data );
376 or Perl::Tidy::Die("couldn't open $filename: $ERRNO\n");
377 Perl::Tidy::Warn_msg("## Please see file $filename\n")
378 unless ref($warning_file);
379 $self->{_fh_warnings} = $fh_warnings;
380 $fh_warnings->print("Perltidy version is $Perl::Tidy::VERSION\n");
383 my $filename_stamp = $self->{_filename_stamp};
385 if ( $warning_count < WARNING_LIMIT ) {
387 if ( !$warning_count ) {
389 # On first error always write a line with the filename. Note
390 # that the filename will be 'perltidy' if input is from stdin
391 # or from a data structure.
392 if ($filename_stamp) {
394 "\n$filename_stamp Begin Error Output Stream\n");
397 # Turn off filename stamping unless error output is directed
398 # to the standard error output (with -se flag)
399 if ( !$rOpts->{'standard-error-output'} ) {
400 $filename_stamp = EMPTY_STRING;
401 $self->{_filename_stamp} = $filename_stamp;
405 if ( $self->get_use_prefix() > 0 ) {
406 $self->write_logfile_entry("WARNING: $msg");
408 # add prefix 'filename:line_no: ' to message lines
409 my $input_line_number =
410 Perl::Tidy::Tokenizer::get_input_line_number();
411 if ( !defined($input_line_number) ) { $input_line_number = -1 }
412 my $pre_string = $filename_stamp . $input_line_number . ': ';
414 $msg =~ s/\n/\n$pre_string/g;
415 $msg = $pre_string . $msg . "\n";
417 $fh_warnings->print($msg);
421 $self->write_logfile_entry($msg);
423 # add prefix 'filename: ' to message lines
424 if ($filename_stamp) {
425 my $pre_string = $filename_stamp . SPACE;
427 $msg =~ s/\n/\n$pre_string/g;
428 $msg = $pre_string . $msg . "\n";
431 $fh_warnings->print($msg);
435 $self->{_warning_count} = $warning_count;
437 if ( $warning_count == WARNING_LIMIT ) {
439 $filename_stamp . "No further warnings will be given\n" );
445 sub report_definite_bug {
447 $self->{_saw_code_bug} = 1;
451 sub get_save_logfile {
453 # Returns a true/false flag indicating whether or not
454 # the logfile will be saved.
456 return $self->{_save_logfile};
457 } ## end sub get_save_logfile
461 # called after all formatting to summarize errors
464 my $warning_count = $self->{_warning_count};
465 my $save_logfile = $self->{_save_logfile};
466 my $log_file = $self->{_log_file};
468 if ($warning_count) {
470 $self->block_log_output(); # avoid echoing this to the logfile
472 "The logfile $log_file may contain useful information\n");
473 $self->unblock_log_output();
476 if ( $self->{_complaint_count} > 0 ) {
478 "To see $self->{_complaint_count} non-critical warnings rerun with -w\n"
482 if ( $self->{_saw_brace_error}
483 && ( $self->{_logfile_gap} > 1 || !$save_logfile ) )
485 $self->warning("To save a full .LOG file rerun with -g\n");
490 my $is_encoded_data = $self->{_is_encoded_data};
491 my ( $fh, $filename ) =
492 Perl::Tidy::streamhandle( $log_file, 'w', $is_encoded_data );
494 my $routput_array = $self->{_output_array};
495 foreach my $line ( @{$routput_array} ) { $fh->print($line) }
496 if ( $log_file ne '-' && !ref $log_file ) {
497 my $ok = eval { $fh->close(); 1 };
498 if ( !$ok && DEVEL_MODE ) {
499 Fault("Could not close file handle(): $EVAL_ERROR\n");