view release on metacpan or  search on metacpan

lib/HTTP/Server/Simple.pm  view on Meta::CPAN

=cut

sub setup {
    my $self = shift;
    while ( my ( $item, $value ) = splice @_, 0, 2 ) {
        $self->$item($value) if $self->can($item);
    }
}

=head2 headers([Header =E<gt> $value, ...])

Receives HTTP headers and does something useful with them.  This is
called by the default C<setup()> method.

You have lots of options when it comes to how you receive headers.

You can, if you really want, define C<parse_headers()> and parse them
raw yourself.

Secondly, you can intercept them very slightly cooked via the
C<setup()> method, above.

Thirdly, you can leave the C<setup()> header as-is (or calling the
superclass C<setup()> for unknown request items).  Then you can define
C<headers()> in your sub-class and receive them all at once.

Finally, you can define handlers to receive individual HTTP headers.
This can be useful for very simple SOAP servers (to name a
crack-fueled standard that defines its own special HTTP headers). 

To do so, you'll want to define the C<header()> method in your subclass.
That method will be handed a (key,value) pair of the header name and the value.


=cut

sub headers {
    my $self    = shift;
    my $headers = shift;

    my $can_header = $self->can("header");
    return unless $can_header;
    while ( my ( $header, $value ) = splice @$headers, 0, 2 ) {
        $self->header( $header => $value );
    }
}

=head2 accept_hook

If defined by a sub-class, this method is called directly after an
accept happens.  An accept_hook to add SSL support might look like this:

    sub accept_hook {
        my $self = shift;
        my $fh   = $self->stdio_handle;

        $self->SUPER::accept_hook(@_);

        my $newfh =
        IO::Socket::SSL->start_SSL( $fh, 
            SSL_server    => 1,
            SSL_use_cert  => 1,
            SSL_cert_file => 'myserver.crt',
            SSL_key_file  => 'myserver.key',
        )
        or warn "problem setting up SSL socket: " . IO::Socket::SSL::errstr();

        $self->stdio_handle($newfh) if $newfh;
    }

=head2 post_setup_hook

If defined by a sub-class, this method is called after all setup has
finished, before the handler method.

=head2  print_banner

This routine prints a banner before the server request-handling loop
starts.

Methods below this point are probably not terribly useful to define
yourself in subclasses.

=cut

sub print_banner {
    my $self = shift;

    print( ref($self) 
            . ": You can connect to your server at "
            . "http://localhost:"
            . $self->port
            . "/\n" );

}

=head2 parse_request

Parse the HTTP request line.  Returns three values, the request
method, request URI and the protocol.

=cut

sub parse_request {
    my $self = shift;
    my $chunk;
    while ( sysread( STDIN, my $buff, 1 ) ) {
        last if $buff eq "\n";
        $chunk .= $buff;
    }
    defined($chunk) or return undef;
    $_ = $chunk;

    m/^(\w+)\s+(\S+)(?:\s+(\S+))?\r?$/;
    my $method   = $1 || '';
    my $uri      = $2 || '';
    my $protocol = $3 || '';

    # strip <scheme>://<host:port> out of HTTP/1.1 requests
    $uri =~ s{^\w+://[^/]+/}{/};

    return ( $method, $uri, $protocol );
}

=head2 parse_headers