diff options
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/HTTP/Request.pm')
-rw-r--r-- | Master/tlpkg/tlperl/site/lib/HTTP/Request.pm | 131 |
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 |