view release on metacpan or  search on metacpan

lib/Apache/Hendrix.pm  view on Meta::CPAN

class_has 'json' => (
    isa     => 'Object', is => 'rw',
    default => sub       { JSON::XS->new()->allow_blessed(1)->convert_blessed(1) },
);
class_has 'handlers'   => ( isa => 'HashRef[ArrayRef]', is => 'rw', default => sub { {} } );
class_has 'class_base' => ( isa => 'Str',               is => 'rw', default => sub {'/'} );
class_has 'request'    => ( isa => 'Apache2::Request',  is => 'rw' );
class_has 'my_template' => (
    isa      => 'HashRef[Template]',
    is       => 'rw',
    default  => sub { {} },
    required => 0,
);

class_has 'my_template_config' => (
    isa     => 'HashRef[HashRef]',
    is      => 'rw',
    default => sub { {} },
);
my $template_config_default = sub {
    {
        INCLUDE_PATH => $ENV{TEMPLATE_PATH},
        INTERPOLATE  => 0,
        POST_CHOMP   => 1,
        EVAL_PERL    => 0,
    }

};
my $template_default = sub {
    return Template->new( __PACKAGE__->my_template_config );
};

class_has 'template_variable' => ( isa => 'HashRef[HashRef]', is => 'rw', required => 0, default => sub { return {} } );

Moose::Exporter->setup_import_methods(
    as_is => [
        qw/handler base
          get post head put any
          template template_config template_variable/
    ] );

sub base {
    return __PACKAGE__->class_base(shift);
}

sub handler {
    my ($r) = @_;

    $r = Apache2::Request->new($r);

    __PACKAGE__->request($r);
    my %params;
    %params = %{ $r->param } if $r->param;

    my $uri = $r->uri;

    # Find handlers for this type of request
    my $handlers =
      __PACKAGE__->handlers->{ $ENV{CONTEXT_PREFIX} }->{ $ENV{REQUEST_METHOD} };

    # 404 if we don't have any
    return Apache2::Const::NOT_FOUND if !$handlers;

    # Check one by one to see if we have a match, either string or regexp
  ROUTE:
    for my $route ( @{$handlers} ) {
        my $base    = $route->get_base();
        my $tmp_uri = $uri;
        $tmp_uri =~ s/^$base//;
        $tmp_uri ||= '/';
        if (
            (
                # RegEXP
                ref( $route->get_path ) eq 'Regexp'
                && $tmp_uri =~ $route->get_path
            )
            || $route->get_path eq $tmp_uri
          )
        {
            my $path = $route->get_path();
            $uri =~ s/^$base\/*//;
            $uri ||= '/';

            $uri =~ m/$path/;

            if (%+) {
                @params{ keys %+ } = values %+;
            }

            my $result = $route->get_method->( \%params, $r, $route );
            if ( ref $result ) {
                return make_json( $r, $result );
            }
            return $result;
        }
    } ## end ROUTE: for my $route ( @{$handlers...})

    # No route found, we 404.
    return Apache2::Const::NOT_FOUND;
} ## end sub handler

sub make_json {
    my ( $r, $object ) = @_;

    my $result = __PACKAGE__->json->encode($object);

    $r->content_type('application/json');
    $r->set_content_length( length($result) );

    print $result;

    return Apache2::Const::OK;
}

## Route Handling

sub route {
    my ( $types, @route ) = @_;
    my $handlers = __PACKAGE__->handlers->{ $ENV{CONTEXT_PREFIX} };
    for my $route_type ( @{$types} ) {
        push @{ $handlers->{$route_type} },
          Apache::Hendrix::Route->new( {
                path   => $route[ 0 ],
                method => $route[ 1 ],
                base   => __PACKAGE__->class_base,
          } );
    }

    __PACKAGE__->handlers->{ $ENV{CONTEXT_PREFIX} } = $handlers;

    return;
}

sub get {    ## no critic (RequireArgUnpacking)
    return route( [ 'GET' ], @_ );
}

sub head {    ## no critic (RequireArgUnpacking)
    return route( [ 'HEAD' ], @_ );
}

sub post {    ## no critic (RequireArgUnpacking)
    return route( [ 'POST' ], @_ );
}

sub put {     ## no critic (RequireArgUnpacking)
    return route( [ 'PUT' ], @_ );
}

sub any {
    my (@route) = @_;

    # If we haven't specified which type, it's truly "any" route.
    # Which for us is currently GET, POST, and HEAD.
    if ( scalar(@route) == 2 ) {
        unshift @route, [ 'GET', 'POST', 'HEAD', 'PUT' ];
    }
    return route(@route);