[catagits/Gitalist.git] / local-lib5 / lib / perl5 / HTTP / Request / Common.pm

package HTTP::Request::Common;

use strict;
use vars qw(@EXPORT @EXPORT_OK $VERSION $DYNAMIC_FILE_UPLOAD);

$DYNAMIC_FILE_UPLOAD ||= 0;  # make it defined (don't know why)

require Exporter;
*import = \&Exporter::import;
@EXPORT =qw(GET HEAD PUT POST);
@EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD DELETE);

require HTTP::Request;
use Carp();

$VERSION = "5.824";

my $CRLF = "\015\012";   # "\r\n" is not portable

sub GET  { _simple_req('GET',  @_); }
sub HEAD { _simple_req('HEAD', @_); }
sub PUT  { _simple_req('PUT' , @_); }
sub DELETE { _simple_req('DELETE', @_); }

sub POST
{
    my $url = shift;
    my $req = HTTP::Request->new(POST => $url);
    my $content;
    $content = shift if @_ and ref $_[0];
    my($k, $v);
    while (($k,$v) = splice(@_, 0, 2)) {
	if (lc($k) eq 'content') {
	    $content = $v;
	}
	else {
	    $req->push_header($k, $v);
	}
    }
    my $ct = $req->header('Content-Type');
    unless ($ct) {
	$ct = 'application/x-www-form-urlencoded';
    }
    elsif ($ct eq 'form-data') {
	$ct = 'multipart/form-data';
    }

    if (ref $content) {
	if ($ct =~ m,^multipart/form-data\s*(;|$),i) {
	    require HTTP::Headers::Util;
	    my @v = HTTP::Headers::Util::split_header_words($ct);
	    Carp::carp("Multiple Content-Type headers") if @v > 1;
	    @v = @{$v[0]};

	    my $boundary;
	    my $boundary_index;
	    for (my @tmp = @v; @tmp;) {
		my($k, $v) = splice(@tmp, 0, 2);
		if ($k eq "boundary") {
		    $boundary = $v;
		    $boundary_index = @v - @tmp - 1;
		    last;
		}
	    }

	    ($content, $boundary) = form_data($content, $boundary, $req);

	    if ($boundary_index) {
		$v[$boundary_index] = $boundary;
	    }
	    else {
		push(@v, boundary => $boundary);
	    }

	    $ct = HTTP::Headers::Util::join_header_words(@v);
	}
	else {
	    # We use a temporary URI object to format
	    # the application/x-www-form-urlencoded content.
	    require URI;
	    my $url = URI->new('http:');
	    $url->query_form(ref($content) eq "HASH" ? %$content : @$content);
	    $content = $url->query;
	}
    }

    $req->header('Content-Type' => $ct);  # might be redundant
    if (defined($content)) {
	$req->header('Content-Length' =>
		     length($content)) unless ref($content);
	$req->content($content);
    }
    else {
        $req->header('Content-Length' => 0);
    }
    $req;
}


sub _simple_req
{
    my($method, $url) = splice(@_, 0, 2);
    my $req = HTTP::Request->new($method => $url);
    my($k, $v);
    my $content;
    while (($k,$v) = splice(@_, 0, 2)) {
	if (lc($k) eq 'content') {
	    $req->add_content($v);
            $content++;
	}
	else {
	    $req->push_header($k, $v);
	}
    }
    if ($content && !defined($req->header("Content-Length"))) {
        $req->header("Content-Length", length(${$req->content_ref}));
    }
    $req;
}


sub form_data   # RFC1867
{
    my($data, $boundary, $req) = @_;
    my @data = ref($data) eq "HASH" ? %$data : @$data;  # copy
    my $fhparts;
    my @parts;
    my($k,$v);
    while (($k,$v) = splice(@data, 0, 2)) {
	if (!ref($v)) {
	    $k =~ s/([\\\"])/\\$1/g;  # escape quotes and backslashes
	    push(@parts,
		 qq(Content-Disposition: form-data; name="$k"$CRLF$CRLF$v));
	}
	else {
	    my($file, $usename, @headers) = @$v;
	    unless (defined $usename) {
		$usename = $file;
		$usename =~ s,.*/,, if defined($usename);
	    }
            $k =~ s/([\\\"])/\\$1/g;
	    my $disp = qq(form-data; name="$k");
            if (defined($usename) and length($usename)) {
                $usename =~ s/([\\\"])/\\$1/g;
                $disp .= qq(; filename="$usename");
            }
	    my $content = "";
	    my $h = HTTP::Headers->new(@headers);
	    if ($file) {
		open(my $fh, "<", $file) or Carp::croak("Can't open file $file: $!");
		binmode($fh);
		if ($DYNAMIC_FILE_UPLOAD) {
		    # will read file later, close it now in order to
                    # not accumulate to many open file handles
                    close($fh);
		    $content = \$file;
		}
		else {
		    local($/) = undef; # slurp files
		    $content = <$fh>;
		    close($fh);
		}
		unless ($h->header("Content-Type")) {
		    require LWP::MediaTypes;
		    LWP::MediaTypes::guess_media_type($file, $h);
		}
	    }
	    if ($h->header("Content-Disposition")) {
		# just to get it sorted first
		$disp = $h->header("Content-Disposition");
		$h->remove_header("Content-Disposition");
	    }
	    if ($h->header("Content")) {
		$content = $h->header("Content");
		$h->remove_header("Content");
	    }
	    my $head = join($CRLF, "Content-Disposition: $disp",
			           $h->as_string($CRLF),
			           "");
	    if (ref $content) {
		push(@parts, [$head, $$content]);
		$fhparts++;
	    }
	    else {
		push(@parts, $head . $content);
	    }
	}
    }
    return ("", "none") unless @parts;

    my $content;
    if ($fhparts) {
	$boundary = boundary(10) # hopefully enough randomness
	    unless $boundary;

	# add the boundaries to the @parts array
	for (1..@parts-1) {
	    splice(@parts, $_*2-1, 0, "$CRLF--$boundary$CRLF");
	}
	unshift(@parts, "--$boundary$CRLF");
	push(@parts, "$CRLF--$boundary--$CRLF");

	# See if we can generate Content-Length header
	my $length = 0;
	for (@parts) {
	    if (ref $_) {
	 	my ($head, $f) = @$_;
		my $file_size;
		unless ( -f $f && ($file_size = -s _) ) {
		    # The file is either a dynamic file like /dev/audio
		    # or perhaps a file in the /proc file system where
		    # stat may return a 0 size even though reading it
		    # will produce data.  So we cannot make
		    # a Content-Length header.  
		    undef $length;
		    last;
		}
	    	$length += $file_size + length $head;
	    }
	    else {
		$length += length;
	    }
        }
        $length && $req->header('Content-Length' => $length);

	# set up a closure that will return content piecemeal
	$content = sub {
	    for (;;) {
		unless (@parts) {
		    defined $length && $length != 0 &&
		    	Carp::croak "length of data sent did not match calculated Content-Length header.  Probably because uploaded file changed in size during transfer.";
		    return;
		}
		my $p = shift @parts;
		unless (ref $p) {
		    $p .= shift @parts while @parts && !ref($parts[0]);
		    defined $length && ($length -= length $p);
		    return $p;
		}
		my($buf, $fh) = @$p;
                unless (ref($fh)) {
                    my $file = $fh;
                    undef($fh);
                    open($fh, "<", $file) || Carp::croak("Can't open file $file: $!");
                    binmode($fh);
                }
		my $buflength = length $buf;
		my $n = read($fh, $buf, 2048, $buflength);
		if ($n) {
		    $buflength += $n;
		    unshift(@parts, ["", $fh]);
		}
		else {
		    close($fh);
		}
		if ($buflength) {
		    defined $length && ($length -= $buflength);
		    return $buf 
	    	}
	    }
	};

    }
    else {
	$boundary = boundary() unless $boundary;

	my $bno = 0;
      CHECK_BOUNDARY:
	{
	    for (@parts) {
		if (index($_, $boundary) >= 0) {
		    # must have a better boundary
		    $boundary = boundary(++$bno);
		    redo CHECK_BOUNDARY;
		}
	    }
	    last;
	}
	$content = "--$boundary$CRLF" .
	           join("$CRLF--$boundary$CRLF", @parts) .
		   "$CRLF--$boundary--$CRLF";
    }

    wantarray ? ($content, $boundary) : $content;
}


sub boundary
{
    my $size = shift || return "xYzZY";
    require MIME::Base64;
    my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
    $b =~ s/[\W]/X/g;  # ensure alnum only
    $b;
}

1;

__END__

=head1 NAME

HTTP::Request::Common - Construct common HTTP::Request objects

=head1 SYNOPSIS

  use HTTP::Request::Common;
  $ua = LWP::UserAgent->new;
  $ua->request(GET 'http://www.sn.no/');
  $ua->request(POST 'http://somewhere/foo', [foo => bar, bar => foo]);

=head1 DESCRIPTION

This module provide functions that return newly created C<HTTP::Request>
objects.  These functions are usually more convenient to use than the
standard C<HTTP::Request> constructor for the most common requests.  The
following functions are provided:

=over 4

=item GET $url

=item GET $url, Header => Value,...

The GET() function returns an C<HTTP::Request> object initialized with
the "GET" method and the specified URL.  It is roughly equivalent to the
following call

  HTTP::Request->new(
     GET => $url,
     HTTP::Headers->new(Header => Value,...),
  )

but is less cluttered.  What is different is that a header named
C<Content> will initialize the content part of the request instead of
setting a header field.  Note that GET requests should normally not
have a content, so this hack makes more sense for the PUT() and POST()
functions described below.

The get(...) method of C<LWP::UserAgent> exists as a shortcut for
$ua->request(GET ...).

=item HEAD $url

=item HEAD $url, Header => Value,...

Like GET() but the method in the request is "HEAD".

The head(...)  method of "LWP::UserAgent" exists as a shortcut for
$ua->request(HEAD ...).

=item PUT $url

=item PUT $url, Header => Value,...

=item PUT $url, Header => Value,..., Content => $content

Like GET() but the method in the request is "PUT".

The content of the request can be specified using the "Content"
pseudo-header.  This steals a bit of the header field namespace as
there is no way to directly specify a header that is actually called
"Content".  If you really need this you must update the request
returned in a separate statement.

=item DELETE $url

=item DELETE $url, Header => Value,...

Like GET() but the method in the request is "DELETE".  This function
is not exported by default.

=item POST $url

=item POST $url, Header => Value,...

=item POST $url, $form_ref, Header => Value,...

=item POST $url, Header => Value,..., Content => $form_ref

=item POST $url, Header => Value,..., Content => $content

This works mostly like PUT() with "POST" as the method, but this
function also takes a second optional array or hash reference
parameter $form_ref.  As for PUT() the content can also be specified
directly using the "Content" pseudo-header, and you may also provide
the $form_ref this way.

The $form_ref argument can be used to pass key/value pairs for the
form content.  By default we will initialize a request using the
C<application/x-www-form-urlencoded> content type.  This means that
you can emulate a HTML E<lt>form> POSTing like this:

  POST 'http://www.perl.org/survey.cgi',
       [ name   => 'Gisle Aas',
         email  => 'gisle@aas.no',
         gender => 'M',
         born   => '1964',
         perc   => '3%',
       ];

This will create a HTTP::Request object that looks like this:

  POST http://www.perl.org/survey.cgi
  Content-Length: 66
  Content-Type: application/x-www-form-urlencoded

  name=Gisle%20Aas&email=gisle%40aas.no&gender=M&born=1964&perc=3%25

Multivalued form fields can be specified by either repeating the field
name or by passing the value as an array reference.

The POST method also supports the C<multipart/form-data> content used
for I<Form-based File Upload> as specified in RFC 1867.  You trigger
this content format by specifying a content type of C<'form-data'> as
one of the request headers.  If one of the values in the $form_ref is
an array reference, then it is treated as a file part specification
with the following interpretation:

  [ $file, $filename, Header => Value... ]
  [ undef, $filename, Header => Value,..., Content => $content ]

The first value in the array ($file) is the name of a file to open.
This file will be read and its content placed in the request.  The
routine will croak if the file can't be opened.  Use an C<undef> as
$file value if you want to specify the content directly with a
C<Content> header.  The $filename is the filename to report in the
request.  If this value is undefined, then the basename of the $file
will be used.  You can specify an empty string as $filename if you
want to suppress sending the filename when you provide a $file value.

If a $file is provided by no C<Content-Type> header, then C<Content-Type>
and C<Content-Encoding> will be filled in automatically with the values
returned by LWP::MediaTypes::guess_media_type()

Sending my F<~/.profile> to the survey used as example above can be
achieved by this:

  POST 'http://www.perl.org/survey.cgi',
       Content_Type => 'form-data',
       Content      => [ name  => 'Gisle Aas',
                         email => 'gisle@aas.no',
                         gender => 'M',
                         born   => '1964',
                         init   => ["$ENV{HOME}/.profile"],
                       ]

This will create a HTTP::Request object that almost looks this (the
boundary and the content of your F<~/.profile> is likely to be
different):

  POST http://www.perl.org/survey.cgi
  Content-Length: 388
  Content-Type: multipart/form-data; boundary="6G+f"

  --6G+f
  Content-Disposition: form-data; name="name"

  Gisle Aas
  --6G+f
  Content-Disposition: form-data; name="email"

  gisle@aas.no
  --6G+f
  Content-Disposition: form-data; name="gender"

  M
  --6G+f
  Content-Disposition: form-data; name="born"

  1964
  --6G+f
  Content-Disposition: form-data; name="init"; filename=".profile"
  Content-Type: text/plain

  PATH=/local/perl/bin:$PATH
  export PATH

  --6G+f--

If you set the $DYNAMIC_FILE_UPLOAD variable (exportable) to some TRUE
value, then you get back a request object with a subroutine closure as
the content attribute.  This subroutine will read the content of any
files on demand and return it in suitable chunks.  This allow you to
upload arbitrary big files without using lots of memory.  You can even
upload infinite files like F</dev/audio> if you wish; however, if
the file is not a plain file, there will be no Content-Length header
defined for the request.  Not all servers (or server
applications) like this.  Also, if the file(s) change in size between
the time the Content-Length is calculated and the time that the last
chunk is delivered, the subroutine will C<Croak>.

The post(...)  method of "LWP::UserAgent" exists as a shortcut for
$ua->request(POST ...).

=back

=head1 SEE ALSO

L<HTTP::Request>, L<LWP::UserAgent>


=head1 COPYRIGHT

Copyright 1997-2004, Gisle Aas

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
Commit	Line	Data
3fea05b9	1	package HTTP::Request::Common;
	2
	3	use strict;
	4	use vars qw(@EXPORT @EXPORT_OK $VERSION $DYNAMIC_FILE_UPLOAD);
	5
	6	$DYNAMIC_FILE_UPLOAD \|\|= 0; # make it defined (don't know why)
	7
	8	require Exporter;
	9	*import = \&Exporter::import;
	10	@EXPORT =qw(GET HEAD PUT POST);
	11	@EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD DELETE);
	12
	13	require HTTP::Request;
	14	use Carp();
	15
	16	$VERSION = "5.824";
	17
	18	my $CRLF = "\015\012"; # "\r\n" is not portable
	19
	20	sub GET { _simple_req('GET', @_); }
	21	sub HEAD { _simple_req('HEAD', @_); }
	22	sub PUT { _simple_req('PUT' , @_); }
	23	sub DELETE { _simple_req('DELETE', @_); }
	24
	25	sub POST
	26	{
	27	my $url = shift;
	28	my $req = HTTP::Request->new(POST => $url);
	29	my $content;
	30	$content = shift if @_ and ref $_[0];
	31	my($k, $v);
	32	while (($k,$v) = splice(@_, 0, 2)) {
	33	if (lc($k) eq 'content') {
	34	$content = $v;
	35	}
	36	else {
	37	$req->push_header($k, $v);
	38	}
	39	}
	40	my $ct = $req->header('Content-Type');
	41	unless ($ct) {
	42	$ct = 'application/x-www-form-urlencoded';
	43	}
	44	elsif ($ct eq 'form-data') {
	45	$ct = 'multipart/form-data';
	46	}
	47
	48	if (ref $content) {
	49	if ($ct =~ m,^multipart/form-data\s*(;\|$),i) {
	50	require HTTP::Headers::Util;
	51	my @v = HTTP::Headers::Util::split_header_words($ct);
	52	Carp::carp("Multiple Content-Type headers") if @v > 1;
	53	@v = @{$v[0]};
	54
	55	my $boundary;
	56	my $boundary_index;
	57	for (my @tmp = @v; @tmp;) {
	58	my($k, $v) = splice(@tmp, 0, 2);
	59	if ($k eq "boundary") {
	60	$boundary = $v;
	61	$boundary_index = @v - @tmp - 1;
	62	last;
	63	}
	64	}
65
66	($content, $boundary) = form_data($content, $boundary, $req);
67
68	if ($boundary_index) {
69	$v[$boundary_index] = $boundary;
70	}
71	else {
72	push(@v, boundary => $boundary);
73	}
74
75	$ct = HTTP::Headers::Util::join_header_words(@v);
76	}
77	else {
78	# We use a temporary URI object to format
79	# the application/x-www-form-urlencoded content.
80	require URI;
81	my $url = URI->new('http:');
82	$url->query_form(ref($content) eq "HASH" ? %$content : @$content);
83	$content = $url->query;
84	}
85	}
86
87	$req->header('Content-Type' => $ct); # might be redundant
88	if (defined($content)) {
89	$req->header('Content-Length' =>
90	length($content)) unless ref($content);
91	$req->content($content);
92	}
93	else {
94	$req->header('Content-Length' => 0);
95	}
96	$req;
97	}
98
99
100	sub _simple_req
101	{
102	my($method, $url) = splice(@_, 0, 2);
103	my $req = HTTP::Request->new($method => $url);
104	my($k, $v);
105	my $content;
106	while (($k,$v) = splice(@_, 0, 2)) {
107	if (lc($k) eq 'content') {
108	$req->add_content($v);
109	$content++;
110	}
111	else {
112	$req->push_header($k, $v);
113	}
114	}
115	if ($content && !defined($req->header("Content-Length"))) {
116	$req->header("Content-Length", length(${$req->content_ref}));
117	}
118	$req;
119	}
120
121
122	sub form_data # RFC1867
123	{
124	my($data, $boundary, $req) = @_;
125	my @data = ref($data) eq "HASH" ? %$data : @$data; # copy
126	my $fhparts;
127	my @parts;
128	my($k,$v);
129	while (($k,$v) = splice(@data, 0, 2)) {
130	if (!ref($v)) {
131	$k =~ s/([\\\"])/\\$1/g; # escape quotes and backslashes
132	push(@parts,
133	qq(Content-Disposition: form-data; name="$k"$CRLF$CRLF$v));
134	}
135	else {
136	my($file, $usename, @headers) = @$v;
137	unless (defined $usename) {
138	$usename = $file;
139	$usename =~ s,.*/,, if defined($usename);
140	}
141	$k =~ s/([\\\"])/\\$1/g;
142	my $disp = qq(form-data; name="$k");
143	if (defined($usename) and length($usename)) {
144	$usename =~ s/([\\\"])/\\$1/g;
145	$disp .= qq(; filename="$usename");
146	}
147	my $content = "";
148	my $h = HTTP::Headers->new(@headers);
149	if ($file) {
150	open(my $fh, "<", $file) or Carp::croak("Can't open file $file: $!");
151	binmode($fh);
152	if ($DYNAMIC_FILE_UPLOAD) {
153	# will read file later, close it now in order to
154	# not accumulate to many open file handles
155	close($fh);
156	$content = \$file;
157	}
158	else {
159	local($/) = undef; # slurp files
160	$content = <$fh>;
161	close($fh);
162	}
163	unless ($h->header("Content-Type")) {
164	require LWP::MediaTypes;
165	LWP::MediaTypes::guess_media_type($file, $h);
166	}
167	}
168	if ($h->header("Content-Disposition")) {
169	# just to get it sorted first
170	$disp = $h->header("Content-Disposition");
171	$h->remove_header("Content-Disposition");
172	}
173	if ($h->header("Content")) {
174	$content = $h->header("Content");
175	$h->remove_header("Content");
176	}
177	my $head = join($CRLF, "Content-Disposition: $disp",
178	$h->as_string($CRLF),
179	"");
180	if (ref $content) {
181	push(@parts, [$head, $$content]);
182	$fhparts++;
183	}
184	else {
185	push(@parts, $head . $content);
186	}
187	}
188	}
189	return ("", "none") unless @parts;
190
191	my $content;
192	if ($fhparts) {
193	$boundary = boundary(10) # hopefully enough randomness
194	unless $boundary;
195
196	# add the boundaries to the @parts array
197	for (1..@parts-1) {
198	splice(@parts, $_*2-1, 0, "$CRLF--$boundary$CRLF");
199	}
200	unshift(@parts, "--$boundary$CRLF");
201	push(@parts, "$CRLF--$boundary--$CRLF");
202
203	# See if we can generate Content-Length header
204	my $length = 0;
205	for (@parts) {
206	if (ref $_) {
207	my ($head, $f) = @$_;
208	my $file_size;
209	unless ( -f $f && ($file_size = -s _) ) {
210	# The file is either a dynamic file like /dev/audio
211	# or perhaps a file in the /proc file system where
212	# stat may return a 0 size even though reading it
213	# will produce data. So we cannot make
214	# a Content-Length header.
215	undef $length;
216	last;
217	}
218	$length += $file_size + length $head;
219	}
220	else {
221	$length += length;
222	}
223	}
224	$length && $req->header('Content-Length' => $length);
225
226	# set up a closure that will return content piecemeal
227	$content = sub {
228	for (;;) {
229	unless (@parts) {
230	defined $length && $length != 0 &&
231	Carp::croak "length of data sent did not match calculated Content-Length header. Probably because uploaded file changed in size during transfer.";
232	return;
233	}
234	my $p = shift @parts;
235	unless (ref $p) {
236	$p .= shift @parts while @parts && !ref($parts[0]);
237	defined $length && ($length -= length $p);
238	return $p;
239	}
240	my($buf, $fh) = @$p;
241	unless (ref($fh)) {
242	my $file = $fh;
243	undef($fh);
244	open($fh, "<", $file) \|\| Carp::croak("Can't open file $file: $!");
245	binmode($fh);
246	}
247	my $buflength = length $buf;
248	my $n = read($fh, $buf, 2048, $buflength);
249	if ($n) {
250	$buflength += $n;
251	unshift(@parts, ["", $fh]);
252	}
253	else {
254	close($fh);
255	}
256	if ($buflength) {
257	defined $length && ($length -= $buflength);
258	return $buf
259	}
260	}
261	};
262
263	}
264	else {
265	$boundary = boundary() unless $boundary;
266
267	my $bno = 0;
268	CHECK_BOUNDARY:
269	{
270	for (@parts) {
271	if (index($_, $boundary) >= 0) {
272	# must have a better boundary
273	$boundary = boundary(++$bno);
274	redo CHECK_BOUNDARY;
275	}
276	}
277	last;
278	}
279	$content = "--$boundary$CRLF" .
280	join("$CRLF--$boundary$CRLF", @parts) .
281	"$CRLF--$boundary--$CRLF";
282	}
283
284	wantarray ? ($content, $boundary) : $content;
285	}
286
287
288	sub boundary
289	{
290	my $size = shift \|\| return "xYzZY";
291	require MIME::Base64;
292	my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
293	$b =~ s/[\W]/X/g; # ensure alnum only
294	$b;
295	}
296
297	1;
298
299	__END__
300
301	=head1 NAME
302
303	HTTP::Request::Common - Construct common HTTP::Request objects
304
305	=head1 SYNOPSIS
306
307	use HTTP::Request::Common;
308	$ua = LWP::UserAgent->new;
309	$ua->request(GET 'http://www.sn.no/');
310	$ua->request(POST 'http://somewhere/foo', [foo => bar, bar => foo]);
311
312	=head1 DESCRIPTION
313
314	This module provide functions that return newly created C<HTTP::Request>
315	objects. These functions are usually more convenient to use than the
316	standard C<HTTP::Request> constructor for the most common requests. The
317	following functions are provided:
318
319	=over 4
320
321	=item GET $url
322
323	=item GET $url, Header => Value,...
324
325	The GET() function returns an C<HTTP::Request> object initialized with
326	the "GET" method and the specified URL. It is roughly equivalent to the
327	following call
328
329	HTTP::Request->new(
330	GET => $url,
331	HTTP::Headers->new(Header => Value,...),
332	)
333
334	but is less cluttered. What is different is that a header named
335	C<Content> will initialize the content part of the request instead of
336	setting a header field. Note that GET requests should normally not
337	have a content, so this hack makes more sense for the PUT() and POST()
338	functions described below.
339
340	The get(...) method of C<LWP::UserAgent> exists as a shortcut for
341	$ua->request(GET ...).
342
343	=item HEAD $url
344
345	=item HEAD $url, Header => Value,...
346
347	Like GET() but the method in the request is "HEAD".
348
349	The head(...) method of "LWP::UserAgent" exists as a shortcut for
350	$ua->request(HEAD ...).
351
352	=item PUT $url
353
354	=item PUT $url, Header => Value,...
355
356	=item PUT $url, Header => Value,..., Content => $content
357
358	Like GET() but the method in the request is "PUT".
359
360	The content of the request can be specified using the "Content"
361	pseudo-header. This steals a bit of the header field namespace as
362	there is no way to directly specify a header that is actually called
363	"Content". If you really need this you must update the request
364	returned in a separate statement.
365
366	=item DELETE $url
367
368	=item DELETE $url, Header => Value,...
369
370	Like GET() but the method in the request is "DELETE". This function
371	is not exported by default.
372
373	=item POST $url
374
375	=item POST $url, Header => Value,...
376
377	=item POST $url, $form_ref, Header => Value,...
378
379	=item POST $url, Header => Value,..., Content => $form_ref
380
381	=item POST $url, Header => Value,..., Content => $content
382
383	This works mostly like PUT() with "POST" as the method, but this
384	function also takes a second optional array or hash reference
385	parameter $form_ref. As for PUT() the content can also be specified
386	directly using the "Content" pseudo-header, and you may also provide
387	the $form_ref this way.
388
389	The $form_ref argument can be used to pass key/value pairs for the
390	form content. By default we will initialize a request using the
391	C<application/x-www-form-urlencoded> content type. This means that
392	you can emulate a HTML E<lt>form> POSTing like this:
393
394	POST 'http://www.perl.org/survey.cgi',
395	[ name => 'Gisle Aas',
396	email => 'gisle@aas.no',
397	gender => 'M',
398	born => '1964',
399	perc => '3%',
400	];
401
402	This will create a HTTP::Request object that looks like this:
403
404	POST http://www.perl.org/survey.cgi
405	Content-Length: 66
406	Content-Type: application/x-www-form-urlencoded
407
408	name=Gisle%20Aas&email=gisle%40aas.no&gender=M&born=1964&perc=3%25
409
410	Multivalued form fields can be specified by either repeating the field
411	name or by passing the value as an array reference.
412
413	The POST method also supports the C<multipart/form-data> content used
414	for I<Form-based File Upload> as specified in RFC 1867. You trigger
415	this content format by specifying a content type of C<'form-data'> as
416	one of the request headers. If one of the values in the $form_ref is
417	an array reference, then it is treated as a file part specification
418	with the following interpretation:
419
420	[ $file, $filename, Header => Value... ]
421	[ undef, $filename, Header => Value,..., Content => $content ]
422
423	The first value in the array ($file) is the name of a file to open.
424	This file will be read and its content placed in the request. The
425	routine will croak if the file can't be opened. Use an C<undef> as
426	$file value if you want to specify the content directly with a
427	C<Content> header. The $filename is the filename to report in the
428	request. If this value is undefined, then the basename of the $file
429	will be used. You can specify an empty string as $filename if you
430	want to suppress sending the filename when you provide a $file value.
431
432	If a $file is provided by no C<Content-Type> header, then C<Content-Type>
433	and C<Content-Encoding> will be filled in automatically with the values
434	returned by LWP::MediaTypes::guess_media_type()
435
436	Sending my F<~/.profile> to the survey used as example above can be
437	achieved by this:
438
439	POST 'http://www.perl.org/survey.cgi',
440	Content_Type => 'form-data',
441	Content => [ name => 'Gisle Aas',
442	email => 'gisle@aas.no',
443	gender => 'M',
444	born => '1964',
445	init => ["$ENV{HOME}/.profile"],
446	]
447
448	This will create a HTTP::Request object that almost looks this (the
449	boundary and the content of your F<~/.profile> is likely to be
450	different):
451
452	POST http://www.perl.org/survey.cgi
453	Content-Length: 388
454	Content-Type: multipart/form-data; boundary="6G+f"
455
456	--6G+f
457	Content-Disposition: form-data; name="name"
458
459	Gisle Aas
460	--6G+f
461	Content-Disposition: form-data; name="email"
462
463	gisle@aas.no
464	--6G+f
465	Content-Disposition: form-data; name="gender"
466
467	M
468	--6G+f
469	Content-Disposition: form-data; name="born"
470
471	1964
472	--6G+f
473	Content-Disposition: form-data; name="init"; filename=".profile"
474	Content-Type: text/plain
475
476	PATH=/local/perl/bin:$PATH
477	export PATH
478
479	--6G+f--
480
481	If you set the $DYNAMIC_FILE_UPLOAD variable (exportable) to some TRUE
482	value, then you get back a request object with a subroutine closure as
483	the content attribute. This subroutine will read the content of any
484	files on demand and return it in suitable chunks. This allow you to
485	upload arbitrary big files without using lots of memory. You can even
486	upload infinite files like F</dev/audio> if you wish; however, if
487	the file is not a plain file, there will be no Content-Length header
488	defined for the request. Not all servers (or server
489	applications) like this. Also, if the file(s) change in size between
490	the time the Content-Length is calculated and the time that the last
491	chunk is delivered, the subroutine will C<Croak>.
492
493	The post(...) method of "LWP::UserAgent" exists as a shortcut for
494	$ua->request(POST ...).
495
496	=back
497
498	=head1 SEE ALSO
499
500	L<HTTP::Request>, L<LWP::UserAgent>
501
502
503	=head1 COPYRIGHT
504
505	Copyright 1997-2004, Gisle Aas
506
507	This library is free software; you can redistribute it and/or
508	modify it under the same terms as Perl itself.
509
510	=cut
511