Sleep::Handler - ModPerl handler for Sleep.


Sleep documentation Contained in the Sleep distribution.

Index


Code Index:

NAME

Top

Sleep::Handler - ModPerl handler for Sleep.

SYNOPSYS

Top

I added this code in a Apache2 vhost file, for a example project that I created with Sleep, called QA.

    <Perl>
        use QA::Handler;
        $QA::Global::object = QA::Handler->new();
    </Perl>

    <Location />
        SetHandler perl-script
        PerlResponseHandler $QA::Global::object->handler
    </Location>

The QA::Handler file looks like this:

    package QA::Handler;

    use strict;
    use warnings;

    use QA::DB;

    require Sleep::Handler;
    our @ISA = qw/Sleep::Handler/;

    my $db = QA::DB->Connect('QA');

    my $routes = Sleep::Routes->new([
        { 
            route => qr{/question(?:/(\d+))?$},
            class => 'QA::Question' 
        },
        { 
            route => qr{/question/(\d+)/comments$},
            class => 'QA::Comment' 
        },
    ]);

    sub new {
        return __PACKAGE__->BUILD($db, $routes);
    }

    sub handler : method {
        my $self = shift;
        return $self->SUPER::handler(@_);
    }

The module QA::DB is a subclass of DBIx::DWIW.

DESCRIPTION

Top

The Apache2 mod_perl handler for Sleep applications.

CLASS METHODS

Top

BUILD($db, $routes)

Creates a Sleep::Handler object. Expects two arguments: $db and routes.

METHODS

Top

handler

Handles a HTTP request.

BUGS

Top

If you find a bug, please let the author know.

COPYRIGHT

Top

AUTHOR

Top

Peter Stuifzand <peter@stuifzand.eu>


Sleep documentation Contained in the Sleep distribution.

package Sleep::Handler;

use strict;
use warnings;

use Apache2::RequestRec;
use Apache2::Const qw/OK HTTP_METHOD_NOT_ALLOWED HTTP_OK HTTP_SEE_OTHER HTTP_NO_CONTENT/;
use Apache2::RequestIO ();
use APR::Table;

use CGI::Simple;

use Sleep::Request;
use Sleep::Routes;

sub BUILD {
    my ($klass, $db, $routes) = @_;
    return bless { db => $db, routes => $routes }, $klass;
}

sub handler : method {
    my $self = shift;
    my $r    = shift;

    my $db     = $self->{db};
    my $routes = $self->{routes};

    my $cgi    = CGI::Simple->new();

    my ($route, @vars) = $routes->resource($r->uri());

    eval "require $route->{class}";

    if ($@) {
        die "Can't load '$route->{class}': $@";
    }

    my $resource = $route->{class}->new({db => $db});

    my $request = Sleep::Request->new($r, $db, @vars);

    my $method = lc $r->method();

    my $mime_type = 'application/json';

    if ($method =~ m/^get|post|put|delete$/) {
        if ($method eq 'get') {
            my $response = $resource->get($request);
            $r->content_type($mime_type);
            $r->print($response->encode($mime_type));
            return Apache2::Const::OK;
        }
        elsif ($method eq 'post') {
            my $postdata = $cgi->param('POSTDATA');
            $request->decode($postdata);
            my $response = $resource->post($request);

            $r->content_type($mime_type);
            $r->status(Apache2::Const::HTTP_SEE_OTHER);
            $r->headers_out->{Location} = $response->location();
            return Apache2::Const::OK;
        }
        elsif ($method eq 'put') {
            my $postdata = $cgi->param('PUTDATA');
            $request->decode($postdata);
            my $response = $resource->put($request);
            $r->status(Apache2::Const::HTTP_OK);
            $r->content_type($mime_type);
            $r->print($response->encode($mime_type));
            return Apache2::Const::OK;
        }
        elsif ($method eq 'delete') {
            my $response = $resource->delete($request);
            $r->status(Apache2::Const::HTTP_NO_CONTENT);
            return Apache2::Const::OK;
        }
    }

    return Apache2::Const::HTTP_METHOD_NOT_ALLOWED;
}

1;

__END__