File Coverage

blib/lib/Route/Switcher.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	2	4	50.0
condition	4	4	100.0
subroutine	11	11	100.0
pod	2	3	66.6
total	58	61	95.0

package Route::Switcher;
use 5.008001;
use strict;
use warnings;
use base 'Exporter';
our $VERSION = "0.02";

our @EXPORT = qw/switcher/;

my $CALLER = caller;
my @methods;
my %ORIG_METHOD;
our ($base_path,$base_class);

sub init {
    my $class = shift;
    my @methods  = @_;
    $class->methods(@_);

    no strict 'refs';
    no warnings 'redefine';
    for my $method (@methods) {
        *{"$CALLER\::$method"} = sub  {
            my $path = ($base_path  || '') . shift;
            my $dest = ($base_class || '') . shift;
            $ORIG_METHOD{$method}->($path,$dest,@_);
        };
    }
}

sub switcher {
    local $base_path = shift;
    local $base_class = shift;
    my $code = shift;
    $code->();
}

sub methods {
    my $class = shift;
    if (@_) {
        @methods = @_;
        _cache_original_method();
    }
    return @methods;
}


sub _cache_original_method {
    for my $method (@methods) {
        next unless( my $sub = $CALLER->can($method));
        $ORIG_METHOD{$method} = $sub;
    }
}

1;

__END__