Как я могу подключиться к печати на Perl?

Вот сценарий. У вас есть большое количество устаревших скриптов, все из которых используют общую библиотеку. Указанные сценарии используют инструкцию print для вывода диагностических данных. Никакие изменения не допускаются к сценариям - они широко варьируются, имеют свои одобрения и уже давно покинули плодотворные долины контроля и контроля.

Теперь появилась новая потребность: теперь в библиотеку нужно добавить журнал. Это должно выполняться автоматически и прозрачно, без необходимости использования стандартной библиотеки для изменения их скриптов. Общие методы библиотеки могут просто добавлять к ним вызовы протоколирования; это легкая часть. Жесткая часть заключается в том, что диагностический вывод из этих сценариев всегда отображался с помощью инструкции "print". Этот диагностический вывод должен быть сохранен, но так же важно, обработан.

В качестве примера этой обработки библиотека должна записывать только печатные строки, содержащие слова "предупреждение", "ошибка", "уведомление" или "внимание". В приведенном ниже Чрезвычайно тривиальном и проигранном примере кода (tm) будет записываться некоторый из указанного вывода:

sub CheckPrintOutput
{
    my @output = @_; # args passed to print eventually find their way here.
    foreach my $value (@output) {
         Log->log($value) if $value =~ /warning|error|notice|attention/i;
    }
}

(Я бы хотел избежать таких проблем, как "что на самом деле должно быть зарегистрировано", "печать не должна использоваться для диагностики", "perl sucks" или "этот пример имеет недостатки xy и z".. Это значительно упрощается для краткости и ясности.)

Основная проблема сводится к захвату и обработке данных, переданных для печати (или любого встроенного perl по этим линиям рассуждений). Является ли это возможным? Есть ли способ сделать это чисто? Существуют ли какие-либо модули регистрации, у которых есть крючки, чтобы вы могли это сделать? Или это то, чего следует избегать, как чума, и я должен отказаться от когда-либо захвата и обработки печатной продукции?

Дополнительно: для этого нужно использовать межплатформенные окна и * nix. Процесс запуска скриптов должен оставаться таким же, как и вывод из script.

Дополнительное дополнение: интересное предложение, сделанное в комментариях к кодологическому ответу:

Вы можете подклассы http://perldoc.perl.org/IO/Handle.html и создать свой   собственный дескриптор файла, который будет выполнять работу по протоколированию. - Камил Кисиэль

Это может сделать это с двумя оговорками:

1) Мне нужен способ экспортировать эту функцию всем, кто использует общую библиотеку. Он должен будет автоматически применяться к STDOUT и, возможно, к STDERR тоже.

2) документация IO:: Handle говорит, что вы не можете подклассифицировать ее, и мои попытки до сих пор были бесплодны. Есть ли что-то особенное, что необходимо для того, чтобы сделать sublclassing IO:: Handle? Стандартная "база использования" IO:: Handle ", а затем переопределение новых/методов печати ничего не делает.

Окончательное редактирование: похоже на IO:: Handle - это тупик, но Tie:: Handle может это сделать. Спасибо за все предложения; они все очень хорошие. Я собираюсь попробовать маршрут Tie:: Handle. Если это вызовет проблемы, я вернусь!

Добавление: Обратите внимание, что после работы с этим я обнаружил, что Tie:: Handle будет работать, если вы не сделаете ничего сложного. Если вы используете какие-либо функции IO:: Handle с привязанным STDOUT или STDERR, это в основном crapshoot, чтобы заставить их работать надежно - я не мог найти способ получить метод автозапуска IO:: Handle для работы на моем связанном ручка. Если бы я включил автозапуск, прежде чем я привязал ручку, он сработает. Если это сработает для вас, маршрут Tie:: Handle может быть приемлемым.

Ответы

package IO::Override;
use base qw<Tie::Handle>;
use Symbol qw<geniosym>;

sub TIEHANDLE { return bless geniosym, __PACKAGE__ }

sub PRINT { 
    shift;
    # You can do pretty much anything you want here. 
    # And it printing to what was STDOUT at the start.
    # 
    print $OLD_STDOUT join( '', 'NOTICE: ', @_ );
}

tie *PRINTOUT, 'IO::Override';
our $OLD_STDOUT = select( *PRINTOUT );

sub PRINTF { 
    shift;
    # You can do pretty much anything you want here. 
    # And it printing to what was STDOUT at the start.
    # 
    my $format = shift;
    print $OLD_STDOUT join( '', 'NOTICE: ', sprintf( $format, @_ ));
}

open my $fh, ">log.txt";
print "test1\n";
my $current_fh = select $fh;
print "test2\n";
select $current_fh;
print "test3\n";

package PsychicSTDOUT;
use strict;

my $c = 0;
my $malformed_header = 0;
open(TRUE_STDOUT, '>', '/dev/stdout');
tie *STDOUT, __PACKAGE__, (*STDOUT);

sub TIEHANDLE {
    my $class = shift;
    my $handles = [@_];
    bless $handles, $class;
    return $handles;
}

sub PRINT {
    my $class = shift;
    if (!$c++ && @_[0] !~ /^content-type/i) {
        my (undef, $file, $line) = caller;
        print STDERR "Missing content-type in $file at line $line!!\n";
        $malformed_header = 1;
    }
    return 0 if ($malformed_header);
    return print TRUE_STDOUT @_;
}
1;

use PsychicSTDOUT;
print "content-type: text/html\n\n"; #try commenting out this line
print "<html>\n";
print "</html>\n";