git.maemo.org Git - dh-make-perl/blob - dev/i386/libwww-perl/libwww-perl-5.813/lib/HTTP/Request.pm

   1 package HTTP::Request;
   2
   3 require HTTP::Message;
   4 @ISA = qw(HTTP::Message);
   5 $VERSION = "5.811";
   6
   7 use strict;
   8
   9
  10
  11 sub new
  12 {
  13     my($class, $method, $uri, $header, $content) = @_;
  14     my $self = $class->SUPER::new($header, $content);
  15     $self->method($method);
  16     $self->uri($uri);
  17     $self;
  18 }
  19
  20
  21 sub parse
  22 {
  23     my($class, $str) = @_;
  24     my $request_line;
  25     if ($str =~ s/^(.*)\n//) {
  26         $request_line = $1;
  27     }
  28     else {
  29         $request_line = $str;
  30         $str = "";
  31     }
  32
  33     my $self = $class->SUPER::parse($str);
  34     my($method, $uri, $protocol) = split(' ', $request_line);
  35     $self->method($method) if defined($method);
  36     $self->uri($uri) if defined($uri);
  37     $self->protocol($protocol) if $protocol;
  38     $self;
  39 }
  40
  41
  42 sub clone
  43 {
  44     my $self = shift;
  45     my $clone = bless $self->SUPER::clone, ref($self);
  46     $clone->method($self->method);
  47     $clone->uri($self->uri);
  48     $clone;
  49 }
  50
  51
  52 sub method
  53 {
  54     shift->_elem('_method', @_);
  55 }
  56
  57
  58 sub uri
  59 {
  60     my $self = shift;
  61     my $old = $self->{'_uri'};
  62     if (@_) {
  63         my $uri = shift;
  64         if (!defined $uri) {
  65             # that's ok
  66         }
  67         elsif (ref $uri) {
  68             Carp::croak("A URI can't be a " . ref($uri) . " reference")
  69                 if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY';
  70             Carp::croak("Can't use a " . ref($uri) . " object as a URI")
  71                 unless $uri->can('scheme');
  72             $uri = $uri->clone;
  73             unless ($HTTP::URI_CLASS eq "URI") {
  74                 # Argh!! Hate this... old LWP legacy!
  75                 eval { local $SIG{__DIE__}; $uri = $uri->abs; };
  76                 die $@ if $@ && $@ !~ /Missing base argument/;
  77             }
  78         }
  79         else {
  80             $uri = $HTTP::URI_CLASS->new($uri);
  81         }
  82         $self->{'_uri'} = $uri;
  83     }
  84     $old;
  85 }
  86
  87 *url = \&uri;  # legacy
  88
  89
  90 sub as_string
  91 {
  92     my $self = shift;
  93     my($eol) = @_;
  94     $eol = "\n" unless defined $eol;
  95
  96     my $req_line = $self->method || "-";
  97     my $uri = $self->uri;
  98     $uri = (defined $uri) ? $uri->as_string : "-";
  99     $req_line .= " $uri";
 100     my $proto = $self->protocol;
 101     $req_line .= " $proto" if $proto;
 102
 103     return join($eol, $req_line, $self->SUPER::as_string(@_));
 104 }
 105
 106
 107 1;
 108
 109 __END__
 110
 111 =head1 NAME
 112
 113 HTTP::Request - HTTP style request message
 114
 115 =head1 SYNOPSIS
 116
 117  require HTTP::Request;
 118  $request = HTTP::Request->new(GET => 'http://www.example.com/');
 119
 120 and usually used like this:
 121
 122  $ua = LWP::UserAgent->new;
 123  $response = $ua->request($request);
 124
 125 =head1 DESCRIPTION
 126
 127 C<HTTP::Request> is a class encapsulating HTTP style requests,
 128 consisting of a request line, some headers, and a content body. Note
 129 that the LWP library uses HTTP style requests even for non-HTTP
 130 protocols.  Instances of this class are usually passed to the
 131 request() method of an C<LWP::UserAgent> object.
 132
 133 C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore
 134 inherits its methods.  The following additional methods are available:
 135
 136 =over 4
 137
 138 =item $r = HTTP::Request->new( $method, $uri )
 139
 140 =item $r = HTTP::Request->new( $method, $uri, $header )
 141
 142 =item $r = HTTP::Request->new( $method, $uri, $header, $content )
 143
 144 Constructs a new C<HTTP::Request> object describing a request on the
 145 object $uri using method $method.  The $method argument must be a
 146 string.  The $uri argument can be either a string, or a reference to a
 147 C<URI> object.  The optional $header argument should be a reference to
 148 an C<HTTP::Headers> object or a plain array reference of key/value
 149 pairs.  The optional $content argument should be a string of bytes.
 150
 151 =item $r = HTTP::Request->parse( $str )
 152
 153 This constructs a new request object by parsing the given string.
 154
 155 =item $r->method
 156
 157 =item $r->method( $val )
 158
 159 This is used to get/set the method attribute.  The method should be a
 160 short string like "GET", "HEAD", "PUT" or "POST".
 161
 162 =item $r->uri
 163
 164 =item $r->uri( $val )
 165
 166 This is used to get/set the uri attribute.  The $val can be a
 167 reference to a URI object or a plain string.  If a string is given,
 168 then it should be parseable as an absolute URI.
 169
 170 =item $r->header( $field )
 171
 172 =item $r->header( $field => $value )
 173
 174 This is used to get/set header values and it is inherited from
 175 C<HTTP::Headers> via C<HTTP::Message>.  See L<HTTP::Headers> for
 176 details and other similar methods that can be used to access the
 177 headers.
 178
 179 =item $r->content
 180
 181 =item $r->content( $bytes )
 182
 183 This is used to get/set the content and it is inherited from the
 184 C<HTTP::Message> base class.  See L<HTTP::Message> for details and
 185 other methods that can be used to access the content.
 186
 187 Note that the content should be a string of bytes.  Strings in perl
 188 can contain characters outside the range of a byte.  The C<Encode>
 189 module can be used to turn such strings into a string of bytes.
 190
 191 =item $r->as_string
 192
 193 =item $r->as_string( $eol )
 194
 195 Method returning a textual representation of the request.
 196
 197 =back
 198
 199 =head1 SEE ALSO
 200
 201 L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
 202 L<HTTP::Response>
 203
 204 =head1 COPYRIGHT
 205
 206 Copyright 1995-2004 Gisle Aas.
 207
 208 This library is free software; you can redistribute it and/or
 209 modify it under the same terms as Perl itself.
 210