use WWW::Mechanize;
use HTTP::Request;
use HTTP::Response;

my $randomtext = $ARGV[0];

my $host = "localhost:15840";
my $url = "http://${host}";

my $mech = WWW::Mechanize->new( autocheck => 1 );
my $noautomech = WWW::Mechanize->new( autocheck => 0 );

eval {
sub urlexists {
    my($suburl) = @_;

    $mech->get($url . $suburl);
}

sub urlin {
    my($suburl,$regexp) = @_;

    $mech->get($url . $suburl);
    die "$regexp not in ${url}${suburl}. Contents:\n" . $mech->content . "\n" unless $mech->content =~ $regexp;
    die "Random text not found in ${url}${suburl}. Content: ". $mech->content unless $mech->content =~ qr/\|RANDOMID=$randomtext\|/;
}

sub urlnotexist {
    my($suburl) = @_;

    $noautomech->get($url . $suburl);
    die "URL ${url}${suburl} should not exist! It does. Content: " . $noautomech->content if $noautomech->success;
}

sub urlstatus {
    my($suburl,$status) = @_;

    $noautomech->get($url . $suburl);
    my $retstatus = $noautomech->status();
    die "URL ${url}${suburl} returned status code $retstatus, when $status was expected." unless $status == $retstatus;
}


############### TESTS GO HERE #########################

# Test a simple handler
urlin "/handler", qr/simple handler/;

# Test the matching system
# Strict match should match itself, but not more
urlin "/strict-match/", qr/strict matcher/;
urlnotexist "/strict-match/more";

# Loose match should match itself and more
urlin "/loose-match/", qr/loose matcher/;
urlin "/loose-match/more", qr/loose matcher/;

# test the root-handler
urlin "/root-handler/", qr/root-handler-tester/;
urlin "/root-handler2/", qr/root-handler-tester2/;

# test a dispatching handler's base response
urlin "/dispatch-handler/", qr/dispatch handler/;
urlin "/dispatch-handler/subhandler", qr/dispatch subhandler handler/;

# test a dispatching dispatching handler
urlin "/dispatch-dispatch/dispatch1/", qr/dispatch 1 handler/;
urlin "/dispatch-dispatch/dispatch1/loose", qr/d1loose/;
urlin "/dispatch-dispatch/dispatch1/loose/pass", qr/d1loose/;
urlin "/dispatch-dispatch/dispatch1/strict", qr/d1strict/;
urlin "/dispatch-dispatch/dispatch1/strict/fail", qr/dispatch 1 handler/;

urlin "/dispatch-dispatch/dispatch1/dispatch2/", qr/dispatch 2 handler/;
urlin "/dispatch-dispatch/dispatch1/dispatch2/loose", qr/d2loose/;
urlin "/dispatch-dispatch/dispatch1/dispatch2/loose/pass", qr/d2loose/;
urlin "/dispatch-dispatch/dispatch1/dispatch2/strict", qr/d2strict/;
urlin "/dispatch-dispatch/dispatch1/dispatch2/strict/fail", qr/dispatch 2 handler/;


urlin "/dispatch-dispatch-root/dispatch1/", qr/dispatch 1 handler/;
urlin "/dispatch-dispatch-root/dispatch1/loose", qr/d1loose/;
urlin "/dispatch-dispatch-root/dispatch1/loose/pass", qr/d1loose/;
urlin "/dispatch-dispatch-root/dispatch1/strict", qr/d1strict/;
urlin "/dispatch-dispatch-root/dispatch1/strict/fail", qr/dispatch 1 handler/;

urlin "/dispatch-dispatch-root/dispatch1/dispatch2/", qr/dispatch 2 handler/;
urlin "/dispatch-dispatch-root/dispatch1/dispatch2/loose", qr/d2loose/;
urlin "/dispatch-dispatch-root/dispatch1/dispatch2/loose/pass", qr/d2loose/;
urlin "/dispatch-dispatch-root/dispatch1/dispatch2/strict", qr/d2strict/;
urlin "/dispatch-dispatch-root/dispatch1/dispatch2/strict/fail", qr/dispatch 2 handler/;


urlin "/dispatch-dispatch-root2/dispatch1/", qr/dispatch 1 handler/;
urlin "/dispatch-dispatch-root2/dispatch1/loose", qr/d1loose/;
urlin "/dispatch-dispatch-root2/dispatch1/loose/pass", qr/d1loose/;
urlin "/dispatch-dispatch-root2/dispatch1/strict", qr/d1strict/;
urlin "/dispatch-dispatch-root2/dispatch1/strict/fail", qr/dispatch 1 handler/;

urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/", qr/dispatch 2 handler/;
urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/loose", qr/d2loose/;
urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/loose/pass", qr/d2loose/;
urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/strict", qr/d2strict/;
urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/strict/fail", qr/dispatch 2 handler/;


# test error responses
urlstatus "/error/bad-request", 400;
urlstatus "/error/unauthorized", 401;
urlstatus "/error/payment-required", 402;
urlstatus "/error/forbidden", 403;
urlstatus "/error/not-found", 404;
urlstatus "/error/method-not-allowed", 405;
urlstatus "/error/not-acceptable", 406;
urlstatus "/error/proxy-authentication-required", 407;
urlstatus "/error/request-time-out", 408;
urlstatus "/error/conflict", 409;
urlstatus "/error/gone", 410;
urlstatus "/error/length-required", 411;
urlstatus "/error/precondition-failed", 412;
urlstatus "/error/request-entity-too-large", 413;
urlstatus "/error/request-url-too-large", 414;
urlstatus "/error/unsupported-media-type", 415;
urlstatus "/error/internal-server-error", 500;
urlstatus "/error/not-implemented", 501;
urlstatus "/error/bad-gateway", 502;
urlstatus "/error/service-unavailable", 503;
urlstatus "/error/gateway-time-out", 504;
urlstatus "/error/version-not-supported", 505;

# Test request-redirect
# explanation: we go to the first and are redirected to the second. We therefore should get the text
# of the second.
urlin "/redirect/first", qr/redirect second handler/;
urlin "/redirect-handler/first", qr/redirect-handler second handler/;

# Test cookie request
# Cookies are tested twice: once to see if the client gets them correctly
# and once again on the server side to make the server gets them correctly
# there's a redirect from receive to send, so make sure of that then check cookies
urlin "/cookie/send", qr/cookie receive handler/;

my $tmp = sub { urlin "/cookie/receive", @_ };
$tmp->(qr/unsafecookie simplecookie=simple-value/);
$tmp->(qr/safecookie simplecookie=simple-value/);
$tmp->(qr/unsafecookie ladencookie=123ladenvalue123---/);
$tmp->(qr/safecookie ladencookie=123ladenvalue123---/);

sub cookie_check {
# now check the local side
    my %cookies_found = {};
    $mech->cookie_jar->scan(sub { my($ver,$key,$val,$path,$domain,$port) = @_; $cookies_found{$key} = $val; });

    my($key,$val) = @_;
    if ($val = -1) {
	exists $cookies_found{$key} or die "No such cookie $key";
    }
    else {
	exists $cookies_found{$key} && $cookies_found{$key} == $val or die "Cookie $key=$val not found"
    }
}
sub cookie_value_isnot {
    my %cookies_found = {};
    $mech->cookie_jar->scan(sub { my($ver,$key,$val) = @_; $cookies_found{$key} = $val; });

    my($key,$val) = @_;
    die "Cookie $key not found" unless exists $cookies_found{$key};
    die "Cookie $key=$val but should not have!" unless $cookies_found{$key} ne $val;
}
sub get_cookie_info {
    my %cookies_found = {};
    $mech->cookie_jar->scan(sub { $cookies_found{$_[1]} = \@_; });
    
    my($key) = @_;
    @{$cookies_found{$key}};
}
cookie_check "simplecookie", "simple-value";
cookie_check "ladencookie", "123ladenvalue123---";


# Test conditional get
urlin "/conditional-get", qr/handler/;
my $request = HTTP::Request->new('GET', $url . "/conditional-get");
$request->header('If-Modified-Since' => HTTP::Date::time2str());
my $response = $noautomech->request($request);
die "Conditional get failed with ${url}/conditional-get . Returned code " . $response->code unless $response->code == 304;

# Test authentication
urlstatus "/authenticated/test", 401;
$mech->credentials($host,"testrealm","testuser","testpass");
urlin "/authenticated/test", qr/authenticated test handler/;

# Test authorization
urlstatus "/authorization/test", 401;
$mech->add_header( Referer => "http://example.com/foobar");
urlin "/authorization/test", qr/authorization test handler/;

# Test session variables
urlin "/session/one", qr{s-one: foo yes bar no baz maybe};
cookie_check "X_SESSIONDEFAULT", -1;
urlin "/session/two", qr{s-two: foo yes bar no baz maybe};
urlin "/session/three", qr{s-three: foo yes bar no baz maybe};
urlin "/session/four", qr{s-four: foo newfoo bar newbar baz newbaz};
urlin "/session/five", qr{s-five: foo NIL bar NIL baz NIL};

urlin "/session2/one", qr{<div>\s*<span>s-one: foo foo1 bar bar1 baz baz1</span>\s*<span>s-one: foo foo2 bar bar2 baz baz2</span>};
cookie_check "X_SESSIONDEFAULT", -1;
cookie_check "X_SESSIONALT", -1;
urlin "/session2/two", qr{<div>\s*<span>s-two: foo foo1 bar bar1 baz baz1</span>\s*<span>s-two: foo foo2 bar bar2 baz baz2</span>};


# Try to get a valid cookie to give to the server
$mech->cookie_jar->clear();
urlin "/session/nonesuch", qr{<span>NILxNIL</span>};

my @sample_cookie = get_cookie_info "X_SESSIONDEFAULT";

$mech->cookie_jar->clear();
$sample_cookie[2] = "100000000000000000000000001";
$mech->cookie_jar->set_cookie(@sample_cookie);
urlin "/session/nonesuch", qr{<span>NILxNIL</span>};
cookie_value_isnot "X_SESSIONDEFAULT", "100000000000000000000000001";
urlin "/session/nonesuch", qr{<span>NILxquark</span>};

# Quit
urlin "/quit", qr/quitting/;
};
if ($@) {
print "Failure: $@\n";
print "Quitting.\n";
$noautomech->get($url."/quit");
exit 1;
}

#############################################
print "All tests passed\n";
exit 0;
