]> git.donarmstrong.com Git - perltidy.git/blob - lib/Perl/Tidy/Diagnostics.pm
af81a0cfc3be11ee5ef8c243f8ff691306da712f
[perltidy.git] / lib / Perl / Tidy / Diagnostics.pm
1 #####################################################################
2 #
3 # The Perl::Tidy::Diagnostics class writes the DIAGNOSTICS file, which is
4 # useful for program development.
5 #
6 # Only one such file is created regardless of the number of input
7 # files processed.  This allows the results of processing many files
8 # to be summarized in a single file.
9
10 # Output messages go to a file named DIAGNOSTICS, where
11 # they are labeled by file and line.  This allows many files to be
12 # scanned at once for some particular condition of interest.  It was
13 # particularly useful for developing guessing strategies.
14 #
15 # NOTE: This feature is deactivated in final releases but can be
16 # reactivated for debugging by un-commenting the 'I' options flag
17 #
18 #####################################################################
19
20 package Perl::Tidy::Diagnostics;
21 use strict;
22 use warnings;
23 use English qw( -no_match_vars );
24 our $VERSION = '20220613';
25
26 use constant EMPTY_STRING => q{};
27
28 sub AUTOLOAD {
29
30     # Catch any undefined sub calls so that we are sure to get
31     # some diagnostic information.  This sub should never be called
32     # except for a programming error.
33     our $AUTOLOAD;
34     return if ( $AUTOLOAD =~ /\bDESTROY$/ );
35     my ( $pkg, $fname, $lno ) = caller();
36     my $my_package = __PACKAGE__;
37     print STDERR <<EOM;
38 ======================================================================
39 Error detected in package '$my_package', version $VERSION
40 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
41 Called from package: '$pkg'  
42 Called from File '$fname'  at line '$lno'
43 This error is probably due to a recent programming change
44 ======================================================================
45 EOM
46     exit 1;
47 }
48
49 sub DESTROY {
50
51     # required to avoid call to AUTOLOAD in some versions of perl
52 }
53
54 sub new {
55
56     my $class = shift;
57     return bless {
58         _write_diagnostics_count => 0,
59         _last_diagnostic_file    => EMPTY_STRING,
60         _input_file              => EMPTY_STRING,
61         _fh                      => undef,
62     }, $class;
63 }
64
65 sub set_input_file {
66     my ( $self, $input_file ) = @_;
67     $self->{_input_file} = $input_file;
68     return;
69 }
70
71 sub write_diagnostics {
72     my ( $self, $msg ) = @_;
73
74     unless ( $self->{_write_diagnostics_count} ) {
75         open( $self->{_fh}, ">", "DIAGNOSTICS" )
76           or Perl::Tidy::Die("couldn't open DIAGNOSTICS: $ERRNO\n");
77     }
78
79     my $fh                   = $self->{_fh};
80     my $last_diagnostic_file = $self->{_last_diagnostic_file};
81     my $input_file           = $self->{_input_file};
82     if ( $last_diagnostic_file ne $input_file ) {
83         $fh->print("\nFILE:$input_file\n");
84     }
85     $self->{_last_diagnostic_file} = $input_file;
86     my $input_line_number = Perl::Tidy::Tokenizer::get_input_line_number();
87     $fh->print("$input_line_number:\t$msg");
88     $self->{_write_diagnostics_count}++;
89     return;
90 }
91
92 1;
93