
package POE::Component::Server::HTTP;

use strict;
use Socket qw(inet_ntoa);
use HTTP::Date;
use HTTP::Status;
use File::Spec;
use Exporter();

use vars qw(@ISA @EXPORT $VERSION);
@ISA = qw(Exporter);
use constant RC_WAIT => -1;
use constant RC_DENY => -2;
@EXPORT = qw(RC_OK RC_WAIT RC_DENY);

use POE qw(Wheel::ReadWrite Driver::SysRW Session Filter::Stream Filter::HTTPD);
use POE::Component::Server::TCP;
use Sys::Hostname qw(hostname);


$VERSION = 0.02;

use POE::Component::Server::HTTP::Response;
use POE::Component::Server::HTTP::Request;
use POE::Component::Server::HTTP::Connection;

use Carp;

my %default_headers = (
		       "Server" => "POE HTTPD Compontent/$VERSION ($])",       
		       );



sub new {
    my $class = shift;
    my $self = bless {@_},$class;
    $self->{Headers} = { %default_headers,  ($self->{Headers} ? %{$self->{Headers}}: ())};



    $self->{TransHandler} = [] unless($self->{TransHandler});
    $self->{PreHandler} = {} unless($self->{PreHandler});
    $self->{PostHandler} = {} unless($self->{PostHandler});
    if(ref($self->{ContentHandler}) ne 'HASH') {
	croak "You need a default content handler or a ContentHandler setup" unless(ref($self->{DefaultContentHandler}) eq 'CODE');
	$self->{ContentHandler} = {};
	$self->{ContentHandler}->{'/'} = $self->{DefaultContentHandler};
    }
    



    $self->{Hostname} = hostname() unless($self->{Hostname});

    my $session =  POE::Session->new(
				     _start => sub { 
					 $poe_kernel->refcount_increment($_[SESSION]->ID(),"deamon");
					 $_[HEAP]->{self} = $self;
					 print "start\n" 
					    
					 },
				     _stop => sub { print "stop\n"},
				     accept => \&accept,
				     input => \&input,
				     execute => \&execute,
				     _signal => sub {},
				     );
    
  POE::Component::Server::TCP->new( Port => $self->{Port}, Acceptor => sub {
      $poe_kernel->post($session,'accept',@_[ARG0,ARG1,ARG2]);
  });

}



sub accept {
      my ($socket,$remote_addr, $remote_port) = @_[ARG0,ARG1,ARG2]; 
      my $self = $_[HEAP]->{self};
      my $connection = POE::Component::Server::HTTP::Connection->new();
      $connection->{remote_ip} = inet_ntoa($remote_addr);
      $connection->{remote_addr} = getpeername($socket);
      $connection->{local_addr} = getsockname($socket);

      $connection->{handlers} = {TransHandler => [@{$self->{TransHandler}}],
				 PreHandler   => [],
				 ContentHandler => undef,
				 PostHandler  => [],
				 Handler => [qw(
						TransHandler
						Map
						PreHandler 
						ContentHandler 
						Send
						PostHandler
						Cleanup
						)],
			     };
      
      my $wheel = POE::Wheel::ReadWrite->new(
	      Handle => $socket,
	      Driver => POE::Driver::SysRW->new,
	      Filter => POE::Filter::HTTPD->new(),
	      InputEvent => 'input',
	      FlushedEvent => 'execute',
	      );
      $_[HEAP]->{wheels}->{$wheel->ID} = $wheel; 
      $_[HEAP]->{c}->{$wheel->ID} = $connection
}


sub execute {
    my $id = $_[ARG0];
    my $self = $_[HEAP]->{self};
    my $connection = $_[HEAP]->{c}->{$id};
    my $handlers = $connection->{handlers};

    my $response = $connection->{response};
    my $request  = $connection->{request};

#    print Data::Dumper::Dumper($handlers);

    my $state = $handlers->{Handler}->[0];
  HANDLERS: while(1) {
      $state = $handlers->{Handler}->[0];

      
      if($state eq 'Map') {
	    my $path = $request->uri->path();
	    my $filename;
	    (undef, $path,$filename) = File::Spec->splitpath($path);
	    my @dirs = File::Spec->splitdir($path);
	    pop @dirs;
	    push(@dirs, $filename) if($filename);
	    my $fulldir;
	    
	    my(@pre,$content,@post);
	    
	    foreach my $dir (@dirs) {
		$fulldir .= $dir.'/';
		if(exists($self->{PreHandler}->{$fulldir})) {
		    push @{$handlers->{PreHandler}}, @{$self->{PreHandler}->{$fulldir}};
		}	    
		if(exists($self->{PostHandler}->{$fulldir})) {
		    push @{$handlers->{PostHandler}}, @{$self->{PostHandler}->{$fulldir}};
		}
		if(exists($self->{ContentHandler}->{$fulldir})) {
		    $handlers->{ContentHandler} = $self->{ContentHandler}->{$fulldir};
		}
		
	    }
	    $state = shift @{$handlers->{Handler}};
	    next;
	} elsif($state eq 'Send') {
	    $response->header(%{$_[HEAP]->{self}->{Headers}});
	    unless($response->header('Date')) {
		$response->header('Date',time2str(time));
	    }
	    if(!($response->header('Content-Lenth')) && !($response->streaming())) {
		$response->header('Content-Length',length($response->content));
	    }
	    

	    $_[HEAP]->{wheels}->{$id}->put($response);
	    $state = shift @{$handlers->{Handler}};
	    last;
	} elsif($state eq 'ContentHandler') {
	    my $retvalue = $handlers->{ContentHandler}->($request,$response);
	    $state = shift @{$handlers->{Handler}};
	    if($retvalue == RC_WAIT) {
		last HANDLERS;
	    }
	    next;
	} elsif($state eq 'Cleanup') {
	    if($response->streaming()) {
		print "Turn on streaming\n";
		$_[HEAP]->{wheels}->{$id}->set_output_filter(POE::Filter::Stream->new() );
		unshift(@{$handlers->{Handler}},'Streaming');
		next HANDLERS;
	    }
	    delete($response->{connection});
	    delete($request->{connection});
	    delete($connection->{handlers});
	    delete($connection->{wheel});
	    delete($_[HEAP]->{c}->{$id});
	    delete($_[HEAP]->{wheels}->{$id});
	    last;
	} elsif($state eq 'Streaming') {
	    print "Streaming mode\n";
	    $self->{StreamHandler}->($request, $response);
	    last HANDLERS;;
	}

      DISPATCH: while(1) {
	  
	  my $handler = shift(@{$handlers->{$state}});
	  last DISPATCH unless($handler);
	  my $retvalue = $handler->($request,$response);
	  
	  if($retvalue == RC_DENY) {
	      last DISPATCH;
	  } elsif($retvalue == RC_WAIT) {
	      last HANDLERS;
	  }
	  
      }

	
	$state = shift @{$handlers->{Handler}};
	last unless($state);
    }

}

sub input {
    my ($request,$id) = @_[ARG0, ARG1];
    bless $request, 'POE::Component::Server::HTTP::Request';
    my $c = $_[HEAP]->{c}->{$id};
    my $self = $_[HEAP]->{self};

    $request->uri->scheme('http');
    $request->uri->host($self->{Hostname});
    $request->uri->port($self->{Port});
    $request->{connection} = $c;


    my $response = POE::Component::Server::HTTP::Response->new();

    $response->{connection} = $c;

    $c->{wheel} = $_[HEAP]->{wheels}->{$id};

    $c->{request} = $request;
    $c->{response} = $response;
    $c->{session} = $_[SESSION];
    $c->{my_id} = $id;
    $poe_kernel->yield('execute',$id);
    
}

=head1 NAME

POE::Component::Server::HTTP - Foundation of a POE HTTP Daemon

=head1 SYNOPSIS

    use POE::Component::Server::HTTP;
    use HTTP::Status;
    POE::Component::Server::HTTP->new(
       Port => 8000,
       ContentHandler => { '/' => \&handler },
       Headers => { Server => 'My Server' },
      );
    
    sub handler {
	my ($request, $response) = @_;
	$response->code(RC_OK);
	$response->content("Hi, you fetched ". $request->uri);
	return RC_OK;	
    }

=head1 DESCRIPTION

POE::Component::Server::HTTP (PoCo::HTTPD) is a framework for building
custom HTTP servers based on POE. It is loosely modeled on the ideas of 
apache and the mod_perl/Apache module.

It is built alot on work done by Gisle Aas on HTTP::* modules and the URI
module which are subclassed.

PoCo::HTTPD lets you register different handler, stacked by directory that
will be run during the cause of the request.

=head2 Handlers

Handlers are put on a stack in fifo order. The path /foo/bar/baz/ will
first push the handlers of / then of /foo/ then of /foo/bar/ and lastly
/foo/bar/baz/, 

However, there can be only one ContentHandler and if any handler installs
a ContentHandler that will override the old ContentHandler.

If no handler installs a ContentHandler it will find the closest one directory wise and use it.

There is also a special StreamHandler which is a coderef that gets invoked if you have turned on streaming by doing $response->streaming(1);

Handlers take the $request and $response objects as arguments.

=over 4

=item RC_OK

Everything is ok, please continue processing.

=item RC_DENY

If it is a TransHandler, stop translation handling and carry on with
a PreHandler, if it is a PostHandler do nothing, else return denied to 
the client.

=item RC_WAIT

This is a special handler that suspends the execution of the handlers.
They will be suspended until $response->continue() is called, this is 
usefull if you want to do a long request and not blocck.

=back

The following handlers are available.

=over 4

=item TransHandler

TransHandlers are run before the URI has been resolved, giving them a chance
to change the URI. They can therefore not be registred per directory.

    new(TransHandler => [ sub {return RC_OK} ]);

A TransHandler can stop the dispatching of TransHandlers and jump to the next
handler type by specifing RC_DENY;

=item PreHandler

PreHandlers are stacked by directory and run after TransHandler but before
the ContentHandler. They can change ContentHandler (but beware, other PreHandlers
might also change it) and push on PostHandlers.

    new(PreHandler => { '/' => [sub {}], '/foo/' => [\&foo]});

=item ContentHandler

The handler that is supposed to give the content. When this handler returns
it will send the response object to the client. It will automaticly add
Content-Length and Date if these are not set. If the response is streaming
it will make sure the correct headers are set. It will also expand any cookies
which have been pushed onto the response object.

    new(ContentHandler => { '/' => sub {}, '/foo/' => \&foo});

=item PostHandler

These handlers are run after the socket has been flushed.

    new(PostHandler => { '/' => [sub {}], '/foo/' => [\&foo]});

=back

=head1 See Also

Please also take a look at L<HTTP::Response>, L<HTTP::Request>, 
L<URI>, L<POE> and L<POE::Filter::HTTPD>

=head1 TODO

=over 4

=item Document Connection Response and Request objects.

=item Write tests

=item Add a PoCo::Server::HTTP::Session that matches a http session against poe session using cookies or other state system

=item Add more options to streaming

=item Probably lots of other API changes

=back

=head1 Author

Arthur Bergman, arthur@contiller.se

Released under the same terms as POE.

=cut
1;











