/[jscoverage]/trunk/tests/server.pl
ViewVC logotype

Contents of /trunk/tests/server.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 126 - (show annotations)
Mon Jun 2 17:53:43 2008 UTC (11 years, 1 month ago) by siliconforks
File MIME type: text/plain
File size: 1530 byte(s)
Fixes for MinGW.

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 $content_type;
30 if ($file =~ /\.js$/) {
31 $content_type = 'text/javascript';
32 }
33 else {
34 $content_type = 'application/octet-stream';
35 }
36 my $response = HTTP::Response->new(200, 'OK', ['Connection' => 'close', 'Content-Type' => $content_type], $content);
37 $c->send_response($response);
38 }
39 else {
40 my $response = HTTP::Response->new(404, 'Not found', ['Connection' => 'close'], 'Not found');
41 $c->send_response($response);
42 }
43 }
44 elsif ($r->method eq 'POST') {
45 if ($r->url->path eq '/perl-shutdown') {
46 $done = 1;
47 }
48 my $content = $r->content;
49 my $response = HTTP::Response->new(200, 'OK', ['Connection' => 'close'], $content);
50 $c->send_response($response);
51 }
52 else {
53 $c->send_error(RC_FORBIDDEN);
54 }
55 $c->close;
56 undef($c);
57 }
58

  ViewVC Help
Powered by ViewVC 1.1.24