# Thanks to merlyn for nudging me and giving me this snippet!
use strict;
use HTTP::Daemon;
use CGI;
use Getopt::Long;
use vars qw($VERSION);
$VERSION = '0.55';

$|++;

GetOptions(
    'e=s' => \my $expression,
);

my $host = 'localhost';
my $d = HTTP::Daemon->new(
    LocalAddr => $host,
) or die;

# HTTP::Deamon doesn't return http://localhost:.../
# for LocalAddr => 'localhost'. This causes the
# tests to fail of many machines.
( my $url = URI->new($d->url) )->host($host);
print "$url\n";

my ($filename,$logfile) = @ARGV[0,1];
if ($filename) {
  open DATA, "< $filename"
    or die "Couldn't read page '$filename' : $!\n";
};
#open LOG, ">", $logfile
#  or die "Couldn't create logfile '$logfile' : $!\n";
my $log;
my $body = join "", <DATA>;

sub debug($) {
  my $message = $_[0];
  $message =~ s!\n!\n#SERVER:!g;
  warn "#SERVER: $message"
    if $ENV{TEST_HTTP_VERBOSE};
};

SERVERLOOP: {
  my $quitserver;
  while (my $c = $d->accept) {
    debug "New connection";
    while (my $r = $c->get_request) {
      debug "Request:\n" . $r->as_string;
      my $location = ($r->uri->path || "/");
      my ($link1,$link2) = ('','');
      if ($location =~ m!^/link/([^/]+)/(.*)$!) {
        ($link1,$link2) = ($1,$2);
      };
      my $res;
      if ($location eq '/get_server_log') {
        $res = HTTP::Response->new(200, "OK", undef, $log);
        $log = '';
      } elsif ( $location eq '/quit_server') {
        debug "Quitting";
        $res = HTTP::Response->new(200, "OK", [Connection => 'close'], "quit");
        $quitserver = 1;
      } else {
        eval $expression
            if $expression;
        warn "eval: $@" if $@;
        $log .= "Request:\n" . $r->as_string . "\n";
        if ($location =~ m!^/redirect/(.*)$!) {
            $res = HTTP::Response->new(302);
            $res->header('location', $d->url . $1);
        } elsif ($location =~ m!^/error/notfound/(.*)$! or $location =~ m!^/favicon.ico!) {
            $res = HTTP::Response->new(404, "Not found", [Connection => 'close']);
        } elsif ($location =~ m!^/error/timeout/(\d+)$!) {
            sleep $1;
            $res = HTTP::Response->new(599, "Timeout reached", [Connection => 'close']);
        } elsif ($location =~ m!^/error/close/(\d+)$!) {
            sleep $1;
            $res = undef;
        } elsif ( $location =~ m!^/chunks!) {
            my $count = 5;
            $res = HTTP::Response->new(200, "OK", undef, sub {
               sleep 1;
               my $buf = 'x' x 16;
               return $buf if $count-- > 0;
               return undef; # done
            });
        } elsif ($location =~ m!^/error/after_headers$!) {
            my $count = 2;
            $res = HTTP::Response->new(200, "OK", undef, sub {
               sleep 1;
               my $buf = 'x' x 16;
               return $buf if $count-- > 0;
               die "Planned error after headers";
            });
        } else {
            my $q = $r->content
                    ? CGI->new($r->content )
                    : CGI->new($r->uri->query);

            # Make sticky form fields
            my ($query,$botcheck_query,$query2,$session,%cat);
            $query = defined $q->param('query') ? $q->param('query') : "(empty)";
            $botcheck_query = defined $q->param('botcheck_query') ? $q->param('botcheck_query') : "(empty)";
            $query2 = defined $q->param('query2') ? $q->param('query2') : "(empty)";
            $session = defined $q->param('session') ? $q->param('session') : 1;
            %cat = map { $_ => 1 } (defined $q->param('cat') ? $q->param('cat') : qw( cat_foo cat_bar ));
            my @categories = map { $cat{$_} ? "checked" : "" } qw( cat_foo cat_bar cat_baz );
            my $headers = CGI::escapeHTML( $r->headers->as_string );
            
            my $rbody = sprintf $body,$headers, $location,$session,$query,$botcheck_query,$query2,@categories;
            $res = HTTP::Response->new(200, "OK", [
                  'Set-Cookie' => $q->cookie(-name => 'log-server-httponly',-value=>'supersecret', -discard => 1, -httponly=>1),
                  'Set-Cookie' => $q->cookie(-name => 'log-server',-value=>'shazam2', -discard=>1,),
                  'Cache-Control' => 'no-cache',
                  'Pragma' => 'no-cache',
                  'Max-Age' => 0,
                  'Connection' => 'close',
                  'Content-Length' => length($rbody),
              ], $rbody);
            $res->content_type('text/html; charset=ISO-8859-1');
            debug "Request " . ($r->uri->path || "/");
        };
      };
      debug "Response:\n" . $res->as_string
          if $res;
      eval {
        $c->send_response($res)
            if $res;
      };
      if (my $err = $@) {
          debug "Server raised error: $err";
          if ($err !~ /^Planned error\b/) {
              warn $err;
          };
          $c->close;
      };
      if (! $res) {
          $c->close;
      };
      last if $quitserver;
    }
    sleep 1;
    undef($c);
    last SERVERLOOP
      if $quitserver;
  }
};
END { debug "Server stopped" };

# The below <link> tag should stop the browser from requesting a favicon.ico, but we still see it...
__DATA__
<html lang="en">
<head>
<title>WWW::Mechanize::Firefox test page</title>
<link rel="shortcut icon" href="#">
<style>
.hidden { display: none; }
</style>
</head>
<body>
<h1>Request headers</h1>
<pre id="request_headers">
%s
</pre>
<h1>Location: %s</h1>
<p>
  <a href="/test">Link /test</a>
  <a href="/foo">Link /foo</a>
  <a href="/slash_end">Link /</a>
  <a href="/slash_front">/Link </a>
  <a href="/slash_both">/Link in slashes/</a>
  <a href="/foo1.save_log_server_test.tmp">Link foo1.save_log_server_test.tmp</a>
  <a href="/foo2.save_log_server_test.tmp">Link foo2.save_log_server_test.tmp</a>
  <a href="/foo3.save_log_server_test.tmp">Link foo3.save_log_server_test.tmp</a>
  <table>
    <tr><th>Col1</th><th>Col2</th><th>Col3</th></tr>
    <tr><td>A1</td><td>A2</td><td>A3</td></tr>
    <tr><td>B1</td><td>B2</td><td>B3</td></tr>
    <tr><td>C1</td><td>C2</td><td>C3</td></tr>
  </table>
  <form name='f' action="/formsubmit" method="GET">
    <input type="hidden" name="session" value="%s"/>
    <input type="text" name="query" value="%s"/>
    <input type="text" name="botcheck_query" class="hidden" value="%s"/>
    <input type="image" name="submit_image" value="Go_img" id="submit_button_image" />
    <input type="text" name="query2" value="%s"/>
    <input type="submit" name="submit" value="Go" id="submit_button" />
    <input type="checkbox" name="cat" value="cat_foo" %s />
    <input type="checkbox" name="cat" value="cat_bar" %s />
    <input type="checkbox" name="cat" value="cat_baz" %s />
  </form>
</p>
</body>
</html>