9bc82ce 11 years ago
1 contributor
391 lines | 10.996kb
package Mojo::UserAgent::Transactor;
use Mojo::Base -base;

use File::Basename 'basename';
use Mojo::Asset::File;
use Mojo::Asset::Memory;
use Mojo::Content::MultiPart;
use Mojo::Content::Single;
use Mojo::JSON;
use Mojo::Parameters;
use Mojo::Transaction::HTTP;
use Mojo::Transaction::WebSocket;
use Mojo::URL;
use Mojo::Util 'encode';

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
  return $self->_proxy($tx, $proto, $host, $port)
    if $proto eq 'http' && lc($req->headers->upgrade || '') ne 'websocket';

  return $proto, $host, $port;
}

sub form {
  my ($self, $url, $encoding) = (shift, shift, shift);
  my $form = ref $encoding ? $encoding : shift;
  $encoding = undef if ref $encoding;

  # Start with normal POST transaction
  my $tx = $self->tx(POST => $url, @_);

  # Check for uploads and force multipart if necessary
  my $multipart;
  for my $value (map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %$form) {
    ++$multipart and last if ref $value eq 'HASH';
  }
  my $req     = $tx->req;
  my $headers = $req->headers;
  $headers->content_type('multipart/form-data') if $multipart;

  # Multipart
  if ((defined $headers->content_type ? $headers->content_type : '') eq 'multipart/form-data') {
    my $parts = $self->_multipart($encoding, $form);
    $req->content(
      Mojo::Content::MultiPart->new(headers => $headers, parts => $parts));
  }

  # Urlencoded
  else {
    $headers->content_type('application/x-www-form-urlencoded');
    my $p = Mojo::Parameters->new(map { $_ => $form->{$_} } sort keys %$form);
    $p->charset($encoding) if defined $encoding;
    $req->body($p->to_string);
  }

  return $tx;
}

sub json {
  my ($self, $url, $data) = (shift, shift, shift);
  my $tx = $self->tx(POST => $url, @_, Mojo::JSON->new->encode($data));
  my $headers = $tx->req->headers;
  $headers->content_type('application/json') unless $headers->content_type;
  return $tx;
}

sub peer {
  my ($self, $tx) = @_;
  return $self->_proxy($tx, $self->endpoint($tx));
}

sub proxy_connect {
  my ($self, $old) = @_;

  # Already a CONNECT request
  my $req = $old->req;
  return undef if $req->method eq 'CONNECT';

  # No proxy
  return undef unless my $proxy = $req->proxy;

  # WebSocket and/or HTTPS
  my $url = $req->url;
  my $upgrade = lc($req->headers->upgrade || '');
  return undef unless $upgrade eq 'websocket' || $url->protocol eq 'https';

  # CONNECT request
  my $new = $self->tx(CONNECT => $url->clone->userinfo(undef));
  $new->req->proxy($proxy);

  return $new;
}

sub redirect {
  my ($self, $old) = @_;

  # Commonly used codes
  my $res = $old->res;
  my $code = defined $res->code ? $res->code : '';
  return undef unless grep { $_ eq $code } 301, 302, 303, 307, 308;

  # Fix broken location without authority and/or scheme
  return unless my $location = $res->headers->location;
  $location = Mojo::URL->new($location);
  $location = $location->base($old->req->url)->to_abs unless $location->is_abs;

  # Clone request if necessary
  my $new    = Mojo::Transaction::HTTP->new;
  my $req    = $old->req;
  my $method = $req->method;
  if (grep { $_ eq $code } 301, 307, 308) {
    return undef unless my $req = $req->clone;
    $new->req($req);
    $req->headers->remove('Host')->remove('Cookie')->remove('Referer');
  }
  elsif ($method ne 'HEAD') { $method = 'GET' }
  $new->req->method($method)->url($location);
  return $new->previous($old);
}

sub tx {
  my $self = shift;

  # Method and URL
  my $tx  = Mojo::Transaction::HTTP->new;
  my $req = $tx->req->method(shift);
  my $url = shift;
  $url = "http://$url" unless $url =~ m!^/|://!;
  ref $url ? $req->url($url) : $req->url->parse($url);

  # Headers
  $req->headers->from_hash(shift) if ref $_[0] eq 'HASH';

  # Body
  $req->body(shift) if @_;

  return $tx;
}

sub upgrade {
  my ($self, $tx) = @_;
  my $code = defined $tx->res->code ? $tx->res->code : '';
  return undef unless $tx->req->headers->upgrade && $code eq '101';
  my $ws = Mojo::Transaction::WebSocket->new(handshake => $tx, masked => 1);
  return $ws->client_challenge ? $ws : undef;
}

sub websocket {
  my $self = shift;

  # New WebSocket transaction
  my $tx    = $self->tx(GET => @_);
  my $req   = $tx->req;
  my $abs   = $req->url->to_abs;
  my $proto = $abs->protocol;
  $req->url($abs->scheme($proto eq 'wss' ? 'https' : 'http')) if $proto;

  # Handshake
  Mojo::Transaction::WebSocket->new(handshake => $tx)->client_handshake;

  return $tx;
}

sub _multipart {
  my ($self, $encoding, $form) = @_;

  my @parts;
  for my $name (sort keys %$form) {
    my $values = $form->{$name};
    for my $value (ref $values eq 'ARRAY' ? @$values : ($values)) {
      push @parts, my $part = Mojo::Content::Single->new;

      # Upload
      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} ||= basename $file->path
            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} || $name;
        $filename = encode $encoding, $filename if $encoding;
        $headers->from_hash($value);
      }

      # Field
      else {
        $value = encode $encoding, $value if $encoding;
        $part->asset(Mojo::Asset::Memory->new->add_chunk($value));
      }

      # Content-Disposition
      $name = encode $encoding, $name if $encoding;
      my $disposition = qq{form-data; name="$name"};
      $disposition .= qq{; filename="$filename"} if $filename;
      $headers->content_disposition($disposition);
    }
  }

  return \@parts;
}

sub _proxy {
  my ($self, $tx, $proto, $host, $port) = @_;

  # Update with proxy information
  if (my $proxy = $tx->req->proxy) {
    $proto = $proxy->protocol;
    $host  = $proxy->ihost;
    $port  = $proxy->port || ($proto eq 'https' ? 443 : 80);
  }

  return $proto, $host, $port;
}

1;

=head1 NAME

Mojo::UserAgent::Transactor - User agent transactor

=head1 SYNOPSIS

  use Mojo::UserAgent::Transactor;

  # Simple GET request
  my $t = Mojo::UserAgent::Transactor->new;
  say $t->tx(GET => 'http://mojolicio.us')->req->to_string;

  # PATCH request with "Do Not Track" header and content
  say $t->tx(PATCH => 'mojolicio.us' => {DNT => 1} => 'Hi!')->req->to_string;

  # POST request with form data
  say $t->form('http://kraih.com' => {a => [1, 2], b => 3})->req->to_string;

  # POST request with JSON data
  say $t->json('http://kraih.com' => {a => [1, 2], b => 3})->req->to_string;

=head1 DESCRIPTION

L<Mojo::UserAgent::Transactor> is the transaction building and manipulation
framework used by L<Mojo::UserAgent>.

=head1 METHODS

L<Mojo::UserAgent::Transactor> inherits all methods from L<Mojo::Base> and
implements the following new ones.

=head2 endpoint

  my ($proto, $host, $port) = $t->endpoint(Mojo::Transaction::HTTP->new);

Actual endpoint for transaction.

=head2 form

  my $tx = $t->form('kraih.com' => {a => 'b'});
  my $tx = $t->form('http://kraih.com' => {a => 'b'});
  my $tx = $t->form('http://kraih.com' => {a => [qw(b c d)]});
  my $tx = $t->form('http://kraih.com' => {mytext => {file => '/foo.txt'}});
  my $tx = $t->form('http://kraih.com' => {mytext => {content => 'lalala'}});
  my $tx = $t->form('http://kraih.com' =>
    {mytexts => [{content => 'first'}, {content => 'second'}]});
  my $tx = $t->form('http://kraih.com' => {
    myzip => {
      file     => Mojo::Asset::Memory->new->add_chunk('lalala'),
      filename => 'foo.zip',
      DNT      => 1
    }
  });
  my $tx = $t->form('http://kraih.com' => 'UTF-8' => {a => 'b'});
  my $tx = $t->form('http://kraih.com' => {a => 'b'} => {DNT => 1});
  my $tx = $t->form('http://kraih.com', 'UTF-8', {a => 'b'}, {DNT => 1});

Versatile L<Mojo::Transaction::HTTP> transaction builder for C<POST> requests
with form data.

  # Multipart upload with filename
  my $tx = $t->form(
    'mojolicio.us' => {fun => {content => 'Hello!', filename => 'test.txt'}});

  # Multipart upload streamed from file
  my $tx = $t->form('mojolicio.us' => {fun => {file => '/etc/passwd'}});

While the "multipart/form-data" content type will be automatically used
instead of "application/x-www-form-urlencoded" when necessary, you can also
enforce it by setting the header manually.

  # Force multipart
  my $tx = $t->form(
    'http://kraih.com/foo',
    {a => 'b'},
    {'Content-Type' => 'multipart/form-data'}
  );

=head2 json

  my $tx = $t->json('kraih.com' => {a => 'b'});
  my $tx = $t->json('http://kraih.com' => [1, 2, 3]);
  my $tx = $t->json('http://kraih.com' => {a => 'b'} => {DNT => 1});
  my $tx = $t->json('http://kraih.com' => [1, 2, 3] => {DNT => 1});

Versatile L<Mojo::Transaction::HTTP> transaction builder for C<POST> requests
with JSON data.

  # Change method
  my $tx = $t->json('mojolicio.us/hello', {hello => 'world'});
  $tx->req->method('PATCH');

=head2 peer

  my ($proto, $host, $port) = $t->peer(Mojo::Transaction::HTTP->new);

Actual peer for transaction.

=head2 proxy_connect

  my $tx = $t->proxy_connect(Mojo::Transaction::HTTP->new);

Build L<Mojo::Transaction::HTTP> proxy connect request for transaction if
possible.

=head2 redirect

  my $tx = $t->redirect(Mojo::Transaction::HTTP->new);

Build L<Mojo::Transaction::HTTP> followup request for C<301>, C<302>, C<303>,
C<307> or C<308> redirect response if possible.

=head2 tx

  my $tx = $t->tx(GET  => 'kraih.com');
  my $tx = $t->tx(POST => 'http://kraih.com');
  my $tx = $t->tx(GET  => 'http://kraih.com' => {DNT => 1});
  my $tx = $t->tx(PUT  => 'http://kraih.com' => 'Hi!');
  my $tx = $t->tx(POST => 'http://kraih.com' => {DNT => 1} => 'Hi!');

Versatile general purpose L<Mojo::Transaction::HTTP> transaction builder for
requests.

  # Inspect generated request
  say $t->tx(GET => 'mojolicio.us' => {DNT => 1} => 'Bye!')->req->to_string;

  # Streaming response
  my $tx = $t->tx(GET => 'http://mojolicio.us');
  $tx->res->body(sub { say $_[1] });

  # Custom socket
  my $tx = $t->tx(GET => 'http://mojolicio.us');
  $tx->connection($sock);

=head2 upgrade

  my $tx = $t->upgrade(Mojo::Transaction::HTTP->new);

Build L<Mojo::Transaction::WebSocket> followup transaction for WebSocket
handshake if possible.

=head2 websocket

  my $tx = $t->websocket('ws://localhost:3000');
  my $tx = $t->websocket('ws://localhost:3000' => {DNT => 1});

Versatile L<Mojo::Transaction::HTTP> transaction builder for WebSocket
handshake requests.

=head1 SEE ALSO

L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.

=cut