#!/usr/bin/perl
# ABSTRACT: List results for specified test(s).
# PODNAME: TestRail::Bin::Results

=head1 SYNOPSIS

  testrail-results [OPTIONS] test1 test2 ...

  require `which testrail-results`;
  TestRail::Bin::Results::run('args' => \@args);

=head1 DESCRIPTION

testrail-results - List results for specified test(s).

Searches across multiple runs (and projects) for results for broad-based metrics; especially useful for diagnosing unreliable tests, and establishing defect density for certain features.

Can be used as the modulino TestRail::Bin::Tests.
Has a single 'run' function which accepts a hash with the 'args' parameter being the array of arguments.

=head1 WARNING

Searching across all projects can take a very long time for highly active TestRail Installations.
However, cross project metrics are also very useful.

As such, the results from prior searches in json mode may be provided, and the runs previously analyzed therein will not be investigated again.

It is up to the caller to integrate this data into their analysis as may be appropriate.

=head1 PARAMETERS:

=head2 MANDATORY PARAMETERS

=over 4

--apiurl   : full URL to get to TestRail index document

--password : Your TestRail Password, or a valid API key (TestRail 4.2 and above).

--user     : Your TestRail User Name.

=back

All mandatory options not passed with the above switches, or in your ~/.testrailrc will be prompted for.

=head2 SEMI-OPTIONAL PARAMETERS

=over 4

-e --encoding : Character encoding of arguments.  Defaults to UTF-8. See L<Encode::Supported> for supported encodings.

=back

=head2 OPTIONAL PARAMETERS

=over 4

-j --project : Restrict search to provided project name.  May be passed multiple times.

-r --run     : Restrict search to runs with the provided name.  May be passed multiple times.

-p --plan    : Restrict search to plans with the provided name. May be passed multiple times.

-g --grep    : Restrict results printed to those matching the provided pattern. Great for looking for specific failure conditions.

-v --version : Restrict results printed to those tested on the provided version(s).  May be passed multiple times.

-d --defect  : Restrict results printed to those related to the provided defect(s).  May be passed multiple times.

-c --cachefile : Load the provided file as a place to pick up your search from.  May be passed multiple times.

-f --fast : Reduce the number of required HTTP requests at the cost of historical data (previous statuses in runs).  Speeds up gathering a great deal when checking many tests.

--json       : Print results as a JSON serialization.

-m --merged : In merge the output with the cached data provided (if any).

--perfile : Output JSON summary data per file to the provided directory when in json mode

=back

=head1 CONFIGURATION FILE

In your \$HOME, (or the current directory, if your system has no concept of a home directory) put a file called .testrailrc with key=value syntax separated by newlines.
Valid Keys are the same as documented by L<App::Prove::Plugin::TestRail>.
All options specified thereby are overridden by passing the command-line switches above.

=head1 MISCELLANEOUS OPTIONS:

=over 4

--help : show this output

=back

=head1 NOTES

One of the primary purposes of this script is to create CPANTesters style matrices per version/platform.
In --json mode, the 'versions_by_status' attribute will return a data structure looking like so:

=over 4

=item platform_ids: a comma separated value of the platform IDs the test was run on (sorted to prevent order oddities).  This value is a hash key.

=over 4

=item versions: the direct version string reported.  This key corresponds to an array value holding hashrefs with status IDs pointing towards result links, sorted by ID.

=back

=back

The consumer of this should be able to render a color-coded table, much like CPANTesters does.

=cut

package TestRail::Bin::Results;

use strict;
use warnings;
use utf8;

use TestRail::API;
use TestRail::Utils;
use TestRail::Utils::Find;

use Getopt::Long qw{GetOptionsFromArray};
use File::HomeDir qw{my_home};
use JSON::MaybeXS ();
use Statistics::Descriptive;
use List::MoreUtils qw{uniq};
use File::Basename qw{basename};

if (!caller()) {
    my ($out,$code) = run('args' => \@ARGV);
    print "$out\n";
    exit $code;
}

sub run {
    my %params = @_;
    my $opts ={};

    #Parse config file if we are missing api url/key or user
    my $homedir = my_home() || '.';
    if (-e $homedir . '/.testrailrc') {
        $opts = TestRail::Utils::parseConfig($homedir);
    }

    GetOptionsFromArray($params{'args'},
        'apiurl=s'        => \$opts->{'apiurl'},
        'password=s'      => \$opts->{'password'},
        'user=s'          => \$opts->{'user'},
        'j|project=s@'    => \$opts->{'projects'},
        'p|plan=s@'       => \$opts->{'plans'},
        'r|run=s@'        => \$opts->{'runs'},
        'e|encoding=s'    => \$opts->{'encoding'},
        'g|grep=s'        => \$opts->{'pattern'},
        'd|defect=s@'     => \$opts->{'defects'},
        'v|version=s@'    => \$opts->{'versions'},
        'c|cachefile=s@'  => \$opts->{'cachefile'},
        'f|fast'          => \$opts->{'fast'},
        'json'            => \$opts->{'json'},
        'perfile=s'       => \$opts->{'perfile'},
        'm|merged'        => \$opts->{'merged'},
        'h|help'          => \$opts->{'help'},
    );

    if ($opts->{help}) { return ('',TestRail::Utils::help()); }

    die("No tests passed") unless scalar(@{$params{'args'}});

    $opts->{'browser'} = $params{'browser'};

    TestRail::Utils::interrogateUser($opts,qw{apiurl user password});

    my $tr = TestRail::Utils::getHandle($opts);
    my $prior_search;
    my $prior_runs = [];
    my $prior_plans = [];
    my $prior_hash = {};
    my @prior_versions;
    if ($opts->{'cachefile'}) {
        foreach my $cf (@{$opts->{cachefile}}) {
            die("Prior search file '$cf' passed does not exist") if $cf && !( -e $cf);
            my $raw_text = '';
            open(my $fh, '<', $cf) or die "Could not open $cf";
            while (<$fh>) {
                $raw_text .= $_;
            }
            close($fh);
            $prior_search = JSON::MaybeXS::decode_json($raw_text);
            foreach my $key (keys(%$prior_search)) {
                my $str_str = $prior_search->{search_string} // '';
                my $str_pat = $opts->{pattern} // '';
                if ( $str_str ne $str_pat) {
                    print "Cached data in $cf has search pattern mismatch, skipping...\n";
                    next;
                }
                $prior_hash->{$key} = $prior_search->{$key} if $opts->{merged};

                #Ensure that we have all versions represented for every test watched in case we add platforms
                if (exists $prior_hash->{$key}) {
                    foreach my $plt (keys(%{$prior_hash->{$key}->{versions_by_status}})) {
                        delete $prior_hash->{$key}->{versions_by_status}->{$plt} if !$plt;
                        foreach my $v (keys(%{$prior_hash->{$key}->{versions_by_status}->{$plt}}) ) {
                            push(@prior_versions,$v);
                        }
                    }
                }

                push(@$prior_runs, @{$prior_search->{$key}->{'seen_runs'}});
                push(@$prior_plans,@{$prior_search->{$key}->{'seen_plans'}});
            }
            @$prior_plans = uniq(@$prior_plans);
            @$prior_runs  = uniq(@$prior_runs);
            $opts->{'plan_ids'} = $prior_plans;
            $opts->{'run_ids'}  = $prior_runs;
        }
    }

    my ($res,$seen_plans,$seen_runs) = TestRail::Utils::Find::getResults($tr,$opts,@{$params{'args'}});

    #Make sure subsequent runs keep ignoring the prior plans
    push(@$seen_plans,@$prior_plans);

    my $statuses = $tr->getPossibleTestStatuses();
    my %status_map;
    @status_map{map {$_->{'id'}} @$statuses} = map {$_->{'label'}} @$statuses;

    my $out = '';
    my $out_json = $prior_hash;


    foreach my $case (keys(%$res)) {
        $out .= "#############################\n";
        my $num_runs = 0;
        my $casetotals = {};
        my $versions_by_status = {};
        my $defects = [];
        my $seen_versions = [];
        my $total_elapsed = 0;
        my $avg_elapsed = 0;
        my $median_runtime = 0;
        my $elapsetotals = [];
        $out_json->{$case} //= {};

        foreach my $casedef (@{$res->{$case}}) {
            $num_runs++;
            my $cplatform = 'default';
            $cplatform = join(',',sort @{$casedef->{config_ids}}) if ref($casedef->{config_ids}) eq 'ARRAY' && scalar(@{$casedef->{config_ids}});
            $cplatform ||= 'default'; #XXX catch blank platform info, this can happen in some plans apparently
            #$out .= "Found case '$case' in run $casedef->{run_id}\n";
            foreach my $result (@{$casedef->{results}}) {
                if (defined $result->{status_id}) {
                    #Assignment is handled as creating a new result with an undef status id
                    $casetotals->{$result->{status_id}}++;
                    $versions_by_status->{$cplatform} //= {};
                    if ($result->{version} ) {
                        push(@$seen_versions,$result->{version});
                        $versions_by_status->{$cplatform}->{$result->{version}} //= [];
                        push(@{$versions_by_status->{$cplatform}->{$result->{version}}}, {$status_map{$result->{status_id}} => "$tr->{apiurl}/index.php?/tests/view/$casedef->{id}"});
                    }
                }
                push(@$defects, $result->{defects})    if $result->{defects} && ref($result->{defects}) ne 'ARRAY';
                push(@$defects, @{$result->{defects}}) if $result->{defects} && ref($result->{defects}) eq 'ARRAY';
                push(@$elapsetotals,_elapsed2secs($result->{'elapsed'}));
            }
        }

        #Ensure versions_by_status has an entry per platform for every single version seen
        @$seen_versions = uniq((@$seen_versions,@prior_versions));

        my @all_platforms = grep { $_ } uniq((keys(%{$out_json->{$case}->{versions_by_status}}),keys(%$versions_by_status)));

        @$defects   = uniq(@$defects);
        foreach my $plt (@all_platforms) {
            $out_json->{$case}->{versions_by_status}->{$plt} //= {};
            foreach my $ver (keys(%{$versions_by_status->{$plt}})) {
                @{$versions_by_status->{$plt}->{$ver}} =  sort { (keys(%$a))[0] cmp (keys(%$b))[0] } @{$versions_by_status->{$plt}->{$ver}};
            }
            foreach my $v (@$seen_versions) {
                $out_json->{$case}->{versions_by_status}->{$plt}->{$v} //= [];
            }
        }

        #Initialize out_json correctly
        $out_json->{$case}->{num_runs}     //= 0;
        $out_json->{$case}->{seen_runs}    //= [];
        $out_json->{$case}->{seen_plans}   //= [];
        $out_json->{$case}->{elapsetotals} //= [];
        $out_json->{$case}->{defects}      //= [];
        foreach my $status (keys(%status_map)) {
            $out_json->{$case}->{$status_map{$status}} //= 0;
        }

        my $pattern_output = '';
        $out_json->{$case}->{search_string} = $opts->{'pattern'};
        $pattern_output = " using search string '$opts->{pattern}'" if $opts->{'pattern'};

        $out .= "$case was present in $num_runs runs$pattern_output.\n";
        $out_json->{$case}->{'num_runs'}   += $num_runs;
        push(@{$out_json->{$case}->{'seen_runs'}}, @$seen_runs);
        push(@{$out_json->{$case}->{'seen_plans'}}, @$seen_plans);

        #Collect time statistics
        push(@{$out_json->{$case}->{elapsetotals}},@$elapsetotals);
        my $timestats = Statistics::Descriptive::Full->new();
        $timestats->add_data(@{$out_json->{$case}->{elapsetotals}});

        $out_json->{$case}->{total_elapsed}   = $timestats->sum() || 0;
        $out .= "Total time spent running this test: $out_json->{$case}->{total_elapsed} seconds\n";
        $out_json->{$case}->{median_elapsed}  = $timestats->median() || 0;
        $out .= "Median time spent running this test: $out_json->{$case}->{median_elapsed} seconds\n";
        $out_json->{$case}->{average_elapsed} = $timestats->mean() || 0;
        $out .= "Mean time spent running this test: $out_json->{$case}->{average_elapsed} seconds\n";
        $out_json->{$case}->{stdev_elapsed}   = $timestats->standard_deviation() || 0;
        $out .= "Standard deviations of runtime in test: $out_json->{$case}->{stdev_elapsed}\n";
        $out_json->{$case}->{max_elapsed}     = $timestats->max() || 0;
        $out .= "Maximum time spent running this test: $out_json->{$case}->{max_elapsed} seconds\n";
        $out_json->{$case}->{min_elapsed}     = $timestats->min() || 0;
        $out .= "Minimum time spent running this test: $out_json->{$case}->{min_elapsed} seconds\n";
        $out_json->{$case}->{times_executed}  = $timestats->count() || 0;
        $out .= "Num times this test has been executed: $out_json->{$case}->{times_executed}\n";

        foreach my $status (keys(%$casetotals)) {
            $out .= "$status_map{$status}: $casetotals->{$status}\n";
            $out_json->{$case}->{$status_map{$status}} += $casetotals->{$status};
        }

        foreach my $platform (keys(%$versions_by_status)) {
            foreach my $version (keys(%{$versions_by_status->{$platform}})) {
                $out .= "Version $version in platform IDs ($platform) had statuses :\n".join(',',@{$versions_by_status->{$platform}->{$version}})."\n";
                push(@{$out_json->{$case}->{versions_by_status}->{$platform}->{$version}}, @{$versions_by_status->{$platform}->{$version}});
                @{$out_json->{$case}->{versions_by_status}->{$platform}->{$version}} = uniq(@{$out_json->{$case}->{versions_by_status}->{$platform}->{$version}});
            }
        }

        $out .= "\nDefects related to case:\n".join(',',@$defects)."\n" if @$defects;
        push(@{$out_json->{$case}->{defects}}, @$defects);
        @{$out_json->{$case}->{defects}} = uniq(@{$out_json->{$case}->{defects}});

    }

    if ($opts->{'json'}) {
        my $coder = JSON::MaybeXS->new;
        $coder->canonical(1);
        return ($coder->encode($out_json),0) unless $opts->{'perfile'};

        die("no such directory $opts->{perfile}") unless -d $opts->{perfile};

        foreach my $test (keys(%$out_json)) {
            my $tn = basename($test);
            open( my $fh, '>', "$opts->{perfile}/$tn.json") or die "could not open $opts->{perfile}/$tn.json";
            print $fh $coder->encode({ $test => $out_json->{$test} });
            close $fh;
        }
        return('',0);
    }

    $out .= "#############################";
    return ($out,0);
}

sub _elapsed2secs {
    my $stamp = shift;
    return 0 if !$stamp;
    my ($seconds)         = $stamp =~ m/(\d*)s/;
    my ($seconds_minutes) = $stamp =~ m/(\d*)m/;
    my ($seconds_hours)   = $stamp =~ m/(\d*)h/;
    return ($seconds || 0) + ($seconds_minutes ? $seconds_minutes * 60 : 0) + ($seconds_hours ? $seconds_hours * 3600 : 0);
}

1;

__END__

L<TestRail::API>

L<File::HomeDir> for the finding of .testrailrc

=head1 SPECIAL THANKS

Thanks to cPanel Inc, for graciously funding the creation of this distribution.