Initial Commit
This commit is contained in:
Riley Schneider
221
database/perl/vendor/lib/Mojo/UserAgent/CookieJar.pm
vendored
Normal file
221
database/perl/vendor/lib/Mojo/UserAgent/CookieJar.pm
vendored
Normal file
@@ -0,0 +1,221 @@
|
||||
package Mojo::UserAgent::CookieJar;
|
||||
use Mojo::Base -base;
|
||||
|
||||
use Mojo::Cookie::Request;
|
||||
use Mojo::Path;
|
||||
use Scalar::Util qw(looks_like_number);
|
||||
|
||||
has 'ignore';
|
||||
has max_cookie_size => 4096;
|
||||
|
||||
sub add {
|
||||
my ($self, @cookies) = @_;
|
||||
|
||||
my $size = $self->max_cookie_size;
|
||||
for my $cookie (@cookies) {
|
||||
|
||||
# Convert max age to expires
|
||||
my $age = $cookie->max_age;
|
||||
$cookie->expires($age <= 0 ? 0 : $age + time) if looks_like_number $age;
|
||||
|
||||
# Check cookie size
|
||||
next if length($cookie->value // '') > $size;
|
||||
|
||||
# Replace cookie
|
||||
next unless my $domain = lc($cookie->domain // '');
|
||||
next unless my $path = $cookie->path;
|
||||
next unless length(my $name = $cookie->name // '');
|
||||
my $jar = $self->{jar}{$domain} //= [];
|
||||
@$jar = (grep({ _compare($_, $path, $name, $domain) } @$jar), $cookie);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub all {
|
||||
my $jar = shift->{jar};
|
||||
return [map { @{$jar->{$_}} } sort keys %$jar];
|
||||
}
|
||||
|
||||
sub collect {
|
||||
my ($self, $tx) = @_;
|
||||
|
||||
my $url = $tx->req->url;
|
||||
for my $cookie (@{$tx->res->cookies}) {
|
||||
|
||||
# Validate domain
|
||||
my $host = lc $url->ihost;
|
||||
$cookie->domain($host)->host_only(1) unless $cookie->domain;
|
||||
my $domain = lc $cookie->domain;
|
||||
if (my $cb = $self->ignore) { next if $cb->($cookie) }
|
||||
next if $host ne $domain && ($host !~ /\Q.$domain\E$/ || $host =~ /\.\d+$/);
|
||||
|
||||
# Validate path
|
||||
my $path = $cookie->path // $url->path->to_dir->to_abs_string;
|
||||
$path = Mojo::Path->new($path)->trailing_slash(0)->to_abs_string;
|
||||
next unless _path($path, $url->path->to_abs_string);
|
||||
$self->add($cookie->path($path));
|
||||
}
|
||||
}
|
||||
|
||||
sub empty { delete shift->{jar} }
|
||||
|
||||
sub find {
|
||||
my ($self, $url) = @_;
|
||||
|
||||
my @found;
|
||||
my $domain = my $host = lc $url->ihost;
|
||||
my $path = $url->path->to_abs_string;
|
||||
while ($domain) {
|
||||
next unless my $old = $self->{jar}{$domain};
|
||||
|
||||
# Grab cookies
|
||||
my $new = $self->{jar}{$domain} = [];
|
||||
for my $cookie (@$old) {
|
||||
next if $cookie->host_only && $host ne $cookie->domain;
|
||||
|
||||
# Check if cookie has expired
|
||||
if (defined(my $expires = $cookie->expires)) { next if time > $expires }
|
||||
push @$new, $cookie;
|
||||
|
||||
# Taste cookie
|
||||
next if $cookie->secure && $url->protocol ne 'https';
|
||||
next unless _path($cookie->path, $path);
|
||||
my $name = $cookie->name;
|
||||
my $value = $cookie->value;
|
||||
push @found, Mojo::Cookie::Request->new(name => $name, value => $value);
|
||||
}
|
||||
}
|
||||
|
||||
# Remove another part
|
||||
continue { $domain =~ s/^[^.]*\.*// }
|
||||
|
||||
return \@found;
|
||||
}
|
||||
|
||||
sub prepare {
|
||||
my ($self, $tx) = @_;
|
||||
return unless keys %{$self->{jar}};
|
||||
my $req = $tx->req;
|
||||
$req->cookies(@{$self->find($req->url)});
|
||||
}
|
||||
|
||||
sub _compare {
|
||||
my ($cookie, $path, $name, $domain) = @_;
|
||||
return $cookie->path ne $path || $cookie->name ne $name || $cookie->domain ne $domain;
|
||||
}
|
||||
|
||||
sub _path { $_[0] eq '/' || $_[0] eq $_[1] || index($_[1], "$_[0]/") == 0 }
|
||||
|
||||
1;
|
||||
|
||||
=encoding utf8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Mojo::UserAgent::CookieJar - Cookie jar for HTTP user agents
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Mojo::UserAgent::CookieJar;
|
||||
|
||||
# Add response cookies
|
||||
my $jar = Mojo::UserAgent::CookieJar->new;
|
||||
$jar->add(
|
||||
Mojo::Cookie::Response->new(
|
||||
name => 'foo',
|
||||
value => 'bar',
|
||||
domain => 'localhost',
|
||||
path => '/test'
|
||||
)
|
||||
);
|
||||
|
||||
# Find request cookies
|
||||
for my $cookie (@{$jar->find(Mojo::URL->new('http://localhost/test'))}) {
|
||||
say $cookie->name;
|
||||
say $cookie->value;
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
L<Mojo::UserAgent::CookieJar> is a minimalistic and relaxed cookie jar used by L<Mojo::UserAgent>, based on L<RFC
|
||||
6265|https://tools.ietf.org/html/rfc6265>.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
L<Mojo::UserAgent::CookieJar> implements the following attributes.
|
||||
|
||||
=head2 ignore
|
||||
|
||||
my $ignore = $jar->ignore;
|
||||
$jar = $jar->ignore(sub {...});
|
||||
|
||||
A callback used to decide if a cookie should be ignored by L</"collect">.
|
||||
|
||||
# Ignore all cookies
|
||||
$jar->ignore(sub { 1 });
|
||||
|
||||
# Ignore cookies for domains "com", "net" and "org"
|
||||
$jar->ignore(sub ($cookie) {
|
||||
return undef unless my $domain = $cookie->domain;
|
||||
return $domain eq 'com' || $domain eq 'net' || $domain eq 'org';
|
||||
});
|
||||
|
||||
=head2 max_cookie_size
|
||||
|
||||
my $size = $jar->max_cookie_size;
|
||||
$jar = $jar->max_cookie_size(4096);
|
||||
|
||||
Maximum cookie size in bytes, defaults to C<4096> (4KiB).
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
L<Mojo::UserAgent::CookieJar> inherits all methods from L<Mojo::Base> and implements the following new ones.
|
||||
|
||||
=head2 add
|
||||
|
||||
$jar = $jar->add(@cookies);
|
||||
|
||||
Add multiple L<Mojo::Cookie::Response> objects to the jar.
|
||||
|
||||
=head2 all
|
||||
|
||||
my $cookies = $jar->all;
|
||||
|
||||
Return all L<Mojo::Cookie::Response> objects that are currently stored in the jar.
|
||||
|
||||
# Names of all cookies
|
||||
say $_->name for @{$jar->all};
|
||||
|
||||
=head2 collect
|
||||
|
||||
$jar->collect(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Collect response cookies from transaction.
|
||||
|
||||
=head2 empty
|
||||
|
||||
$jar->empty;
|
||||
|
||||
Empty the jar.
|
||||
|
||||
=head2 find
|
||||
|
||||
my $cookies = $jar->find(Mojo::URL->new);
|
||||
|
||||
Find L<Mojo::Cookie::Request> objects in the jar for L<Mojo::URL> object.
|
||||
|
||||
# Names of all cookies found
|
||||
say $_->name for @{$jar->find(Mojo::URL->new('http://example.com/foo'))};
|
||||
|
||||
=head2 prepare
|
||||
|
||||
$jar->prepare(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Prepare request cookies for transaction.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
||||
|
||||
=cut
|
||||
109
database/perl/vendor/lib/Mojo/UserAgent/Proxy.pm
vendored
Normal file
109
database/perl/vendor/lib/Mojo/UserAgent/Proxy.pm
vendored
Normal file
@@ -0,0 +1,109 @@
|
||||
package Mojo::UserAgent::Proxy;
|
||||
use Mojo::Base -base;
|
||||
|
||||
use Mojo::URL;
|
||||
|
||||
has [qw(http https not)];
|
||||
|
||||
sub detect {
|
||||
my $self = shift;
|
||||
$self->http($ENV{HTTP_PROXY} || $ENV{http_proxy});
|
||||
$self->https($ENV{HTTPS_PROXY} || $ENV{https_proxy});
|
||||
return $self->not([split /,/, $ENV{NO_PROXY} || $ENV{no_proxy} || '']);
|
||||
}
|
||||
|
||||
sub is_needed {
|
||||
!grep { $_[1] =~ /\Q$_\E$/ } @{$_[0]->not // []};
|
||||
}
|
||||
|
||||
sub prepare {
|
||||
my ($self, $tx) = @_;
|
||||
|
||||
$self->detect if $ENV{MOJO_PROXY};
|
||||
my $req = $tx->req;
|
||||
my $url = $req->url;
|
||||
return unless $self->is_needed($url->host);
|
||||
|
||||
# HTTP proxy
|
||||
my $proto = $url->protocol;
|
||||
my $http = $self->http;
|
||||
$req->proxy(Mojo::URL->new($http)) if $http && $proto eq 'http';
|
||||
|
||||
# HTTPS proxy
|
||||
my $https = $self->https;
|
||||
$req->proxy(Mojo::URL->new($https)) if $https && $proto eq 'https';
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=encoding utf8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Mojo::UserAgent::Proxy - User agent proxy manager
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Mojo::UserAgent::Proxy;
|
||||
|
||||
my $proxy = Mojo::UserAgent::Proxy->new;
|
||||
$proxy->detect;
|
||||
say $proxy->http;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
L<Mojo::UserAgent::Proxy> manages proxy servers for L<Mojo::UserAgent>.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
L<Mojo::UserAgent::Proxy> implements the following attributes.
|
||||
|
||||
=head2 http
|
||||
|
||||
my $http = $proxy->http;
|
||||
$proxy = $proxy->http('socks://sri:secret@127.0.0.1:8080');
|
||||
|
||||
Proxy server to use for HTTP and WebSocket requests.
|
||||
|
||||
=head2 https
|
||||
|
||||
my $https = $proxy->https;
|
||||
$proxy = $proxy->https('http://sri:secret@127.0.0.1:8080');
|
||||
|
||||
Proxy server to use for HTTPS and WebSocket requests.
|
||||
|
||||
=head2 not
|
||||
|
||||
my $not = $proxy->not;
|
||||
$proxy = $proxy->not(['localhost', 'intranet.mojolicious.org']);
|
||||
|
||||
Domains that don't require a proxy server to be used.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
L<Mojo::UserAgent::Proxy> inherits all methods from L<Mojo::Base> and implements the following new ones.
|
||||
|
||||
=head2 detect
|
||||
|
||||
$proxy = $proxy->detect;
|
||||
|
||||
Check environment variables C<HTTP_PROXY>, C<http_proxy>, C<HTTPS_PROXY>, C<https_proxy>, C<NO_PROXY> and C<no_proxy>
|
||||
for proxy information. Automatic proxy detection can be enabled with the C<MOJO_PROXY> environment variable.
|
||||
|
||||
=head2 is_needed
|
||||
|
||||
my $bool = $proxy->is_needed('intranet.example.com');
|
||||
|
||||
Check if request for domain would use a proxy server.
|
||||
|
||||
=head2 prepare
|
||||
|
||||
$proxy->prepare(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Prepare proxy server information for transaction.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
||||
|
||||
=cut
|
||||
127
database/perl/vendor/lib/Mojo/UserAgent/Server.pm
vendored
Normal file
127
database/perl/vendor/lib/Mojo/UserAgent/Server.pm
vendored
Normal file
@@ -0,0 +1,127 @@
|
||||
package Mojo::UserAgent::Server;
|
||||
use Mojo::Base -base;
|
||||
|
||||
use Mojo::IOLoop;
|
||||
use Mojo::Server::Daemon;
|
||||
use Scalar::Util qw(weaken);
|
||||
|
||||
has ioloop => sub { Mojo::IOLoop->singleton };
|
||||
|
||||
sub app {
|
||||
my ($self, $app) = @_;
|
||||
|
||||
# Singleton application
|
||||
state $singleton;
|
||||
return $singleton = $app ? $app : $singleton unless ref $self;
|
||||
|
||||
# Default to singleton application
|
||||
return $self->{app} || $singleton unless $app;
|
||||
$self->{app} = $app;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub nb_url { shift->_url(1, @_) }
|
||||
|
||||
sub restart { delete @{$_[0]}{qw(nb_port nb_server port server)} }
|
||||
|
||||
sub url { shift->_url(0, @_) }
|
||||
|
||||
sub _url {
|
||||
my ($self, $nb, $proto) = @_;
|
||||
|
||||
if (!$self->{server} || $proto) {
|
||||
$proto = $self->{proto} = $proto || 'http';
|
||||
|
||||
# Blocking
|
||||
my $server = $self->{server} = Mojo::Server::Daemon->new(ioloop => $self->ioloop, silent => 1);
|
||||
weaken $server->app($self->app)->{app};
|
||||
my $port = $self->{port} ? ":$self->{port}" : '';
|
||||
$self->{port} = $server->listen(["$proto://127.0.0.1$port"])->start->ports->[0];
|
||||
|
||||
# Non-blocking
|
||||
$server = $self->{nb_server} = Mojo::Server::Daemon->new(silent => 1);
|
||||
weaken $server->app($self->app)->{app};
|
||||
$port = $self->{nb_port} ? ":$self->{nb_port}" : '';
|
||||
$self->{nb_port} = $server->listen(["$proto://127.0.0.1$port"])->start->ports->[0];
|
||||
}
|
||||
|
||||
my $port = $nb ? $self->{nb_port} : $self->{port};
|
||||
return Mojo::URL->new("$self->{proto}://127.0.0.1:$port/");
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=encoding utf8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Mojo::UserAgent::Server - Application server
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Mojo::UserAgent::Server;
|
||||
|
||||
my $server = Mojo::UserAgent::Server->new;
|
||||
say $server->url;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
L<Mojo::UserAgent::Server> is an embedded web server based on L<Mojo::Server::Daemon> that processes requests for
|
||||
L<Mojo::UserAgent>.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
L<Mojo::UserAgent::Server> implements the following attributes.
|
||||
|
||||
=head2 ioloop
|
||||
|
||||
my $loop = $server->ioloop;
|
||||
$server = $server->ioloop(Mojo::IOLoop->new);
|
||||
|
||||
Event loop object to use for I/O operations, defaults to the global L<Mojo::IOLoop> singleton.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
L<Mojo::UserAgent::Server> inherits all methods from L<Mojo::Base> and implements the following new ones.
|
||||
|
||||
=head2 app
|
||||
|
||||
my $app = Mojo::UserAgent::Server->app;
|
||||
Mojo::UserAgent::Server->app(Mojolicious->new);
|
||||
my $app = $server->app;
|
||||
$server = $server->app(Mojolicious->new);
|
||||
|
||||
Application this server handles, instance specific applications override the global default.
|
||||
|
||||
# Change application behavior
|
||||
$server->app->defaults(testing => 'oh yea!');
|
||||
|
||||
=head2 nb_url
|
||||
|
||||
my $url = $server->nb_url;
|
||||
my $url = $server->nb_url('http');
|
||||
my $url = $server->nb_url('https');
|
||||
|
||||
Get absolute L<Mojo::URL> object for server processing non-blocking requests with L</"app"> and switch protocol if
|
||||
necessary.
|
||||
|
||||
=head2 restart
|
||||
|
||||
$server->restart;
|
||||
|
||||
Restart server with new port.
|
||||
|
||||
=head2 url
|
||||
|
||||
my $url = $server->url;
|
||||
my $url = $server->url('http');
|
||||
my $url = $server->url('https');
|
||||
|
||||
Get absolute L<Mojo::URL> object for server processing blocking requests with L</"app"> and switch protocol if
|
||||
necessary.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
||||
|
||||
=cut
|
||||
544
database/perl/vendor/lib/Mojo/UserAgent/Transactor.pm
vendored
Normal file
544
database/perl/vendor/lib/Mojo/UserAgent/Transactor.pm
vendored
Normal file
@@ -0,0 +1,544 @@
|
||||
package Mojo::UserAgent::Transactor;
|
||||
use Mojo::Base -base;
|
||||
|
||||
use Mojo::Asset::File;
|
||||
use Mojo::Asset::Memory;
|
||||
use Mojo::Content::MultiPart;
|
||||
use Mojo::Content::Single;
|
||||
use Mojo::File qw(path);
|
||||
use Mojo::JSON qw(encode_json);
|
||||
use Mojo::Parameters;
|
||||
use Mojo::Transaction::HTTP;
|
||||
use Mojo::Transaction::WebSocket;
|
||||
use Mojo::URL;
|
||||
use Mojo::Util qw(encode url_escape);
|
||||
use Mojo::WebSocket qw(challenge client_handshake);
|
||||
|
||||
has compressed => sub { $ENV{MOJO_GZIP} // 1 };
|
||||
has generators => sub { {form => \&_form, json => \&_json, multipart => \&_multipart} };
|
||||
has name => 'Mojolicious (Perl)';
|
||||
|
||||
sub add_generator { $_[0]->generators->{$_[1]} = $_[2] and return $_[0] }
|
||||
|
||||
sub endpoint {
|
||||
my ($self, $tx) = @_;
|
||||
|
||||
# Basic endpoint
|
||||
my $req = $tx->req;
|
||||
my $url = $req->url;
|
||||
my $proto = $url->protocol || 'http';
|
||||
my $host = $url->ihost;
|
||||
my $port = $url->port // ($proto eq 'https' ? 443 : 80);
|
||||
|
||||
# Proxy for normal HTTP requests
|
||||
my $socks;
|
||||
if (my $proxy = $req->proxy) { $socks = $proxy->protocol eq 'socks' }
|
||||
return _proxy($tx, $proto, $host, $port) if $proto eq 'http' && !$req->is_handshake && !$socks;
|
||||
|
||||
return $proto, $host, $port;
|
||||
}
|
||||
|
||||
sub peer { _proxy($_[1], $_[0]->endpoint($_[1])) }
|
||||
|
||||
sub promisify {
|
||||
my ($self, $promise, $tx) = @_;
|
||||
my $err = $tx->error;
|
||||
return $promise->reject($err->{message}) if $err && !$err->{code};
|
||||
return $promise->reject('WebSocket handshake failed') if $tx->req->is_handshake && !$tx->is_websocket;
|
||||
$promise->resolve($tx);
|
||||
}
|
||||
|
||||
sub proxy_connect {
|
||||
my ($self, $old) = @_;
|
||||
|
||||
# Already a CONNECT request
|
||||
my $req = $old->req;
|
||||
return undef if uc $req->method eq 'CONNECT';
|
||||
|
||||
# No proxy
|
||||
return undef unless (my $proxy = $req->proxy) && $req->via_proxy;
|
||||
return undef if $proxy->protocol eq 'socks';
|
||||
|
||||
# WebSocket and/or HTTPS
|
||||
my $url = $req->url;
|
||||
return undef unless $req->is_handshake || $url->protocol eq 'https';
|
||||
|
||||
# CONNECT request (expect a bad response)
|
||||
my $new = $self->tx(CONNECT => $url->clone->userinfo(undef));
|
||||
$new->req->proxy($proxy);
|
||||
$new->res->content->auto_relax(0)->headers->connection('keep-alive');
|
||||
|
||||
return $new;
|
||||
}
|
||||
|
||||
sub redirect {
|
||||
my ($self, $old) = @_;
|
||||
|
||||
# Commonly used codes
|
||||
my $res = $old->res;
|
||||
my $code = $res->code // 0;
|
||||
return undef unless grep { $_ == $code } 301, 302, 303, 307, 308;
|
||||
|
||||
# CONNECT requests cannot be redirected
|
||||
my $req = $old->req;
|
||||
return undef if uc $req->method eq 'CONNECT';
|
||||
|
||||
# Fix location without authority and/or scheme
|
||||
return undef unless my $location = $res->headers->every_header('Location')->[0];
|
||||
$location = Mojo::URL->new($location);
|
||||
$location = $location->base($req->url)->to_abs unless $location->is_abs;
|
||||
my $proto = $location->protocol;
|
||||
return undef if ($proto ne 'http' && $proto ne 'https') || !$location->host;
|
||||
|
||||
# Clone request if necessary
|
||||
my $new = Mojo::Transaction::HTTP->new;
|
||||
if ($code == 307 || $code == 308) {
|
||||
return undef unless my $clone = $req->clone;
|
||||
$new->req($clone);
|
||||
}
|
||||
else {
|
||||
my $method = uc $req->method;
|
||||
$method = $code == 303 || $method eq 'POST' ? 'GET' : $method;
|
||||
$new->req->method($method)->content->headers(my $headers = $req->headers->clone);
|
||||
$headers->remove($_) for grep {/^content-/i} @{$headers->names};
|
||||
}
|
||||
|
||||
$new->res->content->auto_decompress(0) unless $self->compressed;
|
||||
my $headers = $new->req->url($location)->headers;
|
||||
$headers->remove($_) for qw(Authorization Cookie Host Referer);
|
||||
|
||||
return $new->previous($old);
|
||||
}
|
||||
|
||||
sub tx {
|
||||
my ($self, $method, $url) = (shift, shift, shift);
|
||||
|
||||
# Method and URL
|
||||
my $tx = Mojo::Transaction::HTTP->new;
|
||||
my $req = $tx->req->method($method);
|
||||
ref $url ? $req->url($url) : $req->url->parse($url =~ m!^/|://! ? $url : "http://$url");
|
||||
|
||||
# Headers (we identify ourselves and accept gzip compression)
|
||||
my $headers = $req->headers;
|
||||
$headers->from_hash(shift) if ref $_[0] eq 'HASH';
|
||||
$headers->user_agent($self->name) unless $headers->user_agent;
|
||||
if (!$self->compressed) { $tx->res->content->auto_decompress(0) }
|
||||
elsif (!$headers->accept_encoding) { $headers->accept_encoding('gzip') }
|
||||
|
||||
# Generator
|
||||
if (@_ > 1) {
|
||||
my $cb = $self->generators->{shift()};
|
||||
$self->$cb($tx, @_);
|
||||
}
|
||||
|
||||
# Body
|
||||
elsif (@_) { $req->body(shift) }
|
||||
|
||||
return $tx;
|
||||
}
|
||||
|
||||
sub upgrade {
|
||||
my ($self, $tx) = @_;
|
||||
my $code = $tx->res->code // 0;
|
||||
return undef unless $tx->req->is_handshake && $code == 101;
|
||||
my $ws = Mojo::Transaction::WebSocket->new(handshake => $tx, masked => 1);
|
||||
return challenge($ws) ? $ws->established(1) : undef;
|
||||
}
|
||||
|
||||
sub websocket {
|
||||
my $self = shift;
|
||||
|
||||
# New WebSocket transaction
|
||||
my $sub = ref $_[-1] eq 'ARRAY' ? pop : [];
|
||||
my $tx = $self->tx(GET => @_);
|
||||
my $req = $tx->req;
|
||||
$req->headers->sec_websocket_protocol(join ', ', @$sub) if @$sub;
|
||||
|
||||
# Handshake protocol
|
||||
my $url = $req->url;
|
||||
my $proto = $url->protocol // '';
|
||||
if ($proto eq 'ws') { $url->scheme('http') }
|
||||
elsif ($proto eq 'wss') { $url->scheme('https') }
|
||||
elsif ($proto eq 'ws+unix') { $url->scheme('http+unix') }
|
||||
|
||||
return client_handshake $tx;
|
||||
}
|
||||
|
||||
sub _content { Mojo::Content::MultiPart->new(headers => $_[0], parts => $_[1]) }
|
||||
|
||||
sub _form {
|
||||
my ($self, $tx, $form, %options) = @_;
|
||||
$options{charset} = 'UTF-8' unless exists $options{charset};
|
||||
|
||||
# Check for uploads and force multipart if necessary
|
||||
my $req = $tx->req;
|
||||
my $headers = $req->headers;
|
||||
my $multipart = ($headers->content_type // '') =~ m!multipart/form-data!i;
|
||||
for my $value (map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %$form) {
|
||||
++$multipart and last if ref $value eq 'HASH';
|
||||
}
|
||||
|
||||
# Multipart
|
||||
if ($multipart) {
|
||||
$req->content(_content($headers, _form_parts($options{charset}, $form)));
|
||||
_type($headers, 'multipart/form-data');
|
||||
return $tx;
|
||||
}
|
||||
|
||||
# Query parameters or urlencoded
|
||||
my $method = uc $req->method;
|
||||
my @form = map { $_ => $form->{$_} } sort keys %$form;
|
||||
if ($method eq 'GET' || $method eq 'HEAD') { $req->url->query->merge(@form) }
|
||||
else {
|
||||
$req->body(Mojo::Parameters->new(@form)->charset($options{charset})->to_string);
|
||||
_type($headers, 'application/x-www-form-urlencoded');
|
||||
}
|
||||
|
||||
return $tx;
|
||||
}
|
||||
|
||||
sub _form_parts {
|
||||
my ($charset, $form) = @_;
|
||||
|
||||
my @parts;
|
||||
for my $name (sort keys %$form) {
|
||||
next unless defined(my $values = $form->{$name});
|
||||
$values = [$values] unless ref $values eq 'ARRAY';
|
||||
push @parts, @{_parts($charset, $name, $values)};
|
||||
}
|
||||
|
||||
return \@parts;
|
||||
}
|
||||
|
||||
sub _json {
|
||||
my ($self, $tx, $data) = @_;
|
||||
_type($tx->req->body(encode_json $data)->headers, 'application/json');
|
||||
return $tx;
|
||||
}
|
||||
|
||||
sub _multipart {
|
||||
my ($self, $tx, $parts) = @_;
|
||||
my $req = $tx->req;
|
||||
$req->content(_content($req->headers, _parts(undef, undef, $parts)));
|
||||
return $tx;
|
||||
}
|
||||
|
||||
sub _parts {
|
||||
my ($charset, $name, $values) = @_;
|
||||
|
||||
my @parts;
|
||||
for my $value (@$values) {
|
||||
push @parts, my $part = Mojo::Content::Single->new;
|
||||
|
||||
my $filename;
|
||||
my $headers = $part->headers;
|
||||
if (ref $value eq 'HASH') {
|
||||
|
||||
# File
|
||||
if (my $file = delete $value->{file}) {
|
||||
$file = Mojo::Asset::File->new(path => $file) unless ref $file;
|
||||
$part->asset($file);
|
||||
$value->{filename} //= path($file->path)->basename if $file->isa('Mojo::Asset::File');
|
||||
}
|
||||
|
||||
# Memory
|
||||
elsif (defined(my $content = delete $value->{content})) {
|
||||
$part->asset(Mojo::Asset::Memory->new->add_chunk($content));
|
||||
}
|
||||
|
||||
# Filename and headers
|
||||
$filename = delete $value->{filename};
|
||||
$headers->from_hash($value);
|
||||
next unless defined $name;
|
||||
$filename = url_escape $filename // $name, '"';
|
||||
$filename = encode $charset, $filename if $charset;
|
||||
}
|
||||
|
||||
# Field
|
||||
else {
|
||||
$value = encode $charset, $value if $charset;
|
||||
$part->asset(Mojo::Asset::Memory->new->add_chunk($value));
|
||||
}
|
||||
|
||||
# Content-Disposition
|
||||
next unless defined $name;
|
||||
$name = url_escape $name, '"';
|
||||
$name = encode $charset, $name if $charset;
|
||||
my $disposition = qq{form-data; name="$name"};
|
||||
$disposition .= qq{; filename="$filename"} if defined $filename;
|
||||
$headers->content_disposition($disposition);
|
||||
}
|
||||
|
||||
return \@parts;
|
||||
}
|
||||
|
||||
sub _proxy {
|
||||
my ($tx, $proto, $host, $port) = @_;
|
||||
|
||||
my $req = $tx->req;
|
||||
if ($req->via_proxy && (my $proxy = $req->proxy)) {
|
||||
return $proxy->protocol, $proxy->ihost, $proxy->port // ($proto eq 'https' ? 443 : 80);
|
||||
}
|
||||
|
||||
return $proto, $host, $port;
|
||||
}
|
||||
|
||||
sub _type { $_[0]->content_type($_[1]) unless $_[0]->content_type }
|
||||
|
||||
1;
|
||||
|
||||
=encoding utf8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Mojo::UserAgent::Transactor - User agent transactor
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Mojo::UserAgent::Transactor;
|
||||
|
||||
# GET request with Accept header
|
||||
my $t = Mojo::UserAgent::Transactor->new;
|
||||
say $t->tx(GET => 'http://example.com' => {Accept => '*/*'})->req->to_string;
|
||||
|
||||
# POST request with form-data
|
||||
say $t->tx(POST => 'example.com' => form => {a => 'b'})->req->to_string;
|
||||
|
||||
# PUT request with JSON data
|
||||
say $t->tx(PUT => 'example.com' => json => {a => 'b'})->req->to_string;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
L<Mojo::UserAgent::Transactor> is the transaction building and manipulation framework used by L<Mojo::UserAgent>.
|
||||
|
||||
=head1 GENERATORS
|
||||
|
||||
These content generators are available by default.
|
||||
|
||||
=head2 form
|
||||
|
||||
$t->tx(POST => 'http://example.com' => form => {a => 'b'});
|
||||
|
||||
Generate query string, C<application/x-www-form-urlencoded> or C<multipart/form-data> content. See L</"tx"> for more.
|
||||
|
||||
=head2 json
|
||||
|
||||
$t->tx(PATCH => 'http://example.com' => json => {a => 'b'});
|
||||
|
||||
Generate JSON content with L<Mojo::JSON>. See L</"tx"> for more.
|
||||
|
||||
=head2 multipart
|
||||
|
||||
$t->tx(PUT => 'http://example.com' => multipart => ['Hello', 'World!']);
|
||||
|
||||
Generate multipart content. See L</"tx"> for more.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
L<Mojo::UserAgent::Transactor> implements the following attributes.
|
||||
|
||||
=head2 compressed
|
||||
|
||||
my $bool = $t->compressed;
|
||||
$t = $t->compressed($bool);
|
||||
|
||||
Try to negotiate compression for the response content and decompress it automatically, defaults to the value of the
|
||||
C<MOJO_GZIP> environment variable or true.
|
||||
|
||||
=head2 generators
|
||||
|
||||
my $generators = $t->generators;
|
||||
$t = $t->generators({foo => sub {...}});
|
||||
|
||||
Registered content generators, by default only C<form>, C<json> and C<multipart> are already defined.
|
||||
|
||||
=head2 name
|
||||
|
||||
my $name = $t->name;
|
||||
$t = $t->name('Mojolicious');
|
||||
|
||||
Value for C<User-Agent> request header of generated transactions, defaults to C<Mojolicious (Perl)>.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
L<Mojo::UserAgent::Transactor> inherits all methods from L<Mojo::Base> and implements the following new ones.
|
||||
|
||||
=head2 add_generator
|
||||
|
||||
$t = $t->add_generator(foo => sub {...});
|
||||
|
||||
Register a content generator.
|
||||
|
||||
$t->add_generator(foo => sub ($t, $tx, @args) {...});
|
||||
|
||||
=head2 endpoint
|
||||
|
||||
my ($proto, $host, $port) = $t->endpoint(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Actual endpoint for transaction.
|
||||
|
||||
=head2 peer
|
||||
|
||||
my ($proto, $host, $port) = $t->peer(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Actual peer for transaction.
|
||||
|
||||
=head2 promisify
|
||||
|
||||
$t->promisify(Mojo::Promise->new, Mojo::Transaction::HTTP->new);
|
||||
|
||||
Resolve or reject L<Mojo::Promise> object with L<Mojo::Transaction::HTTP> object.
|
||||
|
||||
=head2 proxy_connect
|
||||
|
||||
my $tx = $t->proxy_connect(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Build L<Mojo::Transaction::HTTP> proxy C<CONNECT> request for transaction if possible.
|
||||
|
||||
=head2 redirect
|
||||
|
||||
my $tx = $t->redirect(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Build L<Mojo::Transaction::HTTP> follow-up request for C<301>, C<302>, C<303>, C<307> or C<308> redirect response if
|
||||
possible.
|
||||
|
||||
=head2 tx
|
||||
|
||||
my $tx = $t->tx(GET => 'example.com');
|
||||
my $tx = $t->tx(POST => 'http://example.com');
|
||||
my $tx = $t->tx(GET => 'http://example.com' => {Accept => '*/*'});
|
||||
my $tx = $t->tx(PUT => 'http://example.com' => 'Content!');
|
||||
my $tx = $t->tx(PUT => 'http://example.com' => form => {a => 'b'});
|
||||
my $tx = $t->tx(PUT => 'http://example.com' => json => {a => 'b'});
|
||||
my $tx = $t->tx(PUT => 'https://example.com' => multipart => ['a', 'b']);
|
||||
my $tx = $t->tx(POST => 'example.com' => {Accept => '*/*'} => 'Content!');
|
||||
my $tx = $t->tx(PUT => 'example.com' => {Accept => '*/*'} => form => {a => 'b'});
|
||||
my $tx = $t->tx(PUT => 'example.com' => {Accept => '*/*'} => json => {a => 'b'});
|
||||
my $tx = $t->tx(PUT => 'example.com' => {Accept => '*/*'} => multipart => ['a', 'b']);
|
||||
|
||||
Versatile general purpose L<Mojo::Transaction::HTTP> transaction builder for requests, with support for
|
||||
L</"GENERATORS">.
|
||||
|
||||
# Generate and inspect custom GET request with DNT header and content
|
||||
say $t->tx(GET => 'example.com' => {DNT => 1} => 'Bye!')->req->to_string;
|
||||
|
||||
# Stream response content to STDOUT
|
||||
my $tx = $t->tx(GET => 'http://example.com');
|
||||
$tx->res->content->unsubscribe('read')->on(read => sub { say $_[1] });
|
||||
|
||||
# PUT request with content streamed from file
|
||||
my $tx = $t->tx(PUT => 'http://example.com');
|
||||
$tx->req->content->asset(Mojo::Asset::File->new(path => '/foo.txt'));
|
||||
|
||||
The C<json> content generator uses L<Mojo::JSON> for encoding and sets the content type to C<application/json>.
|
||||
|
||||
# POST request with "application/json" content
|
||||
my $tx = $t->tx(POST => 'http://example.com' => json => {a => 'b', c => [1, 2, 3]});
|
||||
|
||||
The C<form> content generator will automatically use query parameters for C<GET> and C<HEAD> requests.
|
||||
|
||||
# GET request with query parameters
|
||||
my $tx = $t->tx(GET => 'http://example.com' => form => {a => 'b'});
|
||||
|
||||
For all other request methods the C<application/x-www-form-urlencoded> content type is used.
|
||||
|
||||
# POST request with "application/x-www-form-urlencoded" content
|
||||
my $tx = $t->tx(POST => 'http://example.com' => form => {a => 'b', c => 'd'});
|
||||
|
||||
Parameters may be encoded with the C<charset> option.
|
||||
|
||||
# PUT request with Shift_JIS encoded form values
|
||||
my $tx = $t->tx(PUT => 'example.com' => form => {a => 'b'} => charset => 'Shift_JIS');
|
||||
|
||||
An array reference can be used for multiple form values sharing the same name.
|
||||
|
||||
# POST request with form values sharing the same name
|
||||
my $tx = $t->tx(POST => 'http://example.com' => form => {a => ['b', 'c', 'd']});
|
||||
|
||||
A hash reference with a C<content> or C<file> value can be used to switch to the C<multipart/form-data> content type
|
||||
for file uploads.
|
||||
|
||||
# POST request with "multipart/form-data" content
|
||||
my $tx = $t->tx(POST => 'http://example.com' => form => {mytext => {content => 'lala'}});
|
||||
|
||||
# POST request with multiple files sharing the same name
|
||||
my $tx = $t->tx(POST => 'http://example.com' => form => {mytext => [{content => 'first'}, {content => 'second'}]});
|
||||
|
||||
The C<file> value should contain the path to the file you want to upload or an asset object, like L<Mojo::Asset::File>
|
||||
or L<Mojo::Asset::Memory>.
|
||||
|
||||
# POST request with upload streamed from file
|
||||
my $tx = $t->tx(POST => 'http://example.com' => form => {mytext => {file => '/foo.txt'}});
|
||||
|
||||
# POST request with upload streamed from asset
|
||||
my $asset = Mojo::Asset::Memory->new->add_chunk('lalala');
|
||||
my $tx = $t->tx(POST => 'http://example.com' => form => {mytext => {file => $asset}});
|
||||
|
||||
A C<filename> value will be generated automatically, but can also be set manually if necessary. All remaining values in
|
||||
the hash reference get merged into the C<multipart/form-data> content as headers.
|
||||
|
||||
# POST request with form values and customized upload (filename and header)
|
||||
my $tx = $t->tx(POST => 'http://example.com' => form => {
|
||||
a => 'b',
|
||||
c => 'd',
|
||||
mytext => {
|
||||
content => 'lalala',
|
||||
filename => 'foo.txt',
|
||||
'Content-Type' => 'text/plain'
|
||||
}
|
||||
});
|
||||
|
||||
The C<multipart/form-data> content type can also be enforced by setting the C<Content-Type> header manually.
|
||||
|
||||
# Force "multipart/form-data"
|
||||
my $headers = {'Content-Type' => 'multipart/form-data'};
|
||||
my $tx = $t->tx(POST => 'example.com' => $headers => form => {a => 'b'});
|
||||
|
||||
The C<multipart> content generator can be used to build custom multipart requests and does not set a content type.
|
||||
|
||||
# POST request with multipart content ("foo" and "bar")
|
||||
my $tx = $t->tx(POST => 'http://example.com' => multipart => ['foo', 'bar']);
|
||||
|
||||
Similar to the C<form> content generator you can also pass hash references with C<content> or C<file> values, as well
|
||||
as headers.
|
||||
|
||||
# POST request with multipart content streamed from file
|
||||
my $tx = $t->tx(POST => 'http://example.com' => multipart => [{file => '/foo.txt'}]);
|
||||
|
||||
# PUT request with multipart content streamed from asset
|
||||
my $headers = {'Content-Type' => 'multipart/custom'};
|
||||
my $asset = Mojo::Asset::Memory->new->add_chunk('lalala');
|
||||
my $tx = $t->tx(PUT => 'http://example.com' => $headers => multipart => [{file => $asset}]);
|
||||
|
||||
# POST request with multipart content and custom headers
|
||||
my $tx = $t->tx(POST => 'http://example.com' => multipart => [
|
||||
{
|
||||
content => 'Hello',
|
||||
'Content-Type' => 'text/plain',
|
||||
'Content-Language' => 'en-US'
|
||||
},
|
||||
{
|
||||
content => 'World!',
|
||||
'Content-Type' => 'text/plain',
|
||||
'Content-Language' => 'en-US'
|
||||
}
|
||||
]);
|
||||
|
||||
=head2 upgrade
|
||||
|
||||
my $tx = $t->upgrade(Mojo::Transaction::HTTP->new);
|
||||
|
||||
Build L<Mojo::Transaction::WebSocket> follow-up transaction for WebSocket handshake if possible.
|
||||
|
||||
=head2 websocket
|
||||
|
||||
my $tx = $t->websocket('ws://example.com');
|
||||
my $tx = $t->websocket('ws://example.com' => {DNT => 1} => ['v1.proto']);
|
||||
|
||||
Versatile L<Mojo::Transaction::HTTP> transaction builder for WebSocket handshake requests.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user