view release on metacpan or  search on metacpan

t/010states.t  view on Meta::CPAN

# CALL
$data=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
10	k	/	0	0	Do: $r->notes->{t}=$r->notes->{t}." /:before"
11	k	/	0	1	Call: ':CALL:'
12	k	/	0	2	Do: $r->notes->{t}=$r->notes->{t}." /:after"
13	k	/uri	0	0	Do: $r->notes->{t}=$r->notes->{t}." /uri:before"
14	k	/uri	0	1	Call: ':CALL:'
15	k	/uri	0	2	Do: $r->notes->{t}=$r->notes->{t}." /uri:after"
20	k	:CALL:	0	0	Do: $r->notes->{t}=$r->notes->{t}." c1"
21	k	:CALL:	0	1	Cond: 0
22	k	:CALL:	0	2	Do: $r->notes->{t}=$r->notes->{t}." c2"
23	k	:CALL:	1	0	Do: $r->notes->{t}=$r->notes->{t}." c3"
24	k	:CALL:	1	1	Do: $r->notes->{t}=$r->notes->{t}." c4"
EOD
update_db;

ok t_cmp GET_BODY( '/uri' ), 'init /uri:before c1 c3 c4 /uri:after /:before c1 c3 c4 /:after', n 'Call';

# LAST als Return in CALL & RESTART
$data=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
10	k	/	0	0	Do: $r->notes->{t}=$r->notes->{t}." /:before"
11	k	/	0	1	Call: ':CALL:'
12	k	/	0	2	Do: $r->notes->{t}=$r->notes->{t}." /:after"
13	k	/uri	0	0	Do: $r->notes->{t}=$r->notes->{t}." /uri:before"
14	k	/uri	0	1	Call: ':CALL:'
15	k	/uri	0	2	Do: $r->notes->{t}=$r->notes->{t}." /uri:after"
20	k	:CALL:	0	0	Do: $r->notes->{t}=$r->notes->{t}." c1"
21	k	:CALL:	0	1	Last
22	k	:CALL:	0	2	Do: $r->notes->{t}=$r->notes->{t}." c2"
23	k	:CALL:	1	0	Do: $r->notes->{t}=$r->notes->{t}." c3"
24	k	:CALL:	1	1	Do: $r->notes->{t}=$r->notes->{t}." c4"
30	k	/rstrt	0	0	Do: $r->notes->{t}=$r->notes->{t}." /rstrt"
31	k	/rstrt	0	1	Restart: '/uri'
33	k	/rstrt	0	2	Do: $r->notes->{t}=$r->notes->{t}." must-not-occur"
33	k	/rstrt	1	0	Do: $r->notes->{t}=$r->notes->{t}." must-not-occur"
40	k	/rstrt2	0	0	Do: $r->notes->{t}=$r->notes->{t}." /rstrt2"
41	k	/rstrt2	0	1	Restart: '/uri', 'k2'
50	k2	:PRE:	0	0	Do: $r->notes->{t}=$r->notes->{t}." init2";
51	k2	/	0	0	Do: $r->notes->{t}=$r->notes->{t}." /:before2"; $KEY='k';
52	k2	/	0	1	Call: ':CALL:'
53	k2	/	0	2	Do: $r->notes->{t}=$r->notes->{t}." /:after2"; $KEY='k2';
54	k2	/uri	0	0	Do: $r->notes->{t}=$r->notes->{t}." /uri:before2"; $KEY='k';
55	k2	/uri	0	1	Call: ':CALL:'
56	k2	/uri	0	2	Do: $r->notes->{t}=$r->notes->{t}." /uri:after2"; $KEY='k2';
EOD
update_db;

ok t_cmp GET_BODY( '/uri' ), 'init /uri:before c1 /uri:after /:before c1 /:after', n 'Last as return from Call';
ok t_cmp GET_BODY( '/rstrt' ), 'init /rstrt init /uri:before c1 /uri:after /:before c1 /:after', n 'Restart';
ok t_cmp GET_BODY( '/rstrt2' ), 'init /rstrt2 init2 /uri:before2 c1 /uri:after2 /:before2 c1 /:after2', n 'Restart 2';

# REDIRECT & ERROR
$data=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
10	k	/	0	0	Redirect: 'http://'.join(':', $r->get_server_name, $r->get_server_port).'/redirect1'
11	k	/uri	0	0	Redirect: 'http://'.join(':', $r->get_server_name, $r->get_server_port).'/redirect2', 303
12	k	/error	0	0	Redirect: die "ERROR"
13	k	/404	0	0	Error: 404, 'this appears in the error_log'
EOD
update_db;

my $resp=GET '/';
ok t_cmp $resp->code, 302, n 'Redirect1: code';
ok t_cmp $resp->header('Location'), 'http://'.Apache::TestRequest::hostport.'/redirect1', n 'Redirect1: Location';

$resp=GET '/uri';
ok t_cmp $resp->code, 303, n 'Redirect2: code';
ok t_cmp $resp->header('Location'), 'http://'.Apache::TestRequest::hostport.'/redirect2', n 'Redirect2: Location';

t_client_log_error_is_expected(2);
$resp=GET '/error';
ok t_cmp $resp->code, 500, n 'Redirect error';

t_client_log_error_is_expected();
$resp=GET '/404';
ok t_cmp $resp->code, 404, n 'Error: 404';

# CLIENTIP convenience variable
$data=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
10	k	:PRE:	0	0	Do: $r->notes->{t}=$r->notes->{t}." ".$CLIENTIP
EOD
update_db;

ok t_cmp GET_BODY( '/' ), qr/^init \d+\.\d+\.\d+\.\d+$/, n 'CLIENTIP';

$resp=OPTIONS '*';
ok t_cmp $resp->code, 200, n 'OPTIONS *';

$resp=OPTIONS '/';
ok t_cmp $resp->code, 200, n 'OPTIONS /';

t_client_log_error_is_expected();
{
  # this is not possible using Apache::TestRequest.

  use IO::Socket::INET ();
  my $hostport=Apache::TestRequest::hostport;
  my $s=IO::Socket::INET->new($hostport);
  die "ERROR: Cannot create socket: $!" unless( $s );
  $s->print("Options hallo HTTP/1.1\nHost: $hostport\nConnection: close\n\n");
  my $l=<$s>;
  ok $l=~/ 400 /, n 'OPTIONS hallo';
}

$dbh->disconnect;