#!/usr/bin/env perl

#   Copyright (c) MediaTek USA Inc., 2025-2026
#
#   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/>.
#
# history
#
#   This script is used as a "--history-script history" callback for
#   genhtml/lcov/geninfo.
#   The intent is to reuse profile history from a prior tool execution
#   to enable better load balancing and thus better performance in a
#   subsequent execution.
#   The basic observation is that the next regression job is very similar to
#   the previous one - so we expect similar resource utilization.
#
#   The 'history-script' is called as:
#
#        history->new(previousProfileFile)
#
#   where 'previousProfileFile' is the path to the '--profile' data generated
#   in your previous regression job.
#
#   The configured callback is executed as
#
#       $callback->history(name)
#
#   where 'name' is typically the filename seen by genhtml or lcov.
#   The return value is expected to be the execution time associated
#   with 'name'.
#
#   This example script can be used with 'genhtml' and 'lcov --capture'
#   and should work as expected if:
#     - your command line is the same as the previous execution
#     - file 'previousProfileFile' was generated by the previous execution, and
#     - source and data files (.gdca, etc) are in the same relative locations
#       as the previous execution
#
#   It may be useful to dig into the format of the '--profile' data
#   to implement your own callbacks.
#
#   Note that history is not going to help if:
#     - Individual tasks all have roughly the same resource utilization -
#       there is no 'long pole' which needs to be scheduled first.
#     - Random testing/tests are not reused: either test names never
#       repeat, or the same name is not the same test.
#       (You will need to implement your own prediction callback in that
#        case...history won't help.)
#

use strict;
use lcovutil;
use Time::HiRes;

package history;

our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(new);

sub appendElements
{
    my ($predicted, $in, $sub) = @_;

    while (my ($name, $time) = each(%$in)) {
        $name = $sub->($name) if defined($sub);
        if (!exists($predicted->{$name})) {
            $predicted->{$name} = [$time, 1];
        } else {
            my $p = $predicted->{$name};
            $p->[0] += $time;
            $p->[1] += 1;
        }
    }
}

sub new
{
    my $class      = shift;
    my $script     = shift;
    my $standalone = $script eq $0;

    my $start = Time::HiRes::gettimeofday();
    # these keys should be present in the data file
    #  (else user has given us the wrong one)
    my @verifyKeysList;
    if ($lcovutil::tool_name eq 'genhtml') {
        push(@verifyKeysList, 'file');
    } elsif ($lcovutil::tool_name eq 'geninfo' ||
             ($lcovutil::tool_name eq 'lcov' &&
              $main::callFromLcov)
    ) {
        push(@verifyKeysList, 'file', 'find');
    }
    die("--history-script:  JSON file argument required")
        unless (@_);
    # is the profile history a valid JSON profile file
    my @data;
    foreach my $glob (@_) {
        my @glob = glob($glob);
        lcovutil::ignorable_error($lcovutil::ERROR_EMPTY,
                            "'--history-script $glob' does not match any files")
            unless (@glob);
        foreach my $history (@glob) {
            eval {
                my $data = JsonSupport::load($history);
                for my $k (@verifyKeysList) {
                    die("profile key '$k' not found")
                        unless (exists($data->{$k}));
                }
                push(@data, $data);
            };
            if ($@) {
                $@ =~ s/.+?ERROR: //;
                lcovutil::ignorable_error($lcovutil::ERROR_USAGE,
                    "'--history-script $script $history' is not a valid $lcovutil::tool_name profile file: $@."
                );
                next;
            }
        }
    }
    unless (@data) {
        lcovutil::ignorable_error($lcovutil::ERROR_USAGE,
                                  "'--history-script $script " .
                                      join(',', @_) .
                                      "': profile history not found.");
        return undef;
    }
    my %predicted;
    if ($lcovutil::tool_name eq 'genhtml') {
        # just keep the 'files' hash
        if (1 < scalar(@data)) {
            # compute average
            foreach my $d (@data) {
                # pass the inner 'file' hash, not the top-level profile hash;
                # appendElements iterates the hash to accumulate file-level averages
                appendElements(\%predicted, $d->{'file'});
            }
        } else {
            return bless $data[0]->{$verifyKeysList[0]}, $class;
        }
    } elsif (scalar(@verifyKeysList)) {
        # this is geninfo..munge the data
        #   - there may have been multiple 'capture' calls - say, if the
        #     testsuite is segmented across machines.
        #   - the individual capture directories may have different content
        #     from one regression run to the next - say, if tests are
        #     distributed adaptively.
        # Thus:  the only way to have a complete history is if we merge
        # the data from all of those jobs.
        foreach my $d (@data) {
            # read the profile data to figure out how much each file costs
            my $sep = '^(';
            my $pat = '';
            for my $dir (keys %{$d->{find}}) {
                $pat .= $sep . $dir;
                $sep = '|';
            }
            $pat .= ')/';
            my $re  = qr($pat);
            my $sub = sub {
                my $n = shift;
                $n =~ s/$re//;
                return $n;
            };
            appendElements(\%predicted, $d->{file}, $sub);
        }
    }
    for my $name (keys %predicted) {
        my $p = $predicted{$name};
        # storing the average
        $predicted{$name} = $p->[0] / $p->[1];
    }
    my $now = Time::HiRes::gettimeofday();
    $lcovutil::profileData{history} = $now - $start;

    return bless \%predicted, $class;
}

sub history
{
    my ($self, $name) = @_;

    return exists($self->{$name}) ? $self->{$name} : undef;
}

1;
