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