1 #####################################################################
3 # The Perl::Tidy::Logger class writes the .LOG and .ERR files
5 #####################################################################
7 package Perl::Tidy::Logger;
10 our $VERSION = '20220613';
11 use English qw( -no_match_vars );
13 use constant EMPTY_STRING => q{};
14 use constant SPACE => q{ };
18 # Catch any undefined sub calls so that we are sure to get
19 # some diagnostic information. This sub should never be called
20 # except for a programming error.
22 return if ( $AUTOLOAD =~ /\bDESTROY$/ );
23 my ( $pkg, $fname, $lno ) = caller();
24 my $my_package = __PACKAGE__;
26 ======================================================================
27 Error detected in package '$my_package', version $VERSION
28 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
29 Called from package: '$pkg'
30 Called from File '$fname' at line '$lno'
31 This error is probably due to a recent programming change
32 ======================================================================
39 # required to avoid call to AUTOLOAD in some versions of perl
42 use constant DEFAULT_LOGFILE_GAP => 50;
46 my ( $class, @args ) = @_;
51 warning_file => undef,
53 display_name => undef,
54 is_encoded_data => undef,
57 my %args = ( %defaults, @args );
59 my $rOpts = $args{rOpts};
60 my $log_file = $args{log_file};
61 my $warning_file = $args{warning_file};
62 my $fh_stderr = $args{fh_stderr};
63 my $display_name = $args{display_name};
64 my $is_encoded_data = $args{is_encoded_data};
66 my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
68 # remove any old error output file if we might write a new one
69 unless ( $fh_warnings || ref($warning_file) ) {
70 if ( -e $warning_file ) {
73 "couldn't unlink warning file $warning_file: $ERRNO\n");
78 defined( $rOpts->{'logfile-gap'} )
79 ? $rOpts->{'logfile-gap'}
80 : DEFAULT_LOGFILE_GAP;
81 if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
83 my $filename_stamp = $display_name ? $display_name . ':' : "??";
84 my $input_stream_name = $display_name ? $display_name : "??";
86 _log_file => $log_file,
87 _logfile_gap => $logfile_gap,
89 _fh_warnings => $fh_warnings,
90 _last_input_line_written => 0,
93 _block_log_output => 0,
94 _line_of_tokens => undef,
95 _output_line_number => undef,
96 _wrote_line_information_string => 0,
97 _wrote_column_headings => 0,
98 _warning_file => $warning_file,
100 _complaint_count => 0,
101 _is_encoded_data => $is_encoded_data,
102 _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
103 _saw_brace_error => 0,
105 _input_stream_name => $input_stream_name,
106 _filename_stamp => $filename_stamp,
110 sub get_input_stream_name {
112 return $self->{_input_stream_name};
115 sub get_warning_count {
117 return $self->{_warning_count};
122 return $self->{_use_prefix};
125 sub block_log_output {
127 $self->{_block_log_output} = 1;
131 sub unblock_log_output {
133 $self->{_block_log_output} = 0;
137 sub interrupt_logfile {
139 $self->{_use_prefix} = 0;
140 $self->warning("\n");
141 $self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
147 $self->write_logfile_entry( '#' x 60 . "\n" );
148 $self->{_use_prefix} = 1;
152 sub we_are_at_the_last_line {
154 unless ( $self->{_wrote_line_information_string} ) {
155 $self->write_logfile_entry("Last line\n\n");
157 $self->{_at_end_of_file} = 1;
161 # record some stuff in case we go down in flames
162 use constant MAX_PRINTED_CHARS => 35;
165 my ( $self, $line_of_tokens, $output_line_number ) = @_;
166 my $input_line = $line_of_tokens->{_line_text};
167 my $input_line_number = $line_of_tokens->{_line_number};
169 # save line information in case we have to write a logfile message
170 $self->{_line_of_tokens} = $line_of_tokens;
171 $self->{_output_line_number} = $output_line_number;
172 $self->{_wrote_line_information_string} = 0;
174 my $last_input_line_written = $self->{_last_input_line_written};
177 ( $input_line_number - $last_input_line_written ) >=
178 $self->{_logfile_gap}
180 || ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ )
183 my $structural_indentation_level = $line_of_tokens->{_level_0};
184 $structural_indentation_level = 0
185 if ( $structural_indentation_level < 0 );
186 $self->{_last_input_line_written} = $input_line_number;
187 ( my $out_str = $input_line ) =~ s/^\s*//;
190 $out_str = ( '.' x $structural_indentation_level ) . $out_str;
192 if ( length($out_str) > MAX_PRINTED_CHARS ) {
193 $out_str = substr( $out_str, 0, MAX_PRINTED_CHARS ) . " ....";
195 $self->logfile_output( EMPTY_STRING, "$out_str\n" );
200 sub write_logfile_entry {
202 my ( $self, @msg ) = @_;
204 # add leading >>> to avoid confusing error messages and code
205 $self->logfile_output( ">>>", "@msg" );
209 sub write_column_headings {
212 $self->{_wrote_column_headings} = 1;
213 my $routput_array = $self->{_output_array};
214 push @{$routput_array}, <<EOM;
216 Starting formatting pass...
217 The nesting depths in the table below are at the start of the lines.
218 The indicated output line numbers are not always exact.
219 ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
221 in:out indent c b nesting code + messages; (messages begin with >>>)
222 lines levels i k (code begins with one '.' per indent level)
223 ------ ----- - - -------- -------------------------------------------
228 sub make_line_information_string {
230 # make columns of information when a logfile message needs to go out
232 my $line_of_tokens = $self->{_line_of_tokens};
233 my $input_line_number = $line_of_tokens->{_line_number};
234 my $line_information_string = EMPTY_STRING;
235 if ($input_line_number) {
237 my $output_line_number = $self->{_output_line_number};
238 my $brace_depth = $line_of_tokens->{_curly_brace_depth};
239 my $paren_depth = $line_of_tokens->{_paren_depth};
240 my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
241 my $guessed_indentation_level =
242 $line_of_tokens->{_guessed_indentation_level};
244 my $structural_indentation_level = $line_of_tokens->{_level_0};
246 $self->write_column_headings() unless $self->{_wrote_column_headings};
248 # keep logfile columns aligned for scripts up to 999 lines;
249 # for longer scripts it doesn't really matter
250 my $extra_space = EMPTY_STRING;
252 ( $input_line_number < 10 ) ? SPACE x 2
253 : ( $input_line_number < 100 ) ? SPACE
256 ( $output_line_number < 10 ) ? SPACE x 2
257 : ( $output_line_number < 100 ) ? SPACE
260 # there are 2 possible nesting strings:
261 # the original which looks like this: (0 [1 {2
262 # the new one, which looks like this: {{[
263 # the new one is easier to read, and shows the order, but
264 # could be arbitrarily long, so we use it unless it is too long
266 "($paren_depth [$square_bracket_depth {$brace_depth";
267 my $nesting_string_new = $line_of_tokens->{_nesting_tokens_0};
268 my $ci_level = $line_of_tokens->{_ci_level_0};
269 if ( $ci_level > 9 ) { $ci_level = '*' }
270 my $bk = ( $line_of_tokens->{_nesting_blocks_0} =~ /1$/ ) ? '1' : '0';
272 if ( length($nesting_string_new) <= 8 ) {
274 $nesting_string_new . SPACE x ( 8 - length($nesting_string_new) );
276 $line_information_string =
277 "L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
279 return $line_information_string;
283 my ( $self, $prompt, $msg ) = @_;
284 return if ( $self->{_block_log_output} );
286 my $routput_array = $self->{_output_array};
287 if ( $self->{_at_end_of_file} || !$self->{_use_prefix} ) {
288 push @{$routput_array}, "$msg";
291 my $line_information_string = $self->make_line_information_string();
292 $self->{_wrote_line_information_string} = 1;
294 if ($line_information_string) {
295 push @{$routput_array}, "$line_information_string $prompt$msg";
298 push @{$routput_array}, "$msg";
304 sub get_saw_brace_error {
306 return $self->{_saw_brace_error};
309 sub increment_brace_error {
311 $self->{_saw_brace_error}++;
316 my ( $self, $msg ) = @_;
318 use constant BRACE_WARNING_LIMIT => 10;
319 my $saw_brace_error = $self->{_saw_brace_error};
321 if ( $saw_brace_error < BRACE_WARNING_LIMIT ) {
322 $self->warning($msg);
325 $self->{_saw_brace_error} = $saw_brace_error;
327 if ( $saw_brace_error == BRACE_WARNING_LIMIT ) {
328 $self->warning("No further warnings of this type will be given\n");
335 # handle non-critical warning messages based on input flag
336 my ( $self, $msg ) = @_;
337 my $rOpts = $self->{_rOpts};
339 # these appear in .ERR output only if -w flag is used
340 if ( $rOpts->{'warning-output'} ) {
341 $self->warning($msg);
344 # otherwise, they go to the .LOG file
346 $self->{_complaint_count}++;
347 $self->write_logfile_entry($msg);
354 # report errors to .ERR file (or stdout)
355 my ( $self, $msg ) = @_;
357 use constant WARNING_LIMIT => 50;
359 # Always bump the warn count, even if no message goes out
360 Perl::Tidy::Warn_count_bump();
362 my $rOpts = $self->{_rOpts};
363 unless ( $rOpts->{'quiet'} ) {
365 my $warning_count = $self->{_warning_count};
366 my $fh_warnings = $self->{_fh_warnings};
367 my $is_encoded_data = $self->{_is_encoded_data};
368 if ( !$fh_warnings ) {
369 my $warning_file = $self->{_warning_file};
370 ( $fh_warnings, my $filename ) =
371 Perl::Tidy::streamhandle( $warning_file, 'w', $is_encoded_data );
373 or Perl::Tidy::Die("couldn't open $filename: $ERRNO\n");
374 Perl::Tidy::Warn_msg("## Please see file $filename\n")
375 unless ref($warning_file);
376 $self->{_fh_warnings} = $fh_warnings;
377 $fh_warnings->print("Perltidy version is $Perl::Tidy::VERSION\n");
380 my $filename_stamp = $self->{_filename_stamp};
382 if ( $warning_count < WARNING_LIMIT ) {
384 if ( !$warning_count ) {
386 # On first error always write a line with the filename. Note
387 # that the filename will be 'perltidy' if input is from stdin
388 # or from a data structure.
389 if ($filename_stamp) {
391 "\n$filename_stamp Begin Error Output Stream\n");
394 # Turn off filename stamping unless error output is directed
395 # to the standard error output (with -se flag)
396 if ( !$rOpts->{'standard-error-output'} ) {
397 $filename_stamp = EMPTY_STRING;
398 $self->{_filename_stamp} = $filename_stamp;
402 if ( $self->get_use_prefix() > 0 ) {
403 $self->write_logfile_entry("WARNING: $msg");
405 # add prefix 'filename:line_no: ' to message lines
406 my $input_line_number =
407 Perl::Tidy::Tokenizer::get_input_line_number();
408 if ( !defined($input_line_number) ) { $input_line_number = -1 }
409 my $pre_string = $filename_stamp . $input_line_number . ': ';
411 $msg =~ s/\n/\n$pre_string/g;
412 $msg = $pre_string . $msg . "\n";
414 $fh_warnings->print($msg);
418 $self->write_logfile_entry($msg);
420 # add prefix 'filename: ' to message lines
421 if ($filename_stamp) {
422 my $pre_string = $filename_stamp . SPACE;
424 $msg =~ s/\n/\n$pre_string/g;
425 $msg = $pre_string . $msg . "\n";
428 $fh_warnings->print($msg);
432 $self->{_warning_count} = $warning_count;
434 if ( $warning_count == WARNING_LIMIT ) {
436 $filename_stamp . "No further warnings will be given\n" );
442 sub report_definite_bug {
444 $self->{_saw_code_bug} = 1;
448 sub get_save_logfile {
450 # To be called after tokenizer has finished to make formatting more
453 my $saw_code_bug = $self->{_saw_code_bug};
454 my $rOpts = $self->{_rOpts};
455 return $saw_code_bug == 1 || $rOpts->{'logfile'};
460 # called after all formatting to summarize errors
461 my ( $self, $formatter ) = @_;
463 my $rOpts = $self->{_rOpts};
464 my $warning_count = $self->{_warning_count};
465 my $saw_code_bug = $self->{_saw_code_bug};
467 my $save_logfile = $saw_code_bug == 1
468 || $rOpts->{'logfile'};
469 my $log_file = $self->{_log_file};
470 if ($warning_count) {
472 $self->block_log_output(); # avoid echoing this to the logfile
474 "The logfile $log_file may contain useful information\n");
475 $self->unblock_log_output();
478 if ( $self->{_complaint_count} > 0 ) {
480 "To see $self->{_complaint_count} non-critical warnings rerun with -w\n"
484 if ( $self->{_saw_brace_error}
485 && ( $self->{_logfile_gap} > 1 || !$save_logfile ) )
487 $self->warning("To save a full .LOG file rerun with -g\n");
492 my $is_encoded_data = $self->{_is_encoded_data};
493 my ( $fh, $filename ) =
494 Perl::Tidy::streamhandle( $log_file, 'w', $is_encoded_data );
496 my $routput_array = $self->{_output_array};
497 foreach my $line ( @{$routput_array} ) { $fh->print($line) }
498 if ( $log_file ne '-' && !ref $log_file ) {
499 eval { $fh->close() };