Last active
December 16, 2015 13:28
-
-
Save taiyoh/5441465 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::Util::Controller; | |
use strict; | |
use warnings; | |
use Class::Method::Modifiers (); | |
use Module::Functions; | |
my %FUNCTIONS; | |
sub import { | |
require strict; import strict; | |
require warnings; import warnings; | |
require utf8; import utf8; | |
my $caller = scalar caller; | |
no strict 'refs'; | |
*{"${caller}::before_filter"} = \&before_filter; | |
*{"${caller}::after_filter"} = \&after_filter; | |
} | |
sub make_do_filter { | |
my ($caller, $filter, $args) = @_; | |
if (my $only = $args->{only}) { | |
$only = [$only] unless ref $only; | |
$args->{if} = sub { | |
my ($class, $c) = @_; | |
my $action = $c->{args}{action}; | |
scalar grep { $_ eq $action } @$only; | |
}; | |
} | |
if (my $except = $args->{except}) { | |
$except = [$except] unless ref $except; | |
$args->{unless} = sub { | |
my ($class, $c) = @_; | |
my $action = $c->{args}{action}; | |
scalar grep { $_ eq $action } @$except; | |
}; | |
} | |
my $do_filter = sub { $_->(@_) for (@$filter); }; | |
my ($if, $un) = ($args->{if}, $args->{unless}); | |
if ($if && (ref($if) eq 'CODE' || ($if = $caller->can($if)))) { | |
$do_filter = sub { | |
if ($if->(@_)) { $_->(@_) for (@$filter); } | |
}; | |
} | |
elsif ($un && (ref($un) eq 'CODE' || ($un = $caller->can($un)))) { | |
$do_filter = sub { | |
unless ($un->(@_)) { $_->(@_) for (@$filter); } | |
}; | |
} | |
$do_filter; | |
} | |
sub find_filter { | |
my ($caller, $filter) = @_; | |
$filter = [$filter] if (ref($filter) || '') ne 'ARRAY'; | |
return [grep { $_ } map { | |
if ((ref($_) || '') eq 'CODE') { | |
$_; | |
} | |
elsif (my $code = $caller->can($_)) { | |
$code; | |
} | |
else { | |
undef; | |
} | |
} @$filter]; | |
} | |
sub before_filter($@) { | |
my $caller = scalar caller; | |
my ($filter, %args) = @_; | |
$filter = find_filter($caller, $filter); | |
my $do_filter = make_do_filter($caller, $filter, \%args); | |
my $funcs = $FUNCTIONS{$caller} ||= [get_public_functions($caller)]; | |
around($caller, @$funcs, sub { | |
my $orig = shift; | |
$do_filter->(@_); | |
$orig->(@_); | |
}); | |
} | |
sub after_filter($@) { | |
my $caller = scalar caller; | |
my ($filter, %args) = @_; | |
$filter = find_filter($caller, $filter); | |
my $do_filter = make_do_filter($caller, $filter, \%args); | |
my $funcs = $FUNCTIONS{$caller} ||= [get_public_functions($caller)]; | |
around($caller, @$funcs, sub { | |
my $orig = shift; | |
my $res = $orig->(@_); | |
$do_filter->(@_); | |
$res; | |
}); | |
} | |
sub around { | |
my $caller = shift; | |
Class::Method::Modifiers::install_modifier($caller, 'around', @_); | |
} | |
1; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment