Предотвратить перл от печати одинаковых предупреждающих сообщений

Рассмотрим в качестве примера следующую бессмыслицу script:

use strict;
use warnings;

my $uninitialisedValue;

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

Выполняется из командной строки:

$ perl warningPrinter.pl < longfile.txt

Независимо от того, что содержит STDIN, STDOUT будет заполнен:

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.
...

Я работаю с очень длинными файлами, поэтому получение этого результата при тестировании моего script, по крайней мере, слегка раздражает. Процесс может реагировать на сигнал завершения CTRL-c, и мой терминал внезапно заполняется тем же сообщением об ошибке.

Есть ли способ получить perl для печати только первого экземпляра идентичного и повторяющегося предупреждающего сообщения или просто сделать предупреждающие сообщения фатальными для выполнения script? Видя, что я никогда не производил script, который работает, несмотря на то, что в них есть предупреждения, я бы тоже согласился. Но его, вероятно, более удобно, если я могу получить perl для печати одинаковых предупреждений только один раз.

Ответ 1

Я думал, что покажу вам, как создать уникальную логику предупреждения. Однако я не рекомендую:

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

Я должен сказать, что я не рекомендую это как общую практику. Потому что лучше иметь предупреждение. Это либо операция, которая может принимать значение undefined, либо вы не хотите обрабатывать значение undef. Я пытаюсь удалить все предупреждения из моего кода.

В первом случае размещение no warnings 'uninitialized'; в цикле for намного проще и правильнее. Во втором случае вы, вероятно, захотите потерпеть неудачу.

Однако, если это то, что вы действительно хотели бы обрабатывать, но предупреждали об этом, скажите, что вам нужна надежная обработка данных, но вы хотели бы предупредить восходящие процессы, что у вас есть плохие данные, вы могли бы приступить к созданию 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}++;
    };
}

И назовите его следующим образом:

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

Тогда вы что-то решили.