First working Dist Source plugin pipeline with a dummy GitHub plugin

Raku · Nov 21, 2015 · 5f76c8b · 5f76c8b
1 parent 107e84a
commit 5f76c8b
Show file tree

Hide file tree

Showing 6 changed files with 104 additions and 47 deletions.
diff --git a/web/build-project-list.pl b/web/build-project-list.pl
@@ -8,23 +8,28 @@
 use lib qw/lib/;
 use DbBuilder;
 
-use constant DB_FILE        => 'modulesperl6.db';
-use constant APP            => catfile qw/bin  ModulesPerl6.pl/;
-use constant META_LIST_FILE => 'https://raw.githubusercontent.com'
+use constant DB_FILE           => 'modulesperl6.db';
+use constant GITHUB_TOKEN_FILE => 'github-token';
+use constant APP               => catfile qw/bin  ModulesPerl6.pl/;
+use constant META_LIST_FILE    => 'https://raw.githubusercontent.com'
                                     . '/perl6/ecosystem/master/META.list';
 
-my $meta_list = META_LIST_FILE;
+my $meta_list         = META_LIST_FILE;
+my $github_token_file = GITHUB_TOKEN_FILE;
 GetOptions(
-    'meta-list=s' => \$meta_list,
-    'limit=i'     => \my $limit,
-    'restart-app' => \my $restart_app,
+    'github-token-file' => \$github_token_file,
+    'meta-list=s'       => \$meta_list,
+    'limit=i'           => \my $limit,
+    'restart-app'       => \my $restart_app,
 );
 
+$ENV{MODULES_PERL6_GITHUB_TOKEN_FILE} = $github_token_file;
+
 DbBuilder->new(
-    app         => APP,
-    db_file     => DB_FILE,
-    limit       => $limit,
-    logos_dir   => catdir(qw/public  content-pics  dist-logos/),
-    meta_list   => $meta_list,
-    restart_app => $restart_app,
+    app               => APP,
+    db_file           => DB_FILE,
+    limit             => $limit,
+    logos_dir         => catdir(qw/public  content-pics  dist-logos/),
+    meta_list         => $meta_list,
+    restart_app       => $restart_app,
 )->run;
diff --git a/web/lib-db-builder/P6Project/Hosts/Github.pm b/web/lib-db-builder/P6Project/Hosts/Github.pm
@@ -39,18 +39,6 @@ sub web_url {
     'https://github.com/';
 }
 
-sub _format_error {
-    my ($self, $error) = @_;
-    # depending on the version of Mojolicious, $error might either be a hash
-    # ref or a string
-    if (ref $error) {
-        return join ' ', $error->{code}, $error->{message};
-    }
-    else {
-        return $error;
-    }
-}
-
 sub get_api {
     my ($self, $project, $call) = @_;
     my $url = $self->api_url . "repos/$project->{auth}/$project->{repo_name}";

diff --git a/web/lib/DbBuilder.pm b/web/lib/DbBuilder.pm
@@ -63,46 +63,60 @@ has _meta_list => (
 sub run {
     my $self = shift;
 
-    $self->_prep_dirs;
-
     my $build_id = Data::GUID->new->as_base64;
     log info => "Starting build $build_id";
 
+    $self->_deploy_db->_prep_dirs;
+
     my $dists_m
-    = ModulesPerl6::Model::Dists->new( db_file => $self->db_file )->deploy;
+    = ModulesPerl6::Model::Dists->new( db_file => $self->_db_file );
 
-    my @metas = $self->_meta_list;
+    my @metas = $self->_metas;
     for ( 0 .. $#metas ) {
         log info => 'Processing dist ' . ($_+1) . ' of ' . @metas;
         $dists_m->add(
             DbBuilder::Dist->new(
-                meta_url  => $metas[$_],
-                build_id  => $build_id,
-                logos_dir => $self->_logos_dir,
+                meta_url          => $metas[$_],
+                build_id          => $build_id,
+                logos_dir         => $self->_logos_dir,
             )->info
         );
-    );
+    }
 
     if ( $self->_restart_app ) {
         log info => 'Restarting app ' . $self->_app;
         system $^O eq 'MSWin32'
-            ? $self->_app => 'daemon' # hypnotoad is not supported on Win32
-            : hypnotoad   => $self->_app;
+            ? ( $self->_app => 'daemon'    ) # hypnotoad not supported on Win32
+            : ( hypnotoad   => $self->_app );
     }
 
     $self;
 }
 
 #########################
 
-sub _meta_list {
+sub _deploy_db {
+    my $self = shift;
+    my $db = $self->_db_file;
+
+    log info => "Using database file $db";
+    return $self if -e $db;
+
+    log info => "Database file not found... deploying new database";
+    ModulesPerl6::Model::Dists     ->new( db_file => $db )->deploy;
+    ModulesPerl6::Model::BuildStats->new( db_file => $db )->deploy;
+
+    $self;
+}
+
+sub _metas {
     my $self = shift;
     my $meta_list = $self->_meta_list;
 
     log info => "Loading META.list from $meta_list";
     my $url = Mojo::URL->new( $meta_list );
     my $raw_data;
-    if ( $url->scheme =~ /(ht|f)tps?/i ) {
+    if ( $url->scheme and $url->scheme =~ /(ht|f)tps?/i ) {
         log info => '... a URL detected; trying to fetch';
         my $tx = Mojo::UserAgent->new( max_redirects => 10 )->get( $url );
 
@@ -131,11 +145,13 @@ sub _meta_list {
 
 sub _prep_dirs {
     my $self = shift;
-    my $logos_dir = $self->logos_dir;
+    my $logos_dir = $self->_logos_dir;
 
     log info => "Cleaning up dist logos dir [$logos_dir]";
     remove_tree $logos_dir;
     make_path   $logos_dir => { mode => 0755 };
+
+    $self;
 }
 
 1;

diff --git a/web/lib/DbBuilder/Dist.pm b/web/lib/DbBuilder/Dist.pm
@@ -1,16 +1,13 @@
 package DbBuilder::Dist;
 
 use strictures 2;
-
-use Module::Pluggable search_path => ['DbBuilder::Dist::Source'],
-                      sub_name    => '_sources',
-                      require     => 1;
 use Types::Standard qw/Ref  Maybe  Str/;
-
 use DbBuilder::Log;
-
 use Moo;
 use namespace::clean;
+use Module::Pluggable search_path => ['DbBuilder::Dist::Source'],
+                      sub_name    => '_sources',
+                      require     => 1;
 
 has _build_id => (
     init_arg => 'build_id',
@@ -51,7 +48,10 @@ sub _load_info {
     my $dist = $self->_load_from_source
         or return;
 
-    $dist->{build_id} = $self->_build_id;
+    $dist->{build_id}      = $self->_build_id;
+    $dist->{travis_status} = 'unknown';
+
+    return $dist;
 }
 
 sub _load_from_source {

diff --git a/web/lib/DbBuilder/Dist/Source.pm b/web/lib/DbBuilder/Dist/Source.pm
@@ -57,6 +57,27 @@ sub _parse_meta {
     return $json;
 }
 
+sub _fill_missing {
+    my ( $self, $dist ) = @_;
+
+    %$dist = (
+        name          => 'N/A',
+        author_id     => 'N/A',
+        url           => 'N/A',
+        description   => 'N/A',
+        logo          => 'N_A',
+        kwalitee      => 0,
+        stars         => 0,
+        issues        => 0,
+        date_updated  => 0,
+        date_added    => 0,
+
+        %$dist,
+    );
+
+    return $dist;
+}
+
 sub load { ... }
 sub re   { ... }
 

diff --git a/web/lib/DbBuilder/Dist/Source/GitHub.pm b/web/lib/DbBuilder/Dist/Source/GitHub.pm
@@ -3,14 +3,41 @@ package DbBuilder::Dist::Source::GitHub;
 use strictures 2;
 use base 'DbBuilder::Dist::Source';
 
+use Carp       qw/croak/;
+use Mojo::Util qw/slurp  decode/;
+use Pithub;
+
 use DbBuilder::Log;
 
 use Moo;
 use namespace::clean;
 
-sub re { qr{^https?://\Qraw.githubusercontent.com\Q}i }
+has _repo => (
+    is => 'lazy',
+    default => sub {
+        my $self = shift;
+        my ( $user, $repo ) = $self->_meta_url =~ $self->re;
+        return Pithub->new->repos->get( user => $user, repo => $repo );
+    },
+);
+
+has _token => (
+    is => 'lazy',
+    default => sub {
+        my $file = $ENV{MODULES_PERL6_GITHUB_TOKEN_FILE};
+        -r $file or log fatal => "GitHub token file [$file] is missing "
+                            . 'or has no read permissions';
+        return decode 'utf8', slurp $file;
+    },
+);
+
+sub re { qr{^https?://\Qraw.githubusercontent.com\E/([^/]+)/([^/]+)}i }
 sub load {
     my $self = shift;
 
     my $dist = $self->_parse_meta( $self->_download_meta );
-}
+
+    return $self->_fill_missing( $dist );
+}
+
+1;