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

Annotation of /trunk/tests/server.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 224 - (hide annotations)
Fri Oct 3 02:28:21 2008 UTC (10 years, 11 months ago) by siliconforks
File MIME type: text/plain
File size: 1625 byte(s)
Send no Content-Type with no extension.
1 siliconforks 126 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 siliconforks 224 my @headers = ('Connection' => 'close');
30 siliconforks 126 if ($file =~ /\.js$/) {
31 siliconforks 224 push @headers, 'Content-Type' => 'text/javascript';
32 siliconforks 126 }
33 siliconforks 224 elsif ($file =~ /\.[^\/]+$/) {
34     push @headers, 'Content-Type' => 'application/octet-stream';
35     }
36 siliconforks 126 else {
37 siliconforks 224 # do nothing - no Content-Type
38 siliconforks 126 }
39 siliconforks 224 my $response = HTTP::Response->new(200, 'OK', \@headers, $content);
40 siliconforks 126 $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