view release on metacpan or  search on metacpan

lib/Test2/Tools/HTTP.pm  view on Meta::CPAN

    unless $build->isa('Test2::Tools::HTTP::ResponseCompare');

  my @caller = _caller;

  my $func_name = $caller[3];
  $func_name =~ s/^.*:://;
  Carp::croak "'$func_name' should only ever be called in void context"
    if defined $caller[5];

  ($build, file => $caller[1], lines => [$caller[2]]);
}

sub _add_call
{
  my($name, $expect, $context) = @_;
  $context ||= 'scalar';
  my($build, @cmpargs) = _build;
  $build->add_call(
    $name,
    Test2::Compare::Wildcard->new(
      expect => $expect,
      @cmpargs,
    ),
    undef,
    $context
  );
}

sub http_code ($)
{
  my($expect) = @_;
  _add_call('code', $expect);
}


sub http_message ($)
{
  my($expect) = @_;
  _add_call('message', $expect);
}


sub http_content ($)
{
  my($expect) = @_;
  my($build, @cmpargs) = _build;
  $build->add_http_check(
    sub {
      my($res) = @_;
      ($res->decoded_content || $res->content, 1);
    },
    [DREF => 'content'],
    Test2::Compare::Wildcard->new(
      expect => $expect,
      @cmpargs,
    )
  );
}


sub _T()
{
  my @caller = _caller;
  Test2::Compare::Custom->new(
    code     => sub { $_ ? 1 : 0 },
    name     => 'TRUE',
    operator => 'TRUE()',
    file     => $caller[1],
    lines    => [$caller[2]],
  );
}

sub http_is_info         { _add_call('is_info',         _T()) }
sub http_is_success      { _add_call('is_success',      _T()) }
sub http_is_redirect     { _add_call('is_redirect',     _T()) }
sub http_is_error        { _add_call('is_error',        _T()) }
sub http_is_client_error { _add_call('is_client_error', _T()) }
sub http_is_server_error { _add_call('is_server_error', _T()) }


sub _F()
{
  my @caller = _caller;
  Test2::Compare::Custom->new(
    code     => sub { $_ ? 0 : 1 },
    name     => 'TRUE',
    operator => 'TRUE()',
    file     => $caller[1],
    lines    => [$caller[2]],
  );
}

sub http_isnt_info         { _add_call('is_info',         _F()) }
sub http_isnt_success      { _add_call('is_success',      _F()) }
sub http_isnt_redirect     { _add_call('is_redirect',     _F()) }
sub http_isnt_error        { _add_call('is_error',        _F()) }
sub http_isnt_client_error { _add_call('is_client_error', _F()) }
sub http_isnt_server_error { _add_call('is_server_error', _F()) }


sub http_headers
{
  my($expect) = @_;
  my($build, @cmpargs) = _build;
  $build->add_http_check(
    sub {
      my($res) = @_;

      my @headers = $res->flatten;
      my %headers;
      while(@headers)
      {
        my($key, $val) = splice @headers, 0, 2;
        push @{ $headers{$key} }, $val;
      }
      $_ = join ',', @{$_} for values %headers;

      (\%headers, 1);
    },
    [DREF => 'headers'],
    Test2::Compare::Wildcard->new(
      expect => $expect,
      @cmpargs,
    ),
  );
}


sub http_header
{
  my($name, $expect) = @_;
  my($build, @cmpargs) = _build;
  $build->add_http_check(
    sub {
      my($res) = @_;
      my @values = $res->header($name);
      return (0,0) unless @values;
      if(ref($expect) eq 'ARRAY' || eval { $expect->isa('Test2::Compare::Array') })
      {
        return ([map { split /,/, $_ } @values], 1);
      }