Group
Extension

Net-Travis-API/lib/Net/Travis/API/UA/Response.pm

use 5.010;    # _Pulp__5010_qr_m_propagate_properly
use strict;
use warnings;

package Net::Travis::API::UA::Response;

our $VERSION = '0.002001';

# ABSTRACT: Subclass of HTTP::Tiny::UA::Response for utility methods

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY













use Moo qw( extends has );




























use Encode qw( FB_CROAK );

extends 'HTTP::Tiny::UA::Response';









has 'json' => (
  is      => ro =>,
  lazy    => 1,
  builder => sub {
    require JSON::MaybeXS;
    return JSON::MaybeXS->new();
  },
);













sub content_type {
  my ($self) = @_;
  return unless exists $self->headers->{'content-type'};
  return
    unless my ($type) = $self->headers->{'content-type'} =~ qr{ \A ( [^/]+ / [^;]+ ) }msx;
  return $type;
}
















sub content_type_params {
  my ($self) = @_;
  return [] unless exists $self->headers->{'content-type'};
  return []
    unless my (@params) = $self->headers->{'content-type'} =~ qr{ (?:;([^;]+))+ }msx;
  return [@params];
}

















sub decoded_content {
  my ( $self, $force_encoding ) = @_;
  if ( not $force_encoding ) {
    return $self->content if not my $type = $self->content_type;
    return $self->content unless $type =~ qr{ \Atext/ }msx;
    for my $param ( @{ $self->content_type_params } ) {
      if ( $param =~ qr{ \Acharset=(.+)\z }msx ) {
        $force_encoding = $param;
      }
    }
    return $self->content if not $force_encoding;
  }
  return Encode::decode( $force_encoding, $self->content, Encode::FB_CROAK );
}


















sub content_json {
  my ( $self, $force ) = @_;
  my ($has_force) = ( @_ > 1 );

  my %whitelist = ( 'application/json' => 1 );
  return unless $has_force or exists $whitelist{ $self->content_type };
  my $charset = 'utf-8';
  if ( $has_force and defined $force ) {
    $charset = $force;
  }
  else {
    for my $param ( @{ $self->content_type_params } ) {
      next unless $param =~ /\Acharset=(.+)\z/msx;
      $charset = $1;
    }
  }
  return $self->json->utf8(0)->decode( $self->decoded_content($charset) );
}

no Moo;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Net::Travis::API::UA::Response - Subclass of HTTP::Tiny::UA::Response for utility methods

=head1 VERSION

version 0.002001

=head1 DESCRIPTION

This class warps extends C<HTTP::Tiny::UA::Response> and adds a few utility methods
and features that either

=over 4

=item 1. Have not yet been approved for merge

=over 2

=item * L<< github-pull:HTTP-Tiny-UA#3|https://github.com/dagolden/HTTP-Tiny-UA/pull/3 >>

=back

=item 2. Don't make sense to propagate to a general purpose HTTP User Agent.

=over 2

=item * L<< C<content_json>|/content_json >>

=back

=back

=head1 METHODS

=head2 content_type

Returns the L<< C<type/subtype>|http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.7 >> portion of the C<content-type> header.

Returns C<undef> if there was no C<content-type> header.

    if ( $result->content_type eq 'application/json' ) {
        ...
    }

=head2 content_type_params

Returns all L<< C<parameter>|http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.7 >> parts of the C<content-type> header
as an C<ArrayRef>.

Returns an empty C<ArrayRef> if no such parameters were sent in the C<content-type> header, or there was no C<content-type> header.

    for my $header ( @{ $result->content_type_params } ) {
        if ( $header =~ /^charset=(.+)/ ) {
            print "A charset of $1 was specified! :D";
        }
    }

=head2 decoded_content

Returns L<< C<< ->content >>|/content >> after applying type specific decoding.

At present, this means everything that is not C<text/*> will simply yield C<< ->content >>

And everything that is C<text/*> without a C<text/*;charset=someencoding> will simply yield C<< ->content >>

    my $foo = $result->decoded_content(); # text/* with a specified encoding interpreted properly.

Optionally, you can pass a forced encoding to apply and override smart detection.

    my $foo = $result->decoded_content('utf-8'); # type specific encodings ignored, utf-8 forced.

=head2 C<content_json>

Returns a the data decoded from JSON.

Returns C<undef> if the data

    ->content_json() # decodes automatically as per applicable encoding
                   # or returns undef if its not application/json

    ->content_json(undef) # Forces decoding as json, but defers the text encoding
                        # method to use either utf-8 or an encoding specified
                        # by a ;charset= parameter.

    ->content_json('utf-8') # Forces decoding as json, and forces the text decoding to utf-

=head1 ATTRIBUTES

=head2 C<json>

I<Optional.>

A JSON Object for decoding JSON

=begin MetaPOD::JSON v1.1.0

{
    "namespace":"Net::Travis::API::UA::Response",
    "interface":"class",
    "inherits":"HTTP::Tiny::UA::Response"
}


=end MetaPOD::JSON

=head1 AUTHOR

Kent Fredric <kentnl@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by Kent Fredric <kentfredric@gmail.com>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.