File Coverage

blib/lib/POE/Component/FastCGI/Response.pm
Criterion Covered Total %
statement 18 66 27.2
branch 1 16 6.2
condition n/a
subroutine 5 16 31.2
pod 8 8 100.0
total 32 106 30.1


line stmt bran cond sub pod time code
1             package POE::Component::FastCGI::Response;
2             $POE::Component::FastCGI::Response::VERSION = '0.20';
3 3     3   57103 use strict;
  3         14  
  3         87  
4 3     3   15 use base qw/HTTP::Response/;
  3         4  
  3         1230  
5 3     3   30943 use bytes;
  3         26  
  3         14  
6              
7 3     3   1670 use POE::Kernel;
  3         100608  
  3         29  
8              
9             sub new {
10 3     3 1 7 my($class, $client, $id, $code, @response) = @_;
11 3 50       7 $code = 200 unless defined $code;
12              
13 3         12 my $response = $class->SUPER::new($code, @response);
14              
15 3         124 $response->{client} = $client;
16 3         5 $response->{requestid} = $id;
17              
18 3         6 return $response;
19             }
20              
21             sub DESTROY {
22 0     0     my($self) = @_;
23 0           $self->close;
24             }
25              
26             sub streaming {
27 0     0 1   my($self, $streaming) = @_;
28 0 0         if(defined $streaming) {
29 0           $self->{streaming} = $streaming;
30             }else{
31 0           return $self->{streaming};
32             }
33             }
34              
35             sub closed {
36 0     0 1   my($self, $callback) = @_;
37 0 0         if(defined $callback) {
    0          
38 0           $self->{closed} = $callback;
39             }elsif(defined $self->{closed}) {
40 0           $self->{closed}->($self);
41             }
42             }
43              
44             # Write and send call put() on the wheel. It is imperative that we
45             # do this from the wheel-owners session. Else we might register event
46             # handlers in the wrong sessions. For example, when we register the
47             # FlushedEvent event handler, that would be registered on the wrong
48             # session, and the wheel would never be closed properly.
49             sub send {
50 0     0 1   my($self) = @_;
51             $poe_kernel->call($self->request->{sessionid},
52 0           'w_send', $self);
53             }
54              
55             sub write {
56 0     0 1   my($self, $out) = @_;
57             $poe_kernel->call($self->request->{sessionid},
58 0           'w_write', $self, $out);
59 0           return 1;
60             }
61              
62             sub close {
63 0     0 1   my($self, $out) = @_;
64 0 0         return unless defined $self->{client};
65             $poe_kernel->call($self->request->{sessionid},
66 0           'w_close', $self, $out);
67             }
68              
69              
70             sub _send {
71 0     0     my($self) = @_;
72              
73             # Adapted from POE::Filter::HTTPD
74 0           my $status_line = "Status: " . $self->code;
75              
76             # Use network newlines, and be sure not to mangle newlines in the
77             # response's content.
78              
79 0           $self->header( "Content-Length" => length($self->content) );
80 0           my @headers;
81 0           push @headers, $status_line;
82 0           push @headers, $self->headers_as_string("\x0D\x0A");
83              
84 0           my $filter = $self->{client}->get_input_filter();
85 0           my $keepconn = $filter->{conn}->[$filter->{requestid}]->{keepconn};
86              
87             $self->{client}->put({
88             requestid => $self->{requestid},
89 0           close => !$keepconn,
90             content => join("\x0D\x0A", @headers, "") . $self->content
91             });
92              
93             ### FCGI_KEEP_CONN: disconnect after request if NOT set:
94 0 0         if($keepconn == 0) {
95 0           $self->{client}->event( FlushedEvent => "client_shutdown" );
96             }
97              
98             # Kill circular ref & delete wheel reference
99 0           $self->request->{_res} = 0;
100 0           delete $self->{client};
101 0           return 1;
102             }
103              
104             sub _write {
105 0     0     my($self, $out) = @_;
106 0           $self->{client}->put({requestid => $self->{requestid}, content => $out});
107             }
108              
109             sub _close {
110 0     0     my($self, $out) = @_;
111             $self->{client}->put({
112             requestid => $self->{requestid},
113 0           close => 1,
114             content => ""
115             });
116              
117             # Kill circular ref & delete wheel reference
118 0           $self->request->{_res} = 0;
119 0           delete $self->{client};
120 0           return 1;
121             }
122              
123             sub redirect {
124 0     0 1   my($self, $url, $uri) = @_;
125 0 0         $url = defined $self->request
126             ? URI->new_abs($url, $self->request->uri)
127             : $url;
128              
129 0           $self->code(302);
130 0           $self->header(Location => $url);
131             }
132              
133             sub error {
134 0     0 1   my($self, $code, $text) = @_;
135 0           $self->code($code);
136 0           $self->header("Content-type" => "text/html");
137 0 0         $self->content(defined $text ? $text : $self->error_as_HTML);
138 0           $self->send;
139             }
140              
141             1;
142              
143             =head1 NAME
144              
145             POE::Component::FastCGI::Response - PoCo::FastCGI HTTP Response class
146              
147             =head1 SYNOPSIS
148              
149             use POE::Component::FastCGI::Response;
150             my $response = POE::Component::FastCGI::Response->new($client, $id,
151             200, .. HTTP::Response parameters ..);
152              
153             =head1 DESCRIPTION
154              
155             This module is generally not used directly, you should call
156             L's C method which
157             returns an object of this class.
158              
159             C is a subclass of L
160             so inherits all of its methods. The includes C for setting output
161             headers and C for setting the content.
162              
163             Therefore the following methods mostly deal with actually sending the
164             response:
165              
166             =over 4
167              
168             =item $response = POE::Component::FastCGI::Response->new($client, $id, $code)
169              
170             Creates a new C object, parameters from
171             C<$code> onwards are passed directly to L's constructor.
172              
173             =item $response->streaming
174              
175             Set and check streaming status
176              
177             =item $response->closed
178              
179             Set a callback to be called when this response is closed, mainly useful for
180             streaming.
181              
182             =item $response->send
183              
184             Sends the response object and ends the current connection.
185              
186             =item $response->write($text)
187              
188             Writes some text directly to the output stream, for use when you don't want
189             to or can't send a L object.
190              
191             =item $response->close
192              
193             Closes the output stream.
194              
195             You don't normally need to use this as the object will automatically close
196             when DESTROYed.
197              
198             =item $response->redirect($url)
199              
200             Sets the object to be a redirect to $url. You still need to call C to
201             actually send the redirect.
202              
203             =item $response->error($code, $text)
204              
205             Sends an error to the client, $code is the HTTP error code and $text is
206             the content of the page to send.
207              
208             =back
209              
210             =head1 AUTHOR
211              
212             Copyright 2005, David Leadbeater L. All rights reserved.
213              
214             This library is free software; you can redistribute it and/or modify
215             it under the same terms as Perl itself.
216              
217             =head1 BUGS
218              
219             Please let me know.
220              
221             =head1 SEE ALSO
222              
223             L, L,
224             L, L.
225              
226             =cut