File Coverage

blib/lib/Path/Dispatcher/Rule/Tokens.pm

Criterion	Covered	Total	%
statement	59	73	80.8
branch	15	30	50.0
condition	13	15	86.6
subroutine	10	11	90.9
pod	0	3	0.0
total	97	132	73.4

package Path::Dispatcher::Rule::Tokens;
# ABSTRACT: predicate is a list of tokens

our $VERSION = '1.07';

use Moo;
use Types::Standard qw(Str ArrayRef Bool);

extends 'Path::Dispatcher::Rule';

has tokens => (
    is         => 'ro',
    isa        => ArrayRef,
    required   => 1,
);

has delimiter => (
    is      => 'ro',
    isa     => Str,
    default => ' ',
);

has case_sensitive => (
    is      => 'ro',
    isa     => Bool,
    default => 1,
);

sub _match_as_far_as_possible {
    my $self = shift;
    my $path = shift;

    my @got      = $self->tokenize($path->path);
    my @expected = @{ $self->tokens };
    my @matched;

    while (@got && @expected) {
        my $expected = $expected[0];
        my $got      = $got[0];

        last unless $self->_match_token($got, $expected);

        push @matched, $got;
        shift @expected;
        shift @got;
    }

    return (\@matched, \@got, \@expected);
}

sub _match {
    my $self = shift;
    my $path = shift;

    my ($matched, $got, $expected) = $self->_match_as_far_as_possible($path);

    return if @$expected; # didn't provide everything necessary
    return if @$got && !$self->prefix; # had tokens left over

    my $leftover = $self->untokenize(@$got);

    return if !$matched;

    return {
        positional_captures => $matched,
        leftover            => $leftover,
    };
}

sub complete {
    my $self = shift;
    my $path = shift;

    my ($matched, $got, $expected) = $self->_match_as_far_as_possible($path);
    return if @$got > 1; # had tokens leftover
    return if !@$expected; # consumed all tokens

    my $next = shift @$expected;
    my $part = @$got ? shift @$got : '';
    my @completions;

    for my $completion (ref($next) eq 'ARRAY' ? @$next : $next) {
        next if ref($completion);

        next unless substr($completion, 0, length($part)) eq $part;
        push @completions, $self->untokenize(@$matched, $completion);
    }

    return @completions;
}

sub _each_token {
    my $self     = shift;
    my $got      = shift;
    my $expected = shift;
    my $callback = shift;

    if (ref($expected) eq 'ARRAY') {
        for my $alternative (@$expected) {
            $self->_each_token($got, $alternative, $callback);
        }
    }
    elsif (!ref($expected) || ref($expected) eq 'Regexp') {
        $callback->($got, $expected);
    }
    else {
        die "Unexpected token '$expected'"; # the irony is not lost on me :)
    }
}

sub _match_token {
    my $self     = shift;
    my $got      = shift;
    my $expected = shift;

    my $matched = 0;
    $self->_each_token($got, $expected, sub {
        my ($g, $e) = @_;
        if (!ref($e)) {
            ($g, $e) = (lc $g, lc $e) if !$self->case_sensitive;
            $matched ||= $g eq $e;
        }
        elsif (ref($e) eq 'Regexp') {
            $matched ||= $g =~ $e;
        }
    });

    return $matched;
}

sub tokenize {
    my $self = shift;
    my $path = shift;
    return grep { length } split $self->delimiter, $path;
}

sub untokenize {
    my $self   = shift;
    my @tokens = @_;
    return join $self->delimiter,
           grep { length }
           map { split $self->delimiter, $_ }
           @tokens;
}

__PACKAGE__->meta->make_immutable;
no Moo;

1;

__END__