blog.nomadscafe.jp

完全な思いつき＆パクリ。

package CGI::Application::Plugin;

use 5.006;
use strict;
use attributes ();

our $VERSION = 0.01;

# Code stolen from Class::DBI::Plugin 
# Code stolen from Simon Cozens (Maypole)
our %remember;
sub MODIFY_CODE_ATTRIBUTES { $remember{ $_[1] } = $_[2]; () }
sub FETCH_CODE_ATTRIBUTES { $remember{ $_[1] } }

sub import {
    my $class  = shift;
    my $caller = caller;
    no strict 'refs';
    for my $symname ( keys %{"$class\::"} ) {
        local *sym = ${"$class\::"}{$symname};
        next unless defined &sym;    # We're only in it for the subroutines
        &sym($caller), next
          if $symname eq 'init';
        *{"$caller\::$symname"} = \&sym
          if grep { defined($_) and $_ eq 'Plugged' } attributes::get( \&sym );
    }
}

1;

`Class::DBI::Plugin` =~ s/Class::DBI/CGI::Application/g;
しただけ。

SYNOPSISはこんな感じ。

  package CGI::Application::Plugin::NewPlugin;

  use strict;
  use base 'CGI::Application::Plugin';
  
  sub init {
    my $class = shift;
    $class->add_callback( 'prerun',  ... );
    $class->new_hook('newhook');
  }
  
  sub method_name : Plugged {
    my $self = shift;
    ....
  }

  sub this_method_is_not_exported {}

便利だと思ったり、でも今更間があったり。

ソース：http://svn.nomadscafe.jp/public/library/perl/CGI-Application-Plugin/