view release on metacpan or  search on metacpan

t/serving.t  view on Meta::CPAN

use constant TEST_GROUP => 70;

use Test::More tests => 1 + TEST_GROUP * 4;
use strict;

# $Id$

BEGIN {
    use_ok( 'HTTP::Server::Brick' );
}

use version;
use LWP;
use LWP::UserAgent;
use HTTP::Status;
use POSIX qw(:sys_wait_h SIGHUP SIGKILL);

my $port = $ENV{HSB_TEST_PORT} || 65432;
my $host = $ENV{HSB_TEST_HOST} || '127.0.0.1';

diag( '' );
diag( '' );
diag( "Using port: $port and host: $host for test server.");
diag( 'If these are not suitable settings on your machine, set the environment' );
diag( 'variables HSB_TEST_PORT and HSB_TEST_HOST to something suitable.');
diag( '' );

run_tests( ssl => 0, fork => 0 );
run_tests( ssl => 0, fork => 1 );

SKIP: {
  skip "can't run SSL tests without HTTP::Daemon::SSL and IO::Socket::SSL",
    TEST_GROUP * 2
    unless eval "require HTTP::Daemon::SSL; require IO::Socket::SSL; 1";
  run_tests( ssl => 1, fork => 0 );
  run_tests( ssl => 1, fork => 1 );
}

sub test_url {
    my ($scheme, $method, $uri, $code, $regex, $test_name, $mime_type) = @_;

    my $url = "$scheme://$host:$port$uri";

    my $ua = LWP::UserAgent->new();
    my $req = HTTP::Request->new(GET => $url);

    my $res;
    ok($res = $ua->request($req), "$test_name (LWP request worked)" );
    cmp_ok($res->code, '==', $code, "$test_name (result code as expected).");
    like($res->content, $regex, "$test_name (content matched).");

    if ($mime_type) {
        is($res->header('Content-type'), $mime_type, "$test_name (Mime type)");
    }

}

sub run_tests {
  my %args = @_;

  diag('Configuring' . ($args{fork} ? ' forked' : '') . ' server' . ($args{ssl} ? ' with ssl' : ''));
  
  # set the error out to stdout to play nice with test::harness
  my $server;

  my %server_args = (
      port => $port, host => $host, error_log => \*STDOUT,
      fork => $args{fork},
     );

  if ($args{ssl}) {
      $server_args{daemon_class} = 'HTTP::Daemon::SSL';
      $server_args{daemon_args} = [
          SSL_key_file => 't/test.pem',
          SSL_cert_file => 't/test.pem',
         ];
  }
  
  ok( $server = HTTP::Server::Brick->new( %server_args ), 'Created server object.');
  isa_ok( $server, 'HTTP::Server::Brick');


  # setup dir and file for static tests
  my $temp_text_file = 'foo.txt';
  my $temp_html_file = 'foo.html';

  my $temp_dir = POSIX::tmpnam();
  mkdir $temp_dir or die "Unable to create temp dir $temp_dir";

  {
      my $text_fh;
      open($text_fh, ">$temp_dir/$temp_text_file") or die "Unable to write to temp file $temp_text_file";
      print $text_fh "Hello Everybody";