package Tapper::CLI::Host;
BEGIN {
  $Tapper::CLI::Host::AUTHORITY = 'cpan:AMD';
}
{
  $Tapper::CLI::Host::VERSION = '4.1.0';
}

use 5.010;
use warnings;
use strict;

use Tapper::Model 'model';
use YAML::XS;


sub host_feature_summary
{
        my ($host) = @_;

        return join(",",
                    map { $_->value }
                    sort { $a->entry cmp $b->entry }
                    grep { $_->entry =~ /^(key_word|socket_type|revision)$/ }
                    $host->features->all
                   );
}



sub print_hosts_verbose
{
        my ($hosts, $verbosity_level) = @_;
        my %max = (
                   name      => length('Name'),
                   features  => length ('Features'),
                   comment   => length('Comment'),
                   bindqueue => length('Bound Queues'),
                   denyqueue => length('Denied Queues'),
                  );
 HOST:
        foreach my $host ($hosts->all) {
                my $features = host_feature_summary($host);
                $max{name}    = length($host->name) if length($host->name) > $max{name};
                $max{features} = length($features) if length($features) > $max{features};
                $max{comment} = length($host->comment) if length($host->comment) > $max{comment};

                my $tmp_length = length(join ", ", map {$_->queue->name} $host->queuehosts->all);
                $max{bindqueue} = $tmp_length if $tmp_length > $max{bindqueue} ;

                $tmp_length = length(join ", ", map {$_->queue->name} $host->denied_from_queue->all);
                $max{denyqueue} = $tmp_length if $tmp_length > $max{bindqueue} ;
        }

        my ($name_length, $feature_length, $comment_length, $bq_length, $dq_length) = ($max{name}, $max{features}, $max{comment}, $max{bindqueue}, $max{denyqueue});

        # use printf to get the wanted field width
        if ($verbosity_level > 1) {
                printf("%5s | %${name_length}s | %-${feature_length}s | %11s | %10s | %${comment_length}s | %-${bq_length}s | %-${dq_length}s\n",
                        'ID', 'Name', 'Features', 'Active', 'Testrun ID', 'Comment', 'Bound Queues', 'Denied Queues');
        } else {
                printf("%5s | %${name_length}s | %-${feature_length}s | %11s | %10s | %${bq_length}s | %${dq_length}s\n",
                        'ID', 'Name', 'Features', 'Active', 'Testrun ID', 'Bound Queues', 'Denied Queues');
                $comment_length = 0;
        }
        say "="x(5+$name_length+$feature_length+11+length('Testrun ID')+$comment_length+$bq_length+$dq_length+7*length(' | '));


        foreach my $host ($hosts->all) {
                my ($name_length, $feature_length, $queue_length) = ($max{name}, $max{features}, $max{queue});
                my $testrun_id = 'unknown id';
                if (not $host->free) {
                        my $job_rs = model('TestrunDB')->resultset('TestrunScheduling')->search({host_id => $host->id, status => 'running'});
                        $testrun_id = $job_rs->search({}, {rows => 1})->first->testrun_id if $job_rs->count;
                }
                my $features = host_feature_summary($host);
                my $output = sprintf("%5d | %${name_length}s | %-${feature_length}s | %11s | %10s | ",
                                     $host->id,
                                     $host->name,
                                     $features,
                                     $host->is_deleted ? 'deleted' : ( $host->active ? 'active' : 'deactivated' ),
                                     $host->free   ? 'free'   : "$testrun_id",
                                    );
                if ($verbosity_level > 1) {
                        $output .= sprintf("%${comment_length}s | ", $host->comment);

                }
                $output .= sprintf("%-${bq_length}s | %-${dq_length}s",
                                   $host->queuehosts->count        ? join(", ", map {$_->queue->name} $host->queuehosts->all) : '',
                                   $host->denied_from_queue->count ? join(", ", map {$_->queue->name} $host->denied_from_queue->all) : ''
                                  );
                say $output;
        }
}



sub select_hosts
{
        my ($opt) = @_;
        my %options= (order_by => 'name');
        my %search;
        $search{active}     = 1 if $opt->{active};
        $search{is_deleted} = {-in => [ 0, undef ] } unless $opt->{all};
        $search{free}   = 1 if $opt->{free};

        # ignore all options if host is requested by name
        %search = (name   => $opt->{name}) if $opt->{name};

        if ($opt->{queue}) {
                my @queue_ids       = map {$_->id} model('TestrunDB')->resultset('Queue')->search({name => {-in => [ @{$opt->{queue}} ]}});
                $search{queue_id}   = { -in => [ @queue_ids ]};
                $options{join}      = 'queuehosts';
                $options{'+select'} = 'queuehosts.queue_id';
                $options{'+as'}     = 'queue_id';
        }
        my $hosts = model('TestrunDB')->resultset('Host')->search(\%search, \%options);
        return $hosts;
}


sub print_hosts_yaml
{
        my ($hosts) = @_;
        while (my $host = $hosts->next ) {
                my %host_data = (name       => $host->name,
                                 comment    => $host->comment,
                                 free       => $host->free,
                                 active     => $host->active,
                                 is_deleted => $host->is_deleted,
                                 host_id    => $host->id,
                                 );
                my $job = $host->testrunschedulings->search({status => 'running'}, {rows => 1})->first; # this should always be only one
                if ($job) {
                        $host_data{running_testrun} = $job->testrun->id;
                        $host_data{running_since}   = $job->testrun->starttime_testrun->iso8601;
                }

                if ($host->queuehosts->count > 0) {
                        my @queues = map {$_->queue->name} $host->queuehosts->all;
                        $host_data{queues} = \@queues;
                }

                my %features;
                foreach my $feature ($host->features->all) {
                        $features{$feature->entry} = $feature->value;
                }
                $host_data{features} = \%features;

                print YAML::XS::Dump(\%host_data);
        }
        return;
}


sub listhost
{
        my ($c) = @_;
        $c->getopt( 'free', 'name=s@', 'active', 'queue=s@', 'all|a', 'verbose|v+', 'yaml', 'help|?' );
        if ( $c->options->{help} ) {
                say STDERR "$0 host-list [ --verbose|v ] [ --free ] | [ --name=s ]  [ --active ] [ --queue=s@ ] [ --all|a] [ --yaml ]";
                say STDERR "    --verbose      Increase verbosity level, without show only names, level one shows all but comments, level two shows all including comments";
                say STDERR "    --free         List only free hosts";
                say STDERR "    --name         Find host by name, implies verbose";
                say STDERR "    --active       List only active hosts";
                say STDERR "    --queue        List only hosts bound to this queue";
                say STDERR "    --all          List all hosts, even deleted ones";
                say STDERR "    --help         Print this help message and exit";
                say STDERR "    --yaml         Print information in YAML format, implies verbose";
                exit -1;
        }
        my $hosts = select_hosts($c->options);

        if ($c->options->{yaml}) {
                print_hosts_yaml($hosts);
        } elsif ($c->options->{verbose}) {
                print_hosts_verbose($hosts, $c->options->{verbose});
        } else {
                foreach my $host ($hosts->all) {
                        say sprintf("%10d | %s", $host->id, $host->name);
                }
        }

        return;
}


sub host_deny
{
        my ($c) = @_;
        $c->getopt( 'host=s@','queue=s@','really' ,'off','help|?' );
        if ( $c->options->{help} or not (@{$c->options->{host} ||  []} and $c->options->{queue} )) {
                say STDERR "At least one queuename has to be provided!" unless @{$c->options->{queue} || []};
                say STDERR "At least one hostname has to be provided!" unless @{$c->options->{host} || []};
                say STDERR "$0 host-deny  --host=s@  --queue=s@ [--off] [--really]";
                say STDERR "    --host         Deny this host for testruns of all given queues";
                say STDERR "    --queue        Deny this queue to put testruns on all given hosts";
                say STDERR "    --off          Remove previously installed denial of host/queue combination";
                say STDERR "    --really       Force denial of host/queue combination even if it does not make sense (e.g. because host is also bound to queue)";
                exit -1;
        }

        my @queue_results; my @host_results;
        foreach my $queue_name ( @{$c->options->{queue}}) {
                my $queue_r = model('TestrunDB')->resultset('Queue')->search({name => $queue_name}, {rows => 1})->first;
                die "No such queue: '$queue_name'" unless $queue_r;
                push @queue_results, $queue_r;
        }
        foreach my $host_name ( @{$c->options->{host}}) {
                my $host_r = model('TestrunDB')->resultset('Host')->search({name => $host_name}, {rows => 1})->first;
                die "No such host: '$host_name'" unless $host_r;
                push @host_results, $host_r;
        }

        foreach my $queue_r (@queue_results) {
        HOST:
                foreach my $host_r (@host_results) {
                        if ($c->options->{off}) {
                                my $deny_r = model('TestrunDB')->resultset('DeniedHost')->search({queue_id => $queue_r->id,
                                                                                                  host_id  => $host_r->id, },
                                                                                                 {rows => 1}
                                                                                                )->first;
                                $deny_r->delete if $deny_r;
                        } else {

                                if ($host_r->queuehosts->search({queue_id => $queue_r->id}, {rows => 1})->first) {
                                        my $msg = 'Host '.$host_r->name.' is bound to from queue '.$queue_r->name;
                                        if ($c->options->{really}) {
                                                say STDERR "SUCCESS: $msg. Will still deny it too, because you requested it.";
                                        } else {
                                                say STDERR "ERROR: $msg. This does not make sense. Will not deny it from the queue. You can override it with --really";
                                                next HOST;
                                        }
                                }
                                # don't deny twice
                                next HOST if $host_r->denied_from_queue->search({queue_id => $queue_r->id}, {rows => 1})->first;
                                model('TestrunDB')->resultset('DeniedHost')->new({queue_id => $queue_r->id,
                                                                                  host_id  => $host_r->id,
                                                                                 })->insert;
                        }
                }
        }
        return;
}


sub host_bind
{
        my ($c) = @_;
        $c->getopt( 'host=s@','queue=s@','really' ,'off','help|?' );
        if ( $c->options->{help} or not (@{$c->options->{host} ||  []} and $c->options->{queue} )) {
                say STDERR "At least one queuename has to be provided!" unless @{$c->options->{queue} || []};
                say STDERR "At least one hostname has to be provided!" unless @{$c->options->{host} || []};
                say STDERR "$0 host-bind  --host=s@  --queue=s@ [--off] [--really]";
                say STDERR "    --host         Bind this hosts to all given queues (can be given multiple times)";
                say STDERR "    --queue        Bind all given hosts to this queue (can be given multiple times)";
                say STDERR "    --off          Remove previously installed host/queue bindings";
                say STDERR "    --really       Force binding host/queue combination even if it does not make sense (e.g. because host is also denied from queue)";
                exit -1;
        }

        my @queue_results; my @host_results;
        foreach my $queue_name ( @{$c->options->{queue}}) {
                my $queue_r = model('TestrunDB')->resultset('Queue')->search({name => $queue_name}, {rows => 1})->first;
                die "No such queue: '$queue_name'" unless $queue_r;
                push @queue_results, $queue_r;
        }
        foreach my $host_name ( @{$c->options->{host}}) {
                my $host_r = model('TestrunDB')->resultset('Host')->search({name => $host_name}, {rows => 1})->first;
                die "No such host: '$host_name'" unless $host_r;
                push @host_results, $host_r;
        }

        foreach my $queue_r (@queue_results) {
                foreach my $host_r (@host_results) {
                        if ($c->options->{off}) {
                                my $bind_r = model('TestrunDB')->resultset('QueueHost')->search({queue_id => $queue_r->id,
                                                                                                 host_id  => $host_r->id },
                                                                                                {rows => 1}
                                                                                               )->first;
                                $bind_r->delete if $bind_r;
                        } else {
                                if ($host_r->denied_from_queue->single({queue_id => $queue_r->id})) {
                                        my $msg = 'Host '.$host_r->name.' is denied from from queue '.$queue_r->name;
                                        if ($c->options->{really}) {
                                                say STDERR "SUCCESS: $msg. Will still deny it too, because you requested it.";
                                        } else {
                                                say STDERR "ERROR: $msg. This does not make sense. Will not bind it to the queue. You can override it with --really";
                                                next HOST;
                                        }
                                }
                                # don't bind twice
                                next HOST if $host_r->queuehosts->search({queue_id => $queue_r->id}, {rows => 1})->first;
                                model('TestrunDB')->resultset('QueueHost')->new({queue_id => $queue_r->id,
                                                                                  host_id  => $host_r->id,
                                                                                 })->insert;
                        }
                }
        }
        return;
}



sub setup
{
        my ($c) = @_;
        $c->register('host-list', \&listhost,  'Show all hosts matching a given condition');
        $c->register('host-deny', \&host_deny, 'Setup or remove forbidden host/queue combinations');
        $c->register('host-bind', \&host_bind, 'Setup or remove host/queue bindings');
        if ($c->can('group_commands')) {
                $c->group_commands('Host commands', 'host-list', 'host-bind', 'host-deny', );
        }
        return;
}


1; # End of Tapper::CLI

__END__
=pod

=encoding utf-8

=head1 NAME

Tapper::CLI::Host

=head1 SYNOPSIS

This module is part of the Tapper::CLI framework. It is supposed to be
used together with App::Rad. All following functions expect their
arguments as $c->options->{$arg}.

    use App::Rad;
    use Tapper::CLI::Host;
    Tapper::CLI::Host::setup($c);
    App::Rad->run();

=head1 NAME

Tapper::CLI::Host - Tapper - host related commands for the tapper CLI

=head1 FUNCTIONS

=head2

Generate a feature summary for a given host. This summary only includes
key_word, socket_type and revision. These are the most important
information and having all features would make a to long list. These
features are concatenated together with commas.

@param host object

@return string - containing features

=head2 print_hosts_verbose

=head2 select_hosts

=head2 print_hosts_yaml

Print given host with all available information in YAML.

@param host object

=head2 listhost

List hosts matching given criteria.

=head2 host_deny

Don't use given hosts for testruns of this queue.

=head2 host_bind

Bind given hosts to given queues.

=head2 setup

Initialize the testplan functions for tapper CLI

=head1 AUTHOR

AMD OSRC Tapper Team, C<< <tapper at amd64.org> >>

=head1 BUGS

=head1 COPYRIGHT & LICENSE

Copyright 2008-2011 AMD OSRC Tapper Team, all rights reserved.

This program is released under the following license: freebsd

=head1 AUTHOR

AMD OSRC Tapper Team <tapper@amd64.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2012 by Advanced Micro Devices, Inc..

This is free software, licensed under:

  The (two-clause) FreeBSD License

=cut

