1package Net::GitHub::V3::Query;
2
3our $VERSION = '1.02';
4our $AUTHORITY = 'cpan:FAYLAND';
5
6use URI;
7use JSON::MaybeXS;
8use MIME::Base64;
9use LWP::UserAgent;
10use HTTP::Request;
11use Carp qw/croak/;
12use URI::Escape;
13use Types::Standard qw(Int Str Bool InstanceOf Object HashRef);
14use Cache::LRU;
15
16use Scalar::Util qw(looks_like_number);
17
18use Net::GitHub::V3::ResultSet;
19
20use Moo::Role;
21
22# configurable args
23
24# Authentication
25has 'login'  => ( is => 'rw', isa => Str, predicate => 'has_login' );
26has 'pass'  => ( is => 'rw', isa => Str, predicate => 'has_pass' );
27has 'otp'  => ( is => 'rw', isa => Str, predicate => 'has_otp' );
28has 'access_token' => ( is => 'rw', isa => Str, predicate => 'has_access_token' );
29
30# return raw unparsed JSON
31has 'raw_string' => (is => 'rw', isa => Bool, default => 0);
32has 'raw_response' => (is => 'rw', isa => Bool, default => 0);
33
34has 'api_url' => (is => 'ro', default => 'https://api.github.com');
35has 'api_throttle' => ( is => 'rw', isa => Bool, default => 1 );
36
37has 'upload_url' => (is => 'ro', default => 'https://uploads.github.com');
38
39# pagination
40has 'next_url'  => ( is => 'rw', isa => Str, predicate => 'has_next_page',  clearer => 'clear_next_url' );
41has 'last_url'  => ( is => 'rw', isa => Str, predicate => 'has_last_page',  clearer => 'clear_last_url' );
42has 'first_url' => ( is => 'rw', isa => Str, predicate => 'has_first_page', clearer => 'clear_first_url' );
43has 'prev_url'  => ( is => 'rw', isa => Str, predicate => 'has_prev_page',  clearer => 'clear_prev_url' );
44has 'per_page'  => ( is => 'rw', isa => Str, default => 100 );
45has 'total_pages'  => ( is => 'rw', isa => Str, default => 0 );
46
47# deprecation
48has 'deprecation_url' => ( is => 'rw', isa => Str );
49has 'alternate_url'   => ( is => 'rw', isa => Str );
50
51# Error handle
52has 'RaiseError' => ( is => 'rw', isa => Bool, default => 1 );
53
54# Rate limits
55# has 'rate_limit'           => ( is => 'rw', isa => Int, default => sub { shift->update_rate_limit('rate_limit') } );
56# has 'rate_limit_remaining' => ( is => 'rw', isa => Int, default => sub { shift->update_rate_limit('rate_limit_remaining') } );
57# has 'rate_limit_reset'     => ( is => 'rw', isa => Str, default => sub { shift->update_rate_limit('rate_limit_reset') } );
58has 'rate_limit'           => ( is => 'rw', isa => Int, default => sub { 0 } );
59has 'rate_limit_remaining' => ( is => 'rw', isa => Int, default => sub { 0 } );
60has 'rate_limit_reset'     => ( is => 'rw', isa => Str, default => sub { 0 } );
61
62# optional
63has 'u'  => (is => 'rw', isa => Str);
64has 'repo' => (is => 'rw', isa => Str);
65
66# accept version
67has 'accept_version' => (is => 'rw', isa => Str, default => '');
68
69has 'is_main_module' => (is => 'ro', isa => Bool, default => 0);
70
71sub update_rate_limit {
72    my ( $self, $what ) = @_;
73
74    # If someone calls rate_limit before an API query happens, force these fields to update before giving back a response.
75    # Per github: Accessing this endpoint does not count against your REST API rate limit.
76    # https://developer.github.com/v3/rate_limit/
77    my $content = $self->query('/rate_limit');
78
79    return $self->{$what};
80}
81
82sub set_default_user_repo {
83    my ($self, $user, $repo) = @_;
84
85    $self->u($user);
86    $self->repo($repo);
87
88    # need apply to all sub modules
89    if ($self->is_main_module) {
90        if ($self->is_repos_init) {
91            $self->repos->u($user); $self->repos->repo($repo);
92        }
93        if ($self->is_issue_init) {
94            $self->issue->u($user); $self->issue->repo($repo);
95        }
96        if ($self->is_pull_request_init) {
97            $self->pull_request->u($user); $self->pull_request->repo($repo);
98        }
99        if ($self->is_git_data_init) {
100            $self->git_data->u($user); $self->git_data->repo($repo);
101        }
102    }
103
104    return $self;
105}
106
107sub args_to_pass {
108    my $self = shift;
109    my $ret;
110    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') {
111        my $v = $self->$col;
112        $ret->{$col} = $v if defined $v;
113    }
114    return $ret;
115}
116
117has 'ua' => (
118    isa     => InstanceOf['LWP::UserAgent'],
119    is      => 'ro',
120    lazy    => 1,
121    default => sub {
122        LWP::UserAgent->new(
123            agent       => "perl-net-github/$VERSION",
124            cookie_jar  => {},
125            keep_alive  => 4,
126            timeout     => 60,
127        );
128    },
129);
130
131has 'json' => (
132    is => 'ro',
133    isa => Object, # InstanceOf['JSON::MaybeXS'],
134    lazy => 1,
135    default => sub {
136        return JSON::MaybeXS->new( utf8 => 1 );
137    }
138);
139
140has 'cache' => (
141  isa => InstanceOf['Cache::LRU'],
142  is => 'rw',
143  lazy => 1,
144  default => sub {
145    Cache::LRU->new(
146      size => 200
147    );
148  }
149);
150
151# per-page pagination
152
153has 'result_sets' => (
154  isa => HashRef,
155  is => 'ro',
156  default => sub { {} },
157);
158
159sub next {
160    my $self = shift;
161    my ($url) = @_;
162    my $result_set;
163    $result_set = $self->result_sets->{$url}  or  do {
164        $result_set = Net::GitHub::V3::ResultSet->new( url => $url );
165        $self->result_sets->{$url} = $result_set;
166    };
167    my $results    = $result_set->results;
168    my $cursor     = $result_set->cursor;
169    if ( $cursor > $#$results ) {
170        return if $result_set->done;
171        my $next_url = $result_set->next_url || $result_set->url;
172        my $new_result = $self->query($next_url);
173        $result_set->results(ref $new_result eq 'ARRAY' ?
174                                 $new_result :
175                                 [$new_result]
176        );
177        $result_set->cursor(0);
178        if ($self->has_next_page) {
179            $result_set->next_url($self->next_url);
180        }
181        else {
182            $result_set->done(1);
183        }
184    }
185    my $result = $result_set->results->[$result_set->cursor];
186    $result_set->cursor($result_set->cursor + 1);
187    return $result;
188}
189
190
191sub close {
192    my $self = shift;
193    my ($url) = @_;
194    delete $self->result_sets->{$url};
195    return;
196}
197
198
199sub query {
200    my $self = shift;
201
202    # fix ARGV, not sure if it's the good idea
203    my @args = @_;
204    if (@args == 1) {
205        unshift @args, 'GET'; # method by default
206    } elsif (@args > 1 and not (grep { $args[0] eq $_ } ('GET', 'POST', 'PUT', 'PATCH', 'HEAD', 'DELETE')) ) {
207        unshift @args, 'POST'; # if POST content
208    }
209    my $request_method = shift @args;
210    my $url = shift @args;
211    my $data = shift @args;
212
213    my $ua = $self->ua;
214
215    ## always go with login:pass or access_token (for private repos)
216    if ($self->has_access_token) {
217        $ua->default_header('Authorization', "token " . $self->access_token);
218    } elsif ($self->has_login and $self->has_pass) {
219        my $auth_basic = $self->login . ':' . $self->pass;
220        $ua->default_header('Authorization', 'Basic ' . encode_base64($auth_basic));
221        if ($self->has_otp) {
222            $ua->default_header('X-GitHub-OTP', $self->otp);
223        }
224    }
225
226    $url = $self->api_url . $url unless $url =~ /^https\:/;
227    if ($request_method eq 'GET') {
228        if ($url !~ /per_page=\d/) {
229            ## auto add per_page in url for GET no matter it supports or not
230            my $uri = URI->new($url);
231            my %query_form = $uri->query_form;
232            $query_form{per_page} ||= $self->per_page;
233            $uri->query_form(%query_form);
234            $url = $uri->as_string;
235        }
236        if ($data and ref $data eq 'HASH') {
237            my $uri = URI->new($url);
238            my %query_form = $uri->query_form;
239            $uri->query_form(%$data);
240            $url = $uri->as_string;
241        }
242    }
243
244    print STDERR ">>> $request_method $url\n" if $ENV{NG_DEBUG};
245    my $req = HTTP::Request->new( $request_method, $url );
246    $req->accept_decodable;
247    if ($request_method ne 'GET' and $data) {
248        my $json = $self->json->encode($data);
249        print STDERR ">>> $json\n" if $ENV{NG_DEBUG} and $ENV{NG_DEBUG} > 1;
250        $req->content($json);
251    }
252    $req->header( 'Content-Length' => length $req->content );
253
254    # if preview API, specify a custom media type to Accept header
255    # https://developer.github.com/v3/media/
256    $req->header( 'Accept' => sprintf("application/vnd.github.%s.param+json", $self->accept_version) )
257        if $self->accept_version;
258
259    my $res = $self->_make_request($req);
260
261    # get the rate limit information from the http response headers
262    $self->rate_limit( $res->header('x-ratelimit-limit') );
263    $self->rate_limit_remaining( $res->header('x-ratelimit-remaining') );
264    $self->rate_limit_reset( $res->header('x-ratelimit-reset') );
265
266    # Slow down if we're approaching the rate limit
267    # By the way GitHub mistakes days for minutes in their documentation --
268    # the rate limit is per minute, not per day.
269    if ( $self->api_throttle ) {
270        sleep 2 if (($self->rate_limit_remaining || 0)
271            < ($self->rate_limit || 60) / 2);
272    }
273
274    print STDERR "<<< " . $res->decoded_content . "\n" if $ENV{NG_DEBUG} and $ENV{NG_DEBUG} > 1;
275    return $res if $self->raw_response;
276    return $res->decoded_content if $self->raw_string;
277
278    if ($res->header('Content-Type') and $res->header('Content-Type') =~ 'application/json') {
279        my $json = $res->decoded_content;
280        $data = eval { $self->json->decode($json) };
281        unless ($data) {
282            # We tolerate bad JSON for errors,
283            # otherwise we just rethrow the JSON parsing problem.
284            die unless $res->is_error;
285            $data = { message => $res->message };
286        }
287    } else {
288        $data = { message => $res->message };
289    }
290
291    if ( $self->RaiseError ) {
292        # check for 'Client Errors'
293        if (not $res->is_success and ref $data eq 'HASH' and exists $data->{message}) {
294            my $message = $data->{message};
295
296            # Include any additional error information that was returned by the API
297            if (exists $data->{errors}) {
298                $message .= ': '.join(' - ',
299                                     map { $_->{message} }
300                                     grep { exists $_->{message} }
301                                     @{ $data->{errors} });
302            }
303            croak $message;
304        }
305    }
306
307    $self->_clear_pagination;
308    if ($res->header('link')) {
309        my @rel_strs = split ',', $res->header('link');
310        $self->_extract_link_url(\@rel_strs);
311    }
312
313    ## be smarter
314    if (wantarray) {
315        return @$data if ref $data eq 'ARRAY';
316        return %$data if ref $data eq 'HASH';
317    }
318
319    return $data;
320}
321
322sub set_next_page {
323    my ($self, $page) = @_;
324
325    if( ! looks_like_number($page) ){
326	    croak "Trying to set_next_page to $page, and not a number\n";
327    }
328
329    if( $page > $self->total_page && $page > 0 ){
330	    return 0;
331    }
332
333    my $temp_url = $self->next_url;
334    $temp_url =~ s/([&?])page=[0-9]+([&?]*)/$1page=$page$2/;
335
336    $self->next_url( $temp_url );
337
338    return 1;
339}
340
341sub next_page {
342    my $self = shift;
343    return $self->query($self->next_url);
344}
345
346sub prev_page {
347    my $self = shift;
348    return $self->query($self->prev_url);
349}
350
351sub first_page {
352    my $self = shift;
353    return $self->query($self->first_url);
354}
355
356sub last_page {
357    my $self = shift;
358    return $self->query($self->last_url);
359}
360
361sub _clear_pagination {
362    my $self = shift;
363    foreach my $page (qw/first last prev next/) {
364        my $clearer = 'clear_' . $page . '_url';
365        $self->$clearer;
366    }
367    return 1;
368}
369
370sub iterate {
371    my ( $self, $method, $args, $callback ) = @_;
372
373    die "This is a method class" unless ref $self;
374    die "Need a method name as second argument" unless defined $method && $self->can($method);
375
376    die "Missing a callback function as third argument" unless ref $callback eq 'CODE';
377
378    my @list_args; # 3rd argument
379    if ( ref $args eq 'ARRAY' ) {
380        @list_args = @$args;
381    } elsif ( ref $args eq 'HASH' ) {
382        # used for v2 api which are passing a hash of named parameters instead of a list
383        @list_args = $args;
384    } else {
385        @list_args = $args; # can be undefined [need to preserve it instead of an empty list]
386    }
387
388    my $chunk = $self->can($method)->( $self, $args );
389
390    my $continue = 1;
391    while ( ref $chunk eq 'ARRAY' && scalar @$chunk ) {
392        # process a chunk
393        foreach my $item ( @$chunk ) {
394            $continue = $callback->( $item );
395            last unless $continue; # user has requested to stop iterating
396        }
397        last unless $continue; # user has requested to stop iterating
398
399        # get the next chunk
400        last unless $self->has_next_page;
401        $chunk = $self->next_page;
402    }
403
404    $self->_clear_pagination;
405
406    return;
407}
408
409sub _extract_link_url {
410    my ($self, $raw_strs) = @_;
411    foreach my $str (@$raw_strs) {
412        my ($link_url, $rel) = split ';', $str;
413
414        $link_url =~ s/^\s*//;
415        $link_url =~ s/^<//;
416        $link_url =~ s/>$//;
417
418        if( $rel =~ m/rel="(next|last|first|prev|deprecation|alternate)"/ ){
419            $rel = $1;
420        }
421        elsif( $rel=~ m/rel="(.*?)"/ ){
422            warn "Unexpected link rel='$1' in '$str'";
423            next;
424        }
425        else {
426            warn "Unable to process link rel in '$str'";
427            next;
428        }
429
430        if( $rel eq 'deprecation' ){
431            warn "Deprecation warning: $link_url\n";
432        }
433
434        my $url_attr = $rel . "_url";
435        $self->$url_attr($link_url);
436
437        # Grab, and expose, some additional header information
438	if( $rel eq "last" ){
439	    $link_url =~ /[\&?]page=([0-9]*)[\&?]*/;
440	    $self->total_pages( $1 );
441	}
442    }
443
444    return 1;
445}
446
447sub _make_request {
448  my($self, $req) = @_;
449
450  my $cached_res = $self->_get_shared_cache($req->uri);
451
452  if ($cached_res) {
453    $req->header("If-None-Match" => $cached_res->header("ETag"));
454    my $res = $self->ua->request($req);
455
456    if ($res->code == 304) {
457      return $cached_res;
458    }
459
460    $self->_set_shared_cache($req->uri, $res);
461
462    return $res;
463  } else {
464    my $res = $self->ua->request($req);
465    $self->_set_shared_cache( $req->uri, $res);
466    return $res;
467  }
468}
469
470sub _get_shared_cache {
471  my ($self, $uri) = @_;
472  return $self->cache->get($uri);
473}
474
475sub _set_shared_cache {
476  my($self, $uri, $response) = @_;
477  $self->cache->set($uri, $response);
478}
479
480## build methods on fly
481sub __build_methods {
482    my $package = shift;
483    my %methods = @_;
484
485    foreach my $m (keys %methods) {
486        my $v = $methods{$m};
487        my $url = $v->{url};
488        my $method = $v->{method} || 'GET';
489        my $args = $v->{args} || 0; # args for ->query
490        my $check_status = $v->{check_status};
491        my $is_u_repo = $v->{is_u_repo}; # need auto shift u/repo
492        my $preview_version = $v->{preview};
493        my $paginate = $v->{paginate};
494        my $version  = $v->{v} || $v->{version} || 1; # version for the accessor
495
496        # count how much %s inside u
497        my $n = 0; while ($url =~ /\%s/g) { $n++ }
498
499        no strict 'refs';
500        no warnings 'once';
501        *{"${package}::${m}"} = sub {
502            my $self = shift;
503
504            my ( $u, @qargs );
505
506            if ( $version == 2 ) {
507                my $opts = {};
508                if ( ref $_[0] ) {
509                    my ( $_opts, $_qargs ) = @_;
510
511                    $opts = $_opts;
512                    if ( my $ref = ref $_qargs ) {
513                        @qargs = @$_qargs if $ref eq 'ARRAY';
514                        @qargs = $_qargs  if $ref eq 'HASH';
515                    }
516                } else { # backward compatibility
517                    my $u = $url;
518                    while ( $u =~ s{:([a-z_]+)}{} ) {
519                        my $k = $1;
520                        #next if defined $opts->{$k};
521                        $opts->{$k} = shift;
522                        die "$k value is not a scalar value $opts->{$k}" if ref $opts->{$k};
523                    }
524
525                    @qargs = $args ? splice(@_, 0, $args) : ();
526                }
527                # we can now use named :parameter in the url itself
528                $u = "$url";
529                {
530                    no warnings;
531                    $u =~ s{:([a-z_]+)}{$opts->{$1}}g;
532                }
533            } else {
534                ## if is_u_repo, both ($user, $repo, @args) or (@args) should be supported
535                if ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {
536                    unshift @_, ($self->u, $self->repo);
537                }
538
539                # make url, replace %s with real args
540                my @uargs = splice(@_, 0, $n);
541                $u = sprintf($url, @uargs);
542
543                # args for json data POST
544                @qargs = $args ? splice(@_, 0, $args) : ();
545            }
546
547            # if preview API, set preview version
548            $self->accept_version($preview_version) if $preview_version;
549
550            if ($check_status) { # need check Response Status
551                my $old_raw_response = $self->raw_response;
552                $self->raw_response(1); # need check header
553                my $res = $self->query($method, $u, @qargs);
554                $self->raw_response($old_raw_response);
555                return index($res->header('Status'), $check_status) > -1 ? 1 : 0;
556            } else {
557                return $self->query($method, $u, @qargs);
558            }
559        };
560        if ($paginate) {
561            # Add methods next... and close...
562            # Make method names singular (next_comments to next_comment)
563            $m =~ s/s$//;
564            my $m_name = ref $paginate ? $paginate->{name} : $m;
565            *{"${package}::next_${m_name}"} = sub {
566                my $self = shift;
567
568                # count how much %s inside u
569                my $n = 0; while ($url =~ /\%s/g) { $n++ }
570
571                ## if is_u_repo, both ($user, $repo, @args) or (@args) should be supported
572                if ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {
573                    unshift @_, ($self->u, $self->repo);
574                }
575
576                # make url, replace %s with real args
577                my @uargs = map { defined $_ ? $_ : '' } splice(@_, 0, $n);
578                my $u = sprintf($url, @uargs);
579
580                # if preview API, set preview version
581                $self->accept_version($preview_version) if $preview_version;
582
583                return $self->next($u);
584            };
585            *{"${package}::close_${m_name}"} = sub {
586                my $self = shift;
587
588                # count how much %s inside u
589                my $n = 0; while ($url =~ /\%s/g) { $n++ }
590
591                ## if is_u_repo, both ($user, $repo, @args) or (@args) should be supported
592                if ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {
593                    unshift @_, ($self->u, $self->repo);
594                }
595
596                # make url, replace %s with real args
597                my @uargs = splice(@_, 0, $n);
598                my $u = sprintf($url, @uargs);
599
600                # if preview API, set preview version
601                $self->accept_version($preview_version) if $preview_version;
602
603                $self->close($u);
604            };
605        }
606    }
607}
608
609no Moo::Role;
610
6111;
612__END__
613
614=head1 NAME
615
616Net::GitHub::V3::Query - Base Query role for Net::GitHub::V3
617
618=head1 SYNOPSIS
619
620    package Net::GitHub::V3::XXX;
621
622    use Moo;
623    with 'Net::GitHub::V3::Query';
624
625=head1 DESCRIPTION
626
627set Authentication and call API
628
629=head2 ATTRIBUTES
630
631=over 4
632
633=item login
634
635=item pass
636
637=item access_token
638
639Either set access_token from OAuth or login:pass for Basic Authentication
640
641L<http://developer.github.com/>
642
643=item raw_string
644
645=item raw_response
646
647=item api_throttle
648
649API throttling is enabled by default, set api_throttle to 0 to disable it.
650
651=item rate_limit
652
653The maximum number of queries allowed per hour. 60 for anonymous users and
6545,000 for authenticated users.
655
656=item rate_limit_remaining
657
658The number of requests remaining in the current rate limit window.
659
660=item rate_limit_reset
661
662The time the current rate limit resets in UTC epoch seconds.
663
664=item update_rate_limit
665
666Query the /rate_limit API (for free) to update the cached values for rate_limit, rate_limit_remaining, rate_limit_reset
667
668=item last_page
669
670Denotes the index of the last page in the pagination
671
672=item RaiseError
673
674=back
675
676=head2 METHODS
677
678=over 4
679
680=item query
681
682Refer L<Net::GitHub::V3>
683
684=item next_page
685
686Calls C<query> with C<next_url>. See L<Net::GitHub::V3>
687
688=item prev_page
689
690Calls C<query> with C<prev_url>. See L<Net::GitHub::V3>
691
692=item first_page
693
694Calls C<query> with C<first_url>. See L<Net::GitHub::V3>
695
696=item last_page
697
698Calls C<query> with C<last_url>. See L<Net::GitHub::V3>
699
700=item set_next_page
701
702Adjusts next_url to be a new url in the pagination space
703I.E. you are jumping to a new index in the pagination
704
705=item iterate($method_name, $arguments, $callback)
706
707This provides an helper to iterate over APIs call using pagination,
708using the combo: has_next_page, next_page... for you.
709
710The arguments can be either a scalar if the function is using
711a single argument, an ArrayRef when the function is using multiple
712arguments. You can also use one HashRef for functions supporting named
713parameters.
714
715The callback function is called with a single item.
716The return value of the callback function can be used to stop the
717iteration when returning a 'false' value.
718
719In common cases, you want to return a true value: '1'.
720
721Sample usage:
722
723    $gh->org->iterate( 'repos', 'OrganizationName', sub {
724        my $item = shift;
725
726        print "Repo Name is $item->{name}"
727
728        return 1; # if you want to continue iterating
729        return;   # use a false value when you want to interrupt the iteration
730    } );
731
732=item result_sets
733
734For internal use by the item-per-item pagination: This is a store of
735the state(s) for the pagination.  Each entry maps the initial URL of a
736GitHub query to a L<Net::GitHub::V3::ResultSet> object.
737
738=item next($url)
739
740Returns the next item for the query which started at $url, or undef if
741there are no more items.
742
743=item close($url)
744
745Terminates the item-per-item pagination for the query which started at
746$url.
747
748
749=back
750
751=head3 NG_DEBUG
752
753export NG_DEBUG=1 to view the request URL
754
755NG_DEBUG > 1 to view request/response string
756
757=head1 AUTHOR & COPYRIGHT & LICENSE
758
759Refer L<Net::GitHub>
760