catlxom の プラグイン機構を plagger ライクに #1 (catlxom メモ #6)

昨日のエントリの続き。filter もちゃんと実装して、ついでにプラグインも全て新しいプラグイン機構に対応させてみた。

本家 の Rev.23 との全差分です。

Index: plugins/Entry/Blosxom.pm
===================================================================
--- plugins/Entry/Blosxom.pm    (revision 23)
+++ plugins/Entry/Blosxom.pm    (working copy)
@@ -9,6 +9,15 @@
 
 __PACKAGE__->classdata->{entries} = [];
 
+sub register {
+    my ($class, $c) = @_;
+    $c->catlxom->register_hook(
+        $class,
+        'setup'  => 'setup',
+        'update' => 'update',
+    );
+}
+
 sub setup {
     my ( $self, $c ) = @_;
 
@@ -49,15 +58,11 @@
         }
     );
 
-    $self->entries->add( __PACKAGE__ );
-
-    $self->NEXT::setup($c);
+    $c->catlxom->entries->add( __PACKAGE__ );
 }
 
 sub update {
     my ( $self, $c ) = @_;
-
-    $self->NEXT::update($c);
 }
 
 1;
Index: plugins/Filter/Path.pm
===================================================================
--- plugins/Filter/Path.pm  (revision 23)
+++ plugins/Filter/Path.pm  (working copy)
@@ -4,6 +4,14 @@
 
 our $VERSION = '0.01';
 
+sub register {
+    my ($class, $c) = @_;
+    $c->catlxom->register_hook(
+        $class,
+        'filter' => 'filter',
+    );
+}
+
 sub filter {
     my ( $self, $c, $entry ) = @_;
 
Index: plugins/Filter/Date.pm
===================================================================
--- plugins/Filter/Date.pm  (revision 23)
+++ plugins/Filter/Date.pm  (working copy)
@@ -6,6 +6,14 @@
 
 our $VERSION = '0.01';
 
+sub register {
+    my ($class, $c) = @_;
+    $c->catlxom->register_hook(
+        $class,
+        'filter' => 'filter',
+    );
+}
+
 sub filter {
     my ( $self, $c, $entry ) = @_;
 
Index: plugins/Format/Textile.pm
===================================================================
--- plugins/Format/Textile.pm   (revision 23)
+++ plugins/Format/Textile.pm   (working copy)
@@ -3,29 +3,33 @@
 use warnings;
 use base qw/Catlxom::Plugin/;
 
-use NEXT;
 use Text::Textile;
 
 our $VERSION = '0.01';
 
+sub register {
+    my ($class, $c) = @_;
+    $c->catlxom->register_hook(
+        $class,
+        'setup'   => 'setup',
+        'fixedup' => 'fixedup',
+    );
+}
+
 sub setup {
     my ( $self, $c ) = @_;
 
     $self->classdata->{textile} = Text::Textile->new;
     $self->classdata->{textile}->charset('utf-8');
-
-    $self->NEXT::setup($c);
 }
 
 sub fixedup {
     my ( $self, $c ) = @_;
 
-    for my $entry ( @{ $self->entries->filtered } ) {
+    for my $entry ( @{ $c->catlxom->entries->filtered } ) {
         $entry->content(
             $self->classdata->{textile}->process( $entry->content ) );
     }
-
-    $self->NEXT::fixedup($c);
 }
 
 1;
Index: plugins/Paginate/Simple.pm
===================================================================
--- plugins/Paginate/Simple.pm  (revision 23)
+++ plugins/Paginate/Simple.pm  (working copy)
@@ -1,27 +1,32 @@
 package Catlxom::Plugin::Paginate::Simple;
 use strict;
 use warnings;
-use NEXT;
 
 use Data::Page;
 use Data::Page::Navigation;
 
 our $VERSION = '0.01';
 
+sub register {
+    my ($class, $c) = @_;
+    $c->catlxom->register_hook(
+        $class,
+        'paginate' => 'paginate',
+    );
+}
+
 sub paginate {
     my ( $self, $c ) = @_;
 
     my $page = int( $c->req->params->{page} || 1 );
     $page = 1 unless $page >= 1;
 
-    my $pager = $self->stash->{pager}
-        = Data::Page->new( scalar @{ $self->entries },
+    my $pager = $c->catlxom->stash->{pager}
+        = Data::Page->new( scalar @{ $c->catlxom->entries },
         $c->config->{num_entries} ||= 20, $page, );
 
-    $self->entries->filtered(
-        [ $pager->splice( $self->entries->filtered ) ] );
-
-    $self->NEXT::paginate($c);
+    $c->catlxom->entries->filtered(
+        [ $pager->splice( $c->catlxom->entries->filtered ) ] );
 }
 
 1;
Index: plugins/Template/TT.pm
===================================================================
--- plugins/Template/TT.pm  (revision 23)
+++ plugins/Template/TT.pm  (working copy)
@@ -6,19 +6,27 @@
 use Catlxom::Util;
 use List::Util qw/first/;
 use Template;
-use NEXT;
 
 our $VERSION = '0.01';
 
+my $template_dir = Catlxom::Util::load_dir('template');
+my $path_root    = join '/', $template_dir->dir_list;
+
 __PACKAGE__->classdata->{templates} = {};
-__PACKAGE__->classdata->{tt}        = Template->new;
+__PACKAGE__->classdata->{tt}        = Template->new( INCLUDE_PATH => $path_root );
 
+sub register {
+    my ($class, $c) = @_;
+    $c->catlxom->register_hook(
+        $class,
+        'setup'       => 'setup',
+        'interpolate' => 'interpolate',
+    );
+}
+
 sub setup {
     my ( $self, $c ) = @_;
 
-    my $template_dir = Catlxom::Util::load_dir('template');
-    my $path_root    = join '/', $template_dir->dir_list;
-
     $template_dir->recurse(
         callback => sub {
             my $file = shift;
@@ -48,8 +56,6 @@
             };
         }
     );
-
-    $self->NEXT::setup($c);
 }
 
 sub interpolate {
@@ -78,16 +84,14 @@
             \$template->{template},
             {
                 name => $c->config->{name},
-                %{ $self->stashall },
-                entries => $self->entries->filtered,
+                %{ $c->catlxom->stashall },
+                entries => $c->catlxom->entries->filtered,
 
                 c => $c,
             },
             \$c->res->{body},
-        );
+        ) or $c->error( $self->classdata->{tt}->error );
     }
-
-    $self->NEXT::interpolate($c);
 }
 
 1;
Index: lib/Catlxom/Context/Base.pm
===================================================================
--- lib/Catlxom/Context/Base.pm (revision 23)
+++ lib/Catlxom/Context/Base.pm (working copy)
@@ -5,7 +5,6 @@
 
 use Catlxom::Plugins;
 use Catlxom::Entries;
-use NEXT;
 
 __PACKAGE__->mk_classdata( plugin  => Catlxom::Plugins->new );
 __PACKAGE__->mk_classdata( entries => Catlxom::Entries->new );
@@ -14,50 +13,56 @@
 
 sub setup {
     my ($self, $c) = @_;
+    $self->plugin->load($c);
+    $self->run_hook($c, 'setup');
+}
 
-    $self->plugin->load($c);
-    {
-        # plugin setup
-        no warnings 'redefine';
-        local *setup = sub { };
-        $self->setup($c);
+sub register_hook {
+    my ($self, $plugin, @hooks) = @_;
+    while (my($hook, $callback) = splice @hooks, 0, 2) {
+        push @{ $self->{hooks}->{$hook} }, {
+            callback  => $callback,
+            plugin    => $plugin,
+        };
     }
 }
 
-sub initialize {
-    my ( $self, $c ) = @_;
-
-    $self->_stash( {} );
+sub run_hook {
+    my($self, $c, $hook, $args) = @_;
+    for my $action (@{ $self->{hooks}->{$hook} }) {
+        my $plugin   = $action->{plugin};
+        my $callback = $action->{callback};
+        no strict 'refs';
+        $plugin->$callback($c, $args);
+    }
 }
 
-sub start       { }
-sub update      { }
-sub sort        { }
-sub paginate    { }
-sub fixedup     { }
-sub interpolate { }
-sub end         { }
-
 sub dispatch {
     my ( $self, $c ) = @_;
 
-    $self->initialize($c);
+    $self->_stash( {} );
+    $self->run_hook($c, 'initialize');
 
-    $self->start($c);
-    $self->update($c);
+    $self->run_hook($c, 'start');
+    $self->run_hook($c, 'update');
 
-    $self->entries->filter($c);
-    $self->sort($c);
-    $self->paginate($c);
+    $self->entries->filtered( [] );
+    for my $entry ( @{ $self->entries } ){
+        $self->run_hook($c, 'filter', $entry);
+        push @{ $self->entries->filtered }, $entry->clone;
+    }
+    $self->run_hook($c, 'sort');
+    $self->run_hook($c, 'paginate');
 
-    $self->fixedup($c);
-    $self->interpolate($c);
-    $self->end($c);
+    $self->run_hook($c, 'fixedup');
+    $self->run_hook($c, 'interpolate');
+    $self->run_hook($c, 'end');
 }
 
 sub stash {
     my $self   = shift;
-    my $caller = caller(0);
+    ( my $caller = lc caller(0) ) =~ s/Catlxom::Plugin:://i;
+    $caller =~ s/::/_/g;
 
     if (@_) {
         my $stash = @_ > 1 ? {@_} : $_[0];
Index: lib/Catlxom/Entries.pm
===================================================================
--- lib/Catlxom/Entries.pm  (revision 23)
+++ lib/Catlxom/Entries.pm  (working copy)
@@ -4,7 +4,6 @@
 use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
 
 use Catalyst::Exception;
-use NEXT;
 
 use Catlxom::Entry;
 
@@ -30,21 +29,4 @@
     \@entries;
 }
 
-sub filter {
-    my ( $self, $c ) = @_;
-
-    $self->filtered( [] );
-
-    my @plugins = grep { $_->can('filter') } @{ $c->catlxom->plugin };
-
-FILTER:
-    for my $entry ( @{ $self->entries } ) {
-        for my $plugin (@plugins) {
-            next FILTER unless $plugin->filter( $c, $entry );
-        }
-        push @{ $self->filtered }, $entry->clone;
-    }
-}
-
 1;
-
Index: lib/Catlxom/Plugins.pm
===================================================================
--- lib/Catlxom/Plugins.pm  (revision 23)
+++ lib/Catlxom/Plugins.pm  (working copy)
@@ -51,7 +51,7 @@
         ( my $plugin = 'Catlxom::Plugin::' . join( '::', @path ) . $file->basename )
             =~ s/\.pm$//;
 
-        unshift @Catlxom::Context::ISA, $plugin;
+        $plugin->register($c);
     }
 
     if ( $c->debug ) {