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

Contents of /trunk/tests/server.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 224 - (show annotations)
Fri Oct 3 02:28:21 2008 UTC (10 years, 8 months ago) by siliconforks
File MIME type: text/plain
File size: 1625 byte(s)
Send no Content-Type with no extension.
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

  ViewVC Help
Powered by ViewVC 1.1.24