четверг, апреля 18, 2013

Perl. Перехват warn'ов и carp'ов



Сейчас немного про перл.
В перле есть замечательная функция eval, которая умеет перехватывать критические ошибки, которые были вызваны die и/или croak. Но эта функция не умеет работать с предупреждениями, которые генерируются с помощью функций warn и carp. Ну и что такого, спросите вы, предупреждения для того и существуют, чтобы информировать пользователя/разработчика о некорректной работе скрипта или модуля. Но порой всё-же требуется, чтобы наш скрипт, написанный на перле, умел перехватывать подобные сообщения, сгенерированные модулями или функциями, чтобы, например, обрабатывать подобные сообщения особым образом.

Недолгое гугление выдало вот такой вариант, который более чем на 100% удовлетворяет нашей необходимости:
my $fh_err = undef;
{
    open(FH, '>', \$fh_err);
    local *STDERR = *FH;
    # тут делаем что-то, что может выдать предупреждение,
    # например, вызываем функцию или метод
    close(FH);
};
if ($fh_err) {   # получили сообщение с предпреждением
    # обрабатываем предупреждение
}
Пояснения:
1. Строка open(FH, '>', \$fh_err); создаёт дескриптор с записью данных в переменную(по аналогии с дескриптором файла). Работает, начиная с версии перла 5.8
2. Строка local *STDERR = *FH; переназначает поток вывода STDERR в наш дескриптор
3. Вся конструкция обёрнута в блок для того, чтобы не вызвать проблем с работой остального скрипта. После выхода из блока, STDERR возвращается в обычное состояние.
Небольшой пример для закрепления результата:
#!/usr/bin/perl

use strict;
use warnings;
use Carp    qw/carp/;

my $fh_err = undef;

# тест с warn
{
    open( FH, '>', \$fh_err );
    local *STDERR = *FH;
    warn "Сообщение warn";
    close(FH);
}

if ($fh_err) {
    print "!!!!!!! $fh_err\n";
}

# очищаем нашу переменную для следующего теста
$fh_err = undef;

# тест с carp
{
    open( FH, '>', \$fh_err );
    local *STDERR = *FH;
    carp "сообщение carp";
    close(FH);
}

if ($fh_err) {
    print "^^^^^^^^ $fh_err\n";
}

$fh_err = undef;

# тест с обычным текстом
{
    open( FH, '>', \$fh_err );
    local *STDERR = *FH;
    print "обычный текст\n";
    close(FH);
}

if ($fh_err) {
    print "Это сообщение не будет напечатано\n".
        "&&&&& $fh_err\n";
}
В итоге получаем следующее:
!!!!!!! Сообщение warn at /home/noize/development/perl/other/test_output.pl line 13.

^^^^^^^^ сообщение carp at /home/noize/development/perl/other/test_output.pl line 27.

обычный текст
Что и требовалось доказать.
В третьем примере(с обычным текстом) текст будет напечатан в блоке, т.к. функция оператор print по умолчанию выводит сообщения в STDOUT, а мы перехватываем из STDERR.

2 комментария:

Анонимный комментирует...

Прошу прощения, а чем не устраивает переопределение $SIG{__WARN__}?
Примерно так:
BEGIN {
local $SIG{__WARN__} = sub {
warn "!!! ", join " " => @_;
};
}

Alexander комментирует...

я и не говорил, что не устраивает) просто я не знал такого решения. Теперь вот знаю уже 2 способа по перехвату варнингов )