Group
Extension

WebService-BitbucketServer/lib/WebService/BitbucketServer/Response.pm

package WebService::BitbucketServer::Response;
# ABSTRACT: A response object for Bitbucket Server REST APIs


use warnings;
use strict;

our $VERSION = '0.605'; # VERSION

use Clone qw(clone);
use Types::Standard qw(HashRef Object);

use Moo;
use namespace::clean;

sub _croak { require Carp; Carp::croak(@_) }
sub _usage { _croak("Usage: @_\n") }


has context => (
    is          => 'ro',
    isa         => Object,
    required    => 1,
);


has request_args => (
    is          => 'ro',
    isa         => HashRef,
    required    => 1,
);


has raw => (
    is          => 'ro',
    isa         => HashRef,
    required    => 1,
);


has decoded_content => (
    is  => 'lazy',
);

sub _build_decoded_content {
    my $self = shift;
    my $body = $self->raw->{content};

    if (($self->raw->{headers}{'content-type'} || '') =~ /json/) {
        $body = $self->json->decode($body);
    }

    return $body;
}


has json => (
    is      => 'lazy',
    isa     => Object,
    default => sub {
        shift->context->json || do {
            require JSON::MaybeXS;
            JSON::MaybeXS->new(utf8 => 1);
        };
    },
);


sub is_success  { shift->raw->{success} }
sub status      { shift->raw->{status}  }


sub error {
    my $self = shift;

    return if $self->is_success;

    return $self->decoded_content;
}


sub data {
    my $self = shift;

    return $self->decoded_content->{values} if $self->is_paged;
    return $self->decoded_content;
}

sub info    { shift->data(@_) }
sub value   { shift->data(@_) }
sub values  { shift->data(@_) }


sub is_paged { !!shift->page_info }


has page_info => (
    is  => 'lazy',
);

sub _build_page_info {
    my $self = shift;

    my $content = $self->decoded_content;

    my @envelope_keys = qw(isLastPage limit size start values);
    return if $self->request_args->{method} ne 'GET' ||
        ref($content) ne 'HASH' || @envelope_keys != grep { exists $content->{$_} } @envelope_keys;

    return {
        filter          => $content->{filter},
        is_last_page    => $content->{isLastPage},
        limit           => $content->{limit},
        next_page_start => $content->{nextPageStart},
        size            => $content->{size},
        start           => $content->{start},
    };
}


sub next {
    my $self = shift;

    return if not my $page_info = $self->page_info;

    return if $page_info->{is_last_page} || !$page_info->{next_page_start};

    my $args = clone($self->request_args);
    $args->{data}{start} = $page_info->{next_page_start};

    return $self->context->call($args);
}


sub wrap {
    my $self    = shift;
    my $field   = shift or _usage(qw{$response->wrap($field)});

    return __PACKAGE__->new(
        context         => $self->context,
        request_args    => $self->request_args,
        raw             => $self->raw,
        decoded_content => $self->data->{$field},
        json            => $self->json,
    );
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

WebService::BitbucketServer::Response - A response object for Bitbucket Server REST APIs

=head1 VERSION

version 0.605

=head1 SYNOPSIS

    # Normal response with blocking user agent:

    my $response = $core->get_application_properties;
    my $app_info = $response->data;
    print "Making API calls to: $app_info->{displayName} $app_info->{version}\n";

    # Normal reponse with non-blocking user agent:

    my $future = $core->get_application_properties;
    $future->on_done(sub {
        my $response = shift;

        my $app_info = $response->data;
        print "Making API calls to: $app_info->{displayName} $app_info->{version}\n";
    });

    # Paged response with blocking user agent:

    my $response = $core->get_projects;
    do {
        last if $response->error;

        for my $project_info (@{ $response->values }) {
            print "$project_info->{key}\t$project_info->{name}\n"
        }
    } while ($response = $response->next);

    # Paged response with non-blocking user agent:

    my $future;
    my $print_projects;

    $print_projects = sub {
        my $response = shift;

        for my $project_info (@{ $response->values }) {
            print "$project_info->{key}\t$project_info->{name}\n"
        }

        $future = $response->next;      # get more projects
        $future->on_done($print_projects) if $future;
    };

    $future = $core->get_projects;      # get first page of projects
    $future->on_done($print_projects);

=head1 DESCRIPTION

This module represents a response from a Bitbucket Server API call. It has various convenient
accessors and provides a mechanism to handle paging.

=head1 ATTRIBUTES

=head2 context

A L<WebService::BitbucketServer> object.

=head2 request_args

A hashref of the request arguments originally provided to L<WebService::BitbucketServer/call>.

=head2 raw

The raw L<response|HTTP::AnyUA/The Response> from the server in a hashref structure similar to an
L<HTTP::Tiny> response (regardless of which user agent was used to get the response).

=head2 decoded_content

Get the decoded response content which may include page info if this is a paged response. Consider
using L</data>, L</page_info>, etc. before this.

=head2 json

Get the L<JSON::XS> (or compatible) object used for encoding and decoding documents.

=head1 METHODS

=head2 new

    $response = WebService::BitbucketServer::Response->new(
        context         => $webservice_bitbucketserver_obj,
        request_args    => $data,
        raw             => $response,
    );

Create a new response.

=head2 is_success

Get whether or not the response is a success.

=head2 status

Get the HTTP status code.

=head2 error

Get the error message or structure if this response represents an error (i.e. L</is_success> is
false), or undef if this response is not an error.

=head2 data

Get the decoded response content. If this is a paged response (see L</is_paged>), this will be an
arrayref of values.

Aliases: C<info>, C<value>, C<values>

=head2 is_paged

Get whether or not the response is a page of values.

=head2 page_info

Get a hashref of page info or undef if this is not a paged response.

=over 4

=item *

filter

=item *

is_last_page

=item *

limit

=item *

next_page_start

=item *

size

=item *

start

=back

=head2 next

    $next_response = $response->next;

Get the next page of results or undef if no more results. As with
L<WebService::BitbucketServer/call>, the returned response may be
a L<WebService::BitbucketServer::Response> or a L<Future>.

=head2 wrap

    $subresponse = $response->wrap($field);

Sometimes the response doesn't include the page information in the root object, typically when the
response has an envelope with other non-repeated information. In such cases, L</is_paged> is false
and L</page_info> is undef. You can use this method to easily create a paged response by specifying
the field name of the object that contains the page info.

=for Pod::Coverage info|value|values

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
L<https://github.com/chazmcgarvey/WebService-BitbucketServer/issues>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

Charles McGarvey <chazmcgarvey@brokenzipper.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Charles McGarvey.

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.