use warnings; $^W = 1; use strict; use Apache::Test ':withtestmore'; use Test::More; use Apache::TestConfig; use Apache::TestRequest qw(GET POST); if ($main::location =~ /mod_perl/) { eval 'use Apache2::Request;'; if ($@) { plan skip_all => 'No Apache2::Request, skipping'; exit; } } if ($main::location =~ /storable/) { eval 'use Apache2::SubProcess;'; if ($@) { plan skip_all => 'No Apache2::SubProcess, skipping'; exit; } } plan tests => 123; my $VERSION = '2.004'; my $hostport = Apache::TestRequest::hostport; my ($uri, $res, $body); ok(1, $uri = "/$main::location/app1.xml"); ok($res = GET($uri), 'Did we GET some response?'); is($res->code, 200, 'Success response code?'); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < 13 $main::rayapp_env_data $VERSION EOF ok(1, $uri = "/$main::location/app1.html"); ok($res = GET($uri), 'GOT some response?'); is($res->code, 200, "Test the response code"); $body = $res->content; if ($main::location eq 'mod_perl_proxy1' or $main::location eq 'mod_perl_proxy3_cgi') { # these have pdir is($res->header('Content-Type'), 'text/plain; charset=UTF-8', 'The data should be text/plain; charset=UTF-8'); is($body, <header('Content-Type'), 'text/html; charset=UTF-8', 'The data should be text/html; charset=UTF-8'); is($body, <

The id is 13, the data is $main::rayapp_env_data.

EOF } ok(1, $uri = "/$main::location/app3.html"); ok($res = GET($uri), 'GOT some response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/html; charset=UTF-8', 'The data should be text/html; charset=UTF-8'); $body = $res->content; is($body, <

The id is 13, the data is $main::rayapp_env_data.

Style data is Káťa and style env data is $main::rayapp_env_style_data

EOF ok(1, $uri = "/$main::location/app3.html?m=35;n=auto&id=17"); ok($res = GET($uri), 'GOT some response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/html; charset=UTF-8', 'The data should be text/html; charset=UTF-8'); $body = $res->content; is($body, <

The id is 13, the data is $main::rayapp_env_data.

Style data is Káťa and style env data is $main::rayapp_env_style_data

EOF ok(1, $uri = "/$main::location/"); ok($res = GET($uri), 'Did we GET HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/html; charset=UTF-8', 'The data should be text/html; charset=UTF-8'); $body = $res->content; is($body, <

The id is 13, the data is $main::rayapp_env_data.

Style data is Káťa and style env data is $main::rayapp_env_style_data

EOF ok(1, $uri = "/$main::location"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/html; charset=UTF-8', 'The data should be text/html; charset=UTF-8'); $body = $res->content; is($body, <

The id is 13, the data is $main::rayapp_env_data.

Style data is Káťa and style env data is $main::rayapp_env_style_data

EOF ok(1, $uri = "/$main::location/app2.html"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/html; charset=UTF-8', 'The data should be text/html; charset=UTF-8'); $body = $res->content; is($body, <

The id is 13, the data is $main::rayapp_env_data.

EOF ok(1, $uri = "/$main::location/text.xml"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/plain', 'The data should be text/plain'); $body = $res->content; is($body, < 0), 'Did we get HTTP::Response?'); is($res->code, 302, "Test the response code, redirect"); is($res->header('Content-Type'), 'text/plain', 'The data should be text/plain'); is($res->header('Location'), 'http://perl.apache.org/', 'The redirection target'); $body = $res->content; is($body, <code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < Note, this is not DSD, it should be processed as is. <_param name="id"/> EOF ok(1, $uri = "/$main::location/xml.html"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/html; charset=UTF-8', 'The data should be text/html'); $body = $res->content; is($body, < xml.xsl");

We have _param element here.

We have the empty id element here.

EOF ok(1, $uri = "/$main::location/xml.txt"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/plain; charset=UTF-8', 'The data should be text/plain'); $body = $res->content; is($body, <code, 404, "We expect 404 Not found code"); $body = $res->content; if ($main::location =~ /^cgi[12]$/) { is($res->header('Content-Type'), 'text/plain', 'The plain message'); is($body, <header('Content-Type'), 'text/html; charset=iso-8859-1', 'The HTML message'); is($body, < 404 Not Found

Not Found

The requested URL /$main::location/nonexistent.xml was not found on this server.

EOF } ok(1, $uri = "/$main::location/processq.xml"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < EOF ok(1, $uri = "/$main::location/processq.xml?id=123"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < 123 EOF ok(1, $uri = "/$main::location/processq.xml?value=123;id=jezek"); ok($res = GET($uri), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < jezek 123 EOF ok(1, $uri = "/$main::location/processq.xml?value=123;id=jezek"); ok($res = POST("/$main::location/processq.xml?value=123;id=jezek", [ id => 45, value => 'krtek' ]), 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < 45 krtek EOF my ($request, $ua); ok(1, $uri = "http://$hostport/$main::location/processq.xml?value=888"); $request = new HTTP::Request POST => $uri; $request->content_type('application/x-www-form-urlencoded'); $request->content('id=32&value=jezek'); $ua = new LWP::UserAgent; $res = $ua->request($request); ok($res, 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < 32 jezek EOF ok(1, $uri = "http://$hostport/$main::location/processq.xml?value=88"); $request = new HTTP::Request POST => $uri; $request->content_type('text/plain'); $request->content('This is freeform content where a = 1'); $ua = new LWP::UserAgent; $res = $ua->request($request); ok($res, 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < This is freeform content where a = 1 EOF SKIP: { skip "For CGI, we always fetch a new process.", 2 if $main::location =~ /cgi/; my ($CHANGING, $changing_ok, %server_pids); $CHANGING = 't/htdocs/ray/changing.mpl'; unlink $CHANGING; # purge leftovers $changing_ok = 'skip'; %server_pids = ();; $uri = "/$main::location/changing.xml"; for my $i (1 .. 10) { my $script = <<"EOF"; use strict; use warnings; sub handler { return { pid => \$\$, multiplied_pid => \$\$ * $i, }; } 1; EOF print "# Will try to GET $uri with multiplication $i\n"; my $ret = eval { open OUT, "> $CHANGING" or die "Failed to open $CHANGING for writing: $!\n"; print OUT $script or die "Failed to write $CHANGING: $!\n"; close OUT or die "Failed to close $CHANGING: $!\n"; $res = GET($uri) or die "Failed GET the [$uri]\n"; $res->code eq 200 or die "The status is @{[ $res->code ]}, not good\n"; $body = $res->content; my ($server_id, $multiply) = ($body =~ m!(\d+).*(\d+)!s); $server_id or die "We did not get server pid\n"; ($multiply eq ($server_id * $i)) or die "Got output $multiply, expected @{[ $server_id * $i ]}\n"; if (not exists $server_pids{$server_id}) { $server_pids{$server_id} = $multiply; } elsif ($server_pids{$server_id} eq $multiply) { die "Got the same multiply, so the same code was reused\n"; } else { print "# Script changed ok\n"; $changing_ok = 'yes'; return 1; } return; }; last if $ret; if ($@) { my $out = $@; $out =~ s/^/# /m; print $out; $changing_ok = 'no'; last; } sleep 1; } if ($changing_ok eq 'skip') { SKIP: { skip "Tried multiple times but failed to hit the same server to check how it handles changes in script code.", 1; } } elsif ($changing_ok eq 'no') { ok(0, "Will we notice when the application code changes?"); } elsif ($changing_ok eq 'yes') { ok(1, "We notice changes in application code ok."); } else { ok(0, "Some strange problem with the test suite."); } $CHANGING = 't/htdocs/ray/changing.xsl'; unlink $CHANGING; # purge leftovers $changing_ok = 'skip'; %server_pids = (); $uri = "/$main::location/changing.html"; for my $i (1 .. 10) { my $xsl = <<"EOF"; pid [] $i EOF print "# Will try to GET $uri with value $i\n"; my $ret = eval { open OUT, "> $CHANGING" or die "Failed to open $CHANGING for writing: $!\n"; print OUT $xsl or die "Failed to write $CHANGING: $!\n"; close OUT or die "Failed to close $CHANGING: $!\n"; $res = GET($uri) or die "Failed GET the [$uri]\n"; $res->code eq 200 or die "The status is @{[ $res->code ]}, not good\n"; $body = $res->content; my ($server_id, $outi) = ($body =~ m!pid \[(\d+)\] (\d+)!); $server_id or die "Failed to get pid from the server, got $body\n"; $outi eq $i or die "Failed to get correct output, got $body\n"; if (not exists $server_pids{$server_id}) { $server_pids{$server_id} = $body; } elsif ($server_pids{$server_id} eq $body) { die "Got the same body, so the same stylesheet was reused\n"; } else { print "# Stylesheet changed ok\n"; $changing_ok = 'yes'; return 1; } return; }; last if $ret; if ($@) { my $out = $@; $out =~ s/^/# /mg; print $out; $changing_ok = 'no'; last; } sleep 1; } if ($changing_ok eq 'skip') { SKIP: { skip "Tried multiple times but failed to hit the same server to check how it handles changes in stylesheets.", 1; } } elsif ($changing_ok eq 'no') { ok(0, "Will we notice when the stylesheet changes?"); } elsif ($changing_ok eq 'yes') { ok(1, "We notice changes in stylesheets code ok."); } else { ok(0, "Some strange problem with the test suite."); } } SKIP: { skip "Cookies are not passed through proxy.", 25 if $main::location =~ /proxy/; use HTTP::Cookies; my $jar = new HTTP::Cookies; $ua->cookie_jar($jar); ok(1, $uri = "http://$hostport/$main::location/cookies.xml"); $request = new HTTP::Request GET => $uri; $res = $ua->request($request); ok($res, 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < no session EOF ok(1, $uri = "http://$hostport/$main::location/cookies.xml?login=123"); $request = new HTTP::Request GET => $uri; $res = $ua->request($request); ok($res, 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < 123 logged in 123 EOF ok(1, $uri = "http://$hostport/$main::location/cookies.xml"); $request = new HTTP::Request GET => $uri; $res = $ua->request($request); ok($res, 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < running 123 EOF ok(1, $uri = "http://$hostport/$main::location/cookies.xml?logout=1"); $request = new HTTP::Request GET => $uri; $res = $ua->request($request); ok($res, 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < logged out 123 EOF ok(1, $uri = "http://$hostport/$main::location/cookies.xml"); $request = new HTTP::Request GET => $uri; $res = $ua->request($request); ok($res, 'Did we get HTTP::Response?'); is($res->code, 200, "Test the response code"); is($res->header('Content-Type'), 'text/xml', 'The data should be text/xml'); $body = $res->content; is($body, < no session EOF } 1;