package Net::GitHub::V3::Query;
our $VERSION = '1.03';
our $AUTHORITY = 'cpan:FAYLAND';
use URI;
use JSON::MaybeXS;
use MIME::Base64;
use LWP::UserAgent;
use HTTP::Request;
use Carp qw/croak/;
use URI::Escape;
use Types::Standard qw(Int Str Bool InstanceOf Object HashRef);
use Cache::LRU;
use Scalar::Util qw(looks_like_number);
use Net::GitHub::V3::ResultSet;
use Moo::Role;
# configurable args
# Authentication
has 'login' => ( is => 'rw', isa => Str, predicate => 'has_login' );
has 'pass' => ( is => 'rw', isa => Str, predicate => 'has_pass' );
has 'otp' => ( is => 'rw', isa => Str, predicate => 'has_otp' );
has 'access_token' => ( is => 'rw', isa => Str, predicate => 'has_access_token' );
# return raw unparsed JSON
has 'raw_string' => (is => 'rw', isa => Bool, default => 0);
has 'raw_response' => (is => 'rw', isa => Bool, default => 0);
has 'api_url' => (is => 'ro', default => 'https://api.github.com');
has 'api_throttle' => ( is => 'rw', isa => Bool, default => 1 );
has 'upload_url' => (is => 'ro', default => 'https://uploads.github.com');
# pagination
has 'next_url' => ( is => 'rw', isa => Str, predicate => 'has_next_page', clearer => 'clear_next_url' );
has 'last_url' => ( is => 'rw', isa => Str, predicate => 'has_last_page', clearer => 'clear_last_url' );
has 'first_url' => ( is => 'rw', isa => Str, predicate => 'has_first_page', clearer => 'clear_first_url' );
has 'prev_url' => ( is => 'rw', isa => Str, predicate => 'has_prev_page', clearer => 'clear_prev_url' );
has 'per_page' => ( is => 'rw', isa => Str, default => 100 );
has 'total_pages' => ( is => 'rw', isa => Str, default => 0 );
# deprecation
has 'deprecation_url' => ( is => 'rw', isa => Str );
has 'alternate_url' => ( is => 'rw', isa => Str );
# Error handle
has 'RaiseError' => ( is => 'rw', isa => Bool, default => 1 );
# Rate limits
# has 'rate_limit' => ( is => 'rw', isa => Int, default => sub { shift->update_rate_limit('rate_limit') } );
# has 'rate_limit_remaining' => ( is => 'rw', isa => Int, default => sub { shift->update_rate_limit('rate_limit_remaining') } );
# has 'rate_limit_reset' => ( is => 'rw', isa => Str, default => sub { shift->update_rate_limit('rate_limit_reset') } );
has 'rate_limit' => ( is => 'rw', isa => Int, default => sub { 0 } );
has 'rate_limit_remaining' => ( is => 'rw', isa => Int, default => sub { 0 } );
has 'rate_limit_reset' => ( is => 'rw', isa => Str, default => sub { 0 } );
# optional
has 'u' => (is => 'rw', isa => Str);
has 'repo' => (is => 'rw', isa => Str);
# accept version
has 'accept_version' => (is => 'rw', isa => Str, default => '');
has 'is_main_module' => (is => 'ro', isa => Bool, default => 0);
sub update_rate_limit {
my ( $self, $what ) = @_;
# If someone calls rate_limit before an API query happens, force these fields to update before giving back a response.
# Per github: Accessing this endpoint does not count against your REST API rate limit.
# https://developer.github.com/v3/rate_limit/
my $content = $self->query('/rate_limit');
return $self->{$what};
}
sub set_default_user_repo {
my ($self, $user, $repo) = @_;
$self->u($user);
$self->repo($repo);
# need apply to all sub modules
if ($self->is_main_module) {
if ($self->is_repos_init) {
$self->repos->u($user); $self->repos->repo($repo);
}
if ($self->is_issue_init) {
$self->issue->u($user); $self->issue->repo($repo);
}
if ($self->is_pull_request_init) {
$self->pull_request->u($user); $self->pull_request->repo($repo);
}
if ($self->is_git_data_init) {
$self->git_data->u($user); $self->git_data->repo($repo);
}
}
return $self;
}
sub args_to_pass {
my $self = shift;
my $ret;
foreach my $col ('login', 'pass', 'otp', 'access_token', 'raw_string', 'raw_response', 'api_url', 'api_throttle', 'u', 'repo', 'next_url', 'last_url', 'first_url', 'prev_url', 'per_page', 'ua') {
my $v = $self->$col;
$ret->{$col} = $v if defined $v;
}
return $ret;
}
has 'ua' => (
isa => InstanceOf['LWP::UserAgent'],
is => 'ro',
lazy => 1,
default => sub {
LWP::UserAgent->new(
agent => "perl-net-github/$VERSION",
cookie_jar => {},
keep_alive => 4,
timeout => 60,
);
},
);
has 'json' => (
is => 'ro',
isa => Object, # InstanceOf['JSON::MaybeXS'],
lazy => 1,
default => sub {
return JSON::MaybeXS->new( utf8 => 1 );
}
);
has 'cache' => (
isa => InstanceOf['Cache::LRU'],
is => 'rw',
lazy => 1,
default => sub {
Cache::LRU->new(
size => 200
);
}
);
# per-page pagination
has 'result_sets' => (
isa => HashRef,
is => 'ro',
default => sub { {} },
);
sub next {
my $self = shift;
my ($url) = @_;
my $result_set;
$result_set = $self->result_sets->{$url} or do {
$result_set = Net::GitHub::V3::ResultSet->new( url => $url );
$self->result_sets->{$url} = $result_set;
};
my $results = $result_set->results;
my $cursor = $result_set->cursor;
if ( $cursor > $#$results ) {
return if $result_set->done;
my $next_url = $result_set->next_url || $result_set->url;
my $new_result = $self->query($next_url);
$result_set->results(ref $new_result eq 'ARRAY' ?
$new_result :
[$new_result]
);
$result_set->cursor(0);
if ($self->has_next_page) {
$result_set->next_url($self->next_url);
}
else {
$result_set->done(1);
}
}
my $result = $result_set->results->[$result_set->cursor];
$result_set->cursor($result_set->cursor + 1);
return $result;
}
sub close {
my $self = shift;
my ($url) = @_;
delete $self->result_sets->{$url};
return;
}
sub query {
my $self = shift;
# fix ARGV, not sure if it's the good idea
my @args = @_;
if (@args == 1) {
unshift @args, 'GET'; # method by default
} elsif (@args > 1 and not (grep { $args[0] eq $_ } ('GET', 'POST', 'PUT', 'PATCH', 'HEAD', 'DELETE')) ) {
unshift @args, 'POST'; # if POST content
}
my $request_method = shift @args;
my $url = shift @args;
my $data = shift @args;
my $ua = $self->ua;
## always go with login:pass or access_token (for private repos)
if ($self->has_access_token) {
$ua->default_header('Authorization', "token " . $self->access_token);
} elsif ($self->has_login and $self->has_pass) {
my $auth_basic = $self->login . ':' . $self->pass;
$ua->default_header('Authorization', 'Basic ' . encode_base64($auth_basic));
if ($self->has_otp) {
$ua->default_header('X-GitHub-OTP', $self->otp);
}
}
$url = $self->api_url . $url unless $url =~ /^https\:/;
if ($request_method eq 'GET') {
if ($url !~ /per_page=\d/) {
## auto add per_page in url for GET no matter it supports or not
my $uri = URI->new($url);
my %query_form = $uri->query_form;
$query_form{per_page} ||= $self->per_page;
$uri->query_form(%query_form);
$url = $uri->as_string;
}
if ($data and ref $data eq 'HASH') {
my $uri = URI->new($url);
my %query_form = $uri->query_form;
$uri->query_form(%$data);
$url = $uri->as_string;
}
}
print STDERR ">>> $request_method $url\n" if $ENV{NG_DEBUG};
my $req = HTTP::Request->new( $request_method, $url );
$req->accept_decodable;
if ($request_method ne 'GET' and $data) {
my $json = $self->json->encode($data);
print STDERR ">>> $json\n" if $ENV{NG_DEBUG} and $ENV{NG_DEBUG} > 1;
$req->content($json);
}
$req->header( 'Content-Length' => length $req->content );
# if preview API, specify a custom media type to Accept header
# https://developer.github.com/v3/media/
$req->header( 'Accept' => sprintf("application/vnd.github.%s.param+json", $self->accept_version) )
if $self->accept_version;
my $res = $self->_make_request($req);
# get the rate limit information from the http response headers
$self->rate_limit( $res->header('x-ratelimit-limit') );
$self->rate_limit_remaining( $res->header('x-ratelimit-remaining') );
$self->rate_limit_reset( $res->header('x-ratelimit-reset') );
# Slow down if we're approaching the rate limit
# By the way GitHub mistakes days for minutes in their documentation --
# the rate limit is per minute, not per day.
if ( $self->api_throttle ) {
sleep 2 if (($self->rate_limit_remaining || 0)
< ($self->rate_limit || 60) / 2);
}
print STDERR "<<< " . $res->decoded_content . "\n" if $ENV{NG_DEBUG} and $ENV{NG_DEBUG} > 1;
return $res if $self->raw_response;
return $res->decoded_content if $self->raw_string;
if ($res->header('Content-Type') and $res->header('Content-Type') =~ 'application/json') {
my $json = $res->decoded_content;
$data = eval { $self->json->decode($json) };
unless ($data) {
# We tolerate bad JSON for errors,
# otherwise we just rethrow the JSON parsing problem.
die unless $res->is_error;
$data = { message => $res->message };
}
} else {
$data = { message => $res->message };
}
if ( $self->RaiseError ) {
# check for 'Client Errors'
if (not $res->is_success and ref $data eq 'HASH' and exists $data->{message}) {
my $message = $data->{message};
# Include any additional error information that was returned by the API
if (exists $data->{errors}) {
$message .= ': '.join(' - ',
map { $_->{message} }
grep { exists $_->{message} }
@{ $data->{errors} });
}
croak $message;
}
}
$self->_clear_pagination;
if ($res->header('link')) {
my @rel_strs = split ',', $res->header('link');
$self->_extract_link_url(\@rel_strs);
}
## be smarter
if (wantarray) {
return @$data if ref $data eq 'ARRAY';
return %$data if ref $data eq 'HASH';
}
return $data;
}
sub set_next_page {
my ($self, $page) = @_;
if( ! looks_like_number($page) ){
croak "Trying to set_next_page to $page, and not a number\n";
}
if( $page > $self->total_page && $page > 0 ){
return 0;
}
my $temp_url = $self->next_url;
$temp_url =~ s/([&?])page=[0-9]+([&?]*)/$1page=$page$2/;
$self->next_url( $temp_url );
return 1;
}
sub next_page {
my $self = shift;
return $self->query($self->next_url);
}
sub prev_page {
my $self = shift;
return $self->query($self->prev_url);
}
sub first_page {
my $self = shift;
return $self->query($self->first_url);
}
sub last_page {
my $self = shift;
return $self->query($self->last_url);
}
sub _clear_pagination {
my $self = shift;
foreach my $page (qw/first last prev next/) {
my $clearer = 'clear_' . $page . '_url';
$self->$clearer;
}
return 1;
}
sub iterate {
my ( $self, $method, $args, $callback ) = @_;
die "This is a method class" unless ref $self;
die "Need a method name as second argument" unless defined $method && $self->can($method);
die "Missing a callback function as third argument" unless ref $callback eq 'CODE';
my @list_args; # 3rd argument
if ( ref $args eq 'ARRAY' ) {
@list_args = @$args;
} elsif ( ref $args eq 'HASH' ) {
# used for v2 api which are passing a hash of named parameters instead of a list
@list_args = $args;
} else {
@list_args = $args; # can be undefined [need to preserve it instead of an empty list]
}
my $chunk = $self->can($method)->( $self, $args );
my $continue = 1;
while ( ref $chunk eq 'ARRAY' && scalar @$chunk ) {
# process a chunk
foreach my $item ( @$chunk ) {
$continue = $callback->( $item );
last unless $continue; # user has requested to stop iterating
}
last unless $continue; # user has requested to stop iterating
# get the next chunk
last unless $self->has_next_page;
$chunk = $self->next_page;
}
$self->_clear_pagination;
return;
}
sub _extract_link_url {
my ($self, $raw_strs) = @_;
foreach my $str (@$raw_strs) {
my ($link_url, $rel) = split ';', $str;
$link_url =~ s/^\s*//;
$link_url =~ s/^/;
$link_url =~ s/>$//;
if( $rel =~ m/rel="(next|last|first|prev|deprecation|alternate)"/ ){
$rel = $1;
}
elsif( $rel=~ m/rel="(.*?)"/ ){
warn "Unexpected link rel='$1' in '$str'";
next;
}
else {
warn "Unable to process link rel in '$str'";
next;
}
if( $rel eq 'deprecation' ){
warn "Deprecation warning: $link_url\n";
}
my $url_attr = $rel . "_url";
$self->$url_attr($link_url);
# Grab, and expose, some additional header information
if( $rel eq "last" ){
$link_url =~ /[\&?]page=([0-9]*)[\&?]*/;
$self->total_pages( $1 );
}
}
return 1;
}
sub _make_request {
my($self, $req) = @_;
my $cached_res = $self->_get_shared_cache($req->uri);
if ($cached_res) {
$req->header("If-None-Match" => $cached_res->header("ETag"));
my $res = $self->ua->request($req);
if ($res->code == 304) {
return $cached_res;
}
$self->_set_shared_cache($req->uri, $res);
return $res;
} else {
my $res = $self->ua->request($req);
$self->_set_shared_cache( $req->uri, $res);
return $res;
}
}
sub _get_shared_cache {
my ($self, $uri) = @_;
return $self->cache->get($uri);
}
sub _set_shared_cache {
my($self, $uri, $response) = @_;
$self->cache->set($uri, $response);
}
## build methods on fly
sub __build_methods {
my $package = shift;
my %methods = @_;
foreach my $m (keys %methods) {
my $v = $methods{$m};
my $url = $v->{url};
my $method = $v->{method} || 'GET';
my $args = $v->{args} || 0; # args for ->query
my $check_status = $v->{check_status};
my $is_u_repo = $v->{is_u_repo}; # need auto shift u/repo
my $preview_version = $v->{preview};
my $paginate = $v->{paginate};
my $version = $v->{v} || $v->{version} || 1; # version for the accessor
# count how much %s inside u
my $n = 0; while ($url =~ /\%s/g) { $n++ }
no strict 'refs';
no warnings 'once';
*{"${package}::${m}"} = sub {
my $self = shift;
my ( $u, @qargs );
if ( $version == 2 ) {
my $opts = {};
if ( ref $_[0] ) {
my ( $_opts, $_qargs ) = @_;
$opts = $_opts;
if ( my $ref = ref $_qargs ) {
@qargs = @$_qargs if $ref eq 'ARRAY';
@qargs = $_qargs if $ref eq 'HASH';
}
} else { # backward compatibility
my $u = $url;
while ( $u =~ s{:([a-z_]+)}{} ) {
my $k = $1;
#next if defined $opts->{$k};
$opts->{$k} = shift;
die "$k value is not a scalar value $opts->{$k}" if ref $opts->{$k};
}
@qargs = $args ? splice(@_, 0, $args) : ();
}
# we can now use named :parameter in the url itself
$u = "$url";
{
no warnings;
$u =~ s{:([a-z_]+)}{$opts->{$1}}g;
}
} else {
## if is_u_repo, both ($user, $repo, @args) or (@args) should be supported
if ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {
unshift @_, ($self->u, $self->repo);
}
# make url, replace %s with real args
my @uargs = splice(@_, 0, $n);
$u = sprintf($url, @uargs);
# args for json data POST
@qargs = $args ? splice(@_, 0, $args) : ();
}
# if preview API, set preview version
$self->accept_version($preview_version) if $preview_version;
if ($check_status) { # need check Response Status
my $old_raw_response = $self->raw_response;
$self->raw_response(1); # need check header
my $res = $self->query($method, $u, @qargs);
$self->raw_response($old_raw_response);
return index($res->header('Status'), $check_status) > -1 ? 1 : 0;
} else {
return $self->query($method, $u, @qargs);
}
};
if ($paginate) {
# Add methods next... and close...
# Make method names singular (next_comments to next_comment)
$m =~ s/s$//;
my $m_name = ref $paginate ? $paginate->{name} : $m;
*{"${package}::next_${m_name}"} = sub {
my $self = shift;
# count how much %s inside u
my $n = 0; while ($url =~ /\%s/g) { $n++ }
## if is_u_repo, both ($user, $repo, @args) or (@args) should be supported
if ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {
unshift @_, ($self->u, $self->repo);
}
# make url, replace %s with real args
my @uargs = map { defined $_ ? $_ : '' } splice(@_, 0, $n);
my $u = sprintf($url, @uargs);
# if preview API, set preview version
$self->accept_version($preview_version) if $preview_version;
return $self->next($u);
};
*{"${package}::close_${m_name}"} = sub {
my $self = shift;
# count how much %s inside u
my $n = 0; while ($url =~ /\%s/g) { $n++ }
## if is_u_repo, both ($user, $repo, @args) or (@args) should be supported
if ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {
unshift @_, ($self->u, $self->repo);
}
# make url, replace %s with real args
my @uargs = splice(@_, 0, $n);
my $u = sprintf($url, @uargs);
# if preview API, set preview version
$self->accept_version($preview_version) if $preview_version;
$self->close($u);
};
}
}
}
no Moo::Role;
1;
__END__
=head1 NAME
Net::GitHub::V3::Query - Base Query role for Net::GitHub::V3
=head1 SYNOPSIS
package Net::GitHub::V3::XXX;
use Moo;
with 'Net::GitHub::V3::Query';
=head1 DESCRIPTION
set Authentication and call API
=head2 ATTRIBUTES
=over 4
=item login
=item pass
=item access_token
Either set access_token from OAuth or login:pass for Basic Authentication
L
=item raw_string
=item raw_response
=item api_throttle
API throttling is enabled by default, set api_throttle to 0 to disable it.
=item rate_limit
The maximum number of queries allowed per hour. 60 for anonymous users and
5,000 for authenticated users.
=item rate_limit_remaining
The number of requests remaining in the current rate limit window.
=item rate_limit_reset
The time the current rate limit resets in UTC epoch seconds.
=item update_rate_limit
Query the /rate_limit API (for free) to update the cached values for rate_limit, rate_limit_remaining, rate_limit_reset
=item last_page
Denotes the index of the last page in the pagination
=item RaiseError
=back
=head2 METHODS
=over 4
=item query
Refer L
=item next_page
Calls C with C. See L
=item prev_page
Calls C with C. See L
=item first_page
Calls C with C. See L
=item last_page
Calls C with C. See L
=item set_next_page
Adjusts next_url to be a new url in the pagination space
I.E. you are jumping to a new index in the pagination
=item iterate($method_name, $arguments, $callback)
This provides an helper to iterate over APIs call using pagination,
using the combo: has_next_page, next_page... for you.
The arguments can be either a scalar if the function is using
a single argument, an ArrayRef when the function is using multiple
arguments. You can also use one HashRef for functions supporting named
parameters.
The callback function is called with a single item.
The return value of the callback function can be used to stop the
iteration when returning a 'false' value.
In common cases, you want to return a true value: '1'.
Sample usage:
$gh->org->iterate( 'repos', 'OrganizationName', sub {
my $item = shift;
print "Repo Name is $item->{name}"
return 1; # if you want to continue iterating
return; # use a false value when you want to interrupt the iteration
} );
=item result_sets
For internal use by the item-per-item pagination: This is a store of
the state(s) for the pagination. Each entry maps the initial URL of a
GitHub query to a L object.
=item next($url)
Returns the next item for the query which started at $url, or undef if
there are no more items.
=item close($url)
Terminates the item-per-item pagination for the query which started at
$url.
=back
=head3 NG_DEBUG
export NG_DEBUG=1 to view the request URL
NG_DEBUG > 1 to view request/response string
=head1 AUTHOR & COPYRIGHT & LICENSE
Refer L