1#!/usr/bin/perl -w 2 3use strict; 4use Test::More; 5 6#sub POE::Kernel::TRACE_EVENTS {1} 7sub POE::Kernel::ASSERT_EVENTS {1} 8 9use LWP::UserAgent; 10use HTTP::Request; 11use POE::Kernel; 12use POE::Component::Server::HTTP; 13use IO::Socket::INET; 14use POE::API::Peek; 15 16sub DEBUG { 0 }; 17my $PORT=2080; 18 19my $pid=fork; 20die "Unable to fork: $!" unless defined $pid; 21 22END { 23 if($pid) { 24 kill 2, $pid or ($!==3) or warn "Unable to kill $pid: $!"; 25 } 26} 27 28#################################################################### 29unless ($pid) { # we are child 30 Test::Builder->new->no_ending(1); 31 # stop kernel from griping 32 ${$poe_kernel->[POE::Kernel::KR_RUN]} |= 33 POE::Kernel::KR_RUN_CALLED; 34 35 print STDERR "$$: Sleep 2..."; 36 sleep 2; 37 print STDERR "continue\n"; 38 39 40 ############################ 41 # 1, 2, 3 42 my $sock=IO::Socket::INET->new(PeerAddr=>'localhost', 43 PeerPort=>$PORT); 44 $sock or die "Unable to connect to localhost:$PORT: $!"; 45 $sock->close; # taunt other end 46 47 ############################ 48 # 4, 5, 6 49 $sock=IO::Socket::INET->new(PeerAddr=>'localhost', 50 PeerPort=>$PORT); 51 $sock or die "Unable to connect to localhost:$PORT: $!"; 52 53 my $req=HTTP::Request->new(GET => "http://localhost:$PORT/"); 54 $sock->print(join ' ', $req->method, $req->uri->as_string, "0\n"); 55 sleep 1; 56 $sock->close; # taunt other end 57 58 ############################ 59 # 7, 8, 9 60 $sock=IO::Socket::INET->new(PeerAddr=>'localhost', 61 PeerPort=>$PORT); 62 $sock or die "Unable to connect to localhost:$PORT: $!"; 63 $req=HTTP::Request->new(GET => "http://localhost:$PORT/honk"); 64 $sock->print($req->as_string); 65 $sock->close; # taunt other end 66 67 ############################ 68 # 10, 11 69 $req=HTTP::Request->new(GET => "http://localhost:$PORT/honk/shutdown.html"); 70 my $UA = LWP::UserAgent->new; 71 my $resp=$UA->request($req); 72 73 exit 0; 74} 75 76#################################################################### 77# we are the parent 78 79plan tests=>11; 80 81my $Q=1; 82my $shutdown=0; 83my $top=0; 84my $bonk=0; 85 86my $aliases = POE::Component::Server::HTTP->new( 87 Port => $PORT, 88 Address=>'localhost', 89 ContentHandler => { '/' => \&top, 90 '/honk/shutdown.html' => \&shutdown, 91 '/bonk/' => \&bonk 92 }, 93 PostHandler => { 94 '/' => \&post_top, 95 '/honk/shutdown.html' => \&post_shutdown, 96 }, 97 ErrorHandler => { '/' => \&error }, 98 Headers => { Server => 'TestServer' }, 99 ); 100 101POE::Session->create( 102 inline_states => { 103 _start => sub { 104 $poe_kernel->alias_set('HONK'); 105 $poe_kernel->sig(USR1=>'usr1'); 106 $poe_kernel->sig(USR2=>'usr2'); 107 }, 108 usr1=>sub {__peek(0)}, 109 usr2=>sub {__peek(1)}, 110 }); 111 112 113$poe_kernel->run; 114 115 116####################################### 117sub error 118{ 119 my ($request, $response) = @_; 120 121 DEBUG and __peek(1); 122 123 die "Why is Q=$Q" unless $Q; 124 125 ok(($request->is_error and $response->is_error), "this is an error"); 126 my $op=$request->header('Operation'); 127 my $errstr=$request->header('Error'); 128 my $errnum=$request->header('Errnum'); 129 130 DEBUG and 131 warn "$$: ERROR op=$op errnum=$errnum errstr=$errstr\n"; 132 133 if($Q <= 3) { 134 ok(($op eq 'read' and $errnum == 0), "closed connection") or 135 die "Why did i get this error? op=$op errnum=$errnum errstr=$errstr"; 136 } 137 else { 138 die "Whoah!"; 139 } 140 141 $Q++; 142 return RC_OK; 143} 144 145####################################### 146sub top 147{ 148 my ($request, $response) = @_; 149 $response->code(RC_OK); 150 $response->content_type('text/plain'); 151 $response->content("this is top"); 152 $top=1; 153 return RC_OK; 154} 155 156####################################### 157sub bonk 158{ 159 my ($request, $response) = @_; 160 $response->code(RC_OK); 161 $response->content_type('text/plain'); 162 $response->content("this is bonk"); 163 $bonk=1; 164 return RC_OK; 165} 166 167 168 169####################################### 170sub post_top 171{ 172 my($request, $response)=@_; 173 ok(($shutdown or (not $bonk and $request->is_error)), 174 "all but shutdown requests should be errors"); 175} 176 177####################################### 178sub post_shutdown 179{ 180 my($request, $response)=@_; 181 ok($shutdown, "we are after shutdown"); 182} 183 184####################################### 185sub shutdown 186{ 187 my ($request, $response) = @_; 188 DEBUG and warn "SHUTDOWN"; 189 $poe_kernel->post($aliases->{httpd} => 'shutdown'); 190 $poe_kernel->post($aliases->{tcp} => 'shutdown'); 191 192 $shutdown=1; 193 194 $response->code(RC_OK); 195 $response->content_type('text/plain'); 196 $response->content("going to shutdown"); 197 return RC_OK; 198} 199 200sub __peek 201{ 202 my($verbose)=@_; 203 my $api=POE::API::Peek->new(); 204 my @queue = $api->event_queue_dump(); 205 206 my $ret = "Event Queue:\n"; 207 208 foreach my $item (@queue) { 209 $ret .= "\t* ID: ". $item->{ID}." - Index: ".$item->{index}."\n"; 210 $ret .= "\t\tPriority: ".$item->{priority}."\n"; 211 $ret .= "\t\tEvent: ".$item->{event}."\n"; 212 213 if($verbose) { 214 $ret .= "\t\tSource: ". 215 $api->session_id_loggable($item->{source}). 216 "\n"; 217 $ret .= "\t\tDestination: ". 218 $api->session_id_loggable($item->{destination}). 219 "\n"; 220 $ret .= "\t\tType: ".$item->{type}."\n"; 221 $ret .= "\n"; 222 } 223 } 224 if($verbose) { 225 $ret.="Sessions: \n" if $api->session_count; 226 foreach my $session ($api->session_list) { 227 $ret.="\tSession ".$api->session_id_loggable($session)." ($session)"; 228 $ret.="\n\t\tref count: ".$api->get_session_refcount($session); 229 $ret.="\n"; 230 my $q=$api->get_session_extref_count($session); 231 $ret.="\t\textref count: $q\n" if $q; 232 $q=$api->session_handle_count($session); 233 $ret.="\t\thandle count: $q\n" if $q; 234 $q=join ',', $api->session_alias_list($session); 235 $ret.="\t\tAliases: $q\n" if $q; 236 } 237 } 238 $ret.="\n"; 239 240 $poe_kernel->sig_handled; 241 warn "$$: $ret"; 242 return; 243} 244