view release on metacpan or  search on metacpan

lib/JMAP/Tester/UA/LWP.pm  view on Meta::CPAN

use v5.14.0;
use warnings;

package JMAP::Tester::UA::LWP 0.109;

use Moo;
with 'JMAP::Tester::Role::UA';

use experimental 'signatures';

use Carp ();
use Future;

has lwp => (
  is   => 'ro',
  lazy => 1,
  default => sub ($self) {
    require LWP::UserAgent;
    my $lwp = LWP::UserAgent->new(keep_alive => 1);
    $lwp->cookie_jar({});

    $lwp->default_header('Content-Type' => 'application/json');

    if ($ENV{IGNORE_INVALID_CERT}) {
      $lwp->ssl_opts(SSL_verify_mode => 0, verify_hostname => 0);
    }

    return $lwp;
  },
);

sub set_cookie ($self, $arg) {
  for (qw(api_uri name value)) {
    Carp::confess("can't set_cookie without $_") unless $arg->{$_};
  }

  my $uri = URI->new($arg->{api_uri});

  $self->lwp->cookie_jar->set_cookie(
    1,
    $arg->{name},
    $arg->{value},
    '/',
    $arg->{domain} // $uri->host,
    $uri->port,
    0,
    ($uri->port == 443 ? 1 : 0),
    86400,
    0,
    $arg->{rest} || {},
  );
}

sub scan_cookies ($self, $callback) {
  return $self->lwp->cookie_jar->scan($callback);
}

sub get_default_header ($self, $name) {
  return scalar $self->lwp->default_header($name);
}

sub set_default_header ($self, $name, $value) {
  $self->lwp->default_header($name, $value);
  return;
}

sub request ($self, $tester, $req, $log_type, $log_extra = undef) {
  Carp::cluck("something very strange happened") unless $tester->can('_logger');
  my $logger = $tester->_logger;

  my $log_method = "log_" . ($log_type // 'jmap') . '_request';
  if ($logger->can($log_method)) {
    $self->lwp->set_my_handler(request_send => sub {
      my ($req) = @_;
      $logger->$log_method(
        $tester,
        {
          ($log_extra ? %$log_extra : ()),
          http_request => $req,