summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/site/lib/HTTP/Request.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/HTTP/Request.pm')
-rw-r--r--Master/tlpkg/tlperl/site/lib/HTTP/Request.pm131
1 files changed, 117 insertions, 14 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/HTTP/Request.pm b/Master/tlpkg/tlperl/site/lib/HTTP/Request.pm
index e4cb1e6d153..51150b962af 100644
--- a/Master/tlpkg/tlperl/site/lib/HTTP/Request.pm
+++ b/Master/tlpkg/tlperl/site/lib/HTTP/Request.pm
@@ -3,9 +3,9 @@ package HTTP::Request;
use strict;
use warnings;
-use base 'HTTP::Message';
+our $VERSION = '6.14';
-our $VERSION = "6.11";
+use base 'HTTP::Message';
sub new
{
@@ -20,8 +20,9 @@ sub new
sub parse
{
my($class, $str) = @_;
+ Carp::carp('Undefined argument to parse()') if $^W && ! defined $str;
my $request_line;
- if ($str =~ s/^(.*)\n//) {
+ if (defined $str && $str =~ s/^(.*)\n//) {
$request_line = $1;
}
else {
@@ -30,10 +31,12 @@ sub parse
}
my $self = $class->SUPER::parse($str);
- my($method, $uri, $protocol) = split(' ', $request_line);
- $self->method($method) if defined($method);
- $self->uri($uri) if defined($uri);
- $self->protocol($protocol) if $protocol;
+ if (defined $request_line) {
+ my($method, $uri, $protocol) = split(' ', $request_line);
+ $self->method($method);
+ $self->uri($uri) if defined($uri);
+ $self->protocol($protocol) if $protocol;
+ }
$self;
}
@@ -67,7 +70,7 @@ sub uri
Carp::croak("A URI can't be a " . ref($uri) . " reference")
if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY';
Carp::croak("Can't use a " . ref($uri) . " object as a URI")
- unless $uri->can('scheme');
+ unless $uri->can('scheme') && $uri->can('canonical');
$uri = $uri->clone;
unless ($HTTP::URI_CLASS eq "URI") {
# Argh!! Hate this... old LWP legacy!
@@ -132,12 +135,18 @@ sub dump
1;
-__END__
+=pod
+
+=encoding UTF-8
=head1 NAME
HTTP::Request - HTTP style request message
+=head1 VERSION
+
+version 6.14
+
=head1 SYNOPSIS
require HTTP::Request;
@@ -183,7 +192,7 @@ This constructs a new request object by parsing the given string.
=item $r->method( $val )
This is used to get/set the method attribute. The method should be a
-short string like "GET", "HEAD", "PUT" or "POST".
+short string like "GET", "HEAD", "PUT", "PATCH" or "POST".
=item $r->uri
@@ -227,15 +236,109 @@ Method returning a textual representation of the request.
=back
+=head1 EXAMPLES
+
+Creating requests to be sent with L<LWP::UserAgent> or others can be easy. Here
+are a few examples.
+
+=head2 Simple POST
+
+Here, we'll create a simple POST request that could be used to send JSON data
+to an endpoint.
+
+ #!/usr/bin/env perl
+
+ use strict;
+ use warnings;
+
+ use Encode qw(encode_utf8);
+ use HTTP::Request ();
+ use JSON::MaybeXS qw(encode_json);
+
+ my $url = 'https://www.example.com/api/user/123';
+ my $header = ['Content-Type' => 'application/json; charset=UTF-8'];
+ my $data = {foo => 'bar', baz => 'quux'};
+ my $encoded_data = encode_utf8(encode_json($data));
+
+ my $r = HTTP::Request->new('POST', $url, $header, $encoded_data);
+ # at this point, we could send it via LWP::UserAgent
+ # my $ua = LWP::UserAgent->new();
+ # my $res = $ua->request($r);
+
+=head2 Batch POST Request
+
+Some services, like Google, allow multiple requests to be sent in one batch.
+L<https://developers.google.com/drive/v3/web/batch> for example. Using the
+C<add_part> method from L<HTTP::Message> makes this simple.
+
+ #!/usr/bin/env perl
+
+ use strict;
+ use warnings;
+
+ use Encode qw(encode_utf8);
+ use HTTP::Request ();
+ use JSON::MaybeXS qw(encode_json);
+
+ my $auth_token = 'auth_token';
+ my $batch_url = 'https://www.googleapis.com/batch';
+ my $url = 'https://www.googleapis.com/drive/v3/files/fileId/permissions?fields=id';
+ my $url_no_email = 'https://www.googleapis.com/drive/v3/files/fileId/permissions?fields=id&sendNotificationEmail=false';
+
+ # generate a JSON post request for one of the batch entries
+ my $req1 = build_json_request($url, {
+ emailAddress => 'example@appsrocks.com',
+ role => "writer",
+ type => "user",
+ });
+
+ # generate a JSON post request for one of the batch entries
+ my $req2 = build_json_request($url_no_email, {
+ domain => "appsrocks.com",
+ role => "reader",
+ type => "domain",
+ });
+
+ # generate a multipart request to send all of the other requests
+ my $r = HTTP::Request->new('POST', $batch_url, [
+ 'Accept-Encoding' => 'gzip',
+ # if we don't provide a boundary here, HTTP::Message will generate
+ # one for us. We could use UUID::uuid() here if we wanted.
+ 'Content-Type' => 'multipart/mixed; boundary=END_OF_PART'
+ ]);
+
+ # add the two POST requests to the main request
+ $r->add_part($req1, $req2);
+ # at this point, we could send it via LWP::UserAgent
+ # my $ua = LWP::UserAgent->new();
+ # my $res = $ua->request($r);
+ exit();
+
+ sub build_json_request {
+ my ($url, $href) = @_;
+ my $header = ['Authorization' => "Bearer $auth_token", 'Content-Type' => 'application/json; charset=UTF-8'];
+ return HTTP::Request->new('POST', $url, $header, encode_utf8(encode_json($href)));
+ }
+
=head1 SEE ALSO
L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
L<HTTP::Response>
-=head1 COPYRIGHT
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
-Copyright 1995-2004 Gisle Aas.
+This software is copyright (c) 1994-2017 by Gisle Aas.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+__END__
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+#ABSTRACT: HTTP style request message