Controller.pm

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;