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

Annotation of /trunk/tests/server.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 609 - (hide annotations)
Fri Sep 24 16:01:58 2010 UTC (9 years, 8 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 siliconforks 126 use strict;
2     use warnings;
3    
4     use HTTP::Daemon;
5     use HTTP::Status;
6    
7     $|++;
8    
9 siliconforks 609 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 siliconforks 126 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 siliconforks 224 my @headers = ('Connection' => 'close');
35 siliconforks 126 if ($file =~ /\.js$/) {
36 siliconforks 224 push @headers, 'Content-Type' => 'text/javascript';
37 siliconforks 126 }
38 siliconforks 224 elsif ($file =~ /\.[^\/]+$/) {
39     push @headers, 'Content-Type' => 'application/octet-stream';
40     }
41 siliconforks 126 else {
42 siliconforks 224 # do nothing - no Content-Type
43 siliconforks 126 }
44 siliconforks 224 my $response = HTTP::Response->new(200, 'OK', \@headers, $content);
45 siliconforks 126 $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