package TestServer;

use warnings;
use strict;

use Test::More;
use HTTP::Server::Simple::CGI;
use base qw( HTTP::Server::Simple::CGI );

my $dispatch_table = {};

=head1 OVERLOADED METHODS

=cut

our $pid;

sub new {
    die 'An instance of TestServer has already been started.' if $pid;

    my $class = shift;
    my $port  = shift;

    if ( !$port ) {
        $port = int(rand(20000)) + 20000;
    }
    my $self = $class->SUPER::new( $port );

    my $root = $self->root;

    return $self;
}

sub run {
    my $self = shift;

    $pid = $self->SUPER::run(@_);

    $SIG{__DIE__} = \&stop;

    return $pid;
}

sub handle_request {
    my $self = shift;
    my $cgi  = shift;

    my $path = $cgi->path_info();
    my $handler = $dispatch_table->{$path};

    if (ref($handler) eq "CODE") {
        print "HTTP/1.0 200 OK\r\n";
        $handler->($cgi);
    }
    else {
        my $file = $path;
        if ( $file =~ m{/$} ) {
            $file .= 'index.html';
        }
        $file =~ s/\s+//g;

        my $filename = "t/html/$file";
        if ( -r $filename ) {
            if (my $response=do { local (@ARGV, $/) = $filename; <> }) {
                print "HTTP/1.0 200 OK\r\n";
                print "Content-Type: text/html\r\nContent-Length: ", length($response), "\r\n\r\n", $response;
                return;
            }
        }
        else {
            print "HTTP/1.0 404 Not found\r\n";
            print
            $cgi->header,
            $cgi->start_html('Not found'),
            $cgi->h1('Not found'),
            $cgi->end_html;
        }
    }
}

=head1 METHODS UNIQUE TO TestServer

=cut

sub set_dispatch {
    my $self = shift;
    $dispatch_table = shift;

    return;
}

sub background {
    my $self = shift;

    $pid = $self->SUPER::background()
        or Carp::confess( q{Can't start the test server} );

    sleep 1; # background() may come back prematurely, so give it a second to fire up

    my $root = $self->root;

    diag( "Test server $root as PID $pid" );

    return $pid;
}


sub hostname {
    my $self = shift;

    return '127.0.0.1';
}

sub root {
    my $self = shift;
    my $port = $self->port;
    my $hostname = $self->hostname;

    return "http://$hostname:$port";
}

sub stop {
    if ( $pid ) {
        kill( 9, $pid ) unless $^S;
        undef $pid;
    }

    return;
}

1;