#!/usr/bin/env perl

use strict;
use warnings;

use File::Path qw(make_path);
use File::Spec;
use File::Temp qw(tempdir);
use Getopt::Long qw(GetOptions);
use JSON::XS ();
use Time::HiRes qw(time);

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

use Developer::Dashboard::Config;
use Developer::Dashboard::JSON qw(json_encode);
use Developer::Dashboard::PathRegistry;

my $skill_count = 250;
my $runs        = 21;
my $help        = 0;
GetOptions(
    'skills=i' => \$skill_count,
    'runs=i'   => \$runs,
    'help'     => \$help,
) or die _usage();
if ($help) {
    print _usage();
    exit 0;
}
die "Unexpected argument(s): @ARGV\n" . _usage() if @ARGV;
die "--skills must be a positive integer\n" if $skill_count < 1;
die "--runs must be an odd positive integer\n" if $runs < 1 || $runs % 2 == 0;

my $root = tempdir( 'problem48-collector-config-XXXXXX', TMPDIR => 1, CLEANUP => 1 );
my $home = File::Spec->catdir( $root, 'home' );
make_path($home);
local $ENV{HOME} = $home;
local $ENV{DEVELOPER_DASHBOARD_CHECKERS} = '';
_write_skill_configs( File::Spec->catdir( $home, '.developer-dashboard', 'skills' ), $skill_count );

my $paths = Developer::Dashboard::PathRegistry->new(
    home            => $home,
    cwd             => $home,
    project_roots   => [],
    workspace_roots => [],
);
my $config = Developer::Dashboard::Config->for_path_config($paths);
my $expected = json_encode( _legacy_collectors($config) );
my ( $legacy_probe, $legacy_enumerations ) = _counted_collectors( sub { _legacy_collectors($config) } );
my ( $shared_probe, $shared_enumerations ) = _counted_collectors( sub { $config->collectors } );
die "Legacy collector output mismatch before timing\n" if json_encode($legacy_probe) ne $expected;
die "Shared collector output mismatch before timing\n" if json_encode($shared_probe) ne $expected;
die "Unexpected skill entry enumeration counts\n"
  if $legacy_enumerations != 2 || $shared_enumerations != 1;

my ( @legacy_seconds, @shared_seconds );
for my $run ( 1 .. $runs ) {
    my @order = $run % 2 ? qw(legacy shared) : qw(shared legacy);
    for my $strategy (@order) {
        my $started = time;
        my $result = $strategy eq 'legacy' ? _legacy_collectors($config) : $config->collectors;
        my $elapsed = time - $started;
        die "$strategy collector output changed in run $run\n" if json_encode($result) ne $expected;
        push @{ $strategy eq 'legacy' ? \@legacy_seconds : \@shared_seconds }, $elapsed;
    }
}

printf "skills=%d runs=%d exact_parity=yes legacy_entry_enumerations=%d shared_entry_enumerations=%d\n",
  $skill_count, $runs, $legacy_enumerations, $shared_enumerations;
printf "legacy_median_ms=%.3f shared_median_ms=%.3f speedup=%.2fx\n",
  1000 * _median(@legacy_seconds), 1000 * _median(@shared_seconds),
  _median(@legacy_seconds) / _median(@shared_seconds);
exit 0;

# _usage()
# Returns the benchmark's command-line syntax and workload constraints.
# Input: none.
# Output: usage text string.
sub _usage {
    return "Usage: $0 [--skills N] [--runs ODD_N] [--help]\n"
      . "Compares collector assembly with legacy duplicate skill-config reads.\n";
}

# _write_skill_configs($skills_root, $count)
# Creates independent skill config files with collector data and unrelated fields.
# Input: skill inventory root path and positive number of synthetic skills.
# Output: true after every config file has been written and closed.
sub _write_skill_configs {
    my ( $skills_root, $count ) = @_;
    my $json = JSON::XS->new->canonical;
    for my $index ( 1 .. $count ) {
        my $name = sprintf 'skill-%04d', $index;
        my $dir = File::Spec->catdir( $skills_root, $name, 'config' );
        make_path($dir);
        my %config = map { ( "unrelated_$_" => "value-$index-$_" ) } 1 .. 80;
        $config{collectors} = [ { name => 'probe', interval => 60 } ];
        my $file = File::Spec->catfile( $dir, 'config.json' );
        open my $fh, '>:raw', $file or die "Unable to create $file: $!";
        print {$fh} $json->encode(\%config) or die "Unable to write $file: $!";
        close $fh or die "Unable to close $file: $!";
    }
    return 1;
}

# _legacy_collectors($config)
# Reconstructs the pre-optimization collector assembly flow for comparison.
# Input: Developer::Dashboard::Config object.
# Output: normalized ordered collector job array reference.
sub _legacy_collectors {
    my ($config) = @_;
    my $merged = $config->merged;
    my @jobs = @{ $config->_builtin_collectors };
    if ( ref( $merged->{collectors} ) eq 'ARRAY' ) {
        @jobs = @{ $config->_merge_named_hash_array( \@jobs, $merged->{collectors}, 'name' ) };
    }
    @jobs = @{ $config->_merge_named_hash_array( \@jobs, [ $config->_skill_collectors ], 'name' ) };
    return [ map { $config->_normalize_collector_job($_) } @jobs ];
}

# _counted_collectors($code)
# Counts skill-config entry enumeration while running one collector strategy.
# Input: zero-argument code reference returning the collector result.
# Output: result reference and entry-enumeration count.
sub _counted_collectors {
    my ($code) = @_;
    my $count = 0;
    my $original = \&Developer::Dashboard::Config::_skill_config_entries;
    my $result;
    {
        no warnings 'redefine';
        local *Developer::Dashboard::Config::_skill_config_entries = sub {
            $count++;
            return $original->(@_);
        };
        $result = $code->();
    }
    return ( $result, $count );
}

# _median(@seconds)
# Returns the middle value from an odd, non-empty timing sample list.
# Input: elapsed-time values in seconds.
# Output: median elapsed time.
sub _median {
    my @samples = sort { $a <=> $b } @_;
    die "Cannot compute a median without samples\n" if !@samples;
    return $samples[ int( @samples / 2 ) ];
}

__END__

=pod

=head1 NAME

problem48-collector-config-benchmark - measure collector config-read reuse

=head1 PURPOSE

Compares the pre-optimization collector assembly flow, which reads installed
skill config entries twice, with C<Config::collectors>, which reuses the
entries loaded while constructing merged configuration. It checks exact
canonical output parity, enumeration counts, and alternating timing medians.

=head1 WHY IT EXISTS

Problem 48 profiling exposed repeated per-skill config reads in the collector
path. This benchmark provides a repeatable, isolated measurement for deciding
whether sharing the existing entry list meaningfully reduces that work.

=head1 WHEN TO USE

Use this in the isolated Problem 48 Docker bench after changing collector
configuration loading, entry reuse, or layered skill config semantics. Its
synthetic timings are workload-specific and are not a claim that every
Dashboard subroutine meets the 50x objective.

=head1 HOW TO USE

  perl script/problem48-collector-config-benchmark
  perl script/problem48-collector-config-benchmark --skills 1000 --runs 9

The defaults create 250 skill configs with 80 unrelated fields and one
collector each, then perform 21 alternating comparisons. C<--runs> must be an
odd positive integer. Temporary fixtures are removed automatically.

=head1 WHAT USES IT

Problem 48 performance research uses this script to verify the collector
entry-sharing improvement. The dashboard runtime and release build do not
invoke the benchmark.

=head1 EXAMPLES

Run a short exact-parity check:

  perl script/problem48-collector-config-benchmark --skills 3 --runs 1

Measure the default workload in the isolated benchmark project:

  d2 docker compose -f /tmp/d2-problem48-bench.yml run --rm bench perl script/problem48-collector-config-benchmark

=head1 OUTPUT

The first line reports fixture size, run count, exact parity, and old/new
skill-entry enumeration counts. The second line reports medians and the
observed ratio. The ratio is descriptive; the script does not impose a
machine-dependent speed threshold.

=cut
