#!/usr/bin/perl

# Copyright © 2020-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 DBD::Pg;
use HTTP::Tiny;
use JSON::MaybeXS;
use Time::Duration;
use Time::Piece;
use Unicode::UTF8 qw(encode_utf8);
use YAML::XS qw(LoadFile);

use constant EMPTY   => q{};
use constant SPACE   => q{ };
use constant INDENT   => q{    };
use constant HYPHEN => q{-};

die "Usage: $0 [config-file]"
  unless @ARGV == 1;

my $now = gmtime->datetime;
say "Update started at $now.";

my $configfile = $ARGV[0];
my $yaml = LoadFile($configfile);

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

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

update_suites($postgres);

$postgres->disconnect;

my $elapsed_seconds = time - $^T;
say 'Elapsed time: ' . duration($elapsed_seconds);

exit;

sub update_suites {
    my ($database) = @_;

    my $http = HTTP::Tiny->new(verify_SSL => 1);

    # get archive state via dakweb
    my $response = $http->get('https://api.ftp-master.debian.org/archives');

    die 'Cannot read Dakweb API for suite list'
      unless $response->{success};

    my $json = $response->{content};
    my $db_archives = decode_json($json);

    my @db_suites;
    for my $db_archive (@{$db_archives}) {

        my $archive = $db_archive->{name};

        for my $suite (@{$db_archive->{suites}}) {

            my %db_suite;
            $db_suite{name} = $suite;
            $db_suite{channel} = $archive;

            push(@db_suites, \%db_suite);
        }
    }

    return
      unless @db_suites;

    say 'Current suites (from dakweb):';
    say INDENT . HYPHEN . SPACE . "$_->{name} ($_->{channel})"
      for sort { $a->{name} cmp $b->{name} } @db_suites;

    my $synchronize_sql =<<~'END_OF_QUERY';
        WITH data AS (
            SELECT *
            FROM json_populate_recordset(null::archive.suites, $1)
        ),
        d AS (
            DELETE FROM archive.suites AS s
            WHERE NOT EXISTS (
                SELECT * FROM data
                WHERE data.name = s.name
                AND data.channel = s.channel
            )
        )
        INSERT INTO archive.suites
        SELECT * FROM data
        ON CONFLICT (name)
            DO UPDATE SET channel = EXCLUDED.channel
    END_OF_QUERY

    my $json_array = encode_json(\@db_suites);
    my $synchronize = $database->prepare($synchronize_sql);
    $synchronize->execute($json_array);
    $database->commit;

    update_versioned_sources($database, $_) for map { $_->{name} } @db_suites;

    say 'Pruning sources not present in any suite.';

    my $prune_sources_sql =<<~'END_OF_QUERY';
        DELETE FROM archive.sources AS s
        WHERE NOT EXISTS (
            SELECT * FROM archive.source_suites AS ss
            WHERE ss.source_name = s.source_name
            AND ss.source_version = s.source_version
        )
    END_OF_QUERY

    $database->do($prune_sources_sql);
    $database->commit;

    return;
}

sub update_versioned_sources {
    my ($database, $suite) = @_;

    my $http = HTTP::Tiny->new(verify_SSL => 1);

    # get archive state via dakweb
    my $response = $http->get(
        "https://api.ftp-master.debian.org/sources_in_suite/$suite");

    die "Cannot read Dakweb API for suite $suite"
      unless $response->{success};

    my $json = $response->{content};
    my $dak_sources = decode_json($json);

    my @db_sources;
    for my $entry (@{$dak_sources}) {

        my %db_source;
        $db_source{source_name} = $entry->{source};
        $db_source{source_version} = $entry->{version};

        push(@db_sources, \%db_source);
    }

    say 'Synchronizing ' . scalar @db_sources . " sources in suite $suite.";

    my $synchronize_sql =<<~'END_OF_QUERY';
        WITH data AS (
            SELECT *
            FROM json_populate_recordset(null::archive.sources, $2)
        ),
        i AS (
            INSERT INTO archive.sources
            SELECT *
            FROM data
            ON CONFLICT (source_name, source_version)
                DO NOTHING
        ),
        d AS (
            DELETE FROM archive.source_suites AS ss
            WHERE ss.suite=$1
            AND NOT EXISTS (
                SELECT * FROM data
                WHERE data.source_name = ss.source_name
                AND data.source_version = ss.source_version
            )
        )
        INSERT INTO archive.source_suites (source_name, source_version, suite)
        SELECT source_name, source_version, $1
        FROM data
        ON CONFLICT (source_name, source_version, suite)
            DO NOTHING
    END_OF_QUERY

    my $json_array = encode_json(\@db_sources);
    my $synchronize = $database->prepare($synchronize_sql);
    $synchronize->execute(encode_utf8($suite), $json_array);
    $database->commit;

    return;
}

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