← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:09 2015

Filename/var/www/foswiki11/lib/Foswiki/Response.pm
StatementsExecuted 47 statements in 2.17ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
222140µs142µsFoswiki::Response::::bodyFoswiki::Response::body
11146µs46µsFoswiki::Response::::setDefaultHeadersFoswiki::Response::setDefaultHeaders
11142µs90µsFoswiki::Response::::printFoswiki::Response::print
11115µs32µsFoswiki::Response::::BEGIN@19Foswiki::Response::BEGIN@19
11113µs13µsFoswiki::Response::::newFoswiki::Response::new
11110µs16µsFoswiki::Response::::BEGIN@20Foswiki::Response::BEGIN@20
1119µs23µsFoswiki::Response::::BEGIN@21Foswiki::Response::BEGIN@21
1117µs7µsFoswiki::Response::::statusFoswiki::Response::status
1114µs4µsFoswiki::Response::::outputHasStartedFoswiki::Response::outputHasStarted
1114µs4µsFoswiki::Response::::BEGIN@23Foswiki::Response::BEGIN@23
0000s0sFoswiki::Response::::charsetFoswiki::Response::charset
0000s0sFoswiki::Response::::cookiesFoswiki::Response::cookies
0000s0sFoswiki::Response::::deleteHeaderFoswiki::Response::deleteHeader
0000s0sFoswiki::Response::::getHeaderFoswiki::Response::getHeader
0000s0sFoswiki::Response::::headerFoswiki::Response::header
0000s0sFoswiki::Response::::headersFoswiki::Response::headers
0000s0sFoswiki::Response::::printHeadersFoswiki::Response::printHeaders
0000s0sFoswiki::Response::::pushHeaderFoswiki::Response::pushHeader
0000s0sFoswiki::Response::::redirectFoswiki::Response::redirect
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# See bottom of file for license and copyright information
2
3=begin TML
4
5---+!! package Foswiki::Response
6
7Class to encapsulate response data.
8
9Fields:
10 * =status= - response status
11 * =headers= - hashref to response headers
12 * =body= - response body
13 * =cookies= - hashref to response cookies
14
15=cut
16
17package Foswiki::Response;
18
19232µs249µs
# spent 32µs (15+17) within Foswiki::Response::BEGIN@19 which was called: # once (15µs+17µs) by Foswiki::Engine::CLI::BEGIN@25 at line 19
use strict;
# spent 32µs making 1 call to Foswiki::Response::BEGIN@19 # spent 17µs making 1 call to strict::import
20228µs223µs
# spent 16µs (10+6) within Foswiki::Response::BEGIN@20 which was called: # once (10µs+6µs) by Foswiki::Engine::CLI::BEGIN@25 at line 20
use warnings;
# spent 16µs making 1 call to Foswiki::Response::BEGIN@20 # spent 6µs making 1 call to warnings::import
21226µs238µs
# spent 23µs (9+14) within Foswiki::Response::BEGIN@21 which was called: # once (9µs+14µs) by Foswiki::Engine::CLI::BEGIN@25 at line 21
use Assert;
# spent 23µs making 1 call to Foswiki::Response::BEGIN@21 # spent 14µs making 1 call to Assert::import
22
2321.81ms14µs
# spent 4µs within Foswiki::Response::BEGIN@23 which was called: # once (4µs+0s) by Foswiki::Engine::CLI::BEGIN@25 at line 23
use CGI::Util ();
# spent 4µs making 1 call to Foswiki::Response::BEGIN@23
24
25=begin TML
26
27---++ ClassMethod new() -> $response
28
29Constructs a Foswiki::Response object.
30
31=cut
32
33
# spent 13µs within Foswiki::Response::new which was called: # once (13µs+0s) by Foswiki::new at line 1724 of /var/www/foswiki11/lib/Foswiki.pm
sub new {
341600ns my $proto = shift;
351700ns my $class = ref($proto) || $proto;
3613µs my $this = {
37
38#status needs to default to 'unset' to the web server can set the status to whatever it needs (think basic auth, or other magics)
39 status => undef,
40 headers => {},
41 body => undef,
42 charset => 'ISO-8859-1',
43 cookies => [],
44 outputHasStarted => 0,
45 };
46
47111µs return bless $this, $class;
48}
49
50=begin TML
51
52---++ ObjectMethod status( $status ) -> $status
53
54Gets/Sets response status.
55 * =$status= is a three digit code, optionally followed by a status string
56
57=cut
58
59
# spent 7µs within Foswiki::Response::status which was called: # once (7µs+0s) by Foswiki::UI::__ANON__[/var/www/foswiki11/lib/Foswiki/UI.pm:318] at line 314 of /var/www/foswiki11/lib/Foswiki/UI.pm
sub status {
601900ns my ( $this, $status ) = @_;
611400ns if ($status) {
62 ASSERT( !$this->{outputHasStarted}, 'Too late to change status' )
63 if DEBUG;
64 $this->{status} = $status =~ /^\d{3}/ ? $status : undef;
65 }
6616µs return $this->{status};
67}
68
69=begin TML
70
71---++ ObjectMethod charset([$charset]) -> $charset
72
73Gets/Sets response charset. If not defined, defaults to ISO-8859-1,
74just like CGI.pm
75
76=cut
77
78sub charset {
79 return @_ == 1 ? $_[0]->{charset} : ( $_[0]->{charset} = $_[1] );
80}
81
82=begin TML
83
84---++ ObjectMethod header(-type => $type,
85 -status => $status,
86 -cookie => $cookie || \@cookies,
87 -attachment => $attachName,
88 -charset => $charset,
89 -expires => $expires,
90 -HeaderN => ValueN )
91
92Sets response header. Resonably compatible with CGI.
93Doesn't support -nph, -target and -p3p.
94
95=cut
96
97sub header {
98 my ( $this, @p ) = @_;
99 my (@header);
100
101 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' ) if DEBUG;
102
103 # Ugly hack to avoid html escape in CGI::Util::rearrange
104 local $CGI::Q = { escape => 0 };
105 my ( $type, $status, $cookie, $charset, $expires, @other ) =
106 CGI::Util::rearrange(
107 [
108 [ 'TYPE', 'CONTENT_TYPE', 'CONTENT-TYPE' ], 'STATUS',
109 [ 'COOKIE', 'COOKIES' ], 'CHARSET',
110 'EXPIRES',
111 ],
112 @p
113 );
114
115 if ( defined $charset ) {
116 $this->charset($charset);
117 }
118 else {
119 $charset = $this->charset;
120 }
121
122 foreach (@other) {
123
124 # Don't use \s because of perl bug 21951
125 next unless my ( $header, $value ) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
126
127 $header = lc($header);
128 $header =~ s/\b(\w)/\u$1/g;
129 if ( exists $this->{headers}->{$header} ) {
130 if ( ref $this->{headers}->{$header} ) {
131 push @{ $this->{headers}->{$header} }, $value;
132 }
133 else {
134 $this->{headers}->{$header} =
135 [ $this->{headers}->{$header}, $value ];
136 }
137 }
138 else {
139 $this->{headers}->{$header} = $value;
140 }
141 }
142
143 $type ||= 'text/html' unless defined($type);
144 $type .= "; charset=$charset"
145 if $type ne ''
146 and $type =~ m!^text/!
147 and $type !~ /\bcharset\b/
148 and $charset ne '';
149
150 if ($status) {
151 $this->{headers}->{Status} = $status;
152 $this->status($status);
153 }
154
155 # push all the cookies -- there may be several
156 if ($cookie) {
157 my @cookies = ref($cookie) eq 'ARRAY' ? @$cookie : ($cookie);
158 $this->cookies( \@cookies );
159 }
160 $this->{headers}->{Expires} = CGI::Util::expires( $expires, 'http' )
161 if ( defined $expires );
162 $this->{headers}->{Date} = CGI::Util::expires( 0, 'http' )
163 if defined $expires || $cookie;
164
165 $this->{headers}->{'Content-Type'} = $type if $type ne '';
166}
167
168=begin TML
169
170---++ ObjectMethod headers( { ... } ) -> $headersHashRef
171
172Gets/Sets all response headers. Keys are headers name and values
173are scalars for single-valued headers or arrayref for multivalued ones.
174
175=cut
176
177sub headers {
178 my ( $this, $hdr ) = @_;
179 if ($hdr) {
180 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' )
181 if DEBUG;
182 my %headers = ();
183 while ( my ( $key, $value ) = each %$hdr ) {
184 $key =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
185 $headers{$key} = $value;
186 }
187 $headers{Expires} = CGI::Util::expires( $headers{Expires}, 'http' )
188 if defined $headers{Expires};
189 $headers{Date} = CGI::Util::expires( 0, 'http' )
190 if defined $headers{'Set-Cookie'} || defined $headers{Expires};
191 if ( defined $headers{'Set-Cookie'} ) {
192 my @cookies =
193 ref( $headers{'Set-Cookie'} ) eq 'ARRAY'
194 ? @{ $headers{'Set-Cookie'} }
195 : ( $headers{'Set-Cookie'} );
196 $this->cookies( \@cookies );
197 }
198 $this->status( $headers{Status} ) if defined $headers{Status};
199 $this->{headers} = \%headers;
200 }
201 return $this->{headers};
202}
203
204=begin TML
205
206---++ ObjectMethod getHeader( [ $name ] ) -> $value
207
208If called without parameters returns all present header names,
209otherwise returns a list (maybe with a single element) of values
210associated with $name.
211
212=cut
213
214sub getHeader {
215 my ( $this, $hdr ) = @_;
216 return keys %{ $this->{headers} } unless $hdr;
217 $hdr =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
218 if ( exists $this->{headers}->{$hdr} ) {
219 my $value = $this->{headers}->{$hdr};
220 return ref $value ? @$value : ($value);
221 }
222 else {
223 return;
224 }
225}
226
227=begin TML
228
229---++ ObjectMethod setDefaultHeaders( { $name => $value, ... } )
230
231Sets the header corresponding to the key => value pairs passed in the
232hash, if the key doesn't already exist, otherwise does nothing.
233This ensures some default values are entered, but they can be overridden
234by plugins or other parts in the code.
235
236=cut
237
238
# spent 46µs within Foswiki::Response::setDefaultHeaders which was called: # once (46µs+0s) by Foswiki::generateHTTPHeaders at line 1038 of /var/www/foswiki11/lib/Foswiki.pm
sub setDefaultHeaders {
23911µs my ( $this, $hopt ) = @_;
24011µs return unless $hopt && keys %$hopt;
24116µs while ( my ( $hdr, $value ) = each %$hopt ) {
242320µs $hdr =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
24334µs unless ( exists $this->{headers}->{$hdr} ) {
24432µs if ( $hdr eq 'Status' ) {
245 $this->status($hdr);
246 }
247 elsif ( $hdr eq 'Expires' ) {
248 $value = CGI::Util::expires( $value, 'http' );
249 }
250 elsif ( $hdr eq 'Set-Cookie' ) {
251 my @cookies = ref($value) eq 'ARRAY' ? @$value : ($value);
252 $this->cookies( \@cookies );
253 }
25434µs $this->{headers}->{$hdr} = $value;
255 }
256 }
25718µs $this->{headers}{Date} = CGI::Util::expires( 0, 'http' )
258 if !exists $this->{headers}{Date}
259 && ( defined $this->{headers}{Expires}
260 || defined $this->{headers}{'Set-Cookie'} );
261}
262
263=begin TML
264
265---++ ObjectMethod printHeaders()
266
267Return a string of all headers, separated by CRLF
268
269=cut
270
271sub printHeaders {
272 my ($this) = shift;
273 my $CRLF = "\x0D\x0A";
274 my $hdr = '';
275
276 # make sure we always generate a status for the response
277 $this->{headers}->{Status} = $this->status()
278 if ( $this->status() && !defined( $this->headers->{Status} ) );
279 foreach my $header ( keys %{ $this->{headers} } ) {
280 $hdr .= $header . ': ' . $_ . $CRLF foreach $this->getHeader($header);
281 }
282 $hdr .= $CRLF;
283 return $hdr;
284}
285
286=begin TML
287
288---++ ObjectMethod deleteHeader($h1, $h2, ...)
289
290Deletes headers whose names are passed.
291
292=cut
293
294sub deleteHeader {
295 my $this = shift;
296
297 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' ) if DEBUG;
298
299 foreach (@_) {
300 ( my $hdr = $_ ) =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
301 delete $this->{headers}->{$hdr};
302 }
303}
304
305=begin TML
306
307---++ ObjectMethod pushHeader( $name, $value )
308
309Adds $value to list of values associated with header $name.
310
311=cut
312
313sub pushHeader {
314 my ( $this, $hdr, $value ) = @_;
315
316 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' ) if DEBUG;
317
318 $hdr =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
319 my $cur = $this->{headers}->{$hdr};
320 if ($cur) {
321 if ( ref $cur ) {
322 push @{ $this->{headers}->{$hdr} }, $value;
323 }
324 else {
325 $this->{headers}->{$hdr} = [ $cur, $value ];
326 }
327 }
328 else {
329 $this->{headers}->{$hdr} = $value;
330 }
331}
332
333=begin TML
334
335---++ ObjectMethod cookies( [ \@cookies ] ) -> @cookies
336
337Gets/Sets response cookies. Parameter, if passed, *must* be an arrayref.
338
339Elements may be CGI::Cookie objects or raw cookie strings.
340
341WARNING: cookies set this way are *not* passed in redirects.
342
343=cut
344
345sub cookies {
346 return @_ == 1 ? @{ $_[0]->{cookies} } : @{ $_[0]->{cookies} = $_[1] };
347}
348
349=begin TML
350
351---++ ObjectMethod body( [ $body ] ) -> $body
352
353Gets/Sets response body. Note: do not use this method for output, use
354=print= instead.
355
356=cut
357
358
# spent 142µs (140+2) within Foswiki::Response::body which was called 2 times, avg 71µs/call: # once (93µs+0s) by Foswiki::Engine::finalizeBody at line 378 of /var/www/foswiki11/lib/Foswiki/Engine.pm # once (46µs+2µs) by Foswiki::Response::print at line 418
sub body {
359215µs my ( $this, $body ) = @_;
36021µs if ( defined $body ) {
361
362 # There *is* a risk that a unicode string could reach this far - for
363 # example, if it comes from a plugin. We need to force such strings
364 # into the "Foswiki canonical" representation of a string of bytes.
365 # The output may be crap, but at least it won't trigger a
366 # "Wide character in print" error.
367110µs12µs if ( utf8::is_utf8($body) ) {
# spent 2µs making 1 call to utf8::is_utf8
368 require Encode;
369 $body = Encode::encode( 'iso-8859-1', $body, 0 );
370 }
37113µs $this->{headers}->{'Content-Length'} = length($body);
372116µs $this->{body} = $body;
373 }
3742102µs return $this->{body};
375}
376
377=begin TML
378
379---++ ObjectMethod redirect( $uri, $status, $cookies |
380 -Location => $uri,
381 -Status => $status,
382 -Cookies => $cookies )
383
384Populate object with redirect response headers.
385
386=$uri= *must* be passed. Others are optional.
387
388CGI Compatibility Note: It doesn't support -target or -nph
389
390=cut
391
392sub redirect {
393 my ( $this, @p ) = @_;
394 ASSERT( !$this->{outputHasStarted}, 'Too late to redirect' ) if DEBUG;
395 my ( $url, $status, $cookies ) = CGI::Util::rearrange(
396 [ [qw(LOCATION URL URI)], 'STATUS', [qw(COOKIE COOKIES)], ], @p );
397
398 return unless $url;
399 return if ( $status && $status !~ /^\s*3\d\d.*/ );
400
401 my @headers = ( -Location => $url );
402 push @headers, '-Status' => ( $status || 302 );
403 push @headers, '-Cookie' => $cookies if $cookies;
404 $this->header(@headers);
405}
406
407=begin TML
408
409---++ ObjectMethod print(...)
410
411Add content to the end of the body.
412
413=cut
414
415
# spent 90µs (42+48) within Foswiki::Response::print which was called: # once (42µs+48µs) by Foswiki::writeCompletePage at line 880 of /var/www/foswiki11/lib/Foswiki.pm
sub print {
4161500ns my $this = shift;
41712µs $this->{body} = '' unless defined $this->{body};
418140µs148µs $this->body( $this->{body} . join( '', @_ ) );
# spent 48µs making 1 call to Foswiki::Response::body
419}
420
421=begin TML
422
423---++ ObjectMethod outputHasStarted([$boolean])
424
425Get/set the output-has-started flag. This is used by the Foswiki::Engine
426to separate header and body output. Once output has started, the headers
427cannot be changed (though the body can be modified)
428
429=cut
430
431
# spent 4µs within Foswiki::Response::outputHasStarted which was called: # once (4µs+0s) by Foswiki::Engine::finalize at line 273 of /var/www/foswiki11/lib/Foswiki/Engine.pm
sub outputHasStarted {
43211µs my ( $this, $flag ) = @_;
4331200ns $this->{outputHasStarted} = $flag if defined $flag;
43415µs return $this->{outputHasStarted};
435}
436
43713µs1;
438__END__