← Back to branch summary

~ubuntu-branches/ubuntu/dapper/libwww-perl/dapper-updates

« back to all changes in this revision

Viewing changes to lib/HTTP/Request/Common.pm

  • Committer: Bazaar Package Importer
  • Author(s): Jay Bonci
  • Date: 2005-02-13 18:45:32 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050213184532-67qvopi4wre3010u
Tags: 5.803-4
http://bugs.debian.org/294597
http://bugs.debian.org/294595
* Make GET/POST/HEAD symlinks (Closes: #294597)
* lwp-requests now honors -b when dumping links (Closes: #294595)
  - Thanks to giuseppe bonacci for the patch
* Moved symlinks to a libwww-perl.links file

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/HTTP/Request/Common.pm
1
 
# $Id: Common.pm,v 1.19 2001/01/05 18:53:11 gisle Exp $
 
1
# $Id: Common.pm,v 1.26 2004/11/15 14:52:37 gisle Exp $
2
2
#
3
3
package HTTP::Request::Common;
4
4
 
15
15
require HTTP::Request;
16
16
use Carp();
17
17
 
18
 
$VERSION = sprintf("%d.%02d", q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/);
 
18
$VERSION = sprintf("%d.%02d", q$Revision: 1.26 $ =~ /(\d+)\.(\d+)/);
19
19
 
20
20
my $CRLF = "\015\012";   # "\r\n" is not portable
21
21
 
33
33
    while (($k,$v) = splice(@_, 0, 2)) {
34
34
        if (lc($k) eq 'content') {
35
35
            $content = $v;
36
 
        } else {
 
36
        }
 
37
        else {
37
38
            $req->push_header($k, $v);
38
39
        }
39
40
    }
40
41
    my $ct = $req->header('Content-Type');
41
42
    unless ($ct) {
42
43
        $ct = 'application/x-www-form-urlencoded';
43
 
    } elsif ($ct eq 'form-data') {
 
44
    }
 
45
    elsif ($ct eq 'form-data') {
44
46
        $ct = 'multipart/form-data';
45
47
    }
46
48
 
66
68
 
67
69
            if ($boundary_index) {
68
70
                $v[$boundary_index] = $boundary;
69
 
            } else {
 
71
            }
 
72
            else {
70
73
                push(@v, boundary => $boundary);
71
74
            }
72
75
 
73
76
            $ct = HTTP::Headers::Util::join_header_words(@v);
74
 
        } else {
 
77
        }
 
78
        else {
75
79
            # We use a temporary URI object to format
76
80
            # the application/x-www-form-urlencoded content.
77
81
            require URI;
87
91
                     length($content)) unless ref($content);
88
92
        $req->content($content);
89
93
    }
 
94
    else {
 
95
        $req->header('Content-Length' => 0);
 
96
    }
90
97
    $req;
91
98
}
92
99
 
99
106
    while (($k,$v) = splice(@_, 0, 2)) {
100
107
        if (lc($k) eq 'content') {
101
108
            $req->add_content($v);
102
 
        } else {
 
109
        }
 
110
        else {
103
111
            $req->push_header($k, $v);
104
112
        }
105
113
    }
119
127
            $k =~ s/([\\\"])/\\$1/g;  # escape quotes and backslashes
120
128
            push(@parts,
121
129
                 qq(Content-Disposition: form-data; name="$k"$CRLF$CRLF$v));
122
 
        } else {
 
130
        }
 
131
        else {
123
132
            my($file, $usename, @headers) = @$v;
124
133
            unless (defined $usename) {
125
134
                $usename = $file;
129
138
            $disp .= qq(; filename="$usename") if $usename;
130
139
            my $content = "";
131
140
            my $h = HTTP::Headers->new(@headers);
132
 
            my $ct = $h->header("Content-Type");
133
141
            if ($file) {
134
142
                require Symbol;
135
143
                my $fh = Symbol::gensym();
138
146
                if ($DYNAMIC_FILE_UPLOAD) {
139
147
                    # will read file later
140
148
                    $content = $fh;
141
 
                } else {
 
149
                }
 
150
                else {
142
151
                    local($/) = undef; # slurp files
143
152
                    $content = <$fh>;
144
153
                    close($fh);
145
 
                    $h->header("Content-Length" => length($content));
146
154
                }
147
 
                unless ($ct) {
 
155
                unless ($h->header("Content-Type")) {
148
156
                    require LWP::MediaTypes;
149
 
                    $ct = LWP::MediaTypes::guess_media_type($file, $h);
 
157
                    LWP::MediaTypes::guess_media_type($file, $h);
150
158
                }
151
159
            }
152
160
            if ($h->header("Content-Disposition")) {
164
172
            if (ref $content) {
165
173
                push(@parts, [$head, $content]);
166
174
                $fhparts++;
167
 
            } else {
 
175
            }
 
176
            else {
168
177
                push(@parts, $head . $content);
169
178
            }
170
179
        }
171
180
    }
172
 
    return "" unless @parts;
 
181
    return ("", "none") unless @parts;
173
182
 
174
183
    my $content;
175
184
    if ($fhparts) {
199
208
                    last;
200
209
                }
201
210
                $length += $file_size + length $head;
202
 
            } else {
 
211
            }
 
212
            else {
203
213
                $length += length;
204
214
            }
205
215
        }
225
235
                if ($n) {
226
236
                    $buflength += $n;
227
237
                    unshift(@parts, ["", $fh]);
228
 
                } else {
 
238
                }
 
239
                else {
229
240
                    close($fh);
230
241
                }
231
242
                if ($buflength) {
235
246
            }
236
247
        };
237
248
 
238
 
    } else {
 
249
    }
 
250
    else {
239
251
        $boundary = boundary() unless $boundary;
240
252
 
241
253
        my $bno = 0;
285
297
 
286
298
=head1 DESCRIPTION
287
299
 
288
 
This module provide functions that return newly created HTTP::Request
 
300
This module provide functions that return newly created C<HTTP::Request>
289
301
objects.  These functions are usually more convenient to use than the
290
 
standard HTTP::Request constructor for these common requests.  The
291
 
following functions are provided.
 
302
standard C<HTTP::Request> constructor for the most common requests.  The
 
303
following functions are provided:
292
304
 
293
305
=over 4
294
306
 
 
307
=item GET $url
 
308
 
295
309
=item GET $url, Header => Value,...
296
310
 
297
 
The GET() function returns a HTTP::Request object initialized with the
298
 
GET method and the specified URL.  Without additional arguments it
299
 
is exactly equivalent to the following call
300
 
 
301
 
  HTTP::Request->new(GET => $url)
302
 
 
303
 
but is less cluttered.  It also reads better when used together with the
304
 
LWP::UserAgent->request() method:
305
 
 
306
 
  my $ua = new LWP::UserAgent;
307
 
  my $res = $ua->request(GET 'http://www.sn.no')
308
 
  if ($res->is_success) { ...
309
 
 
310
 
You can also initialize header values in the request by specifying
311
 
some key/value pairs as optional arguments.  For instance:
312
 
 
313
 
  $ua->request(GET 'http://www.sn.no',
314
 
                   If_Match => 'foo',
315
 
                   From     => 'gisle@aas.no',
316
 
              );
317
 
 
318
 
A header key called 'Content' is special and when seen the value will
319
 
initialize the content part of the request instead of setting a header.
320
 
 
321
 
=item HEAD $url, [Header => Value,...]
322
 
 
323
 
Like GET() but the method in the request is HEAD.
324
 
 
325
 
=item PUT $url, [Header => Value,...]
326
 
 
327
 
Like GET() but the method in the request is PUT.
328
 
 
329
 
=item POST $url, [$form_ref], [Header => Value,...]
330
 
 
331
 
This works mostly like GET() with POST as the method, but this function
 
311
The GET() function returns an C<HTTP::Request> object initialized with
 
312
the "GET" method and the specified URL.  It is roughly equivalent to the
 
313
following call
 
314
 
 
315
  HTTP::Request->new(
 
316
     GET => $url,
 
317
     HTTP::Headers->new(Header => Value,...),
 
318
  )
 
319
 
 
320
but is less cluttered.  What is different is that a header named
 
321
C<Content> will initialize the content part of the request instead of
 
322
setting a header field.  Note that GET requests should normally not
 
323
have a content, so this hack makes more sense for the PUT() and POST()
 
324
functions described below.
 
325
 
 
326
The get(...) method of C<LWP::UserAgent> exists as a shortcut for
 
327
$ua->request(GET ...).
 
328
 
 
329
=item HEAD $url
 
330
 
 
331
=item HEAD $url, Header => Value,...
 
332
 
 
333
Like GET() but the method in the request is "HEAD".
 
334
 
 
335
The head(...)  method of "LWP::UserAgent" exists as a shortcut for
 
336
$ua->request(HEAD ...).
 
337
 
 
338
=item PUT $url
 
339
 
 
340
=item PUT $url, Header => Value,...
 
341
 
 
342
=item PUT $url, Header => Value,..., Content => $content
 
343
 
 
344
Like GET() but the method in the request is "PUT".
 
345
 
 
346
=item POST $url
 
347
 
 
348
=item POST $url, Header => Value,...
 
349
 
 
350
=item POST $url, $form_ref, Header => Value,...
 
351
 
 
352
=item POST $url, Header => Value,..., Content => $form_ref
 
353
 
 
354
This works mostly like GET() with "POST" as the method, but this function
332
355
also takes a second optional array or hash reference parameter
333
356
($form_ref).  This argument can be used to pass key/value pairs for
334
357
the form content.  By default we will initialize a request using the
351
374
 
352
375
  name=Gisle%20Aas&email=gisle%40aas.no&gender=M&born=1964&perc=3%25
353
376
 
 
377
Multivalued form fields can be specified by either repeating the field
 
378
name or by passing the value as an array reference.
 
379
 
354
380
The POST method also supports the C<multipart/form-data> content used
355
381
for I<Form-based File Upload> as specified in RFC 1867.  You trigger
356
382
this content format by specifying a content type of C<'form-data'> as
359
385
with the following interpretation:
360
386
 
361
387
  [ $file, $filename, Header => Value... ]
 
388
  [ undef, $filename, Header => Value,..., Content => $content ]
362
389
 
363
390
The first value in the array ($file) is the name of a file to open.
364
391
This file will be read and its content placed in the request.  The
365
 
routine will croak if the file can't be opened.  Use an C<undef> as $file
366
 
value if you want to specify the content directly.  The $filename is
367
 
the filename to report in the request.  If this value is undefined,
368
 
then the basename of the $file will be used.  You can specify an empty
369
 
string as $filename if you don't want any filename in the request.
 
392
routine will croak if the file can't be opened.  Use an C<undef> as
 
393
$file value if you want to specify the content directly with a
 
394
C<Content> header.  The $filename is the filename to report in the
 
395
request.  If this value is undefined, then the basename of the $file
 
396
will be used.  You can specify an empty string as $filename if you
 
397
want to suppress sending the filename when you provide a $file value.
 
398
 
 
399
If a $file is provided by no C<Content-Type> header, then C<Content-Type>
 
400
and C<Content-Encoding> will be filled in automatically with the values
 
401
returned by LWP::MediaTypes::guess_media_type()
370
402
 
371
403
Sending my F<~/.profile> to the survey used as example above can be
372
404
achieved by this:
419
451
files on demand and return it in suitable chunks.  This allow you to
420
452
upload arbitrary big files without using lots of memory.  You can even
421
453
upload infinite files like F</dev/audio> if you wish; however, if
422
 
the file is not a plain file, there will be no Content-Length header 
 
454
the file is not a plain file, there will be no Content-Length header
423
455
defined for the request.  Not all servers (or server
424
456
applications) like this.  Also, if the file(s) change in size between
425
457
the time the Content-Length is calculated and the time that the last
426
458
chunk is delivered, the subroutine will C<Croak>.
427
459
 
 
460
The post(...)  method of "LWP::UserAgent" exists as a shortcut for
 
461
$ua->request(POST ...).
 
462
 
428
463
=back
429
464
 
430
465
=head1 SEE ALSO
434
469
 
435
470
=head1 COPYRIGHT
436
471
 
437
 
Copyright 1997-2000, Gisle Aas
 
472
Copyright 1997-2004, Gisle Aas
438
473
 
439
474
This library is free software; you can redistribute it and/or
440
475
modify it under the same terms as Perl itself.