view release on metacpan or  search on metacpan

lib/Continuity/Adapt/HttpDaemon.pm  view on Meta::CPAN

This may be obvious, but you can't send binary data as part of the same request
that you've already sent text or HTML on, MIME aside. Thus either this is
called OR we invoke a continuation, but not both.

=cut

# HTTP::Daemon::send_file_response uses LWP::MediaTypes to guess the
# Content-Type of a file.  Unfortunately, its list of known extensions is
# rather anemic so we're adding a few more.
add_type('image/png'       => qw(png));
add_type('text/css'        => qw(css));
add_type('text/javascript' => qw(js));

sub send_static {
  my ($self, $r) = @_;
  my $c = $r->conn or die;
  my $url = $r->url;
  $url =~ s{\?.*}{};
  my $path = $self->map_path($url) or do { 
       $self->Continuity::debug(1, "can't map path: " . $url); $c->send_error(404); return; 
  };
  unless (-f $path) {
      $c->send_error(404);
      return;
  }
  $c->send_file_response($path);
  $self->Continuity::debug(3, "Static send '$path'");
}

package Continuity::Adapt::HttpDaemon::Request;

# Accessors

# List of cookies to send
sub cookies { exists $_[1] ? $_[0]->{cookies} = $_[1] : $_[0]->{cookies} }

# The actual connection
sub conn { exists $_[1] ? $_[0]->{conn} = $_[1] : $_[0]->{conn} }

# The HTTP::Request object
sub http_request { exists $_[1] ? $_[0]->{http_request} = $_[1] : $_[0]->{http_request} }

# Watch for writes to the conn
sub write_event { exists $_[1] ? $_[0]->{write_event} = $_[1] : $_[0]->{write_event} }

# Flag, never send type
sub no_content_type { exists $_[1] ? $_[0]->{no_content_type} = $_[1] : $_[0]->{no_content_type} }

# CGI query params
sub cached_params { exists $_[1] ? $_[0]->{cached_params} = $_[1] : $_[0]->{cached_params} }

sub debug_level { exists $_[1] ? $_[0]->{debug_level} = $_[1] : $_[0]->{debug_level} }

sub debug_callback { exists $_[1] ? $_[0]->{debug_callback} = $_[1] : $_[0]->{debug_callback} }

=for comment

See L<Continuity::Request> for API documentation.

This is what gets passed through a queue to coroutines when new requests for
them come in. It needs to encapsulate:

*  The connection filehandle
*  CGI parameters cache

XXX todo: understands GET parameters and POST in
application/x-www-form-urlencoded format, but not POST data in
multipart/form-data format.  Use the AsCGI thing if you actually really need
that (it's used for file uploads).
# XXX check request content-type, if it isn't x-form-data then throw an error
# XXX pass in multiple param names, get back multiple param values

Delegates requests off to the request object it was initialized from.

In other words: Continuity::Adapt::HttpDaemon is the ongoing running HttpDaemon
process, and Continuity::Adapt::HttpDaemon::Request is individual requests sent
through.

=cut

sub new {
    my $class = shift;
    my %args = @_;
    my $self = bless { @_ }, $class;
    eval { $self->conn->isa('HTTP::Daemon::ClientConn') } or warn "\$self->conn isn't an HTTP::Daemon::ClientConn";
    eval { $self->http_request->isa('HTTP::Request') } or warn "\$self->http_request isn't an HTTP::Request";
    $self->Continuity::debug(2, "\n====== Got new request ======\n"
               . "       Conn: ".$self->conn."\n"
               . "    Request: $self"
    );
    return $self;
}

sub param {
    my $self = shift; 
    my $req = $self->http_request;
    unless($self->cached_params) {
      $self->cached_params( do {
        my $in = $req->uri; $in .= '&' . $req->content if $req->content;
        $in =~ s{^.*\?}{};
        my @params;
        for(split/[&]/, $in) { 
            tr/+/ /; 
            s{%(..)}{pack('c',hex($1))}ge; 
            my($k, $v); ($k, $v) = m/(.*?)=(.*)/s or ($k, $v) = ($_, 1);
            push @params, $k, $v; 
        };
        \@params;
      });
    };
    my @params = @{ $self->cached_params };
    if(@_) {
        my @values;
        while(@_) {
          my $param = shift;
          for(my $i = 0; $i < @params; $i += 2) {
              push @values, $params[$i+1] if $params[$i] eq $param;
          }
        }
        return unless @values;