]> git.donarmstrong.com Git - perltidy.git/blobdiff - lib/Perl/Tidy/Logger.pm
New upstream version 20200110
[perltidy.git] / lib / Perl / Tidy / Logger.pm
index 547a635d6ffe6e6001867d1f3de3f8d134de38dc..cab937b3be03a59228ca3072d569d168f33db994 100644 (file)
@@ -7,12 +7,13 @@
 package Perl::Tidy::Logger;
 use strict;
 use warnings;
-our $VERSION = '20190601';
+our $VERSION = '20200110';
 
 sub new {
 
-    my ( $class, $rOpts, $log_file, $warning_file, $fh_stderr, $saw_extrude ) =
-      @_;
+    my ( $class, $rOpts, $log_file, $warning_file, $fh_stderr, $saw_extrude,
+        $display_name )
+      = @_;
 
     my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
 
@@ -31,6 +32,8 @@ sub new {
       : 50;
     if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
 
+    my $filename_stamp    = $display_name ? $display_name . ':' : "??";
+    my $input_stream_name = $display_name ? $display_name       : "??";
     return bless {
         _log_file                      => $log_file,
         _logfile_gap                   => $logfile_gap,
@@ -47,13 +50,20 @@ sub new {
         _warning_file                  => $warning_file,
         _warning_count                 => 0,
         _complaint_count               => 0,
-        _saw_code_bug    => -1,             # -1=no 0=maybe 1=for sure
-        _saw_brace_error => 0,
-        _saw_extrude     => $saw_extrude,
-        _output_array    => [],
+        _saw_code_bug      => -1,                   # -1=no 0=maybe 1=for sure
+        _saw_brace_error   => 0,
+        _saw_extrude       => $saw_extrude,
+        _output_array      => [],
+        _input_stream_name => $input_stream_name,
+        _filename_stamp    => $filename_stamp,
     }, $class;
 }
 
+sub get_input_stream_name {
+    my $self = shift;
+    return $self->{_input_stream_name};
+}
+
 sub get_warning_count {
     my $self = shift;
     return $self->{_warning_count};
@@ -314,24 +324,63 @@ sub warning {
             $fh_warnings->print("Perltidy version is $Perl::Tidy::VERSION\n");
         }
 
+        my $filename_stamp = $self->{_filename_stamp};
+
         if ( $warning_count < $WARNING_LIMIT ) {
+
+            if ( !$warning_count ) {
+
+                # On first error always write a line with the filename.  Note
+                # that the filename will be 'perltidy' if input is from stdin
+                # or from a data structure.
+                if ($filename_stamp) {
+                    $fh_warnings->print(
+                        "\n$filename_stamp Begin Error Output Stream\n");
+                }
+
+                # Turn off filename stamping unless error output is directed
+                # to the standard error output (with -se flag)
+                if ( !$rOpts->{'standard-error-output'} ) {
+                    $filename_stamp = "";
+                    $self->{_filename_stamp} = $filename_stamp;
+                }
+            }
+
             if ( $self->get_use_prefix() > 0 ) {
+                $self->write_logfile_entry("WARNING: $msg");
+
+                # add prefix 'filename:line_no: ' to message lines
                 my $input_line_number =
                   Perl::Tidy::Tokenizer::get_input_line_number();
                 if ( !defined($input_line_number) ) { $input_line_number = -1 }
-                $fh_warnings->print("$input_line_number:\t$msg");
-                $self->write_logfile_entry("WARNING: $msg");
+                my $pre_string = $filename_stamp . $input_line_number . ': ';
+                chomp $msg;
+                $msg =~ s/\n/\n$pre_string/g;
+                $msg = $pre_string . $msg . "\n";
+
+                $fh_warnings->print($msg);
+
             }
             else {
-                $fh_warnings->print($msg);
                 $self->write_logfile_entry($msg);
+
+                # add prefix 'filename: ' to message lines
+                if ($filename_stamp) {
+                    my $pre_string = $filename_stamp . " ";
+                    chomp $msg;
+                    $msg =~ s/\n/\n$pre_string/g;
+                    $msg = $pre_string . $msg . "\n";
+                }
+
+                $fh_warnings->print($msg);
             }
         }
         $warning_count++;
         $self->{_warning_count} = $warning_count;
 
         if ( $warning_count == $WARNING_LIMIT ) {
-            $fh_warnings->print("No further warnings will be given\n");
+            $fh_warnings->print(
+                $filename_stamp . "No further warnings will be given\n" );
         }
     }
     return;