← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 18:42:36 2015
Reported on Fri Jul 31 18:48:13 2015

Filename/var/www/foswikidev/core/lib/Foswiki/Response.pm
StatementsExecuted 56 statements in 2.86ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
2221.08ms1.08msFoswiki::Response::::bodyFoswiki::Response::body
11142µs42µsFoswiki::Response::::setDefaultHeadersFoswiki::Response::setDefaultHeaders
11140µs89µsFoswiki::Response::::printFoswiki::Response::print
11122µs22µsFoswiki::Response::::pushHeaderFoswiki::Response::pushHeader
11113µs27µsFoswiki::Response::::BEGIN@19Foswiki::Response::BEGIN@19
11110µs10µsFoswiki::Response::::newFoswiki::Response::new
1118µs12µsFoswiki::Response::::BEGIN@20Foswiki::Response::BEGIN@20
1118µs31µsFoswiki::Response::::BEGIN@21Foswiki::Response::BEGIN@21
1114µs4µsFoswiki::Response::::statusFoswiki::Response::status
1114µs4µsFoswiki::Response::::outputHasStartedFoswiki::Response::outputHasStarted
1113µs3µsFoswiki::Response::::BEGIN@23Foswiki::Response::BEGIN@23
1113µs3µsFoswiki::Response::::BEGIN@25Foswiki::Response::BEGIN@25
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::::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
19226µs240µs
# spent 27µs (13+14) within Foswiki::Response::BEGIN@19 which was called: # once (13µs+14µs) by Foswiki::Engine::CLI::BEGIN@25 at line 19
use strict;
# spent 27µs making 1 call to Foswiki::Response::BEGIN@19 # spent 14µs making 1 call to strict::import
20222µs216µs
# spent 12µs (8+4) within Foswiki::Response::BEGIN@20 which was called: # once (8µs+4µs) by Foswiki::Engine::CLI::BEGIN@25 at line 20
use warnings;
# spent 12µs making 1 call to Foswiki::Response::BEGIN@20 # spent 4µs making 1 call to warnings::import
21224µs255µs
# spent 31µs (8+23) within Foswiki::Response::BEGIN@21 which was called: # once (8µs+23µs) by Foswiki::Engine::CLI::BEGIN@25 at line 21
use Assert;
# spent 31µs making 1 call to Foswiki::Response::BEGIN@21 # spent 24µs making 1 call to Exporter::import
22
23240µs13µs
# spent 3µs within Foswiki::Response::BEGIN@23 which was called: # once (3µs+0s) by Foswiki::Engine::CLI::BEGIN@25 at line 23
use CGI::Util ();
# spent 3µs making 1 call to Foswiki::Response::BEGIN@23
24
25
# spent 3µs within Foswiki::Response::BEGIN@25 which was called: # once (3µs+0s) by Foswiki::Engine::CLI::BEGIN@25 at line 30
BEGIN {
2614µs if ( $Foswiki::cfg{UseLocale} ) {
27 require locale;
28 import locale();
29 }
3011.53ms13µs}
# spent 3µs making 1 call to Foswiki::Response::BEGIN@25
31
32=begin TML
33
34---++ ClassMethod new() -> $response
35
36Constructs a Foswiki::Response object.
37
38=cut
39
40
# spent 10µs within Foswiki::Response::new which was called: # once (10µs+0s) by Foswiki::new at line 2071 of /var/www/foswikidev/core/lib/Foswiki.pm
sub new {
411600ns my $proto = shift;
421700ns my $class = ref($proto) || $proto;
4313µs my $this = {
44
45#status needs to default to 'unset' so the web server can set the status to whatever it needs (think basic auth, or other magics)
46 status => undef,
47 headers => {},
48 body => undef,
49 charset => 'utf-8',
50 cookies => [],
51 outputHasStarted => 0,
52 };
53
5417µs return bless $this, $class;
55}
56
57=begin TML
58
59---++ ObjectMethod status( $status ) -> $status
60
61Gets/Sets response status.
62 * =$status= is a three digit code, optionally followed by a status string
63
64=cut
65
66
# spent 4µs within Foswiki::Response::status which was called: # once (4µs+0s) by Foswiki::UI::__ANON__[/var/www/foswikidev/core/lib/Foswiki/UI.pm:376] at line 372 of /var/www/foswikidev/core/lib/Foswiki/UI.pm
sub status {
671900ns my ( $this, $status ) = @_;
681300ns if ($status) {
69 ASSERT( !$this->{outputHasStarted}, 'Too late to change status' )
70 if DEBUG;
71 $this->{status} = $status =~ m/^\d{3}/ ? $status : undef;
72 }
7314µs return $this->{status};
74}
75
76=begin TML
77
78---++ ObjectMethod charset([$charset]) -> $charset
79
80Gets/Sets response charset. If not defined, defaults to ISO-8859-1,
81just like CGI.pm
82
83=cut
84
85sub charset {
86 return @_ == 1 ? $_[0]->{charset} : ( $_[0]->{charset} = $_[1] );
87}
88
89=begin TML
90
91---++ ObjectMethod header(-type => $type,
92 -status => $status,
93 -cookie => $cookie || \@cookies,
94 -attachment => $attachName,
95 -charset => $charset,
96 -expires => $expires,
97 -HeaderN => ValueN )
98
99Sets response header. Resonably compatible with CGI.
100Doesn't support -nph, -target and -p3p.
101
102=cut
103
104sub header {
105 my ( $this, @p ) = @_;
106 my (@header);
107
108 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' ) if DEBUG;
109
110 # Ugly hack to avoid html escape in CGI::Util::rearrange
111 local $CGI::Q = { escape => 0 };
112
113 # SMELL: CGI::Util is documented as not having any public subroutines
114 my ( $type, $status, $cookie, $charset, $expires, @other ) =
115 CGI::Util::rearrange(
116 [
117 [ 'TYPE', 'CONTENT_TYPE', 'CONTENT-TYPE' ], 'STATUS',
118 [ 'COOKIE', 'COOKIES' ], 'CHARSET',
119 'EXPIRES',
120 ],
121 @p
122 );
123
124 if ( defined $charset ) {
125 $this->charset($charset);
126 }
127 else {
128 $charset = $this->charset;
129 }
130
131 foreach (@other) {
132
133 # Don't use \s because of perl bug 21951
134 next unless my ( $header, $value ) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
135
136 $header = lc($header);
137 $header =~ s/\b(\w)/\u$1/g;
138 if ( exists $this->{headers}->{$header} ) {
139 if ( ref $this->{headers}->{$header} ) {
140 push @{ $this->{headers}->{$header} }, $value;
141 }
142 else {
143 $this->{headers}->{$header} =
144 [ $this->{headers}->{$header}, $value ];
145 }
146 }
147 else {
148 $this->{headers}->{$header} = $value;
149 }
150 }
151
152 $type ||= 'text/html' unless defined($type);
153 $charset ||= 'utf-8';
154
155 $type .= "; charset=$charset"
156 if $type ne ''
157 and $type =~ m!^text/!
158 and $type !~ /\bcharset\b/
159 and $charset ne '';
160
161 if ($status) {
162 $this->{headers}->{Status} = $status;
163 $this->status($status);
164 }
165
166 # push all the cookies -- there may be several
167 if ($cookie) {
168 my @cookies = ref($cookie) eq 'ARRAY' ? @$cookie : ($cookie);
169 $this->cookies( \@cookies );
170 }
171 $this->{headers}->{Expires} = CGI::Util::expires( $expires, 'http' )
172 if ( defined $expires );
173 $this->{headers}->{Date} = CGI::Util::expires( 0, 'http' )
174 if defined $expires || $cookie;
175
176 $this->{headers}->{'Content-Type'} = $type if $type ne '';
177}
178
179=begin TML
180
181---++ ObjectMethod headers( { ... } ) -> $headersHashRef
182
183Gets/Sets all response headers. Keys are headers name and values
184are scalars for single-valued headers or arrayref for multivalued ones.
185
186=cut
187
188sub headers {
189 my ( $this, $hdr ) = @_;
190 if ($hdr) {
191 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' )
192 if DEBUG;
193 my %headers = ();
194 while ( my ( $key, $value ) = each %$hdr ) {
195 $key =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
196 $headers{$key} = $value;
197 }
198 $headers{Expires} = CGI::Util::expires( $headers{Expires}, 'http' )
199 if defined $headers{Expires};
200 $headers{Date} = CGI::Util::expires( 0, 'http' )
201 if defined $headers{'Set-Cookie'} || defined $headers{Expires};
202 if ( defined $headers{'Set-Cookie'} ) {
203 my @cookies =
204 ref( $headers{'Set-Cookie'} ) eq 'ARRAY'
205 ? @{ $headers{'Set-Cookie'} }
206 : ( $headers{'Set-Cookie'} );
207 $this->cookies( \@cookies );
208 }
209 $this->status( $headers{Status} ) if defined $headers{Status};
210 $this->{headers} = \%headers;
211 }
212 return $this->{headers};
213}
214
215=begin TML
216
217---++ ObjectMethod getHeader( [ $name ] ) -> $value
218
219If called without parameters returns all present header names,
220otherwise returns a list (maybe with a single element) of values
221associated with $name.
222
223=cut
224
225sub getHeader {
226 my ( $this, $hdr ) = @_;
227 return keys %{ $this->{headers} } unless $hdr;
228 $hdr =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
229 if ( exists $this->{headers}->{$hdr} ) {
230 my $value = $this->{headers}->{$hdr};
231 return ref $value ? @$value : ($value);
232 }
233 else {
234 return;
235 }
236}
237
238=begin TML
239
240---++ ObjectMethod setDefaultHeaders( { $name => $value, ... } )
241
242Sets the header corresponding to the key => value pairs passed in the
243hash, if the key doesn't already exist, otherwise does nothing.
244This ensures some default values are entered, but they can be overridden
245by plugins or other parts in the code.
246
247=cut
248
249
# spent 42µs within Foswiki::Response::setDefaultHeaders which was called: # once (42µs+0s) by Foswiki::generateHTTPHeaders at line 1100 of /var/www/foswikidev/core/lib/Foswiki.pm
sub setDefaultHeaders {
25011µs my ( $this, $hopt ) = @_;
2511900ns return unless $hopt && keys %$hopt;
25217µs while ( my ( $hdr, $value ) = each %$hopt ) {
253420µs $hdr =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
25443µs unless ( exists $this->{headers}->{$hdr} ) {
25542µs if ( $hdr eq 'Status' ) {
256 $this->status($value);
257 }
258 elsif ( $hdr eq 'Expires' ) {
259 $value = CGI::Util::expires( $value, 'http' );
260 }
261 elsif ( $hdr eq 'Set-Cookie' ) {
262 my @cookies = ref($value) eq 'ARRAY' ? @$value : ($value);
263 $this->cookies( \@cookies );
264 }
26544µs $this->{headers}->{$hdr} = $value;
266 }
267 }
26816µs $this->{headers}{Date} = CGI::Util::expires( 0, 'http' )
269 if !exists $this->{headers}{Date}
270 && ( defined $this->{headers}{Expires}
271 || defined $this->{headers}{'Set-Cookie'} );
272}
273
274=begin TML
275
276---++ ObjectMethod printHeaders()
277
278Return a string of all headers, encoded as UTF8 and separated by CRLF
279
280=cut
281
282sub printHeaders {
283 my ($this) = shift;
284 my $CRLF = "\x0D\x0A";
285 my $hdr = '';
286
287 # make sure we always generate a status for the response
288 $this->{headers}->{Status} = $this->status()
289 if ( $this->status() && !defined( $this->headers->{Status} ) );
290 foreach my $header ( keys %{ $this->{headers} } ) {
291 $hdr .= $header . ': ' . Foswiki::encode_utf8($_) . $CRLF
292 foreach $this->getHeader($header);
293 }
294 $hdr .= $CRLF;
295 return $hdr;
296}
297
298=begin TML
299
300---++ ObjectMethod deleteHeader($h1, $h2, ...)
301
302Deletes headers whose names are passed.
303
304=cut
305
306sub deleteHeader {
307 my $this = shift;
308
309 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' ) if DEBUG;
310
311 foreach (@_) {
312 ( my $hdr = $_ ) =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
313 delete $this->{headers}->{$hdr};
314 }
315}
316
317=begin TML
318
319---++ ObjectMethod pushHeader( $name, $value )
320
321Adds $value to list of values associated with header $name.
322
323=cut
324
325
# spent 22µs within Foswiki::Response::pushHeader which was called: # once (22µs+0s) by Foswiki::writeCompletePage at line 790 of /var/www/foswikidev/core/lib/Foswiki.pm
sub pushHeader {
32611µs my ( $this, $hdr, $value ) = @_;
327
328 ASSERT( !$this->{outputHasStarted}, 'Too late to change headers' ) if DEBUG;
329
330112µs $hdr =~ s/(?:^|(?<=-))(.)([^-]*)/\u$1\L$2\E/g;
33112µs my $cur = $this->{headers}->{$hdr};
33216µs if ($cur) {
333 if ( ref $cur ) {
334 push @{ $this->{headers}->{$hdr} }, $value;
335 }
336 else {
337 $this->{headers}->{$hdr} = [ $cur, $value ];
338 }
339 }
340 else {
34112µs $this->{headers}->{$hdr} = $value;
342 }
343}
344
345=begin TML
346
347---++ ObjectMethod cookies( [ \@cookies ] ) -> @cookies
348
349Gets/Sets response cookies. Parameter, if passed, *must* be an arrayref.
350
351Elements may be CGI::Cookie objects or raw cookie strings.
352
353WARNING: cookies set this way are *not* passed in redirects.
354
355=cut
356
357sub cookies {
358 return @_ == 1 ? @{ $_[0]->{cookies} } : @{ $_[0]->{cookies} = $_[1] };
359}
360
361=begin TML
362
363---++ ObjectMethod body( [ $body ] ) -> $body
364
365Gets/Sets response body. Note that =$body= must be a byte string.
366Replaces the entire body; if you want to generate the body incrementally,
367use =print= instead.
368
369Note that the =$body= returned is a byte string (utf8 encoded if =print=
370was used to create it)
371
372=cut
373
374
# spent 1.08ms within Foswiki::Response::body which was called 2 times, avg 538µs/call: # once (1.05ms+0s) by Foswiki::Engine::finalizeBody at line 418 of /var/www/foswikidev/core/lib/Foswiki/Engine.pm # once (24µs+0s) by Foswiki::Response::print at line 430
sub body {
375211µs my ( $this, $body ) = @_;
37621µs if ( defined $body ) {
37712µs $this->{headers}->{'Content-Length'} = length($body);
37819µs $this->{body} = $body;
379 }
38021.06ms return $this->{body};
381}
382
383=begin TML
384
385---++ ObjectMethod redirect( $uri, $status, $cookies |
386 -Location => $uri,
387 -Status => $status,
388 -Cookies => $cookies )
389
390Populate object with redirect response headers.
391
392=$uri= *must* be passed. Others are optional.
393
394CGI Compatibility Note: It doesn't support -target or -nph
395
396=cut
397
398sub redirect {
399 my ( $this, @p ) = @_;
400 ASSERT( !$this->{outputHasStarted}, 'Too late to redirect' ) if DEBUG;
401 my ( $url, $status, $cookies ) = CGI::Util::rearrange(
402 [ [qw(LOCATION URL URI)], 'STATUS', [qw(COOKIE COOKIES)], ], @p );
403
404 return unless $url;
405
406 $status = 302 unless $status;
407 ASSERT(
408 $status =~ m/^30\d( [^\r\n]*)?$/,
409 "Not a valid redirect status: '$status'"
410 ) if DEBUG;
411 return if ( $status && $status !~ /^\s*3\d\d.*/ );
412
413 my @headers = ( -Location => $url );
414 push @headers, '-Status' => $status;
415 push @headers, '-Cookie' => $cookies if $cookies;
416 $this->header(@headers);
417}
418
419=begin TML
420
421---++ ObjectMethod print(...)
422
423Add text content to the end of the body. Content may be unicode.
424
425=cut
426
427
# spent 89µs (40+49) within Foswiki::Response::print which was called: # once (40µs+49µs) by Foswiki::writeCompletePage at line 832 of /var/www/foswikidev/core/lib/Foswiki.pm
sub print {
4281600ns my $this = shift;
42912µs $this->{body} = '' unless defined $this->{body};
430136µs249µs $this->body( $this->{body} . Foswiki::encode_utf8( join( '', @_ ) ) );
# spent 25µs making 1 call to Encode::encode_utf8 # spent 24µs making 1 call to Foswiki::Response::body
431}
432
433=begin TML
434
435---++ ObjectMethod outputHasStarted([$boolean])
436
437Get/set the output-has-started flag. This is used by the Foswiki::Engine
438to separate header and body output. Once output has started, the headers
439cannot be changed (though the body can be modified)
440
441=cut
442
443
# spent 4µs within Foswiki::Response::outputHasStarted which was called: # once (4µs+0s) by Foswiki::Engine::finalize at line 313 of /var/www/foswikidev/core/lib/Foswiki/Engine.pm
sub outputHasStarted {
4441900ns my ( $this, $flag ) = @_;
4451200ns $this->{outputHasStarted} = $flag if defined $flag;
44615µs return $this->{outputHasStarted};
447}
448
44912µs1;
450__END__