add fetch command to populate database from API

This is useful for development instances to give them some real data for
testing purposes.

This does not yet download full reports. That should be completed before
the ticket is considered done.

Refs #20

Author: preaction

bin/cpantesters-schema

@@ -20,6 +20,9 @@ our $VERSION = '0.024';
     # check what version our database is running
     cpantesters-schema check
 
+    # fetch data from the CPAN Testers API to populate our database
+    cpantesters-schema fetch report --dist [email protected]
+
 =head1 DESCRIPTION
 
 This script works with L<DBIx::Class::Schema::Versioned> to prepare a new
@@ -54,7 +57,7 @@ L<DBIx::Class::Schema::Versioned>
 use v5.24;
 use warnings;
 use Pod::Usage;
-use Getopt::Long;
+use Getopt::Long qw( GetOptionsFromArray );
 use CPAN::Testers::Schema;
 use File::Share qw( dist_dir );
 
@@ -108,3 +111,25 @@ sub upgrade {
     $schema->upgrade;
 }
 
+sub fetch {
+    my ( @args ) = @_;
+    my $schema = CPAN::Testers::Schema->connect_from_config;
+    GetOptionsFromArray( \my %opt, \@args,
+        'dist|d=@s',
+    );
+    my @tables = @args;
+    if ( !$opt{dist}->@* ) {
+        die "Must specify one or more --dist options";
+    }
+    for my $dist_spec ( $opt{dist}->@* ) {
+        my ( $dist, $version ) = split /\@/, $dist_spec;
+        $schema->populate_from_api(
+            {
+                dist => $dist,
+                version => $version,
+            },
+            @tables,
+        );
+    }
+}
+

dist.ini

@@ -140,6 +140,7 @@ Path::Tiny = 0.072 ; Fixes issues with File::Path
 SQL::Translator = 0.11018 ; Allows deploying the schema
 JSON::MaybeXS = 0
 Data::UUID = 0
+Mojolicious = 8
 
 ;-- Common prereqs with minimum version requirements
 ;List::Util = 1.29 ; First version with pair* functions

lib/CPAN/Testers/Schema.pm

@@ -35,6 +35,8 @@ use File::Share qw( dist_dir );
 use Path::Tiny qw( path );
 use List::Util qw( uniq );
 use base 'DBIx::Class::Schema';
+use Mojo::UserAgent;
+use DateTime::Format::ISO8601;
 
 __PACKAGE__->load_namespaces;
 __PACKAGE__->load_components(qw/Schema::Versioned/);
@@ -97,4 +99,145 @@ sub ordered_schema_versions( $self ) {
     return '0.000', @versions;
 }
 
+=method populate_from_api
+
+    $schema->populate_from_api( \%search, @tables );
+
+Populate the given tables from the CPAN Testers API (L<http://api.cpantesters.org>).
+C<%search> has the following keys:
+
+=over
+
+=item dist
+
+A distribution to populate
+
+=item version
+
+A distribution version to populate
+
+=item author
+
+Populate an author's data
+
+=back
+
+The available C<@tables> are:
+
+=over
+
+=item * upload
+
+=item * release
+
+=item * summary
+
+=item * report
+
+=back
+
+=cut
+
+sub populate_from_api( $self, $search, @tables ) {
+    my $ua = $self->{_ua} ||= Mojo::UserAgent->new;
+    my $base_url = $self->{_url} ||= 'http://api.cpantesters.org/v3';
+    my $dtf = DateTime::Format::ISO8601->new();
+
+    # Establish dependencies
+    my %tables = map {; $_ => 1 } @tables;
+    my @order = qw( upload summary release report );
+    # release depends on data in uploads and summary
+    if ( $tables{ release } ) {
+        @tables{qw( upload summary )} = ( 1, 1 );
+    }
+    # summary depends on data in uploads
+    if ( $tables{ summary } ) {
+        @tables{qw( upload )} = ( 1 );
+    }
+
+    # ; use Data::Dumper;
+    # ; say "Fetching tables: " . Dumper \%tables;
+
+    for my $table ( @order ) {
+        next unless $tables{ $table };
+        my $url = $base_url;
+        if ( $table eq 'upload' ) {
+            $url .= '/upload';
+            if ( $search->{dist} ) {
+                $url .= '/dist/' . $search->{dist};
+            }
+            elsif ( $search->{author} ) {
+                $url .= '/author/' . $search->{author};
+            }
+            my $tx = $ua->get( $url );
+            my @rows = map {
+                $_->{released} = $dtf->parse_datetime( $_->{released} )->epoch;
+                $_->{type} = 'cpan';
+                $_;
+            } $tx->res->json->@*;
+            $self->resultset( 'Upload' )->populate( \@rows );
+        }
+
+        if ( $table eq 'summary' ) {
+            $url .= '/summary';
+            if ( $search->{dist} ) {
+                $url .= '/' . $search->{dist};
+                if ( $search->{version} ) {
+                    $url .= '/' . $search->{version};
+                }
+            }
+            my $tx = $ua->get( $url );
+            my @rows = map {
+                my $dt = $dtf->parse_datetime( delete $_->{date} );
+                $_->{postdate} = $dt->strftime( '%Y%m' );
+                $_->{fulldate} = $dt->strftime( '%Y%m%d%H%M' );
+                $_->{state} = delete $_->{grade};
+                $_->{type} = 2;
+                $_->{tester} = delete $_->{reporter};
+                $_->{uploadid} = $self->resultset( 'Upload' )
+                                 ->search({ $_->%{qw( dist version )} })
+                                 ->first->id;
+                $_;
+            } $tx->res->json->@*;
+            # ; use Data::Dumper;
+            # ; say "Populate summary: " . Dumper \@rows;
+            $self->resultset( 'Stats' )->populate( \@rows );
+        }
+
+        if ( $table eq 'release' ) {
+            $url .= '/release';
+            if ( $search->{dist} ) {
+                $url .= '/dist/' . $search->{dist};
+                if ( $search->{version} ) {
+                    $url .= '/' . $search->{version};
+                }
+            }
+            elsif ( $search->{author} ) {
+                $url .= '/author/' . $search->{author};
+            }
+            my $tx = $ua->get( $url );
+            my @rows = map {
+                delete $_->{author}; # Author is from Upload
+                my $stats_rs = $self->resultset( 'Stats' )
+                           ->search({ $_->%{qw( dist version )} });
+                $_->{id} = $stats_rs->get_column( 'id' )->max;
+                $_->{guid} = $stats_rs->find( $_->{id} )->guid;
+                my $upload = $self->resultset( 'Upload' )
+                             ->search({ $_->%{qw( dist version )} })
+                             ->first;
+                $_->{oncpan} = $upload->type eq 'cpan';
+                $_->{uploadid} = $upload->id;
+                # XXX These are just wrong
+                $_->{distmat} = 1;
+                $_->{perlmat} = 1;
+                $_->{patched} = 1;
+                $_;
+            } $tx->res->json->@*;
+            # ; use Data::Dumper;
+            # ; say "Populate release: " . Dumper \@rows;
+            $self->resultset( 'Release' )->populate( \@rows );
+        }
+    }
+}
+
 1;