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.

Answer 1

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.