The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyrights 2013 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
use warnings;
use strict;

package Any::Daemon::HTTP;
use vars '$VERSION';
$VERSION = '0.10';

use base 'Any::Daemon';

use Log::Report    'any-daemon-http';

use HTTP::Daemon   ();
use IO::Socket     qw/SOCK_STREAM SOMAXCONN/;
use File::Basename qw/basename/;


sub init($)
{   my ($self, $args) = @_;
    $self->SUPER::init($args);

    my $host = $args->{host};
    my ($use_ssl, $socket);
    if($socket = $args->{socket})
    {   $use_ssl = $socket->isa('IO::Socket::SSL');
        $host  ||= $socket->sockhost;
    }
    else
    {   $use_ssl = $args->{use_ssl};
        my $sock_class = $use_ssl ? 'IO::Socket::SSL' : 'IO::Socket::INET';
        eval "require $sock_class" or panic $@;

        $host or error __x"host or socket required for {pkg}::new"
           , pkg => ref $self;

        $socket  = $sock_class->new
          ( LocalHost => $host
          , Listen    => SOMAXCONN
          , Reuse     => 1
          , Type      => SOCK_STREAM
          ) or fault "cannot create socket at $host";
    }

    my $conn_class = 'HTTP::Daemon::ClientConn';
    if($use_ssl)
    {   $conn_class .= '::SSL';
        eval "require $conn_class" or panic $@;
    }

    $self->{ADH_conn_class} = $conn_class;

    $self->{ADH_ssl}    = $use_ssl;
    $self->{ADH_socket} = $socket;
    $self->{ADH_host}   = $host;
    $self->{ADH_root}   = $args->{docroot}
      || ($use_ssl ? 'https' : 'http'). "://$host";

    $self->{ADH_server} = $args->{server_id} || basename($0);
    $self;
}

#----------------

sub useSSL() {shift->{ADH_ssl}}
sub host()   {shift->{ADH_host}}
sub socket() {shift->{ADH_socket}}
sub docroot(){shift->{ADH_root}}

#----------------

sub run(%)
{   my ($self, %args) = @_;

    my $on_new = delete $args{new_connection} || sub {};
    my $handle = delete $args{handle_request} or panic;

    $args{child_task} = sub {
        while(my $client = $self->socket->accept)
        {   info "new client $client using HTTP11";

            # Ugly hack, steal HTTP::Daemon's http/1.1 implementation
            bless $client, $self->{ADH_conn_class};
            ${*$client}{httpd_daemon} = $self;

            while(my $request = $client->get_request)
            {   my $response = $handle->($self, $client, $request);
                $response or next;

                $client->send_response($response);
            }
            $client->close;
        }
        exit 0;
    };

    $self->SUPER::run(%args);
}

# HTTP::Daemon methods used by ::ClientConn.  The names are not compatible
# with MarkOv convention, so hidden for the users of this module
sub url() {shift->{ADH_docroot}}
sub product_tokens() {shift->{ADH_server}}

1;