package DBIx::Fast::Cache;

use v5.38;
use Object::Pad;
use Carp 'croak';
use Time::HiRes 'time';

# In-process query cache with TTL and tag-based invalidation.
#
# Backend: LRU::Cache (XS) by default - 6M+ set+get/s, ~120ns per op.
# Capacity eviction is delegated to the backend. TTL and tags are layered
# on top by storing each value as [$value, $expires_at, \@tags].
#
# Multi-process deployments should swap the backend to CHI (Redis/Memcached)
# via the `backend` option; the API stays identical.

class DBIx::Fast::Cache {
  field $max_size    :param :reader = 1_000;
  field $default_ttl :param :reader = 60;     # seconds; 0 = no expiry
  field $backend     :param :reader = 'LRU';  # 'LRU' | 'CHI' | object

  field $_store;          # backend instance
  field $_delete_cb;      # closure mapping to the backend's delete/remove
  field $_set_ttl;        # backend set() accepts a TTL third arg (CHI)
  field $_tag_index = {}; # tag => { key => 1 }
  field $_index_pairs = 0;   # live key-tag pairs in $_tag_index
  field $_index_watermark;   # sweep threshold (see _sweep_index)
  field $_stats = {
    hits      => 0,
    misses    => 0,
    sets      => 0,
    evictions => 0,
    expirations => 0,
    invalidations => 0,
  };

  ADJUST {
    if (ref $backend) {
      # Pre-built backend object (duck-typed: must respond to get/set
      # and one of delete/remove, plus clear).
      $_store = $backend;
    }
    elsif ($backend eq 'LRU') {
      require LRU::Cache;
      $_store = LRU::Cache->new($max_size);
    }
    elsif ($backend eq 'CHI') {
      croak "CHI backend requires a pre-built CHI object passed as backend";
    }
    else {
      croak "Unknown cache backend: $backend";
    }

    # Normalize delete API across backends. CHI calls it `remove`,
    # LRU::Cache calls it `delete`. Resolved once at construction.
    if ($_store->can('delete')) {
      $_delete_cb = sub { $_store->delete($_[0]) };
    }
    elsif ($_store->can('remove')) {
      $_delete_cb = sub { $_store->remove($_[0]) };
    }
    else {
      croak "Cache backend ", ref($_store),
            " supports neither delete() nor remove()";
    }

    # CHI-like backends accept a TTL on set(): push ours down so the external
    # store (Redis/Memcached) also expires entries physically, instead of
    # holding logically-expired data until eviction.
    $_set_ttl = $_store->isa('CHI::Driver');

    # The tag index is pruned lazily; sweep when it outgrows this many
    # key-tag pairs (see _sweep_index).
    $_index_watermark = 4 * $max_size;
  }

  method get ($key) {
    my $entry = $_store->get($key);
    unless (defined $entry) {
      $_stats->{misses}++;
      return undef;
    }

    # entry = [$value, $expires_at, \@tags]
    my ($value, $expires_at) = @$entry;

    if ($expires_at && $expires_at <= time()) {
      $self->_drop_key($key, $entry);   # reuse the entry we just fetched
      $_stats->{expirations}++;
      $_stats->{misses}++;
      return undef;
    }

    $_stats->{hits}++;
    return $value;
  }

  method set ($key, $value, %opts) {
    my $ttl  = exists $opts{ttl} ? $opts{ttl} : $default_ttl;
    my $tags = $opts{tags} // [];
    croak "tags must be an arrayref" unless ref $tags eq 'ARRAY';

    my $expires_at = $ttl ? (time() + $ttl) : 0;
    my $entry      = [$value, $expires_at, $tags];
    ($_set_ttl && $ttl) ? $_store->set($key, $entry, $ttl)
                        : $_store->set($key, $entry);

    for my $tag (@$tags) {
      $_index_pairs++ unless exists $_tag_index->{$tag}{$key};
      $_tag_index->{$tag}{$key} = 1;
    }

    $self->_sweep_index if $_index_pairs > $_index_watermark;

    $_stats->{sets}++;
    return $value;
  }

  # The backend evicts silently (LRU), so dead keys pile up in the tag index
  # of long-lived workers whose tags are never invalidated. Sweep when the
  # index outgrows the watermark: drop every indexed key the backend no longer
  # holds. One backend get per key, and only when the index has grown to 4x
  # the cache capacity, so the amortized cost per set is negligible.
  method _sweep_index () {
    for my $tag (keys %$_tag_index) {
      my $bucket = $_tag_index->{$tag} or next;
      for my $key (keys %$bucket) {
        next if defined $_store->get($key);
        delete $bucket->{$key};
        $_index_pairs--;
        $_stats->{evictions}++;
      }
      delete $_tag_index->{$tag} unless %$bucket;
    }
    # Keys legitimately carrying many tags can keep the index above the static
    # threshold; leave headroom over the live size so the sweep cannot thrash.
    $_index_watermark = 4 * $max_size;
    $_index_watermark = 2 * $_index_pairs
      if 2 * $_index_pairs > $_index_watermark;
  }

  method delete ($key) {
    $_stats->{invalidations}++ if defined $self->_drop_key($key);
  }

  # Invalidate every key tagged with $tag. Each key is dropped through
  # _drop_key so it is pruned from ALL of its tag buckets, not just $tag -
  # otherwise a multi-tagged key would leave dangling references in its other
  # buckets forever.
  method invalidate ($tag) {
    my $keys = delete $_tag_index->{$tag} or return 0;
    $_index_pairs -= scalar keys %$keys;   # this tag's pairs went with the bucket
    my $n   = 0;
    my $now = time();
    for my $key (keys %$keys) {
      # Count what actually happened: a key the backend already dropped is a
      # detected eviction, a logically-expired one an expiration - neither is
      # an invalidation (the count would be inflated far beyond what the store
      # holds). Pass the fetched entry down so _drop_key doesn't hit the
      # backend a second time.
      my $entry = $_store->get($key);
      $self->_drop_key($key, $entry);
      if    (!defined $entry)                        { $_stats->{evictions}++ }
      elsif ($entry->[1] && $entry->[1] <= $now)     { $_stats->{expirations}++ }
      else                                           { $n++ }
    }
    $_stats->{invalidations} += $n;
    return $n;
  }

  method clear () {
    $_store->clear;
    $_tag_index   = {};
    $_index_pairs = 0;
    $_stats->{invalidations}++;
  }

  method stats () {
    my $total = $_stats->{hits} + $_stats->{misses};
    return {
      %$_stats,
      total       => $total,
      hit_ratio   => $total ? $_stats->{hits} / $total : 0,
      index_pairs => $_index_pairs,
    };
  }

  method reset_stats () {
    $_stats->{$_} = 0 for keys %$_stats;
  }

  # Cheap, stable key builder used by DBIx::Fast::cached() proxies.
  # Avoid hashing the bind values into a serialized blob - just join.
  method build_key ($sql, $params = []) {
    # Length-prefix every component so the encoding is injective: a separator
    # or NUL byte inside a bind value can no longer collide with a different
    # parameter tuple, and undef is encoded out-of-band ('|U') so no string
    # value can forge it.
    my $key = length($sql) . ':' . $sql;
    for my $param (@$params) {
      $key .= defined $param ? ('|' . length($param) . ':' . $param) : '|U';
    }
    return $key;
  }

  # Internal: remove a key from backend + tag index. Returns the entry that
  # was dropped (undef when the backend no longer held the key).
  method _drop_key ($key, $entry = undef) {
    $entry //= $_store->get($key);
    if ($entry && ref $entry->[2] eq 'ARRAY') {
      for my $tag (@{$entry->[2]}) {
        $_index_pairs-- if delete $_tag_index->{$tag}{$key};
        delete $_tag_index->{$tag} unless %{$_tag_index->{$tag} // {}};
      }
    }
    $_delete_cb->($key);
    return $entry;
  }
}

1;

__END__

=head1 NAME

DBIx::Fast::Cache - Query result cache with TTL and tag invalidation

=head1 SYNOPSIS

    use DBIx::Fast::Cache;

    my $cache = DBIx::Fast::Cache->new(
        max_size    => 10_000,
        default_ttl => 60,
        backend     => 'LRU',
    );

    $cache->set('product:42', $row, ttl => 300, tags => ['products']);
    my $row = $cache->get('product:42');

    $cache->invalidate('products');      # drop everything tagged 'products'
    $cache->delete('product:42');        # drop one key
    $cache->clear;                       # drop everything

    my $s = $cache->stats;
    printf "hit ratio: %.2f%%\n", $s->{hit_ratio} * 100;

=head1 DESCRIPTION

In-process query cache used by L<DBIx::Fast>. Default backend is
L<LRU::Cache> (XS, ~120 ns per operation). TTL is layered on top by
wrapping every stored value as C<< [$value, $expires_at, \@tags] >>.

For multi-process deployments, pass a pre-built L<CHI> instance as
C<backend> - the same API is preserved.

=head1 OPTIONS

=over 4

=item C<max_size>

Maximum number of keys before LRU eviction kicks in. Default: C<1_000>.

=item C<default_ttl>

Seconds before a value is considered expired. C<0> disables expiry.
Default: C<60>.

=item C<backend>

C<'LRU'> (default, requires L<LRU::Cache>), or a pre-built object that
responds to C<get/set/delete/clear> (typically a L<CHI> instance). For CHI
backends the TTL is also passed to the backend's C<set>, so the external
store (Redis/Memcached) expires entries physically instead of holding
logically-expired data until eviction.

=back

=head1 METHODS

=head2 get / set / delete / clear / invalidate

See L</SYNOPSIS>.

=head2 stats

Returns a hashref: C<hits>, C<misses>, C<sets>, C<evictions>, C<expirations>,
C<invalidations>, C<total>, C<hit_ratio>, C<index_pairs>.

C<evictions> counts backend evictions as they are I<detected> (the backend
evicts silently; a tracked key found missing during C<invalidate> or an
index sweep counts here - for CHI backends this includes backend-side
expiry). C<index_pairs> is the current size of the tag index in key-tag
pairs; it is swept automatically when it outgrows the cache capacity.

=head2 reset_stats

Zeroes all counters.

=head2 build_key ($sql, \@params)

Stable cache key derived from SQL + bind parameters. Used internally by
L<DBIx::Fast>'s C<cached()> proxy.

=head1 THREAD SAFETY

This is an in-process cache: a single instance must B<not> be shared across
threads (ithreads) - the tag index and the default L<LRU::Cache> backend are
not synchronised. Use one cache per thread, or for cross-process/cross-thread
sharing pass a L<CHI> instance (e.g. Redis/Memcached) as C<backend>. Preforking
workers each get their own cache, which is fine but not shared.

=head1 SHARED BACKENDS

The tag index used by C<invalidate> lives in the process, even when the
backend is shared (CHI/Redis): C<invalidate($tag)> only drops the keys
B<this> process has set under that tag. With L<DBIx::Fast>'s CRUD
auto-invalidation every writing worker prunes its own entries, so shared
deployments converge as long as all writers run through DBIx::Fast; entries
written by other processes are otherwise bounded by their TTL (which is
enforced both logically on C<get> and physically in the CHI store).

=head1 SECURITY

Keys built by L<DBIx::Fast>'s C<cached()> proxy include the connection
identity (DSN and DB user), so instances pointing at different databases or
connecting as different users never serve each other's rows even when they
share one external backend. If you call C<get>/C<set> directly with your own
keys on a shared backend, include an equivalent namespace yourself. Note that
cached results are served without re-checking the database's per-user
permissions.

=head1 AUTHOR

SeHarrys

=head1 LICENSE

This is free software under the Artistic License 2.0.

=cut
