Создание журналов в perl

Question

У меня есть много подпрограмм в моем скрипте perl. Я хочу создать журнал для каждой подпрограммы, т. Е. Журнал будет писать, работает ли подпрограмма, или если она не удалась, тогда там, где она не удалась. В соответствии с моим логическим флагом следует поддерживать &, если на основе журнала подпрограммы флага создается. Я новичок в perl, поэтому кто-нибудь может дать мне пример для этого же.

Answer 1

Наиболее прямое решение просто писать debug подпрограммы и использовать его в случае необходимости:

sub debug { 
    my($p, $f, $l) = caller; 
    print "$p, $f, $l\n"; 
} 

sub test { 
    debug; 
    print "something\n"; 
    debug; 
} 

Вы можете посмотреть caller на странице perlfunc людей.

Если вы хотите, чтобы это было намного шире, возьмите Aspect для вращения.

Answer 2

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

use constant LOG => 1; 

sub foo { 
    debug 'BEFORE', 'main::foo', @_ if LOG; # gets optimized away if LOG is false 
    do stuff; 
    debug 'AFTER', 'main::foo', if LOG;  # the same 
    return $things; 
} 

(при условии, debug это функция, которая делает запись в журнал)

Однако можно автоматизировать, что для некоторых случаев. В частности, мы можем добавить каротажные обертки для каждого под названием подпрограмма. Мы сделаем это как метапрограммирование с помощью пакета пакета, который является таблицей символов.

Запас большой хэш с такими именами, как %main::, обратите внимание на заднюю двойную двоеточие. Он содержит globs, которые являются хешами с фиксированным набором ключей. У них есть сингл *. В поле ввода CODE хранится ссылка на код.

Мы можем выбрать все шарики из притона, которые держат записи коды, как

my $stash = \%main::; 
my @interesting_globs = grep *$_{CODE}, values %$stash; 

Мы можем присвоить ссылку на Glob, это будет заполнить правильный слот в Glob. Например,

sub foo { say 1 } 

примерно то же самое, как

BEGIN { 
    *foo = sub { say 1 }; 
} 

Так что теперь мы можем обернуть оригинальный сабвуфер с оболочкой, которая делает регистрацию:

for my $glob (@interesting_globs) { 
    my $code = *$glob{CODE}; # store the coderef in a lexical variable 
    no warnings 'redefine'; 
    *$glob = sub { 
    debug 'BEFORE', $glob, @_ if LOG; 
    my @return_value = wantarray ? &$code : scalar &$code; 
    debug 'AFTER', $glob, @return_value if LOG; 
    return wantarray ? @return_value : $return_value[0]; 
    } 
} 

wantarray материал делает что внутренний sub вызывается в правильном контексте (контекст контекста/скалярный контекст). Однако мы не проверяем наличие пустотного контекста. &$code (обратите внимание на недостающие парсеры) - это причудливый способ сказать $code->(@_) или &$code(@_).

Важно, чтобы поддоны были украшены после того, как все подмножества были скомпилированы. Поэтому он должен, вероятно, быть выполнен внутри блока INIT, который запускается после основной фазы компиляции, но до начала обычного запуска.

Есть несколько недостатков с этим раствором:

1. Он работает только по имени подлодки, но не анонимные сабвуфер.
2. Он также украшает импортированные поднесущие по умолчанию.
3. Без дополнительных фильтров он украсит все предметы.
4. Мы не распространяем контекст пустоты на исходный код.

Лучшим решением будет использовать подпрограммой атрибуты, но они немного трудно установить. Атрибуты - это обработчики, которые выполняются при компиляции и могут передавать метаданные. Например. в sub foo :log_this { ... }, вызывается обработчик log_this.

---

Полный пример:

$ perl -E' 
    sub foo {say "@_"}; 
    sub bar { foo(0, @_, "inf") } 
    INIT{ 
    for my $glob (grep *$_{CODE}, values %main::){ 
     my $orig = *$glob{CODE}; 
     *$glob = sub { 
     say "BEFORE $glob: @_"; 
     my @ret = $orig->(@_); # this demo misses context handling 
     say "AFTER $glob: @ret"; 
     @ret; 
     }; 
    } 
    } 
    bar(1,2,3)' 
BEFORE *main::bar: 1 2 3 
BEFORE *main::foo: 0 1 2 3 inf 
0 1 2 3 inf 
AFTER *main::foo: 1 
AFTER *main::bar: 1