1 #####################################################################
3 # The Perl::Tidy::Logger class writes the .LOG and .ERR files
5 #####################################################################
7 package Perl::Tidy::Logger;
10 our $VERSION = '20200110';
14 my ( $class, $rOpts, $log_file, $warning_file, $fh_stderr, $saw_extrude,
18 my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
20 # remove any old error output file if we might write a new one
21 unless ( $fh_warnings || ref($warning_file) ) {
22 if ( -e $warning_file ) {
25 "couldn't unlink warning file $warning_file: $!\n");
30 defined( $rOpts->{'logfile-gap'} )
31 ? $rOpts->{'logfile-gap'}
33 if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
35 my $filename_stamp = $display_name ? $display_name . ':' : "??";
36 my $input_stream_name = $display_name ? $display_name : "??";
38 _log_file => $log_file,
39 _logfile_gap => $logfile_gap,
41 _fh_warnings => $fh_warnings,
42 _last_input_line_written => 0,
45 _block_log_output => 0,
46 _line_of_tokens => undef,
47 _output_line_number => undef,
48 _wrote_line_information_string => 0,
49 _wrote_column_headings => 0,
50 _warning_file => $warning_file,
52 _complaint_count => 0,
53 _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
54 _saw_brace_error => 0,
55 _saw_extrude => $saw_extrude,
57 _input_stream_name => $input_stream_name,
58 _filename_stamp => $filename_stamp,
62 sub get_input_stream_name {
64 return $self->{_input_stream_name};
67 sub get_warning_count {
69 return $self->{_warning_count};
74 return $self->{_use_prefix};
77 sub block_log_output {
79 $self->{_block_log_output} = 1;
83 sub unblock_log_output {
85 $self->{_block_log_output} = 0;
89 sub interrupt_logfile {
91 $self->{_use_prefix} = 0;
93 $self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
99 $self->write_logfile_entry( '#' x 60 . "\n" );
100 $self->{_use_prefix} = 1;
104 sub we_are_at_the_last_line {
106 unless ( $self->{_wrote_line_information_string} ) {
107 $self->write_logfile_entry("Last line\n\n");
109 $self->{_at_end_of_file} = 1;
113 # record some stuff in case we go down in flames
115 my ( $self, $line_of_tokens, $output_line_number ) = @_;
116 my $input_line = $line_of_tokens->{_line_text};
117 my $input_line_number = $line_of_tokens->{_line_number};
119 # save line information in case we have to write a logfile message
120 $self->{_line_of_tokens} = $line_of_tokens;
121 $self->{_output_line_number} = $output_line_number;
122 $self->{_wrote_line_information_string} = 0;
124 my $last_input_line_written = $self->{_last_input_line_written};
125 my $rOpts = $self->{_rOpts};
128 ( $input_line_number - $last_input_line_written ) >=
129 $self->{_logfile_gap}
131 || ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ )
134 my $structural_indentation_level = $line_of_tokens->{_level_0};
135 $structural_indentation_level = 0
136 if ( $structural_indentation_level < 0 );
137 $self->{_last_input_line_written} = $input_line_number;
138 ( my $out_str = $input_line ) =~ s/^\s*//;
141 $out_str = ( '.' x $structural_indentation_level ) . $out_str;
143 if ( length($out_str) > 35 ) {
144 $out_str = substr( $out_str, 0, 35 ) . " ....";
146 $self->logfile_output( "", "$out_str\n" );
151 sub write_logfile_entry {
153 my ( $self, @msg ) = @_;
155 # add leading >>> to avoid confusing error messages and code
156 $self->logfile_output( ">>>", "@msg" );
160 sub write_column_headings {
163 $self->{_wrote_column_headings} = 1;
164 my $routput_array = $self->{_output_array};
165 push @{$routput_array}, <<EOM;
166 The nesting depths in the table below are at the start of the lines.
167 The indicated output line numbers are not always exact.
168 ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
170 in:out indent c b nesting code + messages; (messages begin with >>>)
171 lines levels i k (code begins with one '.' per indent level)
172 ------ ----- - - -------- -------------------------------------------
177 sub make_line_information_string {
179 # make columns of information when a logfile message needs to go out
181 my $line_of_tokens = $self->{_line_of_tokens};
182 my $input_line_number = $line_of_tokens->{_line_number};
183 my $line_information_string = "";
184 if ($input_line_number) {
186 my $output_line_number = $self->{_output_line_number};
187 my $brace_depth = $line_of_tokens->{_curly_brace_depth};
188 my $paren_depth = $line_of_tokens->{_paren_depth};
189 my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
190 my $guessed_indentation_level =
191 $line_of_tokens->{_guessed_indentation_level};
192 ##my $rtoken_array = $line_of_tokens->{_rtoken_array};
194 my $structural_indentation_level = $line_of_tokens->{_level_0};
196 $self->write_column_headings() unless $self->{_wrote_column_headings};
198 # keep logfile columns aligned for scripts up to 999 lines;
199 # for longer scripts it doesn't really matter
200 my $extra_space = "";
202 ( $input_line_number < 10 ) ? " "
203 : ( $input_line_number < 100 ) ? " "
206 ( $output_line_number < 10 ) ? " "
207 : ( $output_line_number < 100 ) ? " "
210 # there are 2 possible nesting strings:
211 # the original which looks like this: (0 [1 {2
212 # the new one, which looks like this: {{[
213 # the new one is easier to read, and shows the order, but
214 # could be arbitrarily long, so we use it unless it is too long
216 "($paren_depth [$square_bracket_depth {$brace_depth";
217 my $nesting_string_new = $line_of_tokens->{_nesting_tokens_0};
218 my $ci_level = $line_of_tokens->{_ci_level_0};
219 if ( $ci_level > 9 ) { $ci_level = '*' }
220 my $bk = ( $line_of_tokens->{_nesting_blocks_0} =~ /1$/ ) ? '1' : '0';
222 if ( length($nesting_string_new) <= 8 ) {
224 $nesting_string_new . " " x ( 8 - length($nesting_string_new) );
226 $line_information_string =
227 "L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
229 return $line_information_string;
233 my ( $self, $prompt, $msg ) = @_;
234 return if ( $self->{_block_log_output} );
236 my $routput_array = $self->{_output_array};
237 if ( $self->{_at_end_of_file} || !$self->{_use_prefix} ) {
238 push @{$routput_array}, "$msg";
241 my $line_information_string = $self->make_line_information_string();
242 $self->{_wrote_line_information_string} = 1;
244 if ($line_information_string) {
245 push @{$routput_array}, "$line_information_string $prompt$msg";
248 push @{$routput_array}, "$msg";
254 sub get_saw_brace_error {
256 return $self->{_saw_brace_error};
259 sub increment_brace_error {
261 $self->{_saw_brace_error}++;
266 my ( $self, $msg ) = @_;
268 #use constant BRACE_WARNING_LIMIT => 10;
269 my $BRACE_WARNING_LIMIT = 10;
270 my $saw_brace_error = $self->{_saw_brace_error};
272 if ( $saw_brace_error < $BRACE_WARNING_LIMIT ) {
273 $self->warning($msg);
276 $self->{_saw_brace_error} = $saw_brace_error;
278 if ( $saw_brace_error == $BRACE_WARNING_LIMIT ) {
279 $self->warning("No further warnings of this type will be given\n");
286 # handle non-critical warning messages based on input flag
287 my ( $self, $msg ) = @_;
288 my $rOpts = $self->{_rOpts};
290 # these appear in .ERR output only if -w flag is used
291 if ( $rOpts->{'warning-output'} ) {
292 $self->warning($msg);
295 # otherwise, they go to the .LOG file
297 $self->{_complaint_count}++;
298 $self->write_logfile_entry($msg);
305 # report errors to .ERR file (or stdout)
306 my ( $self, $msg ) = @_;
308 #use constant WARNING_LIMIT => 50;
309 my $WARNING_LIMIT = 50;
311 my $rOpts = $self->{_rOpts};
312 unless ( $rOpts->{'quiet'} ) {
314 my $warning_count = $self->{_warning_count};
315 my $fh_warnings = $self->{_fh_warnings};
316 if ( !$fh_warnings ) {
317 my $warning_file = $self->{_warning_file};
318 ( $fh_warnings, my $filename ) =
319 Perl::Tidy::streamhandle( $warning_file, 'w' );
320 $fh_warnings or Perl::Tidy::Die("couldn't open $filename $!\n");
321 Perl::Tidy::Warn("## Please see file $filename\n")
322 unless ref($warning_file);
323 $self->{_fh_warnings} = $fh_warnings;
324 $fh_warnings->print("Perltidy version is $Perl::Tidy::VERSION\n");
327 my $filename_stamp = $self->{_filename_stamp};
329 if ( $warning_count < $WARNING_LIMIT ) {
331 if ( !$warning_count ) {
333 # On first error always write a line with the filename. Note
334 # that the filename will be 'perltidy' if input is from stdin
335 # or from a data structure.
336 if ($filename_stamp) {
338 "\n$filename_stamp Begin Error Output Stream\n");
341 # Turn off filename stamping unless error output is directed
342 # to the standard error output (with -se flag)
343 if ( !$rOpts->{'standard-error-output'} ) {
344 $filename_stamp = "";
345 $self->{_filename_stamp} = $filename_stamp;
349 if ( $self->get_use_prefix() > 0 ) {
350 $self->write_logfile_entry("WARNING: $msg");
352 # add prefix 'filename:line_no: ' to message lines
353 my $input_line_number =
354 Perl::Tidy::Tokenizer::get_input_line_number();
355 if ( !defined($input_line_number) ) { $input_line_number = -1 }
356 my $pre_string = $filename_stamp . $input_line_number . ': ';
358 $msg =~ s/\n/\n$pre_string/g;
359 $msg = $pre_string . $msg . "\n";
361 $fh_warnings->print($msg);
365 $self->write_logfile_entry($msg);
367 # add prefix 'filename: ' to message lines
368 if ($filename_stamp) {
369 my $pre_string = $filename_stamp . " ";
371 $msg =~ s/\n/\n$pre_string/g;
372 $msg = $pre_string . $msg . "\n";
375 $fh_warnings->print($msg);
379 $self->{_warning_count} = $warning_count;
381 if ( $warning_count == $WARNING_LIMIT ) {
383 $filename_stamp . "No further warnings will be given\n" );
389 # programming bug codes:
391 # 0 = maybe, not sure.
393 sub report_possible_bug {
395 my $saw_code_bug = $self->{_saw_code_bug};
396 $self->{_saw_code_bug} = ( $saw_code_bug < 0 ) ? 0 : $saw_code_bug;
400 sub report_definite_bug {
402 $self->{_saw_code_bug} = 1;
406 sub ask_user_for_bug_report {
408 my ( $self, $infile_syntax_ok, $formatter ) = @_;
409 my $saw_code_bug = $self->{_saw_code_bug};
410 if ( ( $saw_code_bug == 0 ) && ( $infile_syntax_ok == 1 ) ) {
411 $self->warning(<<EOM);
413 You may have encountered a code bug in perltidy. If you think so, and
414 the problem is not listed in the BUGS file at
415 http://perltidy.sourceforge.net, please report it so that it can be
416 corrected. Include the smallest possible script which has the problem,
417 along with the .LOG file. See the manual pages for contact information.
422 elsif ( $saw_code_bug == 1 ) {
423 if ( $self->{_saw_extrude} ) {
424 $self->warning(<<EOM);
426 You may have encountered a bug in perltidy. However, since you are using the
427 -extrude option, the problem may be with perl or one of its modules, which have
428 occasional problems with this type of file. If you believe that the
429 problem is with perltidy, and the problem is not listed in the BUGS file at
430 http://perltidy.sourceforge.net, please report it so that it can be corrected.
431 Include the smallest possible script which has the problem, along with the .LOG
432 file. See the manual pages for contact information.
437 $self->warning(<<EOM);
439 Oops, you seem to have encountered a bug in perltidy. Please check the
440 BUGS file at http://perltidy.sourceforge.net. If the problem is not
441 listed there, please report it so that it can be corrected. Include the
442 smallest possible script which produces this message, along with the
443 .LOG file if appropriate. See the manual pages for contact information.
444 Your efforts are appreciated.
447 my $added_semicolon_count = 0;
449 $added_semicolon_count =
450 $formatter->get_added_semicolon_count();
452 if ( $added_semicolon_count > 0 ) {
453 $self->warning(<<EOM);
455 The log file shows that perltidy added $added_semicolon_count semicolons.
456 Please rerun with -nasc to see if that is the cause of the syntax error. Even
457 if that is the problem, please report it so that it can be fixed.
468 # called after all formatting to summarize errors
469 my ( $self, $infile_syntax_ok, $formatter ) = @_;
471 my $rOpts = $self->{_rOpts};
472 my $warning_count = $self->{_warning_count};
473 my $saw_code_bug = $self->{_saw_code_bug};
476 ( $saw_code_bug == 0 && $infile_syntax_ok == 1 )
477 || $saw_code_bug == 1
478 || $rOpts->{'logfile'};
479 my $log_file = $self->{_log_file};
480 if ($warning_count) {
482 $self->block_log_output(); # avoid echoing this to the logfile
484 "The logfile $log_file may contain useful information\n");
485 $self->unblock_log_output();
488 if ( $self->{_complaint_count} > 0 ) {
490 "To see $self->{_complaint_count} non-critical warnings rerun with -w\n"
494 if ( $self->{_saw_brace_error}
495 && ( $self->{_logfile_gap} > 1 || !$save_logfile ) )
497 $self->warning("To save a full .LOG file rerun with -g\n");
500 $self->ask_user_for_bug_report( $infile_syntax_ok, $formatter );
503 my $log_file = $self->{_log_file};
504 my ( $fh, $filename ) = Perl::Tidy::streamhandle( $log_file, 'w' );
506 my $routput_array = $self->{_output_array};
507 foreach ( @{$routput_array} ) { $fh->print($_) }
508 if ( $log_file ne '-' && !ref $log_file ) {
509 eval { $fh->close() };