← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:53 2010

File /project/perl/lib/HTTP/Message.pm
Statements Executed 35123
Statement Execution Time 477ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
414953136ms136msHTTP::Message::::_elemHTTP::Message::_elem
9222257.5ms86.9msHTTP::Message::::newHTTP::Message::new
4611122.8ms22.8msHTTP::Message::::content_refHTTP::Message::content_ref
4611120.5ms20.5msHTTP::Message::::contentHTTP::Message::content
4611112.3ms26.4msHTTP::Message::::protocolHTTP::Message::protocol
461116.25ms6.25msHTTP::Message::::headersHTTP::Message::headers
553905µs905µsHTTP::Message::::AUTOLOADHTTP::Message::AUTOLOAD
711334µs334µsHTTP::Message::::add_contentHTTP::Message::add_content
11222µs22µsHTTP::Message::::CORE:matchHTTP::Message::CORE:match (opcode)
0000s0sHTTP::Message::::BEGINHTTP::Message::BEGIN
0000s0sHTTP::Message::::_boundaryHTTP::Message::_boundary
0000s0sHTTP::Message::::_contentHTTP::Message::_content
0000s0sHTTP::Message::::_partsHTTP::Message::_parts
0000s0sHTTP::Message::::_set_contentHTTP::Message::_set_content
0000s0sHTTP::Message::::_stale_contentHTTP::Message::_stale_content
0000s0sHTTP::Message::::add_partHTTP::Message::add_part
0000s0sHTTP::Message::::as_stringHTTP::Message::as_string
0000s0sHTTP::Message::::clearHTTP::Message::clear
0000s0sHTTP::Message::::cloneHTTP::Message::clone
0000s0sHTTP::Message::::decoded_contentHTTP::Message::decoded_content
0000s0sHTTP::Message::::headers_as_stringHTTP::Message::headers_as_string
0000s0sHTTP::Message::::parseHTTP::Message::parse
0000s0sHTTP::Message::::partsHTTP::Message::parts
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package HTTP::Message;
2
3# $Id: Message.pm,v 1.57 2005/02/18 20:29:01 gisle Exp $
4
53104µs125µsuse strict;
# spent 25µs making 1 call to strict::import
634.27ms1222µsuse vars qw($VERSION $AUTOLOAD);
# spent 222µs making 1 call to vars::import
7166µs122µs$VERSION = sprintf("%d.%02d", q$Revision: 1.57 $ =~ /(\d+)\.(\d+)/);
# spent 22µs making 1 call to HTTP::Message::CORE:match
8
91268µsrequire HTTP::Headers;
1017µsrequire Carp;
11
1216µsmy $CRLF = "\015\012"; # "\r\n" is not portable
1318µs$HTTP::URI_CLASS ||= $ENV{PERL_HTTP_URI_CLASS} || "URI";
1428.64mseval "require $HTTP::URI_CLASS"; die $@ if $@;
15
16
17
18sub new
19
# spent 86.9ms (57.5+29.4) within HTTP::Message::new which was called 922 times, avg 94µs/call: # 461 times (29.1ms+14.8ms) by HTTP::Response::new at line 17 of HTTP/Response.pm, avg 95µs/call # 461 times (28.4ms+14.7ms) by HTTP::Request::new at line 16 of HTTP/Request.pm, avg 93µs/call
{
20368837.5ms my($class, $header, $content) = @_;
2192217.2ms if (defined $header) {
22 Carp::croak("Bad header argument") unless ref $header;
23 if (ref($header) eq "ARRAY") {
24 $header = HTTP::Headers->new(@$header);
25 }
26 else {
27 $header = $header->clone;
28 }
29 }
30 else {
31 $header = HTTP::Headers->new;
# spent 29.4ms making 922 calls to HTTP::Headers::new, avg 32µs/call
32 }
33 $content = '' unless defined $content;
34
35 bless {
36 '_headers' => $header,
37 '_content' => $content,
38 }, $class;
39}
40
41
42sub parse
43{
44 my($class, $str) = @_;
45
46 my @hdr;
47 while (1) {
48 if ($str =~ s/^([^\s:]+)[ \t]*: ?(.*)\n?//) {
49 push(@hdr, $1, $2);
50 $hdr[-1] =~ s/\r\z//;
51 }
52 elsif (@hdr && $str =~ s/^([ \t].*)\n?//) {
53 $hdr[-1] .= "\n$1";
54 $hdr[-1] =~ s/\r\z//;
55 }
56 else {
57 $str =~ s/^\r?\n//;
58 last;
59 }
60 }
61
62 new($class, \@hdr, $str);
63}
64
65
66sub clone
67{
68 my $self = shift;
69 my $clone = HTTP::Message->new($self->headers,
70 $self->content);
71 $clone->protocol($self->protocol);
72 $clone;
73}
74
75
76sub clear {
77 my $self = shift;
78 $self->{_headers}->clear;
79 $self->content("");
80 delete $self->{_parts};
81 return;
82}
83
84
8546110.8ms46114.2ms
# spent 26.4ms (12.3+14.2) within HTTP::Message::protocol which was called 461 times, avg 57µs/call: # 461 times (12.3ms+14.2ms) by LWP::Protocol::http::request at line 320 of LWP/Protocol/http.pm, avg 57µs/call
sub protocol { shift->_elem('_protocol', @_); }
# spent 14.2ms making 461 calls to HTTP::Message::_elem, avg 31µs/call
86
87
# spent 20.5ms within HTTP::Message::content which was called 461 times, avg 44µs/call: # 461 times (20.5ms+0s) by WWW::Google::PageRank::get at line 37 of WWW/Google/PageRank.pm, avg 44µs/call
sub content {
88
899224.47ms my $self = $_[0];
90230516.7ms if (defined(wantarray)) {
91 $self->_content unless exists $self->{_content};
92 my $old = $self->{_content};
93 $old = $$old if ref($old) eq "SCALAR";
94 &_set_content if @_ > 1;
95 return $old;
96 }
97
98 if (@_ > 1) {
99 &_set_content;
100 }
101 else {
102 Carp::carp("Useless content call in void context") if $^W;
103 }
104}
105
106sub _set_content {
107 my $self = $_[0];
108 if (!ref($_[1]) && ref($self->{_content}) eq "SCALAR") {
109 ${$self->{_content}} = $_[1];
110 }
111 else {
112 die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";
113 $self->{_content} = $_[1];
114 delete $self->{_content_ref};
115 }
116 delete $self->{_parts} unless $_[2];
117}
118
119
120sub add_content
121
# spent 334µs within HTTP::Message::add_content which was called 7 times, avg 48µs/call: # 7 times (334µs+0s) by LWP::Protocol::collect at line 117 of LWP/Protocol.pm, avg 48µs/call
{
12249351µs my $self = shift;
123 $self->_content unless exists $self->{_content};
124 my $chunkref = \$_[0];
125 $chunkref = $$chunkref if ref($$chunkref); # legacy
126
127 my $ref = ref($self->{_content});
128 if (!$ref) {
129 $self->{_content} .= $$chunkref;
130 }
131 elsif ($ref eq "SCALAR") {
132 ${$self->{_content}} .= $$chunkref;
133 }
134 else {
135 Carp::croak("Can't append to $ref content");
136 }
137 delete $self->{_parts};
138}
139
140
141sub content_ref
142
# spent 22.8ms within HTTP::Message::content_ref which was called 461 times, avg 50µs/call: # 461 times (22.8ms+0s) by LWP::Protocol::http::request at line 168 of LWP/Protocol/http.pm, avg 50µs/call
{
143368823.5ms my $self = shift;
144 $self->_content unless exists $self->{_content};
145 delete $self->{_parts};
146 my $old = \$self->{_content};
147 my $old_cref = $self->{_content_ref};
148 if (@_) {
149 my $new = shift;
150 Carp::croak("Setting content_ref to a non-ref") unless ref($new);
151 delete $self->{_content}; # avoid modifying $$old
152 $self->{_content} = $new;
153 $self->{_content_ref}++;
154 }
155 $old = $$old if $old_cref;
156 return $old;
157}
158
159
160sub decoded_content
161{
162 my($self, %opt) = @_;
163 my $content_ref;
164 my $content_ref_iscopy;
165
166 eval {
167
168 require HTTP::Headers::Util;
169 my($ct, %ct_param);
170 if (my @ct = HTTP::Headers::Util::split_header_words($self->header("Content-Type"))) {
171 ($ct, undef, %ct_param) = @{$ct[-1]};
172 $ct = lc($ct);
173
174 die "Can't decode multipart content" if $ct =~ m,^multipart/,;
175 }
176
177 $content_ref = $self->content_ref;
178 die "Can't decode ref content" if ref($content_ref) ne "SCALAR";
179
180 if (my $h = $self->header("Content-Encoding")) {
181 $h =~ s/^\s+//;
182 $h =~ s/\s+$//;
183 for my $ce (reverse split(/\s*,\s*/, lc($h))) {
184 next unless $ce || $ce eq "identity";
185 if ($ce eq "gzip" || $ce eq "x-gzip") {
186 require Compress::Zlib;
187 unless ($content_ref_iscopy) {
188 # memGunzip is documented to destroy its buffer argument
189 my $copy = $$content_ref;
190 $content_ref = \$copy;
191 $content_ref_iscopy++;
192 }
193 $content_ref = \Compress::Zlib::memGunzip($$content_ref);
194 die "Can't gunzip content" unless defined $$content_ref;
195 }
196 elsif ($ce eq "x-bzip2") {
197 require Compress::Bzip2;
198 $content_ref = Compress::Bzip2::decompress($$content_ref);
199 die "Can't bunzip content" unless defined $$content_ref;
200 $content_ref_iscopy++;
201 }
202 elsif ($ce eq "deflate") {
203 require Compress::Zlib;
204 my $out = Compress::Zlib::uncompress($$content_ref);
205 unless (defined $out) {
206 # "Content-Encoding: deflate" is supposed to mean the "zlib"
207 # format of RFC 1950, but Microsoft got that wrong, so some
208 # servers sends the raw compressed "deflate" data. This
209 # tries to inflate this format.
210 unless ($content_ref_iscopy) {
211 # the $i->inflate method is documented to destroy its
212 # buffer argument
213 my $copy = $$content_ref;
214 $content_ref = \$copy;
215 $content_ref_iscopy++;
216 }
217
218 my($i, $status) = Compress::Zlib::inflateInit(
219 WindowBits => -Compress::Zlib::MAX_WBITS(),
220 );
221 my $OK = Compress::Zlib::Z_OK();
222 die "Can't init inflate object" unless $i && $status == $OK;
223 ($out, $status) = $i->inflate($content_ref);
224 if ($status != Compress::Zlib::Z_STREAM_END()) {
225 if ($status == $OK) {
226 $self->push_header("Client-Warning" =>
227 "Content might be truncated; incomplete deflate stream");
228 }
229 else {
230 # something went bad, can't trust $out any more
231 $out = undef;
232 }
233 }
234 }
235 die "Can't inflate content" unless defined $out;
236 $content_ref = \$out;
237 $content_ref_iscopy++;
238 }
239 elsif ($ce eq "compress" || $ce eq "x-compress") {
240 die "Can't uncompress content";
241 }
242 elsif ($ce eq "base64") { # not really C-T-E, but should be harmless
243 require MIME::Base64;
244 $content_ref = \MIME::Base64::decode($$content_ref);
245 $content_ref_iscopy++;
246 }
247 elsif ($ce eq "quoted-printable") { # not really C-T-E, but should be harmless
248 require MIME::QuotedPrint;
249 $content_ref = \MIME::QuotedPrint::decode($$content_ref);
250 $content_ref_iscopy++;
251 }
252 else {
253 die "Don't know how to decode Content-Encoding '$ce'";
254 }
255 }
256 }
257
258 if ($ct && $ct =~ m,^text/,,) {
259 my $charset = $opt{charset} || $ct_param{charset} || $opt{default_charset} || "ISO-8859-1";
260 $charset = lc($charset);
261 if ($charset ne "none") {
262 require Encode;
263 if (do{my $v = $Encode::VERSION; $v =~ s/_//g; $v} < 2.0901 &&
264 !$content_ref_iscopy)
265 {
266 # LEAVE_SRC did not work before Encode-2.0901
267 my $copy = $$content_ref;
268 $content_ref = \$copy;
269 $content_ref_iscopy++;
270 }
271 $content_ref = \Encode::decode($charset, $$content_ref,
272 Encode::FB_CROAK() | Encode::LEAVE_SRC());
273 }
274 }
275 };
276 if ($@) {
277 Carp::croak($@) if $opt{raise_error};
278 return undef;
279 }
280
281 return $opt{ref} ? $content_ref : $$content_ref;
282}
283
284
285sub as_string
286{
287 my($self, $eol) = @_;
288 $eol = "\n" unless defined $eol;
289
290 # The calculation of content might update the headers
291 # so we need to do that first.
292 my $content = $self->content;
293
294 return join("", $self->{'_headers'}->as_string($eol),
295 $eol,
296 $content,
297 (@_ == 1 && length($content) &&
298 $content !~ /\n\z/) ? "\n" : "",
299 );
300}
301
302
3034617.14ms
# spent 6.25ms within HTTP::Message::headers which was called 461 times, avg 14µs/call: # 461 times (6.25ms+0s) by LWP::Protocol::http::request at line 158 of LWP/Protocol/http.pm, avg 14µs/call
sub headers { shift->{'_headers'}; }
304sub headers_as_string { shift->{'_headers'}->as_string(@_); }
305
306
307sub parts {
308 my $self = shift;
309 if (defined(wantarray) && (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR")) {
310 $self->_parts;
311 }
312 my $old = $self->{_parts};
313 if (@_) {
314 my @parts = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
315 my $ct = $self->content_type || "";
316 if ($ct =~ m,^message/,) {
317 Carp::croak("Only one part allowed for $ct content")
318 if @parts > 1;
319 }
320 elsif ($ct !~ m,^multipart/,) {
321 $self->remove_content_headers;
322 $self->content_type("multipart/mixed");
323 }
324 $self->{_parts} = \@parts;
325 _stale_content($self);
326 }
327 return @$old if wantarray;
328 return $old->[0];
329}
330
331sub add_part {
332 my $self = shift;
333 if (($self->content_type || "") !~ m,^multipart/,) {
334 my $p = HTTP::Message->new($self->remove_content_headers,
335 $self->content(""));
336 $self->content_type("multipart/mixed");
337 $self->{_parts} = [$p];
338 }
339 elsif (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR") {
340 $self->_parts;
341 }
342
343 push(@{$self->{_parts}}, @_);
344 _stale_content($self);
345 return;
346}
347
348sub _stale_content {
349 my $self = shift;
350 if (ref($self->{_content}) eq "SCALAR") {
351 # must recalculate now
352 $self->_content;
353 }
354 else {
355 # just invalidate cache
356 delete $self->{_content};
357 delete $self->{_content_ref};
358 }
359}
360
361
362# delegate all other method calls the the _headers object.
363sub AUTOLOAD
364
# spent 905µs within HTTP::Message::AUTOLOAD which was called 5 times, avg 181µs/call: # once (197µs+0s) by LWP::Protocol::http::_get_sock_info at line 75 of LWP/Protocol/http.pm # once (185µs+0s) by LWP::UserAgent::prepare_request at line 248 of LWP/UserAgent.pm # once (183µs+0s) by LWP::Protocol::http::request at line 323 of LWP/Protocol/http.pm # once (183µs+0s) by LWP::Protocol::collect at line 104 of LWP/Protocol.pm # once (157µs+0s) by LWP::Protocol::http::request at line 335 of LWP/Protocol/http.pm
{
365186413.2ms my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
366 return if $method eq "DESTROY";
367
368 # We create the function here so that it will not need to be
369 # autoloaded the next time.
37031.69ms1130µs no strict 'refs';
# spent 130µs making 1 call to strict::unimport
3711181ms73691.13s *$method = eval "sub { shift->{'_headers'}->$method(\@_) }";
# spent 731ms making 5064 calls to HTTP::Headers::push_header, avg 144µs/call # spent 204ms making 922 calls to HTTP::Headers::header, avg 222µs/call # spent 88.5ms making 461 calls to HTTP::Headers::content_type, avg 192µs/call # spent 74.2ms making 461 calls to HTTP::Headers::init_header, avg 161µs/call # spent 35.7ms making 461 calls to HTTP::Headers::remove_header, avg 78µs/call
372 goto &$method;
# spent 1.10ms making 5 calls to HTTP::Message::__ANON__[(eval 0)[HTTP/Message.pm:371]:1], avg 221µs/call
373}
374
375
376# Private method to access members in %$self
377sub _elem
378
# spent 136ms within HTTP::Message::_elem which was called 4149 times, avg 33µs/call: # 1383 times (44.5ms+0s) by HTTP::Request::method at line 56 of HTTP/Request.pm, avg 32µs/call # 922 times (33.1ms+0s) by HTTP::Response::request at line 66 of HTTP/Response.pm, avg 36µs/call # 922 times (30.1ms+0s) by HTTP::Response::code at line 63 of HTTP/Response.pm, avg 33µs/call # 461 times (14.2ms+0s) by HTTP::Message::protocol at line 85, avg 31µs/call # 461 times (14.0ms+0s) by HTTP::Response::message at line 64 of HTTP/Response.pm, avg 30µs/call
{
37920745150ms my $self = shift;
380 my $elem = shift;
381 my $old = $self->{$elem};
382 $self->{$elem} = $_[0] if @_;
383 return $old;
384}
385
386
387# Create private _parts attribute from current _content
388sub _parts {
389 my $self = shift;
390 my $ct = $self->content_type;
391 if ($ct =~ m,^multipart/,) {
392 require HTTP::Headers::Util;
393 my @h = HTTP::Headers::Util::split_header_words($self->header("Content-Type"));
394 die "Assert" unless @h;
395 my %h = @{$h[0]};
396 if (defined(my $b = $h{boundary})) {
397 my $str = $self->content;
398 $str =~ s/\r?\n--\Q$b\E--\r?\n.*//s;
399 if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) {
400 $self->{_parts} = [map HTTP::Message->parse($_),
401 split(/\r?\n--\Q$b\E\r?\n/, $str)]
402 }
403 }
404 }
405 elsif ($ct eq "message/http") {
406 require HTTP::Request;
407 require HTTP::Response;
408 my $content = $self->content;
409 my $class = ($content =~ m,^(HTTP/.*)\n,) ?
410 "HTTP::Response" : "HTTP::Request";
411 $self->{_parts} = [$class->parse($content)];
412 }
413 elsif ($ct =~ m,^message/,) {
414 $self->{_parts} = [ HTTP::Message->parse($self->content) ];
415 }
416
417 $self->{_parts} ||= [];
418}
419
420
421# Create private _content attribute from current _parts
422sub _content {
423 my $self = shift;
424 my $ct = $self->header("Content-Type") || "multipart/mixed";
425 if ($ct =~ m,^\s*message/,i) {
426 _set_content($self, $self->{_parts}[0]->as_string($CRLF), 1);
427 return;
428 }
429
430 require HTTP::Headers::Util;
431 my @v = HTTP::Headers::Util::split_header_words($ct);
432 Carp::carp("Multiple Content-Type headers") if @v > 1;
433 @v = @{$v[0]};
434
435 my $boundary;
436 my $boundary_index;
437 for (my @tmp = @v; @tmp;) {
438 my($k, $v) = splice(@tmp, 0, 2);
439 if (lc($k) eq "boundary") {
440 $boundary = $v;
441 $boundary_index = @v - @tmp - 1;
442 last;
443 }
444 }
445
446 my @parts = map $_->as_string($CRLF), @{$self->{_parts}};
447
448 my $bno = 0;
449 $boundary = _boundary() unless defined $boundary;
450 CHECK_BOUNDARY:
451 {
452 for (@parts) {
453 if (index($_, $boundary) >= 0) {
454 # must have a better boundary
455 $boundary = _boundary(++$bno);
456 redo CHECK_BOUNDARY;
457 }
458 }
459 }
460
461 if ($boundary_index) {
462 $v[$boundary_index] = $boundary;
463 }
464 else {
465 push(@v, boundary => $boundary);
466 }
467
468 $ct = HTTP::Headers::Util::join_header_words(@v);
469 $self->header("Content-Type", $ct);
470
471 _set_content($self, "--$boundary$CRLF" .
472 join("$CRLF--$boundary$CRLF", @parts) .
473 "$CRLF--$boundary--$CRLF",
474 1);
475}
476
477
478sub _boundary
479{
480 my $size = shift || return "xYzZY";
481 require MIME::Base64;
482 my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
483 $b =~ s/[\W]/X/g; # ensure alnum only
484 $b;
485}
486
487
488125µs1;
489
490
491__END__
492
493=head1 NAME
494
495HTTP::Message - HTTP style message (base class)
496
497=head1 SYNOPSIS
498
499 use base 'HTTP::Message';
500
501=head1 DESCRIPTION
502
503An C<HTTP::Message> object contains some headers and a content body.
504The following methods are available:
505
506=over 4
507
508=item $mess = HTTP::Message->new
509
510=item $mess = HTTP::Message->new( $headers )
511
512=item $mess = HTTP::Message->new( $headers, $content )
513
514This constructs a new message object. Normally you would want
515construct C<HTTP::Request> or C<HTTP::Response> objects instead.
516
517The optional $header argument should be a reference to an
518C<HTTP::Headers> object or a plain array reference of key/value pairs.
519If an C<HTTP::Headers> object is provided then a copy of it will be
520embedded into the constructed message, i.e. it will not be owned and
521can be modified afterwards without affecting the message.
522
523The optional $content argument should be a string of bytes.
524
525=item $mess = HTTP::Message->parse( $str )
526
527This constructs a new message object by parsing the given string.
528
529=item $mess->headers
530
531Returns the embedded C<HTTP::Headers> object.
532
533=item $mess->headers_as_string
534
535=item $mess->headers_as_string( $eol )
536
537Call the as_string() method for the headers in the
538message. This will be the same as
539
540 $mess->headers->as_string
541
542but it will make your program a whole character shorter :-)
543
544=item $mess->content
545
546=item $mess->content( $content )
547
548The content() method sets the raw content if an argument is given. If no
549argument is given the content is not touched. In either case the
550original raw content is returned.
551
552Note that the content should be a string of bytes. Strings in perl
553can contain characters outside the range of a byte. The C<Encode>
554module can be used to turn such strings into a string of bytes.
555
556=item $mess->add_content( $data )
557
558The add_content() methods appends more data to the end of the current
559content buffer.
560
561=item $mess->content_ref
562
563=item $mess->content_ref( \$content )
564
565The content_ref() method will return a reference to content buffer string.
566It can be more efficient to access the content this way if the content
567is huge, and it can even be used for direct manipulation of the content,
568for instance:
569
570 ${$res->content_ref} =~ s/\bfoo\b/bar/g;
571
572This example would modify the content buffer in-place.
573
574If an argument is passed it will setup the content to reference some
575external source. The content() and add_content() methods
576will automatically dereference scalar references passed this way. For
577other references content() will return the reference itself and
578add_content() will refuse to do anything.
579
580=item $mess->decoded_content( %options )
581
582Returns the content with any C<Content-Encoding> undone and strings
583mapped to perl's Unicode strings. If the C<Content-Encoding> or
584C<charset> of the message is unknown this method will fail by
585returning C<undef>.
586
587The following options can be specified.
588
589=over
590
591=item C<charset>
592
593This override the charset parameter for text content. The value
594C<none> can used to suppress decoding of the charset.
595
596=item C<default_charset>
597
598This override the default charset of "ISO-8859-1".
599
600=item C<raise_error>
601
602If TRUE then raise an exception if not able to decode content. Reason
603might be that the specified C<Content-Encoding> or C<charset> is not
604supported. If this option is FALSE, then decode_content() will return
605C<undef> on errors, but will still set $@.
606
607=item C<ref>
608
609If TRUE then a reference to decoded content is returned. This might
610be more efficient in cases where the decoded content is identical to
611the raw content as no data copying is required in this case.
612
613=back
614
615=item $mess->parts
616
617=item $mess->parts( @parts )
618
619=item $mess->parts( \@parts )
620
621Messages can be composite, i.e. contain other messages. The composite
622messages have a content type of C<multipart/*> or C<message/*>. This
623method give access to the contained messages.
624
625The argumentless form will return a list of C<HTTP::Message> objects.
626If the content type of $msg is not C<multipart/*> or C<message/*> then
627this will return the empty list. In scalar context only the first
628object is returned. The returned message parts should be regarded as
629are read only (future versions of this library might make it possible
630to modify the parent by modifying the parts).
631
632If the content type of $msg is C<message/*> then there will only be
633one part returned.
634
635If the content type is C<message/http>, then the return value will be
636either an C<HTTP::Request> or an C<HTTP::Response> object.
637
638If an @parts argument is given, then the content of the message will
639modified. The array reference form is provided so that an empty list
640can be provided. The @parts array should contain C<HTTP::Message>
641objects. The @parts objects are owned by $mess after this call and
642should not be modified or made part of other messages.
643
644When updating the message with this method and the old content type of
645$mess is not C<multipart/*> or C<message/*>, then the content type is
646set to C<multipart/mixed> and all other content headers are cleared.
647
648This method will croak if the content type is C<message/*> and more
649than one part is provided.
650
651=item $mess->add_part( $part )
652
653This will add a part to a message. The $part argument should be
654another C<HTTP::Message> object. If the previous content type of
655$mess is not C<multipart/*> then the old content (together with all
656content headers) will be made part #1 and the content type made
657C<multipart/mixed> before the new part is added. The $part object is
658owned by $mess after this call and should not be modified or made part
659of other messages.
660
661There is no return value.
662
663=item $mess->clear
664
665Will clear the headers and set the content to the empty string. There
666is no return value
667
668=item $mess->protocol
669
670=item $mess->protocol( $proto )
671
672Sets the HTTP protocol used for the message. The protocol() is a string
673like C<HTTP/1.0> or C<HTTP/1.1>.
674
675=item $mess->clone
676
677Returns a copy of the message object.
678
679=item $mess->as_string
680
681=item $mess->as_string( $eol )
682
683Returns the message formatted as a single string.
684
685The optional $eol parameter specifies the line ending sequence to use.
686The default is "\n". If no $eol is given then as_string will ensure
687that the returned string is newline terminated (even when the message
688content is not). No extra newline is appended if an explicit $eol is
689passed.
690
691=back
692
693All methods unknown to C<HTTP::Message> itself are delegated to the
694C<HTTP::Headers> object that is part of every message. This allows
695convenient access to these methods. Refer to L<HTTP::Headers> for
696details of these methods:
697
698 $mess->header( $field => $val )
699 $mess->push_header( $field => $val )
700 $mess->init_header( $field => $val )
701 $mess->remove_header( $field )
702 $mess->remove_content_headers
703 $mess->header_field_names
704 $mess->scan( \&doit )
705
706 $mess->date
707 $mess->expires
708 $mess->if_modified_since
709 $mess->if_unmodified_since
710 $mess->last_modified
711 $mess->content_type
712 $mess->content_encoding
713 $mess->content_length
714 $mess->content_language
715 $mess->title
716 $mess->user_agent
717 $mess->server
718 $mess->from
719 $mess->referer
720 $mess->www_authenticate
721 $mess->authorization
722 $mess->proxy_authorization
723 $mess->authorization_basic
724 $mess->proxy_authorization_basic
725
726=head1 COPYRIGHT
727
728Copyright 1995-2004 Gisle Aas.
729
730This library is free software; you can redistribute it and/or
731modify it under the same terms as Perl itself.
732
# spent 22µs within HTTP::Message::CORE:match which was called # once (22µs+0s) by LWP::UserAgent::BEGIN at line 7 of HTTP/Message.pm
sub HTTP::Message::CORE:match; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.