File Coverage

blib/lib/Path/AttrRouter/Controller.pm

Criterion	Covered	Total	%
statement	55	70	78.5
branch	18	28	64.2
condition	4	8	50.0
subroutine	15	16	93.7
pod			n/a
total	92	122	75.4

package Path::AttrRouter::Controller;
use Mouse;
use Carp;

extends 'Mouse::Object', 'Class::Data::Inheritable';

__PACKAGE__->mk_classdata( _attr_cache => [] );
__PACKAGE__->mk_classdata( _method_cache => [] );

has namespace => (
    is  => 'rw',
    isa => 'Str',
);

no Mouse;

sub import {
    my ($class, $flag) = @_;

    if (($flag || '') =~ /^\-extends/i) {
        my $caller = caller;

        if ($caller->can('meta')) {
            $caller->meta->superclasses($caller->meta->superclasses, $class);
        }
        else {
            no strict 'refs';
            push @{ $caller . '::ISA' }, $class;
        }
    }
}

sub MODIFY_CODE_ATTRIBUTES {
    my ($class, $code, @attrs) = @_;

    $class->_attr_cache([ @{ $class->_attr_cache } ]);
    push @{ $class->_attr_cache }, [ $code, \@attrs ];
    return;
}

sub _parse_Path_attr {
    my ($self, $name, $value) = @_;
    $value = '' unless defined $value;

    if ($value =~ m!^/!) {
        return Path => $value;
    }
    elsif (length $value) {
        return Path => join '/', $self->namespace, $value;
    }
    else {
        return Path => $self->namespace;
    }
}

sub _parse_Global_attr {
    my ($self, $name, $value) = @_;
    $self->_parse_Path_attr( $name, "/${name}" );
}

sub _parse_Local_attr {
    my ($self, $name, $value) = @_;
    $self->_parse_Path_attr( $name, $name );
}

sub _parse_Args_attr {
    my ($self, $name, $value) = @_;

    if (defined $value and $value !~ /^\d+$/) {
        carp "Args attribute is required numeric arguments: ignored Args('${value}')";
        return;
    }

    return Args => $value;
}

sub _parse_Private_attr {
    my ($self, $name, $value) = @_;

    if ($value) {
        carp "Arguments to Private attribute are invalid. ignored: Private('${value}')";
        return;
    }

    return Private => 1;
}

sub _parse_Regex_attr {
    my ($self, $name, $value) = @_;
    return Regex => $value;
}

sub _parse_LocalRegex_attr {
    my ($self, $name, $value) = @_;

    unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }

    my $prefix = $self->namespace;
    $prefix .= '/' if length( $prefix );

    return ( 'Regex', "^${prefix}${value}" );
}

sub _parse_Chained_attr {
    my ($self, $name, $value) = @_;

    if (defined $value && length $value) {
        if ($value eq '.') {
            $value = '/' . $self->namespace;
        }
        elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
            my @parts  = split '/', $self->namespace;
            my @levels = split '/', $rel;

            $value = '/' . join '/', @parts[0 .. $#parts - @levels], $rest;
        }
        elsif ($value !~ m!^/!) {
            my $action_ns = $self->namespace;

            if ($action_ns) {
                $value = '/' . join '/', $action_ns, $value;
            }
            else {
                $value = '/' . $value;
            }
        }
    }
    else {
        $value = '/';
    }

    return Chained => $value;
}

sub _parse_CaptureArgs_attr {
    my ($self, $name, $value) = @_;
    return CaptureArgs => $value;
}

sub _parse_PathPart_attr {
    my ($self, $name, $value) = @_;
    return PathPart => $value;
}

__PACKAGE__->meta->make_immutable;

__END__