view release on metacpan or  search on metacpan

lib/AnyEvent/HTTPD/Router.pm  view on Meta::CPAN

package AnyEvent::HTTPD::Router;

use common::sense;
use parent 'AnyEvent::HTTPD';

use AnyEvent::HTTPD;
use Carp;

use AnyEvent::HTTPD::Router::DefaultDispatcher;
our $VERSION = '1.0.1';

sub new {
    my $this  = shift;
    my $class = ref($this) || $this;
    my %args  = @_;

    # todo documentation how to overwrite your dispathing
    my $dispatcher       = delete $args{dispatcher};
    my $routes           = delete $args{routes};
    my $auto_respond_404 = delete $args{auto_respond_404};
    my $dispatcher_class = delete $args{dispatcher_class}
        || 'AnyEvent::HTTPD::Router::DefaultDispatcher';
    my $known_methods    = delete $args{known_methods}
        || [ qw/GET HEAD POST PUT PATCH DELETE TRACE OPTIONS CONNECT/ ];

    my $self = $class->SUPER::new(%args);

    $self->{known_methods} = $known_methods;
    $self->{dispatcher}    = defined $dispatcher
        ? $dispatcher
        : $dispatcher_class->new();

    $self->reg_cb(
        'request' => sub {
            my $self = shift;
            my $req  = shift;
            my $matched = $self->dispatcher->match( $self, $req );
            unless ($matched) {
                $self->event( 'no_route_found' => $req );
            }
        },
    );

    $self->reg_cb('no_route_found' => sub {
        my ( $httpd, $req ) = @_;
        $req->respond( [ 404, 'not found', {}, '' ] );
    }) if $auto_respond_404;

    if ($routes) {
        $self->reg_routes( @$routes );
    }

    return $self;
}

sub dispatcher { shift->{dispatcher} }

sub _check_verb {
    my $self    = shift;
    my $verb    = shift;
    my $methods = shift;

    if ( $verb =~ m/^:/ ) {
        $methods->{$_}++ for qw(GET POST);  # convert ':verbs' to POST and GET
        return 1;
    } elsif ( grep { $verb eq $_ } @{ $self->{known_methods} } ) {
        $methods->{$verb}++;
        return 1;
    }

    return;
}

sub reg_routes {
    my $self = shift;

    croak 'arguments to reg_routes are required' if @_ == 0;
    croak 'arguments to reg_routes are confusing' if @_ % 3 != 0;

	# * mix allowed methods and new http methods together
    my %methods = map { $_ => 1 } @{ $self->allowed_methods };

    while (my ($verbs, $path, $cb) = splice(@_, 0, 3) ) {

        $verbs = ref($verbs) eq 'ARRAY'
            ? $verbs