#!/usr/bin/perl

# Copyright © 2021 Felix Lechner
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.

use v5.20;
use warnings;
use utf8;

use Const::Fast;
use DBI;
use File::Find::Rule;
use JSON::MaybeXS;
use List::SomeUtils qw(any);
use Path::Tiny;
use Time::Duration;
use Time::Piece;
use Unicode::UTF8 qw(encode_utf8);
use YAML::XS qw(LoadFile);
use ZMQ::FFI qw(ZMQ_REP);

const my $EMPTY => q{};
const my $SPACE => q{ };
const my $INDENT => $SPACE x 4;
const my $HYPHEN => q{-};
const my $SLASH => q{/};
const my $UNDERSCORE => q{_};

const my $LOWEST_PRIORITY => 19;
const my $LIBRARY_SORTER_LENGTH => 4;

setpriority(0, $$, $LOWEST_PRIORITY);

die encode_utf8("Usage $0 CONFIG-FILE [PATTERN]\n")
  unless @ARGV >= 1 && @ARGV <= 2;

my $config_file = $ARGV[0];
die encode_utf8('No configuration file.')
  unless length $config_file;
my $yaml = LoadFile($config_file);

my $listen_port = $yaml->{port};
die encode_utf8('No config for port')
  unless defined $listen_port;

# get database config
my $dbconnectstring = $yaml->{database};
die encode_utf8('No database connect string')
  unless length $dbconnectstring;

my $postgres = DBI->connect('dbi:Pg:' . $dbconnectstring,
    $EMPTY, $EMPTY,{AutoCommit => 0, pg_enable_utf8 => 0});

my @releases = qw{sid experimental};
my $port_architecture = 'amd64';

schedule_tasks($postgres, $ARGV[1], \@releases, $port_architecture,
    $listen_port);

$postgres->disconnect;

exit;

sub schedule_tasks {
    my ($database, $pattern, $releases, $installable_port, $dispatch_port)
      = @_;

    my $get_sources_sql =<<~'END_OF_QUERY';
SELECT
    json_agg(u)
FROM ( SELECT DISTINCT
        rs.source_name,
        rs.source_version,
        rs.release,
        ri.port
    FROM
        archive.released_sources AS rs
        JOIN archive.installables AS i ON i.source_name = rs.source_name
            AND i.source_version = rs.source_version
        JOIN archive.released_installables AS ri ON ri.installable_name = i.installable_name
            AND ri.installable_version = i.installable_version
            AND ri.installable_architecture = i.installable_architecture
            AND ri.release = rs.release
    WHERE
        rs.release = ANY ($1)
        AND ri.port = $2
    ORDER BY
        source_name,
        source_version,
        release,
        port) AS u
END_OF_QUERY

    my $get_sources = $database->prepare($get_sources_sql);
    $get_sources->execute([map { encode_utf8($_) } @{$releases}],
        encode_utf8($installable_port));
    my $sources_json = $get_sources->fetchrow_arrayref->[0];
    $get_sources->finish;
    $database->commit;

    my @sources = @{decode_json($sources_json)};

    my @included;
    my @excluded;

    if (length $pattern) {
        # do not consider block_list; do not show excluded sources
        @included = grep { $_->{source_name} =~ /$pattern/ } @sources;

    } else {
        for my $source (@sources)  {

            my @block_list = @{$yaml->{block_list} // []};

            if (any { $source->{source_name} =~ m{$_} } @block_list) {

                push(@excluded, $source);
                next;
            }

            push(@included, $source);
        }
    }

    say encode_utf8('Excluding blocked sources:')
      if @excluded;
    say encode_utf8($INDENT
          . $HYPHEN
          . $SPACE
          . $_->{source_name}
          . $UNDERSCORE
          . $_->{source_version}
          . ' from '
          . $_->{release}
          . $SLASH
          . $_->{port})
      for @excluded;
    say encode_utf8($EMPTY)
      if @excluded;

    say encode_utf8('Spooling ' . scalar @included . ' tasks.');

    my $zeromq = ZMQ::FFI->new();
    my $in = $zeromq->socket(ZMQ_REP);

    my $endpoint = "tcp://*:$dispatch_port";
    $in->bind($endpoint);

    my $encoder = JSON->new;
    $encoder->canonical;
    $encoder->utf8;
    $encoder->pretty;

    my $task_count = 1;
    for my $source (@included) {

        my $source_name = $source->{source_name};
        my $source_version = $source->{source_version};
        my $release = $source->{release};
        my $port = $source->{port};

        my @inputs
          = get_inputs($database, $source_name, $source_version,
            $release, $port);
        next
          unless @inputs;

        my $group = $source_name . $UNDERSCORE . $source_version;
        my %task = (
            tool_name => 'Lintian',
            name => "$group ($release/$port)",
            source_name => $source_name,
            source_version => $source_version,
            release => $release,
            port => $port,
            inputs => \@inputs,
            creation_time => gmtime->datetime . 'Z',
        );

        my $json = $encoder->encode(\%task);

        my $message = $in->recv;
        next
          unless lc($message) eq 'ready';

        $in->send($json);

        my $total_tasks = scalar @included;
        say encode_utf8("Scheduled $task{name}. [$task_count/$total_tasks]");

    } continue {
        ++$task_count;
    }

    my $elapsed_seconds = time - $^T;
    say encode_utf8('Spooled '
          . scalar @included
          . ' tasks in: '
          . duration($elapsed_seconds));

    return;
}

sub get_inputs {
    my ($database, $source_name, $source_version, $release, $port) = @_;

    my $get_inputs_sql =<<~'END_OF_QUERY';
SELECT
    json_agg(u)
FROM (
    SELECT
        i.pool_path
    FROM
        archive.installables AS i
        JOIN archive.released_installables AS ri ON ri.installable_name = i.installable_name
            AND ri.installable_version = i.installable_version
            AND ri.installable_architecture = i.installable_architecture
    WHERE
        i.source_name = $1
        AND i.source_version = $2
        AND ri.release = $3
        AND ri.port = $4
    UNION
    SELECT
        s.pool_path
    FROM
        archive.sources AS s
        JOIN archive.released_sources AS rs ON rs.source_name = s.source_name
            AND rs.source_version = s.source_version
    WHERE
        s.source_name = $1
        AND s.source_version = $2
        AND rs.release = $3) AS u
END_OF_QUERY

    my $get_inputs = $database->prepare($get_inputs_sql);
    $get_inputs->execute(
        encode_utf8($source_name), encode_utf8($source_version),
        encode_utf8($release), encode_utf8($port));
    my $inputs_json = $get_inputs->fetchrow_arrayref->[0];
    $get_inputs->finish;
    $database->commit;

    my @inputs = map { $_->{pool_path} } @{decode_json($inputs_json)};

    return @inputs;
}

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et
