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

Contents of /trunk/tests/server.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 609 - (show annotations)
Fri Sep 24 16:01:58 2010 UTC (8 years, 2 months ago) by siliconforks
File MIME type: text/plain
File size: 1696 byte(s)
Allow server to take a port as a command-line argument.

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

  ViewVC Help
Powered by ViewVC 1.1.24