gistfile1.txt

package VCR;
use Mojo::Base 'Mojolicious';
use Mojo::Server::Daemon;
use Mojo::UserAgent;
use Mojo::JSON;

use Digest::MD5 qw/md5_hex/;
use File::Path qw/make_path/;
use File::Basename qw/dirname/;
use Mojo::Util qw/decode encode/;
use utf8;

sub startup {
  my $app = shift;

  $app->attr(cassette => 'default');
  $app->attr(dir => 'cassettes');
  $app->attr([qw/http_port https_port/]);
  $app->ua(Mojo::UserAgent->new->cookie_jar(0));

  $app->routes->route('/')->detour(cb => sub {
    my $self = shift;
    $self->render_later;

    my $meth = lc $self->req->method;
    my $url = $self->req->url->to_abs;
    my $headers = $self->req->headers->to_hash;
    my $body = $self->req->body;
    my $req = [$meth, $url, $headers, $body];

    my $key = $self->key(@$req);
    my $file = join '/', $self->app->dir, $self->app->cassette, "$key.json";

    $self->serve($file) || $self->proxy($req => $file);
  });

  $app->helper(key => sub {
    my ($self, $meth, $url, $headers, $body) = @_;
    my $str = ":$meth:$url:$body";

    for my $key (sort keys %$headers) {
      $str .= ":$key:$headers->{$key}";
    }
    md5_hex $str;
  });

  $app->helper(serve => sub {
    my ($self, $file) = @_;
    if (-f $file) {
      local $/;
      open(my $fh, $file);
      my $data = <$fh>;
      close($fh);

      my $res = Mojo::JSON->new->decode($data);
      $self->res->code($res->{code});
      $self->res->headers->from_hash($res->{headers});
      $self->res->body(encode($res->{charset}, $res->{body}));
      $self->rendered;
      1;
    }
  });

  $app->helper(proxy => sub {
    my ($self, $req, $file) = @_;
    my ($meth, @args) = @$req;

    $self->ua->$meth(@args, sub {
      my $res = pop->res;
      $self->cache($req, $res, $file);
      $self->tx->res($res);
      $self->rendered;
    });
  });

  $app->helper(cache => sub {
    my ($self, $req, $res, $file) = @_;

    my $charset = $res->content->charset || $res->default_charset || 'UTF-8';

    my $json = {
      code => $res->code,
      headers => $res->headers->to_hash,
      body => decode($charset, $res->body),
      charset => $charset,
      req => $req
    };


    make_path(dirname($file));

    open(my $fh, '>', $file);
    say $fh Mojo::JSON->new->encode($json);
    close($fh);
  });
}

sub run {
  my ($class, %opts) = @_;

  my $app = $class->new(%opts);

  my $server = $app->{server} = Mojo::Server::Daemon->new(silent => 1, app => $app);

  $app->http_port(my $http_port = Mojo::IOLoop->generate_port);
  die "Couldn't find a free TCP port for testing.\n" unless $http_port;

  $app->https_port(my $https_port = Mojo::IOLoop->generate_port);
  die "Couldn't find a free TCP port for testing.\n" unless $https_port;

  $server->listen(["http://*:$http_port", "https://*:$https_port"]);
  $server->prepare_ioloop;
  $app;
}

sub inject {
  my $app = shift;
  my $http_port = $app->{http_port};
  my $https_port = $app->{https_port};

  for my $ua (@_) {
    $ua->transactor(VCR::Transactor->new);
    $ua->http_proxy("http://127.0.0.1:$http_port");
    $ua->https_proxy("https://127.0.0.1:$https_port");
    $ua->no_proxy(['localhost']);
  }

  $app;
}

sub switch {
  my ($app, $name) = shift;
  $app->cassette($name) if $name;
}

package VCR::Transactor;
use Mojo::Base 'Mojo::UserAgent::Transactor';
sub proxy_connect { }

1;