#!/usr/bin/env perl
use v5.38;
use Benchmark qw(cmpthese);
use LRU::Cache;
use Cache::LRU;
use CHI;

# Compara backends de cache para usar como query cache de DBIx::Fast.
#
# Escenarios:
#   1. set+get puro (hot path, valor pequeno)
#   2. get-only (post-warm, caso real: 90% hits)
#   3. set+get con TTL emulado en nuestra capa ([$val, $expires_at])
#   4. valor "realista" (hashref tipo row de productos)
#   5. miss rate (key inexistente)

my $CAPACITY = 1000;

# --- Construir instancias ---
my $lru_xs    = LRU::Cache->new($CAPACITY);
my $lru_pp    = Cache::LRU->new(size => $CAPACITY);
# Nota: CHI::Memory tiene un bug con max_size+Storable. Lo dejamos sin tope
# (favor para CHI: menos overhead que con LRU eviction).
my $chi_mem = CHI->new(driver => 'Memory',    global => 1);
my $chi_raw = CHI->new(driver => 'RawMemory', global => 1);

# --- Valor de prueba realista (un row tipo producto ecommerce) ---
my $row = {
    id    => 42,
    sku   => 'PROD-0042',
    name  => 'Wireless Headphones',
    price => 79.99,
    stock => 150,
    descr => 'Bluetooth 5.3, active noise cancelling, 30h battery life',
    tags  => [qw(audio wireless premium)],
};

# --- Warm-up para get-only ---
for my $i (1 .. 500) {
    my $k = "key:$i";
    $lru_xs->set($k => $row);
    $lru_pp->set($k => $row);
    $chi_mem->set($k => $row);
    $chi_raw->set($k => $row);
}

say "=== 1. SET + GET (1000 iteraciones, valor=hashref) ===";
cmpthese(-3, {
    'LRU::Cache (XS)' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $lru_xs->set($k => $row);
            my $v = $lru_xs->get($k);
        }
    },
    'Cache::LRU (PP)' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $lru_pp->set($k => $row);
            my $v = $lru_pp->get($k);
        }
    },
    'CHI::Memory' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $chi_mem->set($k => $row);
            my $v = $chi_mem->get($k);
        }
    },
    'CHI::RawMemory' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $chi_raw->set($k => $row);
            my $v = $chi_raw->get($k);
        }
    },
});

say "\n=== 2. GET-ONLY hits (1000 iteraciones, caso 90% real) ===";
cmpthese(-3, {
    'LRU::Cache (XS)' => sub { my $v = $lru_xs->get("key:" . ($_ % 500 + 1))  for 1 .. 1000 },
    'Cache::LRU (PP)' => sub { my $v = $lru_pp->get("key:" . ($_ % 500 + 1))  for 1 .. 1000 },
    'CHI::Memory'    => sub { my $v = $chi_mem->get("key:" . ($_ % 500 + 1)) for 1 .. 1000 },
    'CHI::RawMemory' => sub { my $v = $chi_raw->get("key:" . ($_ % 500 + 1)) for 1 .. 1000 },
});

say "\n=== 3. SET + GET con TTL emulado en nuestra capa ===";
# Simula que envolvemos en [$value, $expires_at] para soportar TTL
# sobre backends que no lo tienen nativos (LRU::Cache, Cache::LRU).
my $now = time;
my $ttl = 60;

cmpthese(-3, {
    'LRU::Cache+TTL_wrap' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $lru_xs->set($k => [$row, $now + $ttl]);
            my $entry = $lru_xs->get($k);
            my $v = ($entry && $entry->[1] > $now) ? $entry->[0] : undef;
        }
    },
    'Cache::LRU+TTL_wrap' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $lru_pp->set($k => [$row, $now + $ttl]);
            my $entry = $lru_pp->get($k);
            my $v = ($entry && $entry->[1] > $now) ? $entry->[0] : undef;
        }
    },
    'CHI::Memory_native_TTL' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $chi_mem->set($k => $row, $ttl);
            my $v = $chi_mem->get($k);
        }
    },
    'CHI::RawMemory_native_TTL' => sub {
        for my $i (1 .. 1000) {
            my $k = "k:$i";
            $chi_raw->set($k => $row, $ttl);
            my $v = $chi_raw->get($k);
        }
    },
});

say "\n=== 4. GET miss (key inexistente, fallback rate) ===";
cmpthese(-3, {
    'LRU::Cache (XS)' => sub { my $v = $lru_xs->get("missing:$_")  for 1 .. 1000 },
    'Cache::LRU (PP)' => sub { my $v = $lru_pp->get("missing:$_")  for 1 .. 1000 },
    'CHI::Memory'    => sub { my $v = $chi_mem->get("missing:$_") for 1 .. 1000 },
    'CHI::RawMemory' => sub { my $v = $chi_raw->get("missing:$_") for 1 .. 1000 },
});

say "\n=== Resumen interpretacion ===";
say "- CHI::Memory serializa con Storable -> pierde mucho.";
say "- CHI::RawMemory evita serializacion -> comparable a las LRU puras.";
say "- LRU::Cache XS lider claro en operaciones in-process.";
say "- TTL wrap sobre LRU::Cache anade ~1 array deref + comparacion: casi gratis.";
