The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Eve::HttpDispatcher;

use parent qw(Eve::Class);

use strict;
use warnings;

use Eve::Event::HttpResponseReady;
use Eve::Exception;

=head1 NAME

B<Eve::HttpDispatcher> - an event handler for HTTP request events.

=head1 SYNOPSIS

    use Eve::HttpDispatcher;

    my $dispatcher = Eve::HttpDispatcher->new(
        request_constructor => $request_constructor,
        response => $response,
        base_uri => $base_uri,
        alias_base_uri_list => [$alias_base_uri, $another_alias_base_uri],
        event_map => $event_map);

    $dispatcher->bind(
        name => $name
        pattern => $pattern,
        resource_constructor => $resource_constructor);

    $dispatcher->bind(
        name => $name_404
        pattern => $pattern_404,
        resource_constructor => $resource_constructor_404,
        exception => 'Eve::Exception::Http::404NotFound');

    $dispatcher->handle(event => $event);

=head1 DESCRIPTION

B<Eve::HttpDispatcher> class is a central component to a web
service application.

=head3 Constructor arguments

=over 4

=item C<request_constructor>

a code reference that returns an HTTP request object when passed an
environment hash

=item C<response>

an HTTP response object

=item C<event_map>

an event map object.

=item C<base_uri>

a base URI object used for resource binding.

=item C<alias_base_uri_list>

(optional) a reference to a list of additional base URI objects that
will be used for resource matching.

=back

=head1 METHODS

=head2 B<init()>

=cut

sub init {
    my ($self, %arg_hash) = @_;
    Eve::Support::arguments(
        \%arg_hash,
        my ($request_constructor, $response, $event_map, $base_uri),
        my $alias_base_uri_list = []);

    $self->{'_request_constructor'} = $request_constructor;
    $self->{'_response'} = $response;
    $self->{'_event_map'} = $event_map;
    $self->{'_base_uri'} = $base_uri;

    $self->{'_base_uri_list'} = [$base_uri, @{$alias_base_uri_list}];

    $self->{'_uri_map'} = {};
    $self->{'_name_map'} = {};
    $self->{'_exception_name_hash'} = {};

    return;
}

=head2 B<bind()>

Binds an HTTP resource.

=head3 Arguments

=over 4

=item C<name>

a name identifying the binding

=item C<pattern>

an URI pattern string that can contain placeholders

=item C<base_uri>

a URI object that represents a base URL for the binding resource

=item C<resource_constructor>

a code reference that returns an HTTP resource object

=item C<exception>

(optional) an HTTP exception class name that the bound resource should
be used to handle. B<Note>: there can be only one resource bound to
handle a certain exception.

=back

=head3 Throws

=over 3

=item C<Eve::Exception::HttpDispatcher>

if either name or compound URI or exception class name is not unique.

=back

=cut

sub bind {
    my ($self, %arg_hash) = @_;
    Eve::Support::arguments(
        \%arg_hash, my ($name, $pattern, $resource_constructor),
        my $exception = \undef);

    if (exists $self->_uri_map->{$pattern}) {
        Eve::Error::HttpDispatcher->throw(
            message => 'Binding URI must be unique: '.$pattern);
    }

    if (exists $self->_name_map->{$name}) {
        Eve::Error::HttpDispatcher->throw(
            message => 'Binding name must be unique: '.$name);
    }

    # Constructing all possible URIs that this resource is supposed to match
    # using the base URI as well as possible aliases
    my $uri_list = [];
    for my $uri (@{$self->_base_uri_list}) {
        my $map_uri = $uri->clone();
        $map_uri->path_concat(string => $pattern);

        push(@{$uri_list}, $map_uri);
    }

    $self->_uri_map->{$pattern} = {
        'resource' => $resource_constructor->(),
        'uri_list' => $uri_list};

    $self->_name_map->{$name} = {
        'pattern' => $pattern, 'uri_list' => $uri_list};

    if (defined $exception) {
        if (exists $self->_exception_name_hash->{$exception}) {
            Eve::Error::HttpDispatcher->throw(
                message => 'Exception name must be unique: ' . $exception);
        }
        $self->_exception_name_hash->{$exception} = $pattern;
    }

    return;
}

=head2 B<get_uri()>

=head3 Arguments

=over 4

=item C<name>

a name identifying the binding

=back

=head3 Returns

A URI bound to the resource name.

=head3 Throws

=over 3

=item C<Eve::Error::HttpDispatcher>

When there is no resource with the requested name.

=back

=cut

sub get_uri {
    my ($self, %arg_hash) = @_;
    Eve::Support::arguments(\%arg_hash, my $name);

    if (not exists $self->_name_map->{$name}) {
        Eve::Error::HttpDispatcher->throw(
            message => 'There is no resource with such name: '.$name);
    }

    # We are relying on the fact that the page URI generated by the
    # base URI is always the first in the uri list for the specified
    # name.
    return $self->_name_map->{$name}->{'uri_list'}->[0];
}

=head2 B<handle()>

Chooses a resource using the request URI and delegates control to the
resource's C<process()> method. It also passes placeholder matches
into this method.

=head3 Arguments

=over 4

=item C<event>

a C<Eve::Event::HttpRequestReceived> object.

=back

=head3 Throws

=over 3

=item C<Eve::Exception::Http::404NotFound>

if no resources match the request and no resources that handle the
C<Eve::Exception::Http::404NotFound> are bound.

=back

=cut

sub handle {
    my ($self, %arg_hash) = @_;
    Eve::Support::arguments(\%arg_hash, my $event);

    $self->{'_request'} =
        $self->_request_constructor->(env_hash => $event->env_hash);

    my $response;

    eval {
        for my $key (keys %{$self->_uri_map}) {
            my $request_uri = $self->_request->get_uri();

            for my $uri (@{$self->_uri_map->{$key}->{'uri_list'}}) {
                my $match_hash = $uri->match(uri => $request_uri);
                if ($match_hash) {
                    $response = $self->_uri_map->{$key}->{'resource'}->process(
                        matches_hash => $match_hash,
                        request => $self->_request);
                    return;
                }
            }
        }

        Eve::Exception::Http::404NotFound->throw();
    };

    my $e;
    if ($e = Eve::Exception::Base->caught()) {
        if (defined $self->_exception_name_hash->{ref $e}){
            my $resource =
                $self->_uri_map->{$self->_exception_name_hash->{ref $e}}->{
                    'resource'};

            $response = $resource->process(
                matches_hash => {'exception' => $e},
                request => $self->_request);
        } else {
            $e->throw();
        }
    } elsif ($e = Exception::Class->caught()) {
        ref $e ? $e->rethrow() : die $e;
    }

    $event->response = $response;

    return;
}

=head1 SEE ALSO

=over 4

=item L<Eve::Class>

=item L<Eve::Event::HttpResponseReady>

=item L<Eve::Exception>

=item L<Eve::HttpResource>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Igor Zinovyev.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=head1 AUTHOR

=over 4

=item L<Sergey Konoplev|mailto:gray.ru@gmail.com>

=item L<Igor Zinovyev|mailto:zinigor@gmail.com>

=back

=cut

1;