File Coverage

blib/lib/POE/Component/Server/HTTPServer.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package POE::Component::Server::HTTPServer;
use strict;
use Carp;
use POE qw( Component::Server::TCP Filter::HTTPD );
use HTTP::Status;
use HTTP::Response;
use POE::Component::Server::HTTPServer::Handler qw( H_CONT H_FINAL );
use base 'Exporter';
our @EXPORT = qw( new_handler );

our $VERSION = '0.9.2';

sub new_handler {
  my $package_suffix = shift;
  eval "use POE::Component::Server::HTTPServer::$package_suffix;";
  if ($@) {
    warn $@;
    die "Failed to intialize handler";
  }
  return "POE::Component::Server::HTTPServer::$package_suffix"->new(@_);
}

sub new {
  my $class = shift;
  my $self = bless {
		    _port => 8080,
		    _handlers => [],
		    _log_file => "httpserver.log",
		    _backstop_handler => new_handler('NotFoundHandler'),
		    _debug => sub {},
		   }, $class;
  $self->_init(@_);
  return $self;
}

sub _init {
  my $self = shift;
  my %args = @_;
  if ( defined( $args{_debug} ) ) {
    $self->{_debug} = $args{_debug};
    $self->{_debug}->("Debugging: on.\n");
  }
  if ( defined( $args{handlers} ) ) {
    $self->handlers( $args{handlers} );
  }
  if ( defined( $args{port} ) ) {
    $self->port( $args{port} );
  }
  if ( defined( $args{log_file} ) ) {
    $self->log_file( $args{log_file} );
  }
  if ( defined( $args{backstop_handler} ) ) {
    $self->backstop_handler( $args{backstop_handler} );
  }
}

sub log_file {
  my $self = shift;
  my $log_file = shift;
  if ( defined($log_file) ) {
    $self->{_debug}->("Log file: $log_file\n");
    return $self->{_log_file} = $log_file;
  } else {
    return $self->{_log_file};
  }
}

sub port {
  my $self = shift;
  my $port = shift;
  if ( defined($port) ) {
    $self->{_debug}->("Port: $port\n");
    return $self->{_port} = $port;
  } else {
    return $self->{_port};
  }
}

sub handlers {
  my $self = shift;
  my $handlers = shift;
  if ( defined($handlers) ) {
    $self->{_debug}->("Handlers: ", map("  $_\n", @$handlers), "\n");
    return $self->{_handlers} = $handlers;
  } else {
    return $self->{_handlers};
  }
}

# usage: $s->add_handler( '/foo' => new_handler('NotFoundHandler') )
sub add_handler {
  my $self = shift;
  my( $path, $handler ) = @_;
  push( @{$self->{_handlers}}, $path, $handler );
}

sub create_server {
  my $self = shift;
  unless ( @{$self->handlers()} ) {
    $self->{_debug}->("No handlers: setting NotFoundHandler for all\n");
    $self->handlers( ['/' => new_handler('NotFoundHandler')] );
  }
  if ( defined($self->{_log_file}) ) {
    $self->{_debug}->("Opening log: $self->{_log_file}\n");
    open( $self->{_log_fh}, ">> $self->{_log_file}" ) ||
      warn "Could not open log file '$self->{_log_file}' ($!)\n";
  }
  $self->{_debug}->("Creating server component\n");
  return
    POE::Component::Server::TCP->new( Port => $self->port,
				      ClientInput => $self->_get_dispatcher,
				      ClientFilter => 'POE::Filter::HTTPD',
				    );
}

# dispatch( $context [, $fullpath] )
#  can be used by handlers ($context->{dispatcher}->dispatch) for re-dispatch
sub dispatch {
  my $self = shift;
  my $context = shift;
  my $fullpath = shift;
  if ( defined($fullpath) ) {
    $context->{fullpath} = $fullpath;
  }

  if ($context->{_dispatch_count}++ > 10) {
    warn "Detected deep dispatch for '$context->{fullpath}', aborting!\n";
    return H_FINAL;
  }

  eval {
    $self->{_debug}->("Dispatching request\n");
    # copy handler list for splicing
    my @handlers = ( @{$self->handlers}, '.' => $self->backstop_handler );
    while ( @handlers ) {
      # shift two elts from handlers in to prefix, handler
      my( $prefix, $handler ) = splice( @handlers, 0, 2 );
      $self->{_debug}->("Checking path:$context->{fullpath} =~ prefix:$prefix ($handler)\n");
      if ( $context->{fullpath} =~ /^$prefix/ ) {
	$self->{_debug}->("Fullpath: $context->{fullpath}\n");
	$self->{_debug}->("Prefix: $prefix\n");
	($context->{contextpath} = $context->{fullpath}) =~ s/^$prefix//;
	my $retval;
	if (UNIVERSAL::can($handler, 'handle')) {
	  $retval = $handler->handle($context);
	} else {
	  # assume handler's a coderef (might wanna check that sometime)
	  $retval = $handler->($context);
	}
	if ( $retval == H_FINAL ) {
	  $self->{_debug}->("Handler returned H_FINAL, stopping\n");
	  last;
	}
      }
    }
  };
  if ($@) { # internal server error
    my $error = $@;
    warn "Caught error: $@\n";
    $context->{response}->code(500);
    $context->{response}->content_type("text/plain");
    $context->{response}->content("An error occured while processing request:\n$error\n");
  }
  return H_FINAL; # in case this is being called from a handler

} # dispatch()

sub backstop_handler {
  my $self = shift;
  $self->{_backstop_handler} = shift if @_;
  return $self->{_backstop_handler};
}

sub _get_dispatcher {
  my $self = shift;
  return sub {
    my( $kernel, $heap, $request ) = @_[ KERNEL, HEAP, ARG0 ];

    if ( $request->isa('HTTP::Response') ) {
      # if a processing error occurrs, POE::Filter::HTTPD generates
      # a suitable response for you to send back
      $heap->{client}->put( $request );
      $kernel->yield('shutdown');
      return;
    }

    $self->{_debug}->("Handling request\n");

    my $context = { request => $request,
		    response => HTTP::Response->new( RC_OK ),
		    remote_ip => $heap->{remote_ip},
		    fullpath => $request->uri->path,
		    dispatcher => $self,
		    _dispatch_count => 0,
		  };

    $self->dispatch($context);

    $self->_request_log( $context );
    $heap->{client}->put( $context->{response} );
    undef($context);
    $kernel->yield( 'shutdown' ); # signal that we're done sending to client
  };

} # _get_dispatcher

# pretty lame, so far
sub _request_log {
  my $self = shift;
  my $context = shift;
  my($req,$resp) = ($context->{request}, $context->{response});
  my @log;
  push(@log, $context->{remote_ip});
  if ( defined($context->{username}) ) {
    push(@log, $context->{username});
  } else {
    push(@log, '-');
  }
  push(@log, "[".scalar(localtime())."]"); # wrong format
  push(@log, $req->method);
  push(@log, '"'.$req->uri.'"');
  push(@log, $resp->code);
  push(@log, $resp->content_length);
  my $fh = $self->{_log_fh};
  print $fh join(" ", @log), "\n";
}


1;
__END__