OpenAPI-Modern

 view release on metacpan or  search on metacpan

t/lib/Helper.pm  view on Meta::CPAN

# 'plack': classes of type Plack::Request, Plack::Response
# 'catalyst': classes of type Catalyst::Request, Catalyst::Response
# 'dancer2': classes of type Dancer2::Core::Request, Dancer2::Core::Response
our @TYPES = $ENV{TYPE} ? split(/,/, $ENV{TYPE}) : qw(mojo lwp plack catalyst dancer2);
our $TYPE = $ENV{TYPE} ? (split(/,/, $ENV{TYPE}))[0] : 'mojo'; # safe default

# Note: if you want your query parameters or uri fragment to be normalized, set them afterwards
# body_content can be a reference; the Content-Type header is used to determine the encoding format:
# see _generate_body
sub request ($method, $uri_string, $headers = [], $body_content = undef) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
  die 'Wide character in body content at ', join(' line ', (caller)[1,2]), ".\n"
    if not ref $body_content and length $body_content and $body_content =~ /[^\x00-\xff]/;

  ($headers, $body_content) = _generate_body($headers, $body_content) if ref $body_content;

  my $req;
  if (elem($TYPE, [qw(lwp plack catalyst dancer2)])) {
    test_needs('HTTP::Request', 'URI');

    my $uri = URI->new($uri_string);
    my $host = $uri->can('host') && $uri->host;

t/lib/Helper.pm  view on Meta::CPAN

  }
  elsif ($TYPE eq 'mojo') {
    $req = Mojo::Message::Request->new(method => $method, url => Mojo::URL->new($uri_string));
    $req->${\ (ref $body_content ? 'content' : 'body')}($body_content) if defined $body_content;
    $req->headers->add(@$_) foreach pairs @$headers;

    # add missing Content-Length, etc
    $req->fix_headers;
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  return $req;
}

# body_content can be a reference; the Content-Type header is used to determine the encoding format:
# see _generate_body
sub response ($code, $headers = [], $body_content = undef) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
  die 'Wide character in body content at ', join(' line ', (caller)[1,2]), ".\n"
    if not ref $body_content and length $body_content and $body_content =~ /[^\x00-\xff]/;

  ($headers, $body_content) = _generate_body($headers, $body_content) if ref $body_content;

  my $res;
  if ($TYPE eq 'mojo') {
    $res = Mojo::Message::Response->new(code => $code);
    $res->${\ (ref $body_content ? 'content' : 'body') }($body_content) if defined $body_content;
    $res->headers->add(@$_) foreach pairs @$headers;

t/lib/Helper.pm  view on Meta::CPAN

    test_needs({ 'Dancer2::Core::Response' => '2.1.0' }, 'HTTP::Message::PSGI', { 'HTTP::Headers::Fast' => 0.21 });
    die 'HTTP::Headers::Fast::XS is buggy and should not be used' if eval { HTTP::Headers::Fast::XS->VERSION };

    $res = Dancer2::Core::Response->new(
      status => $code,
      headers => $headers,
      defined $body_content ? (content => $body_content) : (),
    );
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  if ($TYPE eq 'lwp' or $TYPE eq 'plack' or $TYPE eq 'catalyst' or $TYPE eq 'dancer2') {
    $res->headers->header('Content-Length' => length $body_content)
      if defined $body_content
        and not defined $res->headers->header('Content-Length')
        and not defined $res->headers->header('Transfer-Encoding');
  }

  return $res;
}

sub uri ($uri_string, @path_parts) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;

  my $uri;
  if (elem($TYPE, [qw(lwp plack catalyst dancer2)])) {
    test_needs('URI');
    $uri = URI->new($uri_string);
    $uri->path_segments(@path_parts) if @path_parts;
  }
  elsif ($TYPE eq 'mojo') {
    $uri = Mojo::URL->new($uri_string);
    $uri->path->parts(\@path_parts) if @path_parts;
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  return $uri;
}

# sets query parameters on the request
sub query_params ($request, $pairs) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;

  my $uri;
  if ($TYPE eq 'lwp') {
    $request->uri->query_form($pairs);
  }
  elsif ($TYPE eq 'mojo') {
    $request->url->query->pairs($pairs);
  }
  elsif (elem($TYPE, [qw(plack catalyst dancer2)])) {
    # this is the encoded query string portion of the URI
    $request->env->{QUERY_STRING} = Mojo::Parameters->new->pairs($pairs)->to_string;
    $request->env->{REQUEST_URI} .= '?' . $request->env->{QUERY_STRING};
    $request->uri->query($request->env->{QUERY_STRING}) if $TYPE eq 'catalyst';
    # $request->_clear_parameters if $TYPE eq 'catalyst';  # might need this later
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  return $uri;
}

sub remove_header ($message, $header_name) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;

  if ($TYPE eq 'lwp') {
    $message->headers->remove_header($header_name);
  }
  elsif ($TYPE eq 'mojo') {
    $message->headers->remove($header_name);
  }
  elsif (elem($TYPE, [qw(plack catalyst dancer2)])) {
    $message->headers->remove_header($header_name);
    delete $message->env->{uc $header_name =~ s/-/_/r} if $message->can('env');
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }
}

sub _generate_body ($headers, $body_content) {
  my (undef, $content_type) = pairgrep { $a eq 'Content-Type' } @$headers;

  die 'missing Content-Type header' if not defined $content_type;

  if ($content_type eq 'application/x-www-form-urlencoded') {
    $body_content = _form_urlencoded_content($body_content);

t/lib/Helper.pm  view on Meta::CPAN

    $message = do { +require Plack::Request; Plack::Request->new($message->env) }
      if not $message->isa('Plack::Request') and not $message->isa('Plack::Response');
    my $content = Mojo::Content::MultiPart->new;
    $content->headers->content_type($message->content_type);
    $content->emit(read => $message->content);
    return map +(
      ($_->headers->content_type//'') =~ m{^multipart/(?:[\w-]+); boundary=(.+)\z},
    ), $content->parts->@*;
  }

  die 'unrecognized type ', ref $message, ' at ', join(' line ', (caller)[1,2]), ".\n";
}

# prints the method and URI of the request, or the response code and message of the response,
# or the method and URI of the two-element hash
sub to_str (@args) {
  if (@args > 1) {
    my %hash = @args;
    return $hash{method}.' '.$hash{uri};
  }

t/lib/Helper.pm  view on Meta::CPAN

  if ($message->isa('Mojo::Message::Response')) {
    return $message->code.' '.($message->message//$message->default_message);
  }
  elsif ($message->isa('HTTP::Response')) {
    return $message->code.' '.$message->message;
  }
  elsif ($message->isa('Plack::Response') or $message->isa('Catalyst::Response')) {
    return $message->status.' '.HTTP::Status::status_message($message->status);
  }

  die 'unrecognized type ', ref $message, ' at ', join(' line ', (caller)[1,2]), ".\n";
}

# create a Result object out of the document errors; suitable for stringifying
# as the OpenAPI::Modern constructor might do.
sub document_result ($document) {
  JSON::Schema::Modern::Result->new(
    valid => !$document->has_errors,
    errors => [ $document->errors ],
  );
}