PageRenderTime 344ms CodeModel.GetById 181ms app.highlight 12ms RepoModel.GetById 149ms app.codeStats 0ms

/js/lib/Socket.IO-node/support/expresso/deps/jscoverage/tests/server.pl

http://github.com/onedayitwillmake/RealtimeMultiplayerNodeJs
Perl | 61 lines | 56 code | 4 blank | 1 comment | 10 complexity | a714389ef86397ea0d175856cb522141 MD5 | raw file
 1use strict;
 2use warnings;
 3
 4use HTTP::Daemon;
 5use HTTP::Status;
 6
 7$|++;
 8
 9my $d = HTTP::Daemon->new(LocalPort => 8000, ReuseAddr => 1) || die;
10print "Please contact me at: <URL:", $d->url, ">\n";
11my $done = 0;
12while (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