trunk/tests/server.pl

use strict;
use warnings;

use HTTP::Daemon;
use HTTP::Status;

$|++;

my $d = HTTP::Daemon->new(LocalPort => 8000, ReuseAddr => 1) || die;
print "Please contact me at: <URL:", $d->url, ">\n";
my $done = 0;
while (not $done and my $c = $d->accept) {
  my $r = $c->get_request;
  if (not defined($r)) {
    print "Error: ", $c->reason, "\n";
    $c->close;
    undef($c);
    next;
  }
  print STDERR $r->method, ' ', $r->url, "\n";
  $c->force_last_request;
  if ($r->method eq 'GET') {
    my $file = substr($r->url->path, 1);
    if (open FILE, $file) {
      undef $/;
      binmode FILE;
      my $content = <FILE>;
      close FILE;
      my @headers = ('Connection' => 'close');
      if ($file =~ /\.js$/) {
        push @headers, 'Content-Type' => 'text/javascript';
      }
      elsif ($file =~ /\.[^\/]+$/) {
        push @headers, 'Content-Type' => 'application/octet-stream';
      }
      else {
        # do nothing - no Content-Type
      }
      my $response = HTTP::Response->new(200, 'OK', \@headers, $content);
      $c->send_response($response);
    }
    else {
      my $response = HTTP::Response->new(404, 'Not found', ['Connection' => 'close'], 'Not found');
      $c->send_response($response);
    }
  }
  elsif ($r->method eq 'POST') {
    if ($r->url->path eq '/perl-shutdown') {
      $done = 1;
    }
    my $content = $r->content;
    my $response = HTTP::Response->new(200, 'OK', ['Connection' => 'close'], $content);
    $c->send_response($response);
  }
  else {
    $c->send_error(RC_FORBIDDEN);
  }
  $c->close;
  undef($c);
}

1	use strict;
2	use warnings;
3
4	use HTTP::Daemon;
5	use HTTP::Status;
6
7	$\|++;
8
9	my $d = HTTP::Daemon->new(LocalPort => 8000, ReuseAddr => 1) \|\| die;
10	print "Please contact me at: <URL:", $d->url, ">\n";
11	my $done = 0;
12	while (not $done and my $c = $d->accept) {
13	my $r = $c->get_request;
14	if (not defined($r)) {
15	print "Error: ", $c->reason, "\n";
16	$c->close;
17	undef($c);
18	next;
19	}
20	print STDERR $r->method, ' ', $r->url, "\n";
21	$c->force_last_request;
22	if ($r->method eq 'GET') {
23	my $file = substr($r->url->path, 1);
24	if (open FILE, $file) {
25	undef $/;
26	binmode FILE;
27	my $content = <FILE>;
28	close FILE;
29	my @headers = ('Connection' => 'close');
30	if ($file =~ /\.js$/) {
31	push @headers, 'Content-Type' => 'text/javascript';
32	}
33	elsif ($file =~ /\.[^\/]+$/) {
34	push @headers, 'Content-Type' => 'application/octet-stream';
35	}
36	else {
37	# do nothing - no Content-Type
38	}
39	my $response = HTTP::Response->new(200, 'OK', \@headers, $content);
40	$c->send_response($response);
41	}
42	else {
43	my $response = HTTP::Response->new(404, 'Not found', ['Connection' => 'close'], 'Not found');
44	$c->send_response($response);
45	}
46	}
47	elsif ($r->method eq 'POST') {
48	if ($r->url->path eq '/perl-shutdown') {
49	$done = 1;
50	}
51	my $content = $r->content;
52	my $response = HTTP::Response->new(200, 'OK', ['Connection' => 'close'], $content);
53	$c->send_response($response);
54	}
55	else {
56	$c->send_error(RC_FORBIDDEN);
57	}
58	$c->close;
59	undef($c);
60	}
61