package Router::Boom;
use 5.008005;
use strict;
use warnings;
use Carp ();

our $VERSION = "1.03";

# Matcher stuff
our $LEAF_IDX;
our @CAPTURED;

# Compiler stuff
our @LEAVES;
our $PAREN_CNT;
our @PARENS;

use re 'eval';

use Router::Boom::Node;

sub new {
    my $class = shift;
    my $self = bless { }, $class;
    $self->{root} = Router::Boom::Node->new(key => '/');
    return $self;
}

# True if : ()
# False if : (?:)
sub _is_normal_capture {
    $_[0] =~ /
        \(
            (?!
                \?:
            )
    /x
}

sub add {
    my ($self, $path, $stuff) = @_;
    $path =~ s!\A/!!;

    delete $self->{regexp}; # clear cache

    my $p = $self->{root};
    my @capture;
    while ($path =~ m!\G(?:
            \{((?:\{[0-9,]+\}|[^{}]+)+)\} | # /blog/{year:\d{4}}
            :([A-Za-z0-9_]+)              | # /blog/:year
            (\*)                          | # /blog/*/*
            ([^{:*]+)                       # normal string
        )!xg) {

        if (defined $1) {
            my ($name, $pattern) = split /:/, $1, 2;
            if (defined($pattern) && _is_normal_capture($pattern)) {
                Carp::croak("You can't include parens in your custom rule.");
            }
            push @capture, $name;
            $pattern = $pattern ? "($pattern)" : "([^/]+)";
            $p = $p->add_node($pattern);
        } elsif (defined $2) {
            push @capture, $2;
            $p = $p->add_node("([^/]+)");
        } elsif (defined $3) {
            push @capture, '*';
            $p = $p->add_node("(.+)");
        } else {
            $p = $p->add_node(quotemeta $4);
        }
    }
    $p->leaf([\@capture, $stuff]);

    return;
}

sub _build_regexp {
    my ($self) = @_;

    my $trie = $self->{root};
    local @LEAVES;
    local $PAREN_CNT = 0;
    local @PARENS;
    my $re = _to_regexp($trie);
    $self->{leaves} = [@LEAVES];
    $self->{regexp} = qr{\A$re};
}

sub match {
    my ($self, $path) = @_;

    # "I think there was a discussion about that a while ago and it is up to apps to deal with empty PATH_INFO as root / iirc"
    # -- by @miyagawa
    #
    # see http://blog.64p.org/entry/2012/10/05/132354
    $path = '/' if $path eq '';

    if ($path =~ $self->regexp) {
        my ($captured, $stuff) = @{$self->{leaves}->[$Router::Boom::LEAF_IDX]};
        my %captured;
        @captured{@$captured} = @Router::Boom::CAPTURED;
        return ($stuff, \%captured);
    } else {
        return ();
    }
}

sub regexp {
    my $self = shift;
    if (not exists $self->{regexp}) {
        $self->_build_regexp();
    }
    $self->{regexp};
}

sub _to_regexp {
    my ($node) = @_;

    my %leaves;

    local @PARENS = @PARENS;

    my $key = $node->key;
    if ($key =~ /\(/) {
        $PAREN_CNT++;
        push @PARENS, $PAREN_CNT;
    }
    my @re;
    if (@{$node->children}>0) {
        push @re, map { _to_regexp($_) } @{$node->children};
    }
    if ($node->leaf) {
        push @Router::Boom::LEAVES, $node->leaf;
        push @re, sprintf '\z(?{ $Router::Boom::LEAF_IDX=%s; @Router::Boom::CAPTURED = (%s) })', @Router::Boom::LEAVES-1, join(',', map { "\$$_" } @PARENS);
    }
    my $re = $node->key;
    if (@re==0) {
        # nop
    } elsif (@re == 1) {
        $re .= $re[0];
    } else {
        $re .= '(?:' . join('|', @re) . ')';
    }
    return qr{$re};
}

1;
__END__

=encoding utf-8

=head1 NAME

Router::Boom - Fast routing engine for web applications

=head1 SYNOPSIS

    use Router::Boom;

    my $router = Router::Boom->new();
    $router->add('/', 'dispatch_root');
    $router->add('/entrylist', 'dispatch_entrylist');
    $router->add('/:user', 'dispatch_user');
    $router->add('/:user/{year}', 'dispatch_year');
    $router->add('/:user/{year}/{month:\d+}', 'dispatch_month');
    $router->add('/download/*', 'dispatch_download');

    my $dest = $router->match($env->{PATH_INFO});

=head1 DESCRIPTION

Router::Boom is a fast path routing engine for Perl5.

=head1 MEHTODS

=over 4

=item my $router = Router::Boom->new()

Create new instance.

=item $router->add($path:Str, $destination:Any)

Add new route.

=item my ($destination, $captured) = $router->match($path:Str);

Matching the route. If matching successfully, this method returns 2 values.

First: The destination value, you registered. Second: Captured values from the path.

If matching was failed, this method returns empty list.

=back

=head1 HOW TO WRITE A ROUTING RULE

=head2 plain string 

    $router->add( '/foo', { controller => 'Root', action => 'foo' } );

=head2 :name notation

    $router->add( '/wiki/:page', { controller => 'WikiPage', action => 'show' } );
    ...
    $router->match('/wiki/john');
    # => {controller => 'WikiPage', action => 'show'}, {page => 'john'}

':name' notation matches C<qr{([^/]+)}>.

=head2 '*' notation

    $router->add( '/download/*', { controller => 'Download', action => 'file' } );
    ...
    $router->match('/download/path/to/file.xml');
    # => {controller => 'Download', action => 'file'}, {'*' => 'path/to/file.xml'}

'*' notation matches C<qr{(.+)}>. You will get the captured argument as the special key: C<*>.

=head2 '{year}' notation

    $router->add( '/blog/{year}', { controller => 'Blog', action => 'yearly' } );
    ...
    $router->match('/blog/2010');
    # => {controller => 'Blog', action => 'yearly'}, {year => 2010}

'{year}' notation matches C<qr{([^/]+)}>, and it will be captured.

=head2 '{year:[0-9]+}' notation

    $router->add( '/blog/{year:[0-9]+}/{month:[0-9]{2}}', { controller => 'Blog', action => 'monthly' } );
    ...
    $router->match('/blog/2010/04');
    # => {controller => 'Blog', action => 'monthly'}, {year => 2010, month => '04'}

You can specify regular expressions in named captures.

Note. You can't include normal capture in custom regular expression. i.e. You can't use C< {year:(\d+)} >.
But you can use C<< {year:(?:\d+)} >>.

=head1 PERFORMANCE

Router::Boom is pretty fast!

                      Rate Router::Simple   Router::Boom
    Router::Simple  8000/s             --           -90%
    Router::Boom   83651/s           946%             --

Router::Boom's computational complexity is not linear scale, bug Router::Simple's computational complexity is linear scale.

Then, Router::Simple get slower if registered too much routes.
But if you're using Router::Boom then you don't care the performance :)

=head1 LICENSE

Copyright (C) tokuhirom.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

tokuhirom E<lt>tokuhirom@gmail.comE<gt>

=head1 SEE ALSO

L<Router::Simple> is my old one. But it's bit slow and complicated.

L<Path::Dispatcher> is similar, but so complex.

L<Path::Router> is heavy. It depends on L<Moose>.

L<HTTP::Router> has many dependencies. It is not well documented.

L<HTTPx::Dispatcher> is my old one. It does not provide an OO-ish interface.

=cut