#!/usr/bin/perl -w

# Copyright (C) 2014 SUSE Linux Products GmbH
#
# 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 2 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 <http://www.gnu.org/licenses/>.

=head1 clean_needles

clean_needles - clean openQA needles

=head1 SYNOPSIS

clean_needles [OPTIONS]

=head1 OPTIONS

=over 4

=item B<--dry>

dry run, don't actually delete

=item B<--days> N

evaluate jobs for the last N days

=item B<--verbose>

verbose output

=item B<--debug>

debug output

=item B<--help, -h>

print help

=back

=head1 DESCRIPTION

Dump openQA database tables for Machines TestSuites Products
JobTemplates e.g. to load them on another instance.

=cut

BEGIN {
    use FindBin qw($Bin);
    use lib "$Bin/../lib";
}

use strict;
use OpenQA::Schema;
use Data::Dump 'dd';
use v5.10;
use DBIx::Class::DeploymentHandler;
use Getopt::Long;
use OpenQA::Utils;
use OpenQA::Scheduler::Scheduler;
use Mojo::JSON 'decode_json';

Getopt::Long::Configure("no_ignore_case");

my %options;

sub usage($) {
    my $r = shift;
    eval "use Pod::Usage; pod2usage($r);";
    if ($@) {
        die "cannot display help, install perl(Pod::Usage)\n";
    }
    exit $_[0];
}

GetOptions(\%options, "days=i", "debug", "verbose", "dry", "help|h",) or usage(1);

$options{days} = 60 unless $options{days} // 0 > 0;

usage(0) if $options{help};

my $schema = OpenQA::Schema->singleton;

sub list_jobs {
    my %args = (state => 'done', maxage => $options{days} * 24 * 60 * 60,);
    return $schema->resultset('Jobs')->complex_query(%args);
}

my $jobs = list_jobs();

if ($options{verbose}) {
    printf "%d jobs in %d days\n", scalar keys %$jobs, $options{days};
}

# FIXME: actually determine which distros share needles
sub map_version($$) {
    my ($distri, $version) = @_;

    return 'Factory';
}

my %needles_by_name;
my %needles_by_tag;
sub load_needles($$) {
    my ($distri, $version) = @_;

    return if exists $needles_by_name{$distri}{$version // ''};

    my $needledir = needledir($distri, $version);

    opendir(my $dh, $needledir) || die "$needledir\n";
    my @names = grep { s/\.json$// } readdir($dh);
    closedir $dh;
    for my $name (@names) {
        my $needle = needle_info($name, $distri, $version, "");
        $needles_by_name{$distri}{$version // ''}{$name} = $needle;
        for my $tag (@{$needle->{tags}}) {
            push @{$needles_by_tag{$distri}{$version // ''}{$tag}}, $needle;
        }
    }
}

my %seen_tags;
my %seen_needles;
while (my $j = $jobs->next) {
    for my $module (OpenQA::Schema::Result::JobModules::job_modules($j)) {
        my $job = OpenQA::Scheduler::Scheduler::job_get($j->id);
        my $fn  = join('/', $OpenQA::Utils::resultdir, $job->{settings}->{NAME}, 'details-' . $module->name . '.json');
        next unless -e $fn;
        open(my $fd, '<', $fn);
        next unless $fd;
        local $/;    # enable localized slurp mode
        my $details;
        eval { $details = decode_json(<$fd>) };
        close $fd;
        if ($@ || !$details) {
            warn "failed to parse $fn";
            next;
        }
        my $distri  = $job->{settings}->{DISTRI};
        my $version = map_version($distri, $job->{settings}->{VERSION});

        load_needles($distri, $version);

        for my $detail (@{$details}) {
            next unless $detail->{result} eq 'ok';
            next unless $detail->{needle};
            next unless $detail->{tags};
            my $needle      = $needles_by_name{$distri}{$version}{$detail->{needle}};
            my %needle_tags = map { $_ => 1 } @{$needle->{tags}};
            for my $tag (@{$detail->{tags}}) {
                next unless $needle_tags{$tag};
                $seen_tags{$distri}{$version}{$tag}{$needle->{name}} = 1;
                $seen_needles{$distri}{$version}{$needle->{name}} = 1;
            }
        }
    }
}

dd \%seen_needles if $options{debug};

my %stats;
for my $distri (sort keys %seen_tags) {
    for my $version (sort keys %{$seen_tags{$distri}}) {
        printf "%s-%s\n", $distri, $version if $options{verbose};
        for my $tag (sort keys %{$seen_tags{$distri}{$version}}) {
            printf "  %s\n", $tag if $options{verbose};
            for my $needle (@{$needles_by_tag{$distri}{$version}{$tag}}) {
                my $keep = exists $seen_needles{$distri}{$version}{$needle->{name}};
                if ($options{verbose}) {
                    if ($keep) {
                        if (exists $seen_tags{$distri}{$version}{$tag}{$needle->{name}}) {
                            printf "     \e[32m[%s]\e[m\n", $needle->{name};
                        }
                        else {
                            printf "     \e[33m[%s]\e[m\n", $needle->{name};
                        }
                    }
                    else {
                        printf "     %s\n", $needle->{name};
                    }
                }
                unless ($keep) {
                    $stats{$distri}{$version}{obsolete}++;
                    unless ($options{dry}) {
                        unlink($needle->{json});
                        unlink($needle->{image});
                    }
                }
            }
        }
    }
}

dd \%stats if $options{verbose};

# vim: sw=4 et
