package CGI::Application::Dispatch::Regexp;
use strict;
use base 'CGI::Application::Dispatch';

=pod

=head1 NAME

CGI::Application::Dispatch::Regexp -  Dispatch requests to CGI::Application based objects using regular expressions

=head1 SYNOPSIS

    use CGI::Application::Dispatch::Regexp;

    CGI::Application::Dispatch::Regexp->dispatch(
            prefix  => 'MyApp',
            table   => [
                ''                                    => { app => 'Welcome', rm => 'start' },
                qr|/([^/]+)/?|                        => { names => ['app']                },
                qr|/([^/]+)/([^/]+)/?|                => { names => [qw(app rm)]           },
                qr|/([^/]+)/([^/]+)/page(\d+)\.html?| => { names => [qw(app rm page)]      },
            ],
    );


=head1 DESCRIPTION

L<CGI::Application::Dispatch> uses its own syntax dispatch table.
C<CGI::Application::Dispatch::Regexp> allows to use flexible and powerful Perl
regular expressions to transform PATH_INFO into argument list.

=head1 DISPATCH TABLE

The dispatch table should contain list of regular expressions with hashref of
corresponding parameters. Hash element 'names' is a list of names of regular
expression groups. The default table looks like this:

        table       => [
            qr|/([^/]+)/?|          => { names => ['app']      },
            qr|/([^/]+)/([^/]+)/?|  => { names => [qw(app rm)] },
        ],

Here's an example of defining a custom 'page' parameter:

        qr|/([^/]+)/([^/]+)/page(\d+)\.html/?| => { names => [qw(app rm page)] },


=head1 SEE ALSO

L<CGI::Application>, L<CGI::Application::Dispatch>


=cut

# protected method - designed to be used by sub classes, not by end users
sub _parse_path {
    my ( $self, $path, $table ) = @_;

    # get the module name from the table
    return unless defined($path);

    unless (ref($table) eq 'ARRAY' ) {
        warn "Invalid or no dispatch table!\n";
        return;
    }

    for ( my $i = 0 ; $i < scalar(@$table) ; $i += 2 ) {

        # translate the rule into a regular expression, but remember where the named args are
        my $rule = $table->[$i];

        warn "[Dispatch::Regexp] Trying to match '$path' against rule '$table->[$i]' using regex '$rule'\n"
            if $CGI::Application::Dispatch::DEBUG;


        # if we found a match, then run with it
        if ( my @values = ( $path =~ m|^$rule$| ) ) {

            warn "[Dispatch::Regexp] Matched!\n" if $CGI::Application::Dispatch::DEBUG;

            my %named_args = %{ $table->[ ++$i ] };
            my $names = delete($named_args{names});

            @named_args{@$names} = @values  if (ref($names) eq 'ARRAY');

            return \%named_args;

        }

    }

    return;
}

sub dispatch_args {
    my ($self, $args) = @_;
    return {
        default     => ( $args->{default} || ''),
        prefix      => ( $args->{prefix}  || ''),
        args_to_new => ( $args->{args_to_new} || {} ),

        table       => [
            qr|/([^/]+)/?|          => { names => ['app']      },
            qr|/([^/]+)/([^/]+)/?|  => { names => [qw(app rm)] },
        ],

    };
}

1;
