1 | package HTTP::Request;
|
---|
2 |
|
---|
3 | require HTTP::Message;
|
---|
4 | @ISA = qw(HTTP::Message);
|
---|
5 | $VERSION = "6.00";
|
---|
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 | delete $self->{'_uri_canonical'};
|
---|
84 | }
|
---|
85 | $old;
|
---|
86 | }
|
---|
87 |
|
---|
88 | *url = \&uri; # legacy
|
---|
89 |
|
---|
90 | sub uri_canonical
|
---|
91 | {
|
---|
92 | my $self = shift;
|
---|
93 | return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical;
|
---|
94 | }
|
---|
95 |
|
---|
96 |
|
---|
97 | sub accept_decodable
|
---|
98 | {
|
---|
99 | my $self = shift;
|
---|
100 | $self->header("Accept-Encoding", scalar($self->decodable));
|
---|
101 | }
|
---|
102 |
|
---|
103 | sub as_string
|
---|
104 | {
|
---|
105 | my $self = shift;
|
---|
106 | my($eol) = @_;
|
---|
107 | $eol = "\n" unless defined $eol;
|
---|
108 |
|
---|
109 | my $req_line = $self->method || "-";
|
---|
110 | my $uri = $self->uri;
|
---|
111 | $uri = (defined $uri) ? $uri->as_string : "-";
|
---|
112 | $req_line .= " $uri";
|
---|
113 | my $proto = $self->protocol;
|
---|
114 | $req_line .= " $proto" if $proto;
|
---|
115 |
|
---|
116 | return join($eol, $req_line, $self->SUPER::as_string(@_));
|
---|
117 | }
|
---|
118 |
|
---|
119 | sub dump
|
---|
120 | {
|
---|
121 | my $self = shift;
|
---|
122 | my @pre = ($self->method || "-", $self->uri || "-");
|
---|
123 | if (my $prot = $self->protocol) {
|
---|
124 | push(@pre, $prot);
|
---|
125 | }
|
---|
126 |
|
---|
127 | return $self->SUPER::dump(
|
---|
128 | preheader => join(" ", @pre),
|
---|
129 | @_,
|
---|
130 | );
|
---|
131 | }
|
---|
132 |
|
---|
133 |
|
---|
134 | 1;
|
---|
135 |
|
---|
136 | __END__
|
---|
137 |
|
---|
138 | =head1 NAME
|
---|
139 |
|
---|
140 | HTTP::Request - HTTP style request message
|
---|
141 |
|
---|
142 | =head1 SYNOPSIS
|
---|
143 |
|
---|
144 | require HTTP::Request;
|
---|
145 | $request = HTTP::Request->new(GET => 'http://www.example.com/');
|
---|
146 |
|
---|
147 | and usually used like this:
|
---|
148 |
|
---|
149 | $ua = LWP::UserAgent->new;
|
---|
150 | $response = $ua->request($request);
|
---|
151 |
|
---|
152 | =head1 DESCRIPTION
|
---|
153 |
|
---|
154 | C<HTTP::Request> is a class encapsulating HTTP style requests,
|
---|
155 | consisting of a request line, some headers, and a content body. Note
|
---|
156 | that the LWP library uses HTTP style requests even for non-HTTP
|
---|
157 | protocols. Instances of this class are usually passed to the
|
---|
158 | request() method of an C<LWP::UserAgent> object.
|
---|
159 |
|
---|
160 | C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore
|
---|
161 | inherits its methods. The following additional methods are available:
|
---|
162 |
|
---|
163 | =over 4
|
---|
164 |
|
---|
165 | =item $r = HTTP::Request->new( $method, $uri )
|
---|
166 |
|
---|
167 | =item $r = HTTP::Request->new( $method, $uri, $header )
|
---|
168 |
|
---|
169 | =item $r = HTTP::Request->new( $method, $uri, $header, $content )
|
---|
170 |
|
---|
171 | Constructs a new C<HTTP::Request> object describing a request on the
|
---|
172 | object $uri using method $method. The $method argument must be a
|
---|
173 | string. The $uri argument can be either a string, or a reference to a
|
---|
174 | C<URI> object. The optional $header argument should be a reference to
|
---|
175 | an C<HTTP::Headers> object or a plain array reference of key/value
|
---|
176 | pairs. The optional $content argument should be a string of bytes.
|
---|
177 |
|
---|
178 | =item $r = HTTP::Request->parse( $str )
|
---|
179 |
|
---|
180 | This constructs a new request object by parsing the given string.
|
---|
181 |
|
---|
182 | =item $r->method
|
---|
183 |
|
---|
184 | =item $r->method( $val )
|
---|
185 |
|
---|
186 | This is used to get/set the method attribute. The method should be a
|
---|
187 | short string like "GET", "HEAD", "PUT" or "POST".
|
---|
188 |
|
---|
189 | =item $r->uri
|
---|
190 |
|
---|
191 | =item $r->uri( $val )
|
---|
192 |
|
---|
193 | This is used to get/set the uri attribute. The $val can be a
|
---|
194 | reference to a URI object or a plain string. If a string is given,
|
---|
195 | then it should be parseable as an absolute URI.
|
---|
196 |
|
---|
197 | =item $r->header( $field )
|
---|
198 |
|
---|
199 | =item $r->header( $field => $value )
|
---|
200 |
|
---|
201 | This is used to get/set header values and it is inherited from
|
---|
202 | C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for
|
---|
203 | details and other similar methods that can be used to access the
|
---|
204 | headers.
|
---|
205 |
|
---|
206 | =item $r->accept_decodable
|
---|
207 |
|
---|
208 | This will set the C<Accept-Encoding> header to the list of encodings
|
---|
209 | that decoded_content() can decode.
|
---|
210 |
|
---|
211 | =item $r->content
|
---|
212 |
|
---|
213 | =item $r->content( $bytes )
|
---|
214 |
|
---|
215 | This is used to get/set the content and it is inherited from the
|
---|
216 | C<HTTP::Message> base class. See L<HTTP::Message> for details and
|
---|
217 | other methods that can be used to access the content.
|
---|
218 |
|
---|
219 | Note that the content should be a string of bytes. Strings in perl
|
---|
220 | can contain characters outside the range of a byte. The C<Encode>
|
---|
221 | module can be used to turn such strings into a string of bytes.
|
---|
222 |
|
---|
223 | =item $r->as_string
|
---|
224 |
|
---|
225 | =item $r->as_string( $eol )
|
---|
226 |
|
---|
227 | Method returning a textual representation of the request.
|
---|
228 |
|
---|
229 | =back
|
---|
230 |
|
---|
231 | =head1 SEE ALSO
|
---|
232 |
|
---|
233 | L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
|
---|
234 | L<HTTP::Response>
|
---|
235 |
|
---|
236 | =head1 COPYRIGHT
|
---|
237 |
|
---|
238 | Copyright 1995-2004 Gisle Aas.
|
---|
239 |
|
---|
240 | This library is free software; you can redistribute it and/or
|
---|
241 | modify it under the same terms as Perl itself.
|
---|
242 |
|
---|