File Coverage

blib/lib/CPAN/Testers/API/Controller/Upload.pm
Criterion Covered Total %
statement 58 58 100.0
branch 19 20 95.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 86 87 98.8


line stmt bran cond sub pod time code
1             package CPAN::Testers::API::Controller::Upload;
2             our $VERSION = '0.018';
3             # ABSTRACT: API for uploads to CPAN
4              
5             #pod =head1 DESCRIPTION
6             #pod
7             #pod =head1 SEE ALSO
8             #pod
9             #pod =over
10             #pod
11             #pod =item L<CPAN::Testers::Schema::Result::Upload>
12             #pod
13             #pod =item L<Mojolicious::Controller>
14             #pod
15             #pod =back
16             #pod
17             #pod =cut
18              
19 1     1   5229 use Mojo::Base 'Mojolicious::Controller';
  1         4  
  1         13  
20 1     1   287 use CPAN::Testers::API::Base;
  1         3  
  1         18  
21 1     1   32 use Mojo::UserAgent;
  1         2  
  1         13  
22              
23             #pod =method get
24             #pod
25             #pod ### Requests:
26             #pod GET /v1/upload
27             #pod GET /v1/upload?since=2016-01-01T12:34:00Z
28             #pod GET /v1/upload/dist/My-Dist
29             #pod GET /v1/upload/dist/My-Dist?since=2016-01-01T12:34:00Z
30             #pod GET /v1/upload/author/PREACTION
31             #pod GET /v1/upload/author/PREACTION?since=2016-01-01T12:34:00Z
32             #pod
33             #pod ### Response:
34             #pod 200 OK
35             #pod Content-Type: application/json
36             #pod
37             #pod [
38             #pod {
39             #pod "dist": "My-Dist",
40             #pod "version": "1.000",
41             #pod "author": "PREACTION",
42             #pod "filename": "My-Dist-1.000.tar.gz",
43             #pod "released": "2016-08-12T04:02:34Z",
44             #pod }
45             #pod ]
46             #pod
47             #pod Get CPAN upload data. Results can be limited by distribution (with the
48             #pod C<dist> key in the stash), by author (with the C<author> key in the
49             #pod stash), and by date (with the C<since> query parameter).
50             #pod
51             #pod =cut
52              
53 18     18 1 48036 sub get( $c ) {
  18         54  
  18         34  
54 18 100       163 $c->openapi->valid_input or return;
55              
56 16         19577 my $rs = $c->schema->resultset( 'Upload' );
57 16         7710 $rs = $rs->search(
58             { },
59             {
60             order_by => 'released',
61             columns => [qw( dist version author filename released )],
62             }
63             );
64              
65 16 100       6003 if ( my $since = $c->param( 'since' ) ) {
66 6         604 $rs = $rs->since( $since );
67             }
68              
69 16         6370 my @results;
70 16 100       68 if ( my $dist = $c->validation->param( 'dist' ) ) {
    100          
71 6         224 $rs = $rs->by_dist( $dist );
72 6         1789 @results = $rs->all;
73 6 100       17170 if ( !@results ) {
74 2         31 return $c->render_error( 404, sprintf 'Distribution "%s" not found', $dist );
75             }
76             }
77             elsif ( my $author = $c->validation->param( 'author' ) ) {
78 6         336 @results = $rs->by_author( $author )->all;
79 6 100       18530 if ( !@results ) {
80 2         109 return $c->render_error( 404, sprintf 'Author "%s" not found', $author );
81             }
82             }
83             else {
84 4         234 @results = $rs->all;
85             }
86              
87 12         10971 my @formatted = map { +{
88 22         13284 dist => $_->dist,
89             version => $_->version,
90             author => $_->author,
91             filename => $_->filename,
92             released => $_->released . "",
93             } } @results;
94              
95 12         13569 return $c->render(
96             openapi => \@formatted,
97             );
98             }
99              
100             #pod =method feed
101             #pod
102             #pod Get a feed for uploads to CPAN. This feed returns the same information as
103             #pod the regular API, but as they come in.
104             #pod
105             #pod =cut
106              
107 6     6 1 16391 sub feed( $c ) {
  6         20  
  6         11  
108 6         65 $c->inactivity_timeout( 60000 );
109 6 100       951 my $path = $c->stash( 'dist' ) ? '/upload/dist/' . $c->stash( 'dist' )
    100          
110             : $c->stash( 'author' ) ? '/upload/author/' . $c->stash( 'author' )
111             : '/upload/dist' # Default to all dists
112             ;
113              
114 6         166 my $ua = Mojo::UserAgent->new( inactivity_timeout => 6000 );
115             $ua->websocket(
116 6         17 $c->app->config->{broker} . '/sub' . $path,
117 6     6   16 sub( $ua, $tx ) {
  6         54485  
  6         14  
118 6         33 $c->stash( tx => $tx );
119 6         10 $tx->on(finish => sub( $tx, $code ) {
120             # Broker closed connection, so close connection with
121             # client, unless that's what we're already doing
122 6 100       29 $c->finish if !$c->stash( 'finished' );
123 6         144 });
124              
125 8         10 $tx->on( message => sub( $tx, $msg ) {
126 8         36 $c->send( $msg );
127 6         57 } );
128             }
129 6         52 );
130              
131 6         5241 $c->stash( ua => $ua );
132 6     6   10 $c->on( finish => sub( $c, $tx ) {
  6         16973  
  6         11  
  6         15  
133             # Client closed connection, so close connection with broker
134 6 50       19 if ( my $tx = $c->stash( 'tx' ) ) {
135 6         82 $c->stash( finished => 1 );
136 6         93 $tx->finish;
137             }
138 6         171 } );
139 6         1367 $c->rendered( 101 );
140             }
141              
142             1;
143              
144             __END__
145              
146             =pod
147              
148             =head1 NAME
149              
150             CPAN::Testers::API::Controller::Upload - API for uploads to CPAN
151              
152             =head1 VERSION
153              
154             version 0.018
155              
156             =head1 DESCRIPTION
157              
158             =head1 METHODS
159              
160             =head2 get
161              
162             ### Requests:
163             GET /v1/upload
164             GET /v1/upload?since=2016-01-01T12:34:00Z
165             GET /v1/upload/dist/My-Dist
166             GET /v1/upload/dist/My-Dist?since=2016-01-01T12:34:00Z
167             GET /v1/upload/author/PREACTION
168             GET /v1/upload/author/PREACTION?since=2016-01-01T12:34:00Z
169              
170             ### Response:
171             200 OK
172             Content-Type: application/json
173              
174             [
175             {
176             "dist": "My-Dist",
177             "version": "1.000",
178             "author": "PREACTION",
179             "filename": "My-Dist-1.000.tar.gz",
180             "released": "2016-08-12T04:02:34Z",
181             }
182             ]
183              
184             Get CPAN upload data. Results can be limited by distribution (with the
185             C<dist> key in the stash), by author (with the C<author> key in the
186             stash), and by date (with the C<since> query parameter).
187              
188             =head2 feed
189              
190             Get a feed for uploads to CPAN. This feed returns the same information as
191             the regular API, but as they come in.
192              
193             =head1 SEE ALSO
194              
195             =over
196              
197             =item L<CPAN::Testers::Schema::Result::Upload>
198              
199             =item L<Mojolicious::Controller>
200              
201             =back
202              
203             =head1 AUTHOR
204              
205             Doug Bell <preaction@cpan.org>
206              
207             =head1 COPYRIGHT AND LICENSE
208              
209             This software is copyright (c) 2016 by Doug Bell.
210              
211             This is free software; you can redistribute it and/or modify it under
212             the same terms as the Perl 5 programming language system itself.
213              
214             =cut