view release on metacpan or  search on metacpan

ex/httpd.pl  view on Meta::CPAN

#!/opt/local/bin/pperl
{

    package My::HTTP::Server;
    use Cogwheel;

    extends qw(Cogwheel::Server);

    has '+Plugins' => (
        default => sub {
            [
                {
                    plugin   => My::HTTP::Server::Plugin->new(),
                    priority => 0,
                }
            ];
        },
    );

    has document_root => (
        isa     => 'Str',
        is      => 'ro',
        default => sub { 'html' },
    );

    has aio => (
        isa     => 'Bool',
        is      => 'ro',
        default => sub { 0 },
    );

    no Cogwheel;
}

{

    package My::HTTP::Request;
    use Moose;

    has raw => (
        isa     => 'HTTP::Request',
        is      => 'rw',
        handles => [qw(protocol uri header)],
    );

    has start_time => (
        isa     => 'Str',
        is      => 'ro',
        default => sub { time() },
    );

    has content => (
        isa       => 'Str',
        is        => 'rw',
        predicate => 'has_content',
    );

    has content_length => (
        isa     => 'Int',
        is      => 'rw',
        lazy    => 1,
        default => sub { length( $_[0]->content ) },
    );

    has keep_alive => (
        isa       => 'Bool',
        is        => 'rw',
        predicate => 'has_keep_alive',
    );

    has forwarded_from => (
        isa => 'Str',
        is  => 'rw',
    );

    no Moose;
    __PACKAGE__->meta->make_immutable;
}

{

    package My::HTTP::Server::Plugin;
    use Cogwheel;
    use HTTP::Request;
    use HTTP::Response;
    use HTTP::Status qw( status_message is_info RC_BAD_REQUEST );
    use POE qw(Filter::HTTPD);
    use Time::HiRes qw( time );
    use HTTP::Date;

    extends qw(Cogwheel::Plugin);

    sub OK()    { 1 }
    sub DEFER() { 0 }
    sub BAD()   { undef }

    has request => (
        isa       => 'My::HTTP::Request',
        is        => 'rw',
        predicate => 'has_request',
        clearer   => 'clear_request',
        lazy      => 1,
        default   => sub { My::HTTP::Request->new() },
        handles   => [qw(content has_content content_length)],
    );

    has response => (
        isa       => 'HTTP::Response',
        is        => 'rw',
        lazy      => 1,
        predicate => 'has_response',
        default   => sub { HTTP::Response->new(500) },
    );

    after setup_connection => sub {
        my ( $self, $sprocket, $con, $socket ) = @_;
        die "got here";
    };

    # sub local_connected {
    #     my ( $self, $server, $con, $socket ) = @_;
    #     warn "got here";
    #     $self->setup_connection($con);
    #     $con->filter->push( POE::Filter::HTTPD->new() );
    #     $con->set_time_out(5);
    # }

    sub local_receive {
        my ( $self, $server, $con, $req ) = @_;
        my $ok_retval = $self->start_http_request( $server, $con, $req );
        return $ok_retval unless $ok_retval;
        $req = $self->request;
        $con->wheel->pause_input();    # no more requests
        $con->set_time_out(undef);

        # IMPLEMENT HTTP LOGIC HERE

        $con->call( 'simple_response' => 500, 'No Handlers Installed!' );
        return OK;
    }

    sub start_http_request {
        my ( $self, $server, $con, $req ) = @_;

        $self->clear_request() if $self->has_request;

        my $type = blessed($req);
        unless ($type) {
            $self->close_connection(1);
            $con->call( finish => 'invalid request' );
            return BAD;
        }

        $type eq 'HTTP::Response'
          ? $self->response($req)
          : $self->request->raw($req);

        unless ( $self->has_request ) {
            my $req = $self->response;
            $con->call('finish');
            return DEFER;
        }
        return OK;