home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / HTTP / Message.pm < prev    next >
Encoding:
Perl POD Document  |  2008-10-20  |  25.2 KB  |  974 lines

  1. package HTTP::Message;
  2.  
  3. use strict;
  4. use vars qw($VERSION $AUTOLOAD);
  5. $VERSION = "5.818";
  6.  
  7. require HTTP::Headers;
  8. require Carp;
  9.  
  10. my $CRLF = "\015\012";   # "\r\n" is not portable
  11. $HTTP::URI_CLASS ||= $ENV{PERL_HTTP_URI_CLASS} || "URI";
  12. eval "require $HTTP::URI_CLASS"; die $@ if $@;
  13.  
  14. *_utf8_downgrade = defined(&utf8::downgrade) ?
  15.     sub {
  16.         utf8::downgrade($_[0], 1) or
  17.             Carp::croak("HTTP::Message content must be bytes")
  18.     }
  19.     :
  20.     sub {
  21.     };
  22.  
  23. sub new
  24. {
  25.     my($class, $header, $content) = @_;
  26.     if (defined $header) {
  27.     Carp::croak("Bad header argument") unless ref $header;
  28.         if (ref($header) eq "ARRAY") {
  29.         $header = HTTP::Headers->new(@$header);
  30.     }
  31.     else {
  32.         $header = $header->clone;
  33.     }
  34.     }
  35.     else {
  36.     $header = HTTP::Headers->new;
  37.     }
  38.     if (defined $content) {
  39.         _utf8_downgrade($content);
  40.     }
  41.     else {
  42.         $content = '';
  43.     }
  44.  
  45.     bless {
  46.     '_headers' => $header,
  47.     '_content' => $content,
  48.     }, $class;
  49. }
  50.  
  51.  
  52. sub parse
  53. {
  54.     my($class, $str) = @_;
  55.  
  56.     my @hdr;
  57.     while (1) {
  58.     if ($str =~ s/^([^\s:]+)[ \t]*: ?(.*)\n?//) {
  59.         push(@hdr, $1, $2);
  60.         $hdr[-1] =~ s/\r\z//;
  61.     }
  62.     elsif (@hdr && $str =~ s/^([ \t].*)\n?//) {
  63.         $hdr[-1] .= "\n$1";
  64.         $hdr[-1] =~ s/\r\z//;
  65.     }
  66.     else {
  67.         $str =~ s/^\r?\n//;
  68.         last;
  69.     }
  70.     }
  71.     local $HTTP::Headers::TRANSLATE_UNDERSCORE;
  72.     new($class, \@hdr, $str);
  73. }
  74.  
  75.  
  76. sub clone
  77. {
  78.     my $self  = shift;
  79.     my $clone = HTTP::Message->new($self->headers,
  80.                    $self->content);
  81.     $clone->protocol($self->protocol);
  82.     $clone;
  83. }
  84.  
  85.  
  86. sub clear {
  87.     my $self = shift;
  88.     $self->{_headers}->clear;
  89.     $self->content("");
  90.     delete $self->{_parts};
  91.     return;
  92. }
  93.  
  94.  
  95. sub protocol {
  96.     shift->_elem('_protocol',  @_);
  97. }
  98.  
  99. sub headers {
  100.     shift->{'_headers'};
  101. }
  102.  
  103. sub headers_as_string {
  104.     shift->{'_headers'}->as_string(@_);
  105. }
  106.  
  107.  
  108. sub content  {
  109.  
  110.     my $self = $_[0];
  111.     if (defined(wantarray)) {
  112.     $self->_content unless exists $self->{_content};
  113.     my $old = $self->{_content};
  114.     $old = $$old if ref($old) eq "SCALAR";
  115.     &_set_content if @_ > 1;
  116.     return $old;
  117.     }
  118.  
  119.     if (@_ > 1) {
  120.     &_set_content;
  121.     }
  122.     else {
  123.     Carp::carp("Useless content call in void context") if $^W;
  124.     }
  125. }
  126.  
  127.  
  128. sub _set_content {
  129.     my $self = $_[0];
  130.     _utf8_downgrade($_[1]);
  131.     if (!ref($_[1]) && ref($self->{_content}) eq "SCALAR") {
  132.     ${$self->{_content}} = $_[1];
  133.     }
  134.     else {
  135.     die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";
  136.     $self->{_content} = $_[1];
  137.     delete $self->{_content_ref};
  138.     }
  139.     delete $self->{_parts} unless $_[2];
  140. }
  141.  
  142.  
  143. sub add_content
  144. {
  145.     my $self = shift;
  146.     $self->_content unless exists $self->{_content};
  147.     my $chunkref = \$_[0];
  148.     $chunkref = $$chunkref if ref($$chunkref);  # legacy
  149.  
  150.     _utf8_downgrade($$chunkref);
  151.  
  152.     my $ref = ref($self->{_content});
  153.     if (!$ref) {
  154.     $self->{_content} .= $$chunkref;
  155.     }
  156.     elsif ($ref eq "SCALAR") {
  157.     ${$self->{_content}} .= $$chunkref;
  158.     }
  159.     else {
  160.     Carp::croak("Can't append to $ref content");
  161.     }
  162.     delete $self->{_parts};
  163. }
  164.  
  165. sub add_content_utf8 {
  166.     my($self, $buf)  = @_;
  167.     utf8::upgrade($buf);
  168.     utf8::encode($buf);
  169.     $self->add_content($buf);
  170. }
  171.  
  172. sub content_ref
  173. {
  174.     my $self = shift;
  175.     $self->_content unless exists $self->{_content};
  176.     delete $self->{_parts};
  177.     my $old = \$self->{_content};
  178.     my $old_cref = $self->{_content_ref};
  179.     if (@_) {
  180.     my $new = shift;
  181.     Carp::croak("Setting content_ref to a non-ref") unless ref($new);
  182.     delete $self->{_content};  # avoid modifying $$old
  183.     $self->{_content} = $new;
  184.     $self->{_content_ref}++;
  185.     }
  186.     $old = $$old if $old_cref;
  187.     return $old;
  188. }
  189.  
  190.  
  191. sub decoded_content
  192. {
  193.     my($self, %opt) = @_;
  194.     my $content_ref;
  195.     my $content_ref_iscopy;
  196.  
  197.     eval {
  198.  
  199.     require HTTP::Headers::Util;
  200.     my($ct, %ct_param);
  201.     if (my @ct = HTTP::Headers::Util::split_header_words($self->header("Content-Type"))) {
  202.         ($ct, undef, %ct_param) = @{$ct[-1]};
  203.         die "Can't decode multipart content" if $ct =~ m,^multipart/,;
  204.     }
  205.  
  206.     $content_ref = $self->content_ref;
  207.     die "Can't decode ref content" if ref($content_ref) ne "SCALAR";
  208.  
  209.     if (my $h = $self->header("Content-Encoding")) {
  210.         $h =~ s/^\s+//;
  211.         $h =~ s/\s+$//;
  212.         for my $ce (reverse split(/\s*,\s*/, lc($h))) {
  213.         next unless $ce;
  214.         next if $ce eq "identity";
  215.         if ($ce eq "gzip" || $ce eq "x-gzip") {
  216.             require Compress::Zlib;
  217.             unless ($content_ref_iscopy) {
  218.             # memGunzip is documented to destroy its buffer argument
  219.             my $copy = $$content_ref;
  220.             $content_ref = \$copy;
  221.             $content_ref_iscopy++;
  222.             }
  223.             $content_ref = \Compress::Zlib::memGunzip($$content_ref);
  224.             die "Can't gunzip content" unless defined $$content_ref;
  225.         }
  226.         elsif ($ce eq "x-bzip2") {
  227.             require Compress::Bzip2;
  228.             unless ($content_ref_iscopy) {
  229.             # memBunzip is documented to destroy its buffer argument
  230.             my $copy = $$content_ref;
  231.             $content_ref = \$copy;
  232.             $content_ref_iscopy++;
  233.             }
  234.             $content_ref = \Compress::Bzip2::memBunzip($$content_ref);
  235.             die "Can't bunzip content" unless defined $$content_ref;
  236.         }
  237.         elsif ($ce eq "deflate") {
  238.             require Compress::Zlib;
  239.             my $out = Compress::Zlib::uncompress($$content_ref);
  240.             unless (defined $out) {
  241.             # "Content-Encoding: deflate" is supposed to mean the "zlib"
  242.                         # format of RFC 1950, but Microsoft got that wrong, so some
  243.                         # servers sends the raw compressed "deflate" data.  This
  244.                         # tries to inflate this format.
  245.             unless ($content_ref_iscopy) {
  246.                 # the $i->inflate method is documented to destroy its
  247.                 # buffer argument
  248.                 my $copy = $$content_ref;
  249.                 $content_ref = \$copy;
  250.                 $content_ref_iscopy++;
  251.             }
  252.  
  253.             my($i, $status) = Compress::Zlib::inflateInit(
  254.                 WindowBits => -Compress::Zlib::MAX_WBITS(),
  255.                         );
  256.             my $OK = Compress::Zlib::Z_OK();
  257.             die "Can't init inflate object" unless $i && $status == $OK;
  258.             ($out, $status) = $i->inflate($content_ref);
  259.             if ($status != Compress::Zlib::Z_STREAM_END()) {
  260.                 if ($status == $OK) {
  261.                 $self->push_header("Client-Warning" =>
  262.                     "Content might be truncated; incomplete deflate stream");
  263.                 }
  264.                 else {
  265.                 # something went bad, can't trust $out any more
  266.                 $out = undef;
  267.                 }
  268.             }
  269.             }
  270.             die "Can't inflate content" unless defined $out;
  271.             $content_ref = \$out;
  272.             $content_ref_iscopy++;
  273.         }
  274.         elsif ($ce eq "compress" || $ce eq "x-compress") {
  275.             die "Can't uncompress content";
  276.         }
  277.         elsif ($ce eq "base64") {  # not really C-T-E, but should be harmless
  278.             require MIME::Base64;
  279.             $content_ref = \MIME::Base64::decode($$content_ref);
  280.             $content_ref_iscopy++;
  281.         }
  282.         elsif ($ce eq "quoted-printable") { # not really C-T-E, but should be harmless
  283.             require MIME::QuotedPrint;
  284.             $content_ref = \MIME::QuotedPrint::decode($$content_ref);
  285.             $content_ref_iscopy++;
  286.         }
  287.         else {
  288.             die "Don't know how to decode Content-Encoding '$ce'";
  289.         }
  290.         }
  291.     }
  292.  
  293.     if ($ct && $ct =~ m,^text/,,) {
  294.         my $charset = $opt{charset} || $ct_param{charset} || $opt{default_charset} || "ISO-8859-1";
  295.         $charset = lc($charset);
  296.         if ($charset ne "none") {
  297.         require Encode;
  298.         if (do{my $v = $Encode::VERSION; $v =~ s/_//g; $v} < 2.0901 &&
  299.             !$content_ref_iscopy)
  300.         {
  301.             # LEAVE_SRC did not work before Encode-2.0901
  302.             my $copy = $$content_ref;
  303.             $content_ref = \$copy;
  304.             $content_ref_iscopy++;
  305.         }
  306.         $content_ref = \Encode::decode($charset, $$content_ref,
  307.              ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());
  308.         }
  309.     }
  310.     };
  311.     if ($@) {
  312.     Carp::croak($@) if $opt{raise_error};
  313.     return undef;
  314.     }
  315.  
  316.     return $opt{ref} ? $content_ref : $$content_ref;
  317. }
  318.  
  319.  
  320. sub decodable
  321. {
  322.     # should match the Content-Encoding values that decoded_content can deal with
  323.     my $self = shift;
  324.     my @enc;
  325.     # XXX preferably we should deterine if the modules are available without loading
  326.     # them here
  327.     eval {
  328.         require Compress::Zlib;
  329.         push(@enc, "gzip", "x-gzip", "deflate");
  330.     };
  331.     eval {
  332.         require Compress::Bzip2;
  333.         push(@enc, "x-bzip2");
  334.     };
  335.     # we don't care about announcing the 'base64' and 'quoted-printable' stuff
  336.     return wantarray ? @enc : join(", ", @enc);
  337. }
  338.  
  339.  
  340. sub decode
  341. {
  342.     my $self = shift;
  343.     return 1 unless $self->header("Content-Encoding");
  344.     if (defined(my $content = $self->decoded_content(charset => "none"))) {
  345.     $self->remove_header("Content-Encoding");
  346.     $self->content($content);
  347.     return 1;
  348.     }
  349.     return 0;
  350. }
  351.  
  352.  
  353. sub encode
  354. {
  355.     my($self, @enc) = @_;
  356.  
  357.     Carp::croak("Can't encode multipart/* messages") if $self->content_type =~ m,^multipart/,;
  358.     Carp::croak("Can't encode message/* messages") if $self->content_type =~ m,^message/,;
  359.  
  360.     return 1 unless @enc;  # nothing to do
  361.  
  362.     my $content = $self->content;
  363.     for my $encoding (@enc) {
  364.     if ($encoding eq "identity") {
  365.         # noting to do
  366.     }
  367.     elsif ($encoding eq "base64") {
  368.         require MIME::Base64;
  369.         $content = MIME::Base64::encode($content);
  370.     }
  371.     elsif ($encoding eq "gzip" || $encoding eq "x-gzip") {
  372.         require Compress::Zlib;
  373.         $content = Compress::Zlib::memGzip($content);
  374.     }
  375.     elsif ($encoding eq "deflate") {
  376.         require Compress::Zlib;
  377.         $content = Compress::Zlib::compress($content);
  378.     }
  379.     elsif ($encoding eq "x-bzip2") {
  380.         require Compress::Bzip2;
  381.         $content = Compress::Bzip2::memGzip($content);
  382.     }
  383.     elsif ($encoding eq "rot13") {  # for the fun of it
  384.         $content =~ tr/A-Za-z/N-ZA-Mn-za-m/;
  385.     }
  386.     else {
  387.         return 0;
  388.     }
  389.     }
  390.     my $h = $self->header("Content-Encoding");
  391.     unshift(@enc, $h) if $h;
  392.     $self->header("Content-Encoding", join(", ", @enc));
  393.     $self->content($content);
  394.     return 1;
  395. }
  396.  
  397.  
  398. sub as_string
  399. {
  400.     my($self, $eol) = @_;
  401.     $eol = "\n" unless defined $eol;
  402.  
  403.     # The calculation of content might update the headers
  404.     # so we need to do that first.
  405.     my $content = $self->content;
  406.  
  407.     return join("", $self->{'_headers'}->as_string($eol),
  408.             $eol,
  409.             $content,
  410.             (@_ == 1 && length($content) &&
  411.              $content !~ /\n\z/) ? "\n" : "",
  412.         );
  413. }
  414.  
  415.  
  416. sub dump
  417. {
  418.     my($self, %opt) = @_;
  419.     my $content = $self->content;
  420.     my $chopped = 0;
  421.     if (!ref($content)) {
  422.     my $maxlen = $opt{maxlength};
  423.     $maxlen = 512 unless defined($maxlen);
  424.     if ($maxlen && length($content) > $maxlen * 1.1 + 3) {
  425.         $chopped = length($content) - $maxlen;
  426.         $content = substr($content, 0, $maxlen) . "...";
  427.     }
  428.  
  429.     $content =~ s/\\/\\\\/g;
  430.     $content =~ s/\t/\\t/g;
  431.     $content =~ s/\r/\\r/g;
  432.  
  433.     # no need for 3 digits in escape for these
  434.     $content =~ s/([\0-\11\13-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
  435.  
  436.     $content =~ s/([\0-\11\13-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
  437.     $content =~ s/([^\12\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
  438.  
  439.     # remaining whitespace
  440.     $content =~ s/( +)\n/("\\40" x length($1)) . "\n"/eg;
  441.     $content =~ s/(\n+)\n/("\\n" x length($1)) . "\n"/eg;
  442.     $content =~ s/\n\z/\\n/;
  443.  
  444.     my $no_content = "(no content)";
  445.     if ($content eq $no_content) {
  446.         # escape our $no_content marker
  447.         $content =~ s/^(.)/sprintf('\\x%02X',ord($1))/eg;
  448.     }
  449.     elsif ($content eq "") {
  450.         $content = "(no content)";
  451.     }
  452.     }
  453.  
  454.     my @dump;
  455.     push(@dump, $opt{preheader}) if $opt{preheader};
  456.     push(@dump, $self->{_headers}->as_string, $content);
  457.     push(@dump, "(+ $chopped more bytes not shown)") if $chopped;
  458.  
  459.     my $dump = join("\n", @dump, "");
  460.     $dump =~ s/^/$opt{prefix}/gm if $opt{prefix};
  461.  
  462.     print $dump unless defined wantarray;
  463.     return $dump;
  464. }
  465.  
  466.  
  467. sub parts {
  468.     my $self = shift;
  469.     if (defined(wantarray) && (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR")) {
  470.     $self->_parts;
  471.     }
  472.     my $old = $self->{_parts};
  473.     if (@_) {
  474.     my @parts = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
  475.     my $ct = $self->content_type || "";
  476.     if ($ct =~ m,^message/,) {
  477.         Carp::croak("Only one part allowed for $ct content")
  478.         if @parts > 1;
  479.     }
  480.     elsif ($ct !~ m,^multipart/,) {
  481.         $self->remove_content_headers;
  482.         $self->content_type("multipart/mixed");
  483.     }
  484.     $self->{_parts} = \@parts;
  485.     _stale_content($self);
  486.     }
  487.     return @$old if wantarray;
  488.     return $old->[0];
  489. }
  490.  
  491. sub add_part {
  492.     my $self = shift;
  493.     if (($self->content_type || "") !~ m,^multipart/,) {
  494.     my $p = HTTP::Message->new($self->remove_content_headers,
  495.                    $self->content(""));
  496.     $self->content_type("multipart/mixed");
  497.     $self->{_parts} = [];
  498.         if ($p->headers->header_field_names || $p->content ne "") {
  499.             push(@{$self->{_parts}}, $p);
  500.         }
  501.     }
  502.     elsif (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR") {
  503.     $self->_parts;
  504.     }
  505.  
  506.     push(@{$self->{_parts}}, @_);
  507.     _stale_content($self);
  508.     return;
  509. }
  510.  
  511. sub _stale_content {
  512.     my $self = shift;
  513.     if (ref($self->{_content}) eq "SCALAR") {
  514.     # must recalculate now
  515.     $self->_content;
  516.     }
  517.     else {
  518.     # just invalidate cache
  519.     delete $self->{_content};
  520.     delete $self->{_content_ref};
  521.     }
  522. }
  523.  
  524.  
  525. # delegate all other method calls the the _headers object.
  526. sub AUTOLOAD
  527. {
  528.     my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
  529.  
  530.     # We create the function here so that it will not need to be
  531.     # autoloaded the next time.
  532.     no strict 'refs';
  533.     *$method = sub { shift->{'_headers'}->$method(@_) };
  534.     goto &$method;
  535. }
  536.  
  537.  
  538. sub DESTROY {}  # avoid AUTOLOADing it
  539.  
  540.  
  541. # Private method to access members in %$self
  542. sub _elem
  543. {
  544.     my $self = shift;
  545.     my $elem = shift;
  546.     my $old = $self->{$elem};
  547.     $self->{$elem} = $_[0] if @_;
  548.     return $old;
  549. }
  550.  
  551.  
  552. # Create private _parts attribute from current _content
  553. sub _parts {
  554.     my $self = shift;
  555.     my $ct = $self->content_type;
  556.     if ($ct =~ m,^multipart/,) {
  557.     require HTTP::Headers::Util;
  558.     my @h = HTTP::Headers::Util::split_header_words($self->header("Content-Type"));
  559.     die "Assert" unless @h;
  560.     my %h = @{$h[0]};
  561.     if (defined(my $b = $h{boundary})) {
  562.         my $str = $self->content;
  563.         $str =~ s/\r?\n--\Q$b\E--\r?\n.*//s;
  564.         if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) {
  565.         $self->{_parts} = [map HTTP::Message->parse($_),
  566.                    split(/\r?\n--\Q$b\E\r?\n/, $str)]
  567.         }
  568.     }
  569.     }
  570.     elsif ($ct eq "message/http") {
  571.     require HTTP::Request;
  572.     require HTTP::Response;
  573.     my $content = $self->content;
  574.     my $class = ($content =~ m,^(HTTP/.*)\n,) ?
  575.         "HTTP::Response" : "HTTP::Request";
  576.     $self->{_parts} = [$class->parse($content)];
  577.     }
  578.     elsif ($ct =~ m,^message/,) {
  579.     $self->{_parts} = [ HTTP::Message->parse($self->content) ];
  580.     }
  581.  
  582.     $self->{_parts} ||= [];
  583. }
  584.  
  585.  
  586. # Create private _content attribute from current _parts
  587. sub _content {
  588.     my $self = shift;
  589.     my $ct = $self->header("Content-Type") || "multipart/mixed";
  590.     if ($ct =~ m,^\s*message/,i) {
  591.     _set_content($self, $self->{_parts}[0]->as_string($CRLF), 1);
  592.     return;
  593.     }
  594.  
  595.     require HTTP::Headers::Util;
  596.     my @v = HTTP::Headers::Util::split_header_words($ct);
  597.     Carp::carp("Multiple Content-Type headers") if @v > 1;
  598.     @v = @{$v[0]};
  599.  
  600.     my $boundary;
  601.     my $boundary_index;
  602.     for (my @tmp = @v; @tmp;) {
  603.     my($k, $v) = splice(@tmp, 0, 2);
  604.     if ($k eq "boundary") {
  605.         $boundary = $v;
  606.         $boundary_index = @v - @tmp - 1;
  607.         last;
  608.     }
  609.     }
  610.  
  611.     my @parts = map $_->as_string($CRLF), @{$self->{_parts}};
  612.  
  613.     my $bno = 0;
  614.     $boundary = _boundary() unless defined $boundary;
  615.  CHECK_BOUNDARY:
  616.     {
  617.     for (@parts) {
  618.         if (index($_, $boundary) >= 0) {
  619.         # must have a better boundary
  620.         $boundary = _boundary(++$bno);
  621.         redo CHECK_BOUNDARY;
  622.         }
  623.     }
  624.     }
  625.  
  626.     if ($boundary_index) {
  627.     $v[$boundary_index] = $boundary;
  628.     }
  629.     else {
  630.     push(@v, boundary => $boundary);
  631.     }
  632.  
  633.     $ct = HTTP::Headers::Util::join_header_words(@v);
  634.     $self->header("Content-Type", $ct);
  635.  
  636.     _set_content($self, "--$boundary$CRLF" .
  637.                     join("$CRLF--$boundary$CRLF", @parts) .
  638.             "$CRLF--$boundary--$CRLF",
  639.                         1);
  640. }
  641.  
  642.  
  643. sub _boundary
  644. {
  645.     my $size = shift || return "xYzZY";
  646.     require MIME::Base64;
  647.     my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
  648.     $b =~ s/[\W]/X/g;  # ensure alnum only
  649.     $b;
  650. }
  651.  
  652.  
  653. 1;
  654.  
  655.  
  656. __END__
  657.  
  658. =head1 NAME
  659.  
  660. HTTP::Message - HTTP style message (base class)
  661.  
  662. =head1 SYNOPSIS
  663.  
  664.  use base 'HTTP::Message';
  665.  
  666. =head1 DESCRIPTION
  667.  
  668. An C<HTTP::Message> object contains some headers and a content body.
  669. The following methods are available:
  670.  
  671. =over 4
  672.  
  673. =item $mess = HTTP::Message->new
  674.  
  675. =item $mess = HTTP::Message->new( $headers )
  676.  
  677. =item $mess = HTTP::Message->new( $headers, $content )
  678.  
  679. This constructs a new message object.  Normally you would want
  680. construct C<HTTP::Request> or C<HTTP::Response> objects instead.
  681.  
  682. The optional $header argument should be a reference to an
  683. C<HTTP::Headers> object or a plain array reference of key/value pairs.
  684. If an C<HTTP::Headers> object is provided then a copy of it will be
  685. embedded into the constructed message, i.e. it will not be owned and
  686. can be modified afterwards without affecting the message.
  687.  
  688. The optional $content argument should be a string of bytes.
  689.  
  690. =item $mess = HTTP::Message->parse( $str )
  691.  
  692. This constructs a new message object by parsing the given string.
  693.  
  694. =item $mess->headers
  695.  
  696. Returns the embedded C<HTTP::Headers> object.
  697.  
  698. =item $mess->headers_as_string
  699.  
  700. =item $mess->headers_as_string( $eol )
  701.  
  702. Call the as_string() method for the headers in the
  703. message.  This will be the same as
  704.  
  705.     $mess->headers->as_string
  706.  
  707. but it will make your program a whole character shorter :-)
  708.  
  709. =item $mess->content
  710.  
  711. =item $mess->content( $bytes )
  712.  
  713. The content() method sets the raw content if an argument is given.  If no
  714. argument is given the content is not touched.  In either case the
  715. original raw content is returned.
  716.  
  717. Note that the content should be a string of bytes.  Strings in perl
  718. can contain characters outside the range of a byte.  The C<Encode>
  719. module can be used to turn such strings into a string of bytes.
  720.  
  721. =item $mess->add_content( $bytes )
  722.  
  723. The add_content() methods appends more data bytes to the end of the
  724. current content buffer.
  725.  
  726. =item $mess->add_content_utf8( $string )
  727.  
  728. The add_content_utf8() method appends the UTF-8 bytes representing the
  729. string to the end of the current content buffer.
  730.  
  731. =item $mess->content_ref
  732.  
  733. =item $mess->content_ref( \$bytes )
  734.  
  735. The content_ref() method will return a reference to content buffer string.
  736. It can be more efficient to access the content this way if the content
  737. is huge, and it can even be used for direct manipulation of the content,
  738. for instance:
  739.  
  740.   ${$res->content_ref} =~ s/\bfoo\b/bar/g;
  741.  
  742. This example would modify the content buffer in-place.
  743.  
  744. If an argument is passed it will setup the content to reference some
  745. external source.  The content() and add_content() methods
  746. will automatically dereference scalar references passed this way.  For
  747. other references content() will return the reference itself and
  748. add_content() will refuse to do anything.
  749.  
  750. =item $mess->decoded_content( %options )
  751.  
  752. Returns the content with any C<Content-Encoding> undone and the raw
  753. content encoded to perl's Unicode strings.  If the C<Content-Encoding>
  754. or C<charset> of the message is unknown this method will fail by
  755. returning C<undef>.
  756.  
  757. The following options can be specified.
  758.  
  759. =over
  760.  
  761. =item C<charset>
  762.  
  763. This override the charset parameter for text content.  The value
  764. C<none> can used to suppress decoding of the charset.
  765.  
  766. =item C<default_charset>
  767.  
  768. This override the default charset of "ISO-8859-1".
  769.  
  770. =item C<charset_strict>
  771.  
  772. Abort decoding if malformed characters is found in the content.  By
  773. default you get the substitution character ("\x{FFFD}") in place of
  774. malformed characters.
  775.  
  776. =item C<raise_error>
  777.  
  778. If TRUE then raise an exception if not able to decode content.  Reason
  779. might be that the specified C<Content-Encoding> or C<charset> is not
  780. supported.  If this option is FALSE, then decoded_content() will return
  781. C<undef> on errors, but will still set $@.
  782.  
  783. =item C<ref>
  784.  
  785. If TRUE then a reference to decoded content is returned.  This might
  786. be more efficient in cases where the decoded content is identical to
  787. the raw content as no data copying is required in this case.
  788.  
  789. =back
  790.  
  791. =item $mess->decodeable
  792.  
  793. =item HTTP::Message::decodeable()
  794.  
  795. This returns the encoding identifiers that decoded_content() can
  796. process.  In scalar context returns a comma separated string of
  797. identifiers.
  798.  
  799. This value is suitable for initializing the C<Accept-Encoding> request
  800. header field.
  801.  
  802. =item $mess->decode
  803.  
  804. This method tries to replace the content of the message with the
  805. decoded version and removes the C<Content-Encoding> header.  Return
  806. TRUE if successful and FALSE if not.
  807.  
  808. If the message does not have a C<Content-Encoding> header this method
  809. does nothing and returns TRUE.
  810.  
  811. Note that the content of the message is still bytes after this method
  812. has been called and you still need to call decoded_content() if you
  813. want to process its content as a string.
  814.  
  815. =item $mess->encode( $encoding, ... )
  816.  
  817. Apply the given encodings to the content of the message.  Returns TRUE
  818. if successful. Currently supported encodings are "gzip", "deflate",
  819. "x-bzip2" and "base64".
  820.  
  821. A successful call to this function will set the C<Content-Encoding>
  822. header.
  823.  
  824. Note that C<multipart/*> or C<message/*> messages can't be encoded and
  825. this method will croak if you try.
  826.  
  827. =item $mess->parts
  828.  
  829. =item $mess->parts( @parts )
  830.  
  831. =item $mess->parts( \@parts )
  832.  
  833. Messages can be composite, i.e. contain other messages.  The composite
  834. messages have a content type of C<multipart/*> or C<message/*>.  This
  835. method give access to the contained messages.
  836.  
  837. The argumentless form will return a list of C<HTTP::Message> objects.
  838. If the content type of $msg is not C<multipart/*> or C<message/*> then
  839. this will return the empty list.  In scalar context only the first
  840. object is returned.  The returned message parts should be regarded as
  841. read-only (future versions of this library might make it possible
  842. to modify the parent by modifying the parts).
  843.  
  844. If the content type of $msg is C<message/*> then there will only be
  845. one part returned.
  846.  
  847. If the content type is C<message/http>, then the return value will be
  848. either an C<HTTP::Request> or an C<HTTP::Response> object.
  849.  
  850. If an @parts argument is given, then the content of the message will be
  851. modified. The array reference form is provided so that an empty list
  852. can be provided.  The @parts array should contain C<HTTP::Message>
  853. objects.  The @parts objects are owned by $mess after this call and
  854. should not be modified or made part of other messages.
  855.  
  856. When updating the message with this method and the old content type of
  857. $mess is not C<multipart/*> or C<message/*>, then the content type is
  858. set to C<multipart/mixed> and all other content headers are cleared.
  859.  
  860. This method will croak if the content type is C<message/*> and more
  861. than one part is provided.
  862.  
  863. =item $mess->add_part( $part )
  864.  
  865. This will add a part to a message.  The $part argument should be
  866. another C<HTTP::Message> object.  If the previous content type of
  867. $mess is not C<multipart/*> then the old content (together with all
  868. content headers) will be made part #1 and the content type made
  869. C<multipart/mixed> before the new part is added.  The $part object is
  870. owned by $mess after this call and should not be modified or made part
  871. of other messages.
  872.  
  873. There is no return value.
  874.  
  875. =item $mess->clear
  876.  
  877. Will clear the headers and set the content to the empty string.  There
  878. is no return value
  879.  
  880. =item $mess->protocol
  881.  
  882. =item $mess->protocol( $proto )
  883.  
  884. Sets the HTTP protocol used for the message.  The protocol() is a string
  885. like C<HTTP/1.0> or C<HTTP/1.1>.
  886.  
  887. =item $mess->clone
  888.  
  889. Returns a copy of the message object.
  890.  
  891. =item $mess->as_string
  892.  
  893. =item $mess->as_string( $eol )
  894.  
  895. Returns the message formatted as a single string.
  896.  
  897. The optional $eol parameter specifies the line ending sequence to use.
  898. The default is "\n".  If no $eol is given then as_string will ensure
  899. that the returned string is newline terminated (even when the message
  900. content is not).  No extra newline is appended if an explicit $eol is
  901. passed.
  902.  
  903. =item $mess->dump( %opt )
  904.  
  905. Returns the message formatted as a string.  In void context print the string.
  906.  
  907. This differs from C<< $mess->as_string >> in that it escapes the bytes
  908. of the content so that it's safe to print them and it limits how much
  909. content to print.  The escapes syntax used is the same as for Perl's
  910. double quoted strings.  If there is no content the string "(no
  911. content)" is shown in its place.
  912.  
  913. Options to influence the output can be passed as key/value pairs. The
  914. following options are recognized:
  915.  
  916. =over
  917.  
  918. =item maxlength => $num
  919.  
  920. How much of the content to show.  The default is 512.  Set this to 0
  921. for unlimited.
  922.  
  923. If the content is longer then the string is chopped at the limit and
  924. the string "...\n(### more bytes not shown)" appended.
  925.  
  926. =item prefix => $str
  927.  
  928. A string that will be prefixed to each line of the dump.
  929.  
  930. =back
  931.  
  932. =back
  933.  
  934. All methods unknown to C<HTTP::Message> itself are delegated to the
  935. C<HTTP::Headers> object that is part of every message.  This allows
  936. convenient access to these methods.  Refer to L<HTTP::Headers> for
  937. details of these methods:
  938.  
  939.     $mess->header( $field => $val )
  940.     $mess->push_header( $field => $val )
  941.     $mess->init_header( $field => $val )
  942.     $mess->remove_header( $field )
  943.     $mess->remove_content_headers
  944.     $mess->header_field_names
  945.     $mess->scan( \&doit )
  946.  
  947.     $mess->date
  948.     $mess->expires
  949.     $mess->if_modified_since
  950.     $mess->if_unmodified_since
  951.     $mess->last_modified
  952.     $mess->content_type
  953.     $mess->content_encoding
  954.     $mess->content_length
  955.     $mess->content_language
  956.     $mess->title
  957.     $mess->user_agent
  958.     $mess->server
  959.     $mess->from
  960.     $mess->referer
  961.     $mess->www_authenticate
  962.     $mess->authorization
  963.     $mess->proxy_authorization
  964.     $mess->authorization_basic
  965.     $mess->proxy_authorization_basic
  966.  
  967. =head1 COPYRIGHT
  968.  
  969. Copyright 1995-2004 Gisle Aas.
  970.  
  971. This library is free software; you can redistribute it and/or
  972. modify it under the same terms as Perl itself.
  973.  
  974.