Prevent Perl from printing identical warning messages

Question

Consider the following nonsense script as an example:

use strict;
use warnings;

my $uninitialisedValue;

while(<>){
  print ${$uninitialisedValue}{$_},"\n";
}

Which is run from the command line:

$ perl warningPrinter.pl < longfile.txt

Regardless of what standard input contains, standard output will be full of:

Use of uninitialized value in print at warningPrinter.pl line 16, <> line 1.

Use of uninitialized value in print at warningPrinter.pl line 16, <> line 2.

Use of uninitialized value in print at warningPrinter.pl line 16, <> line 3.

Use of uninitialized value in print at warningPrinter.pl line 16, <> line 4.
...

I work with very long files, so receiving this as output when testing my script is at the very least mildly irritating. It can take a while for the process to respond to a Ctrl + C termination signal and my terminal is suddenly filled with the same error message.

Is there a way of either getting Perl to print just the first instance of an identical and reoccurring warning message, or to just make warning messages fatal to the execution of the script? Seeing as I have never produced a script that works despite having warnings in them, I would accept either. But it's probably more convenient if I can get Perl to print identical warnings just once.

Try this other StackOverflow post: [How can I make Perl die if a warning is generated?][1] [1]: http://stackoverflow.com/questions/3896060/how-can-i-make-perl-die-if-a-warning-is-generated — Kevin G., Mar 19 '12 at 11:54
Excellent. `use warnings FATAL => 'all'` works great for killing the process after a warning in my case. — MattLBeck, Mar 19 '12 at 12:01
Don't use `for` when reading a file, especially when that file is large, because a for loop pre-loads its list into memory. Use `while` instead. Also, redirecting a file to stdin is redundant, just use the file as argument. In your specific problem, reopening STDERR to a file can be a solution. — TLP, Mar 19 '12 at 12:18
Oh woops, I meant `while` :p. However, I find reading from STDIN both quicker to code for and the script will automatically be compatible with piping from another process. If i just took an argument from the command line I would have to check to see if the user actually wants to read from STDIN instead. — MattLBeck, Mar 19 '12 at 12:32
Also, yes, I could open STDERR to a file but this further detracts from the way I like to test my scripts since I need to open the error log to check if something went wrong every time. Not a very elegent solution for me, where I like to iterate on testing the script, receiving the line with the problem, editing that line and then retest. — MattLBeck, Mar 19 '12 at 12:34
@kikumbob The diamond operator works both on STDIN or file arguments. Your distinction is invalid. Using `script.pl < file` and `script.pl file` is for practical purposes identical when using the diamond operator `<>`. — TLP, Mar 19 '12 at 12:55

Axeman · Accepted Answer · 2012-03-19T13:19:26.193

I thought I would show you how unique warning logic might be created. I don't recommend it though:

my %printed;
local $SIG{__WARN__} = sub { 
    my $message = shift;
    my ( $msg, $loc ) = $message =~ m/(.*?) at (.*?line \d+)/;
    print $message unless $printed{$loc}{$msg}++;
};

I should say that I do not recommend this as a general practice. Because it's better to have a warning policy. It's either an operation that can take an undefined value, or you don't want to handle an undef value. I try to remove all warnings from my completed code.

In the first case, putting no warnings 'uninitialized'; in the for loop is a much easier--and regular thing to do. In the second case, you'd probably want to fail.

However, if it is something you would actually like to handle but warn once about, say that you wanted robust handling of the data, but wanted to warn upstream processes that you got some bad data, you could go about creating a sub warn_once:

{   use Carp ();
    my %warned;
    sub warn_once { 
        my $message = shift;
        my ( $msg, $loc ) = $message =~ m/(.*?) at (.*?line \d+)/;
        Carp::carp( $message ) unless $warned{$loc}{$msg}++;
    };
}

And call it like this:

while ( <> ) { 
    warn_once( '$uninitialisedValue is uninitialized' )
        unless defined( $uninitialisedValue)
        ;
    no warnings 'uninitialized';
    print ${$uninitialisedValue}{$_},"\n";
}

Then you have decided something.

Nice! I guess I would have to add this kind of thing to every script I want to use this logic with? Why would you not recommend it? — MattLBeck, Mar 19 '12 at 12:38
Note that the `diagnostics` module does all of this except for the part about considering the line number of the input chunk. — tchrist, Mar 19 '12 at 14:24

Prevent Perl from printing identical warning messages

1 Answers1