Запретить Perl печатать идентичные предупреждающие сообщения

Question

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

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

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

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

Answer 1

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

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

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

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

Однако, если это то, что вы на самом деле хотели бы обработать, но однажды предупредите, скажем, что вы хотели надежной обработки данных, но хотели предупредить процессы верхнего уровня, что у вас есть плохие данные, вы можете приступить к созданию sub warn_once * * 1016

{   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";
}

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