メソッドのフック in Perl DouKaku?

例えば、あるクラスのあるメソッドを実行する前に他の処理を呼びたい(例えばログやトランザクション開始など)。また、そのメソッドの終了後にも何らかの後処理を呼びたい(トランザクション終了など)。

そのような、メソッドに対するフック処理を書いてください。ライブラリを使用してメソッドのフックを実現した場合はライブラリの名前を紹介してくれると助かります。

メソッドって言うか, 関数に対して. (勿論メソッドにも適用可能)

無い関数に対しては, 勝手に作っちゃうけど良いっすか?

use warnings;
use strict;

{
  my %hooks   = ();

  sub add_hook($$&;$){
    my ($class, $meth, $sub, $is_after) = @_;
    my $key = "$class\0$meth";
    my $orig = UNIVERSAL::can($class, $meth) || sub(@){};
    unless(exists $hooks{$key}){
      my $pre   = [];
      my $after = [];
      my $hook  = [$pre, $after];
      $hooks{$key} = $hook;
      {
        no strict;
        no warnings;
        my $proto = defined(prototype $orig) ? "(".prototype($orig).")" : "";
        *{"${class}::${meth}"} =  eval qq{ sub ${proto}{
          use strict;
          foreach my \$fun (\@\$pre)
            {
              \$fun->();
            }

          my \@R = ();
          my \$R = undef;
          if(wantarray)
            {
              \@R = \$orig->(\@_);
            }
          else
            {
              \$R = \$orig->(\@_);
            }

          foreach my \$fun (\@\$after)
            {
              \$fun->();
            }
          wantarray ? \@R : \$R;
        } };
      }
    }
    push @{$hooks{$key}->[$is_after ? 1 : 0]}, $sub;
  }
}


# TEST
use Data::Dumper;
{
  package hoge;
  sub hemo(){
    print "HEMO\n";
    (wantarray ? (1,2,3) : [1,2,3])
  }
}

add_hook(hoge => hemo => sub(){
           print "pre1\n";
         });
add_hook(hoge => hemo => sub(){
           print "pre2\n";
         });

add_hook(hoge => hemo => sub(){
           print "after1\n";
         },1);
add_hook(hoge => hemo => sub(){
           print "after2\n";
         },1);

print join "-", hoge::hemo;
print "\n\n\n";
print Dumper scalar hoge::hemo;

Perlの関数アトリビュートを使ってみました。

#!/usr/bin/perl

use strict;
use warnings;

package HookAttribute;

use Attribute::Handlers;

sub Hook: ATTR(CODE) {
  my (undef, undef, $referent, undef, $args) = @_;
  $args = [$args] unless ref($args) eq "ARRAY";
  my $hook_before = shift(@$args) eq "Before";

  no strict "refs";
  no warnings "redefine";
  for my $funcname (@$args) {
    next unless defined *{$funcname}{CODE};

    my $funcref = \&{$funcname};
    *$funcname = $hook_before
               ? sub { $referent->(@_); goto &$funcref }
               : sub { $funcref->(@_); $referent->(@_) }; #callerなどが狂う
  }
}

#テストコード
package Foo;

use Perl6::Say;

sub new { bless {}, shift }
sub foo { say "foo" }

package FooHooks;

use base qw/HookAttribute/;
use Perl6::Say;

sub bar: Hook("Before", qw/Foo::foo/) { say "bar" }
sub baz: Hook("After", qw/Foo::foo/) { say "baz" }

Foo->new->foo;

DouKaku?

メソッドのフック

Posted feedbacks - Perl

Index

Feed

Other

Link

Pathtraq