view release on metacpan or  search on metacpan

bin/queue  view on Meta::CPAN

#!/usr/bin/env perl

use 5.26.0;

# requires: Mojolicious Minion Minion::Backend::SQLite
use Mojolicious::Lite -signatures;
use Mojo::File;
use CPAN::DistnameInfo;
use Capture::Tiny "capture_merged";

my $Debug = $ENV{COVER_DEBUG};

plugin Config => {
    default => {
        minion           => { SQLite => "sqlite:queue.db" },
        # uploads_socket => "ws://api-3.cpantesters.org/v3/upload",
        uploads_socket   => "ws://localhost:3001/v3/upload",
        results_dir      => "/cover/staging_dev",
    },
};

plugin "Minion" => app->config->{minion};
plugin "Minion::Admin";

helper results => sub { Mojo::File->new(shift->app->config->{results_dir}) };

push app->static->paths->@*,        app->results->to_string;
push app->commands->namespaces->@*, "Devel::Cover::Queue::Commands";

package Devel::Cover::Queue::Commands::monitor {
    use Mojo::Base "Mojolicious::Command";
    use Mojo::IOLoop;
    use Mojo::UserAgent;
    use Mojo::WebSocket;
    use Scalar::Util ();
    use experimental "signatures";

    has ua => sub { Mojo::UserAgent->new->inactivity_timeout(0) };

    sub run ($command) {
        say STDERR "run" if $Debug;
        $command->connect;
        Mojo::IOLoop->start;
    }

    sub connect ($command) {
        say STDERR "connect" if $Debug;
        my $url = $command->app->config->{uploads_socket};

        Scalar::Util::weaken $command;
        $command->ua->websocket($url => sub ($, $tx) {
            unless ($tx->is_websocket) {
                $command->app->log->warn("Not a websocket");
                Mojo::IOLoop->timer(1 => sub { $command->connect });
                return;
            }

            say STDERR "CONNECTED" if $Debug;
            my $waiting;

            $tx->on(json => sub ($, $data) {
                print STDERR Mojo::Util::dumper $data if $Debug;
                $command->app->minion->enqueue(run_cover => [ $data ]);
            });

            $tx->on(frame => sub ($, $frame) {
                return unless $frame->[4] eq Mojo::WebSocket::WS_PONG;
                say STDERR "PONG" if $Debug;
                $waiting = 0;
            });

            my $pinger = Mojo::IOLoop->recurring(30 => sub {
                say STDERR "PING" if $Debug;
                return $tx->finish if $waiting;
                $waiting = 1;
                $tx->send([ 1, 0, 0, 0, Mojo::WebSocket::WS_PING, "" ])
            });

            $tx->on(finish => sub {
                Mojo::IOLoop->remove($pinger);
                say STDERR "FINISH" if $Debug;
                Mojo::IOLoop->timer(1 => sub { $command->connect });
            });
        });
    }
}

package Devel::Cover::Queue::Commands::add {
    use Mojo::Base "Mojolicious::Command";
    use experimental "signatures";

    has description => "Add a distribution to the queue";
    has usage       => "add P/PJ/PJCJ/Shell-Source-0.01.tar.gz";

    sub run ($command, $dist) {
        say STDERR "add $dist" if $Debug;
        $command->app->minion->enqueue(run_cover => [ $dist ]);
    }
}

helper release_covered => sub ($c, $release) {
    my $check = $c->results->child($release)->to_abs;
    -d "$check"
};

helper visit_latest_releases => sub ($c, $cb) {
    require CPAN::Releases::Latest;
    my $latest   = CPAN::Releases::Latest->new(max_age => 0);  # no caching
    my $iterator = $latest->release_iterator;
    while (my $release = $iterator->next_release) { $c->$cb($release) }