lib/Database/Abstraction.pm

        start → end → jump
        

    1: package Database::Abstraction;
    2: 
    3: # Author Nigel Horne: njh@nigelhorne.com
    4: # Copyright (C) 2015-2026, Nigel Horne
    5: 
    6: # Usage is subject to licence terms.
    7: 
    8: # TODO:	Switch "entry" to off by default, and enable by passing 'entry'
    9: #	though that wouldn't be so nice for AUTOLOAD
   10: # TODO:	support a directory hierarchy of databases
   11: # TODO:	consider returning an object or array of objects, rather than hashes
   12: # Redis backend (database => 'redis://...') was added in 0.48.
   13: # TODO:	Add a "key" property, defaulting to "entry", which would be the name of the key
   14: # TODO:	The maximum number to return should be tuneable (as a LIMIT)
   15: # TODO:	Add full CRUD support
   16: # TODO:	It would be better for the default sep_char to be ',' rather than '!'
   17: # TODO:	Other noSQL databases e.g., MongoDB, Cassandra
   18: # TODO: The no_entry/entry terminology is confusing.  Replace with no_id/id_column
   19: # TODO: Log queries and the time that they took to execute per database
   20: # TODO: Use DBD::JSON if one is ever written
   21: 
   22: use warnings;
   23: use strict;
   24: use autodie qw(:all);
   25: 
   26: use Carp;
   27: use Class::Abstract;
   28: use Data::Reuse;
   29: use DBI;
   30: use Fcntl;	# For O_RDONLY
   31: use Cwd;
   32: use File::Spec;
   33: use File::Temp;
   34: use List::Util qw(all any);
   35: use Log::Abstraction 0.33;
   36: use Object::Configure 0.16;
   37: use Params::Get 0.17;
   38: use Return::Set qw(set_return);
   39: use Scalar::Util;
   40: use Sub::Private { mode => 'enforce' };
   41: use Sub::Protected;
   42: 
   43: # File::Slurp::Remote is loaded lazily in _open() when host => '...' is given.
   44: 
   45: our %defaults;
   46: use constant	DEFAULT_MAX_SLURP_SIZE => 16 * 1024;	# CSV files <= than this size are read into memory
   47: 
   48: # Compiled once at module load; reused in every identifier-safety check.
   49: # Using \A/\z (true string anchors) rather than ^/$ which match around \n.
   50: # SAFE_IDENTIFIER: bare SQL identifier — letters, digits, underscore.
   51: # SAFE_QUALIFIED:  allows a single dot for table.column notation in JOINs.
   52: my $SAFE_IDENTIFIER = qr/\A[a-zA-Z_][a-zA-Z0-9_]*\z/;
   53: my $SAFE_QUALIFIED  = qr/\A[a-zA-Z_][a-zA-Z0-9_.]*\z/;
   54: 
   55: # Type-inference regexes and sample size for schema() when infer_types => 1.
   56: # Compiled once at load; reused in _infer_type() across all schema() calls.
   57: use constant INFER_TYPE_SAMPLE_SIZE => 100;
   58: my $INFER_INT_RE  = qr/\A-?\d+\z/;
   59: my $INFER_REAL_RE = qr/
   60: 	\A              # start of string
   61: 	-?              # optional leading minus
   62: 	\d+             # integer part -- required
   63: 	(?:\.\d+)?      # optional decimal part
   64: 	(?:             # optional exponent block:
   65: 		[eE]        #   e or E marker
   66: 		[+-]?       #   optional sign
   67: 		\d+         #   exponent digits
   68: 	)?
   69: 	\z              # end of string
   70: /x;
   71: # No \z anchor: intentionally matches any valid timestamp prefix so that full
   72: # timestamps with seconds, fractional seconds, or timezone offsets are still
   73: # classified as TIMESTAMP -- e.g. 2024-01-01 12:34:00.000+05:30
   74: my $INFER_TS_RE   = qr/
   75: 	\A                              # start of string
   76: 	\d{4}                           # 4-digit year
   77: 	- (?:0[1-9]|1[0-2])            # month 01-12
   78: 	- (?:0[1-9]|[12]\d|3[01])      # day   01-31
   79: 	[T\ ]                           # ISO 8601 date-time separator: T or space
   80: 	\d{2}:\d{2}                     # HH:MM -- no end anchor, see note above
   81: /x;
   82: my $INFER_DATE_RE = qr/
   83: 	\A                              # start of string
   84: 	\d{4}                           # 4-digit year
   85: 	- (?:0[1-9]|1[0-2])            # month 01-12
   86: 	- (?:0[1-9]|[12]\d|3[01])      # day   01-31
   87: 	\z                              # end of string
   88: /x;
   89: 
   90: # Module-level constant: valid JOIN types after uc() normalisation.
   91: # Built once at compile time; reused by every _build_joins call.
   92: my %VALID_JOIN_TYPES = map { $_ => 1 } qw(INNER LEFT RIGHT FULL CROSS);
   93: 
   94: # Valid aggregate functions (lower-cased) for _validate_aggregate_spec.
   95: my %VALID_AGG_FNS = map { $_ => 1 } qw(sum avg min max count count_distinct median stddev);
   96: 
   97: # Functions that are Perl-fold-only (no SQL pushdown).
   98: my %PERL_ONLY_AGG_FNS = map { $_ => 1 } qw(median stddev);
   99: 
  100: =encoding utf8
  101: 
  102: =head1 NAME
  103: 
  104: Database::Abstraction - Read-only Database Abstraction Layer (ORM)
  105: 
  106: =head1 VERSION
  107: 
  108: Version 0.52
  109: 
  110: =cut
  111: 
  112: our $VERSION = '0.52';
  113: 
  114: =head1 DESCRIPTION
  115: 
  116: C<Database::Abstraction> is a read-only ORM for Perl that gives a uniform
  117: interface over CSV, PSV, TSV, JSON, XML, SQLite, DBM::Deep, BerkeleyDB, and
  118: Excel (XLS/XLSX) files - local, remote (via SSH), or fetched from a URL -
  119: without writing any SQL.
  120: Effectively it allows you to access a database table, of many different
  121: database formats, as an object.
  122: 
  123: Key features:
  124: 
  125: =over 4
  126: 
  127: =item *
  128: 
  129: B<No SQL required.>  Use plain Perl method calls for simple lookups and
  130: scans; switch storage formats without changing application code.
  131: 
  132: =item *
  133: 
  134: B<Rich query criteria.>  Pass plain values, SQL wildcards, C<undef> (IS NULL),
  135: comparison operators (C<< > >> C<< < >> C<< >= >> C<< <= >> C<!=>), pattern
  136: operators (C<-like>, C<-not_like>), set operators (C<-in>, C<-not_in>,
  137: C<-between>), and logical groupings (C<-or>, C<-and>).
  138: 
  139: =item *
  140: 
  141: B<Automatic joins.>  Add a C<join> parameter to any select method to
  142: combine tables with INNER, LEFT, RIGHT, FULL, or CROSS joins.
  143: 
  144: =item *
  145: 
  146: B<Chained query builder.>  The C<query()> method returns a
  147: L<Database::Abstraction::Query> object for fluent, composable queries:
  148: C<< $db->query->where(...)->order_by(...)->limit(...)->all() >>.
  149: 
  150: =item *
  151: 
  152: B<Aggregation.>  The C<aggregate()> method and the fluent
  153: C<< ->group_by()->measure()->having()->all() >> chain push C<GROUP BY> to
  154: SQL backends and fold rows in Perl on slurp-only backends.
  155: 
  156: =item *
  157: 
  158: B<Schema introspection.>  C<columns()> lists column names; C<schema()>
  159: returns full type/nullability metadata, using native driver introspection
  160: (C<PRAGMA table_info> for SQLite, C<column_info> for others).
  161: 
  162: =item *
  163: 
  164: B<DSN portability.>  Pass a C<dsn> (plus optional C<username>/C<password>)
  165: to connect to any DBI-supported database (SQLite, PostgreSQL, MySQL, ...)
  166: instead of pointing at a local file.
  167: 
  168: =item *
  169: 
  170: B<Performance.>  Small files are slurped into a RAM hash for sub-millisecond
  171: lookups.  All DBI statement handles are cached with C<prepare_cached()>.
  172: A CHI-compatible cache layer is also supported.
  173: 
  174: =back
  175: 
  176: =head1 SYNOPSIS
  177: 
  178:     # 1. Create a thin subclass for your table (e.g. Database/Foo.pm)
  179:     package Database::Foo;
  180:     use parent 'Database::Abstraction';
  181: 
  182:     # 2. Open the database - file is auto-detected from the class name
  183:     #    (looks for foo.sql / foo.sqlite / foo.sqlite3 / foo.psv / foo.tsv / foo.csv / foo.xlsx / foo.xml / foo.json / foo.db)
  184:     my $db = Database::Foo->new(directory => '/path/to/data');
  185: 
  186:     # 3. Simple lookups -----------------------------------------------
  187: 
  188:     # Fetch one row
  189:     my $row = $db->fetchrow_hashref(entry => 'key1');
  190: 
  191:     # Fetch all rows matching a criterion
  192:     my $rows = $db->selectall_arrayref(status => 'active');
  193: 
  194:     # Column shortcut via AUTOLOAD
  195:     my $name = $db->name(entry => 'key1');
  196: 
  197:     # 4. Rich criteria ------------------------------------------------
  198: 
  199:     # Comparison operators
  200:     my $high = $db->selectall_arrayref(score => { '>' => 90 });
  201: 
  202:     # Set membership
  203:     my $selected = $db->selectall_arrayref(
  204:         name => { -in => ['Alice', 'Bob'] }
  205:     );
  206: 
  207:     # Range
  208:     my $mid = $db->selectall_arrayref(
  209:         score => { -between => [60, 80] }
  210:     );
  211: 
  212:     # OR grouping
  213:     my $either = $db->selectall_arrayref(
  214:         -or => [
  215:             { status => 'active'    },
  216:             { score  => { '>' => 95 } },
  217:         ]
  218:     );
  219: 
  220:     # 5. Joins --------------------------------------------------------
  221: 
  222:     my $joined = $db->selectall_arrayref(
  223:         join => { table => 'dept', on => 'foo.dept_id = dept.id', type => 'LEFT' }
  224:     );
  225: 
  226:     # 6. Chained query builder ----------------------------------------
  227: 
  228:     my $results = $db->query
  229:         ->where(status => 'active')
  230:         ->where(score  => { '>=' => 80 })
  231:         ->order_by('score DESC')
  232:         ->limit(10)
  233:         ->all();
  234: 
  235:     my $first = $db->query->where(name => 'Alice')->first();
  236:     my $count = $db->query->where(status => 'active')->count();
  237: 
  238:     # 7. Connect via DSN (PostgreSQL, MySQL, SQLite, ...) ---------------
  239: 
  240:     my $db2 = Database::Foo->new(
  241:         dsn      => 'dbi:Pg:dbname=mydb;host=db.example.com',
  242:         username => 'myuser',
  243:         password => 's3cret',
  244:     );
  245: 
  246:     # 8. Schema introspection -----------------------------------------
  247: 
  248:     my $cols   = $db->columns();  # ['entry', 'name', 'score', ...]
  249:     my $schema = $db->schema();   # { name => { type=>'TEXT', nullable=>1, ... }, ... }
  250: 
  251:     # 9. Aggregation (GROUP BY) ----------------------------------------
  252: 
  253:     # Total revenue and order count per region
  254:     my $summary = $db->aggregate(
  255:         by       => ['region'],
  256:         measures => [
  257:             { col => 'amount', fn => 'sum',   as => 'revenue' },
  258:             {                  fn => 'count', as => 'orders'  },
  259:         ],
  260:     );
  261: 
  262:     # Grand total across all rows
  263:     my $totals = $db->aggregate(
  264:         measures => [{ col => 'amount', fn => 'sum', as => 'total' }],
  265:     )->[0];
  266: 
  267:     # Fluent style with HAVING and sort
  268:     my $top = $db->query
  269:         ->group_by('region')
  270:         ->measure('amount', 'sum',   'revenue')
  271:         ->measure(undef,    'count', 'orders')
  272:         ->having(revenue => { '>' => 1000 })
  273:         ->order_by('revenue DESC')
  274:         ->limit(5)
  275:         ->all();
  276: 
  277: =head1 QUICK START EXAMPLE
  278: 
  279: If F</var/dat/foo.csv> contains:
  280: 
  281:     "customer_id","name"
  282:     "plugh","John"
  283:     "xyzzy","Jane"
  284: 
  285: Create a driver in F<.../Database/foo.pm>:
  286: 
  287:     package Database::foo;
  288:     use parent 'Database::Abstraction';
  289: 
  290:     # Regular CSV: no entry column, comma-separated
  291:     sub new {
  292:         my ($class, %args) = @_;
  293:         return $class->SUPER::new(no_entry => 1, sep_char => ',', %args);
  294:     }
  295: 
  296: Then query it:
  297: 
  298:     my $foo = Database::foo->new(directory => '/var/dat');
  299: 
  300:     # Prints "John"
  301:     print 'Customer: ', $foo->name(customer_id => 'plugh'), "\n";
  302: 
  303:     # Returns { customer_id => 'xyzzy', name => 'Jane' }
  304:     my $row = $foo->fetchrow_hashref(customer_id => 'xyzzy');
  305: 
  306: =head1 FILE FORMATS
  307: 
  308: The module probes the C<directory> for files in this priority order:
  309: 
  310: =over 4
  311: 
  312: =item 1. C<SQLite>
  313: 
  314: File ending C<.sql>, C<.sqlite>, or C<.sqlite3>.
  315: Requires L<DBD::SQLite>.
  316: 
  317: =item 2. C<Deep>
  318: 
  319: DBM::Deep file ending C<.dbm> or C<.deep>.  The entire file is slurped
  320: into a plain Perl hash on open; all in-memory fast-paths apply.
  321: Requires L<DBM::Deep> (loaded lazily).
  322: 
  323: =item 3. C<PSV>
  324: 
  325: Pipe-separated file, ending C<.psv>.
  326: 
  327: =item 4. C<TSV>
  328: 
  329: Tab-separated file, ending C<.tsv>.
  330: 
  331: =item 5. C<CSV>
  332: 
  333: Comma (or custom) separated file, ending C<.csv> or C<.db>; can be
  334: gzipped (C<.csv.gz> or C<.db.gz>).
  335: B<Note:> the default separator is C<!> not C<,> for historical
  336: reasons - pass C<< sep_char => ',' >> for standard CSVs.
  337: Requires L<Text::xSV::Slurp> for the slurp fast-path (loaded lazily).
  338: 
  339: =item 6. C<Excel> (C<.xls>) and C<XLSX> (C<.xlsx>)
  340: 
  341: Two separate Excel backends - one per file format:
  342: 
  343: =over 4
  344: 
  345: =item B<.xls> - old binary format, opened via L<DBD::Excel> (which uses
  346: L<Spreadsheet::ParseExcel> internally).  All queries go through DBI/SQL;
  347: no in-memory slurp path.  C<max_slurp_size> has no effect.
  348: 
  349: =item B<.xlsx> - modern OOXML format, parsed directly via
  350: L<Spreadsheet::ParseXLSX> and slurped into an in-memory hash (keyed mode)
  351: or array (C<no_entry> mode).  No DBI handle is created; all queries use
  352: the in-memory fast-path.  Complex criteria (operator hashes, C<-or>/C<-and>)
  353: will fall through to the SQL path and croak - use simple scalar criteria.
  354: 
  355: =back
  356: 
  357: For both formats, each worksheet is a separate logical table; the active
  358: worksheet is determined by the class-derived table name (or the C<table>
  359: constructor parameter).  Both modules are loaded lazily.
  360: 
  361: =item 7. C<XML>
  362: 
  363: File ending C<.xml>.
  364: Requires L<XML::Simple> for the slurp fast-path (loaded lazily).
  365: 
  366: =item 8. C<JSON>
  367: 
  368: File ending C<.json>, slurped into memory via L<JSON::MaybeXS> (loaded
  369: lazily).
  370: 
  371: The file may contain either a JSON array of row objects:
  372: 
  373:     [
  374:       { "entry": "key1", "col": "val1" },
  375:       { "entry": "key2", "col": "val2" }
  376:     ]
  377: 
  378: or a JSON object whose keys are the primary-key values:
  379: 
  380:     {
  381:       "key1": { "col": "val1" },
  382:       "key2": { "col": "val2" }
  383:     }
  384: 
  385: In the object form, each key is injected into its row hash under the C<id>
  386: column name (default C<entry>), so all normal lookups work identically to
  387: the array form.
  388: 
  389: A zero-byte or whitespace-only file is treated as empty - all query methods
  390: return 0 / C<undef> / C<[]> without throwing.
  391: Requires L<JSON::MaybeXS> (loaded lazily).
  392: 
  393: =item 9. C<BerkeleyDB>
  394: 
  395: Binary key-value file ending C<.db>.
  396: 
  397: =item 10. C<HTML>
  398: 
  399: HTML page fetched via a C<url>.  Pass C<url => 'https://...'> instead of
  400: C<directory>; the module fetches the page with L<LWP::UserAgent::Cached>, parses all
  401: C<< <table> >> elements with L<HTML::TableExtract>, and slurps the first (or
  402: C<html_table_index>-selected) table into memory.  The first row of the table
  403: is treated as column headers.  Both modules are loaded lazily and are not
  404: required for other backends.
  405: 
  406: =back
  407: 
  408: Pass C<dsn> to bypass file detection entirely and connect via any DBI driver.
  409: Pass C<url> to fetch and slurp data from a remote source without a local
  410: directory.  When the URL returns C<Content-Type: application/json> or the URL
  411: path ends in C<.json>, the response is parsed as JSON (see item 8 above).
  412: Otherwise the response is parsed as an HTML page (item 10).
  413: 
  414: Example - fetching CPAN Testers results:
  415: 
  416:     package Database::cpantesters;
  417:     use parent 'Database::Abstraction';
  418: 
  419:     my $db = Database::cpantesters->new(
  420:         url      => 'https://www.cpantesters.org/show/Database-Abstraction.json',
  421:         no_entry => 1,
  422:     );
  423:     my $passes = $db->selectall_arrayref(grade => 'PASS');
  424: 
  425: =head1 QUERY CRITERIA
  426: 
  427: All select methods (C<selectall_arrayref>, C<selectall_array>,
  428: C<fetchrow_hashref>, C<count>) accept the same criteria syntax.
  429: 
  430: =head2 Plain value
  431: 
  432:     status => 'active'          # status = 'active'
  433:     name   => undef             # name IS NULL
  434: 
  435: Values containing C<%> or C<_> are matched with C<LIKE>:
  436: 
  437:     name => 'A%'                # name LIKE 'A%'
  438: 
  439: =head2 Comparison operator hashref
  440: 
  441:     score => { '>'  => 90  }   # score > 90
  442:     score => { '<'  => 50  }   # score < 50
  443:     score => { '>=' => 80  }   # score >= 80
  444:     score => { '<=' => 100 }   # score <= 100
  445:     score => { '!=' => 0   }   # score != 0
  446: 
  447: Multiple operators on one column are ANDed:
  448: 
  449:     score => { '>' => 60, '<' => 90 }   # 60 < score < 90
  450: 
  451: =head2 Pattern matching
  452: 
  453:     name => { -like     => 'A%'  }   # name LIKE 'A%'
  454:     name => { -not_like => 'Z%'  }   # name NOT LIKE 'Z%'
  455: 
  456: =head2 Set membership
  457: 
  458:     name => { -in     => ['Alice', 'Bob'] }   # name IN (...)
  459:     name => { -not_in => ['Alice', 'Bob'] }   # name NOT IN (...)
  460: 
  461: =head2 Range
  462: 
  463:     score => { -between => [60, 90] }   # score BETWEEN 60 AND 90
  464: 
  465: =head2 Logical groupings
  466: 
  467: C<-or> and C<-and> take an arrayref of condition hashrefs:
  468: 
  469:     -or => [
  470:         { status => 'active'        },
  471:         { score  => { '>' => 95 }   },
  472:     ]
  473: 
  474:     -and => [
  475:         { status => 'active'        },
  476:         { score  => { '>=' => 80 }  },
  477:     ]
  478: 
  479: =head2 Joins
  480: 
  481: Any select method accepts a C<join> key with a hashref (or arrayref of
  482: hashrefs) describing the join:
  483: 
  484:     join => {
  485:         table => 'dept',
  486:         on    => 'employees.dept_id = dept.id',
  487:         type  => 'LEFT',    # INNER (default) | LEFT | RIGHT | FULL | CROSS
  488:     }
  489: 
  490:     # Multiple joins
  491:     join => [
  492:         { table => 'dept',    on => 'e.dept_id   = dept.id'   },
  493:         { table => 'country', on => 'e.country_id = country.id' },
  494:     ]
  495: 
  496: =head1 SUBROUTINES/METHODS
  497: 
  498: =head2 init
  499: 
  500: Set class-level defaults shared by all instances.
  501: 
  502:     Database::Abstraction::init(directory => '../data');
  503: 
  504: Accepts the same parameters as L</new>.  Returns a reference to the
  505: current defaults hash, so you can read them back:
  506: 
  507:     my $defaults = Database::Abstraction::init();
  508:     print $defaults->{'directory'}, "\n";
  509: 
  510: =cut
  511: 
  512: # Subroutine to initialize with args
  513: sub init
  514: {
●515 → 515 → 525  515: 	if(my $params = Params::Get::get_params(undef, \@_)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  516: 		if(($params->{'expires_in'} && !$params->{'cache_duration'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  517: 			# Compatibility with CHI
  518: 			$params->{'cache_duration'} = $params->{'expires_in'};
  519: 		}
  520: 
  521: 		%defaults = (%defaults, %{$params});
  522: 		$defaults{'cache_duration'} ||= '1 hour';
  523: 	}
  524: 
  525: 	return \%defaults
  Mutants (Total: 2, Killed: 2, Survived: 0)
  526: }
  527: 
  528: =head2 import
  529: 
  530: The module can be initialised by the C<use> directive.
  531: 
  532:     use Database::Abstraction 'directory' => '/etc/data';
  533: 
  534: or
  535: 
  536:     use Database::Abstraction { 'directory' => '/etc/data' };
  537: 
  538: =cut
  539: 
  540: sub import
  541: {
●542 → 544 → 0  542: 	my $pkg = shift;
  543: 
  544: 	if((scalar(@_) == 0) && (ref($pkg) eq 'HASH')) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  545: 		init(Object::Configure::configure(__PACKAGE__, $pkg));
  546: 	} elsif((scalar(@_) % 2) == 0) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  547: 		my %h = @_;
  548: 		init(Object::Configure::configure($pkg, \%h));
  549: 	} elsif((scalar(@_) == 1) && (ref($_[0]) eq 'HASH')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  550: 		init(Object::Configure::configure($pkg, $_[0]));
  551: 	} elsif(scalar(@_) > 0) {	# >= 3 would also work here
  Mutants (Total: 3, Killed: 3, Survived: 0)
  552: 		init(\@_);
  553: 	}
  554: }
  555: 
  556: =head2 new
  557: 
  558: Create an object pointing to a read-only database.
  559: 
  560: Accepts arguments as a hash, a hashref, or - as a shortcut - a single bare
  561: string which is taken to be C<directory>.
  562: 
  563: =head3 Connection parameters
  564: 
  565: =over 4
  566: 
  567: =item * C<directory>
  568: 
  569: Directory containing the data files.  The module probes this directory for
  570: files named after the subclass (see L</FILE FORMATS>).  Required unless
  571: C<dsn> is given.
  572: 
  573: =item * C<dsn>
  574: 
  575: A DBI data-source string (e.g. C<dbi:SQLite:dbname=/path/to/db> or
  576: C<dbi:Pg:dbname=mydb;host=db.example.com>).  When present, file detection
  577: is skipped entirely and the DSN is used directly.  The SQL dialect is
  578: inferred from the DSN prefix (C<sqlite>, C<postgres>, C<mysql>).
  579: 
  580: =item * C<username>
  581: 
  582: Database username.  Used only with C<dsn>; ignored for file-based backends.
  583: 
  584: =item * C<password>
  585: 
  586: Database password.  Used only with C<dsn>; ignored for file-based backends.
  587: 
  588: =item * C<dbname>
  589: 
  590: Override the filename stem searched in C<directory> (default: the table
  591: name derived from the class name).
  592: 
  593: =item * C<table>
  594: 
  595: Override the table (or worksheet) name used in SQL queries for this object.
  596: Default is the class-name-derived table name (e.g. C<Database::Foo> =>
  597: C<foo>).  Particularly useful for Excel workbooks where a single F<.xlsx>
  598: file contains multiple worksheets: pass C<< table => 'Summary' >> to query
  599: the C<Summary> worksheet without creating a dedicated subclass.  Also works
  600: with SQLite/DSN connections to select a table other than the class-derived
  601: default.  The filename stem (C<dbname>) continues to fall back to the class
  602: name, so the correct file is opened regardless of this override.  The value
  603: is validated against C<$SAFE_QUALIFIED> at construction time.
  604: 
  605: =item * C<filename>
  606: 
  607: Override the full filename (relative to C<directory>).  Takes precedence
  608: over C<dbname>.
  609: 
  610: =item * C<host>
  611: 
  612: Remote hostname (or C<user@host>) from which to fetch the data file(s) via
  613: SSH/SCP.  When present, each candidate filename is fetched with
  614: L<File::Slurp::Remote> into a local temporary directory; the existing
  615: extension-based file-type detection then runs against that directory.
  616: C<directory> is treated as the remote path (no local canonicalization is
  617: applied).  Using C<filename> together with C<host> avoids probing multiple
  618: extensions and is therefore more efficient.  L<File::Slurp::Remote> must be
  619: installed; it is loaded lazily (only when C<host> is given).
  620: 
  621: =item * C<url>
  622: 
  623: A URL (C<http://> or C<https://>) pointing to an HTML page that contains one
  624: or more C<< <table> >> elements.  When present, C<directory> is not required.
  625: The first row of the selected table is used as column headers.
  626: Requires L<LWP::UserAgent::Cached> and L<HTML::TableExtract> (both loaded lazily).
  627: 
  628: =item * C<database>
  629: 
  630: A Redis connection URL in the form C<redis://[password@]host[:port][/db_index]>.
  631: When present, C<directory>, C<dsn>, and C<url> are not required.  Rows are
  632: expected to be stored as Redis Hashes at keys of the form
  633: C<tablename:entry_value>; fields of each Hash become column values.  The
  634: module slurps all matching keys via C<KEYS tablename:*> + C<HGETALL> into the
  635: same in-memory structure used by the CSV and DBM::Deep backends, so all
  636: existing fast-paths (C<selectall_arrayref>, C<selectall_array>,
  637: C<fetchrow_hashref>, C<count>, C<columns>, C<schema>, AUTOLOAD) work without
  638: modification.  C<no_entry> mode is supported.
  639: 
  640: L<Redis::Fast> is tried first (XS, faster); if unavailable, L<Redis>
  641: (pure-Perl) is used as a fallback.  Both are loaded lazily - neither is
  642: required when using file-based or DSN-based backends.  The URL scheme is
  643: validated at construction time (C<redis://> only; all other schemes croak).
  644: 
  645: Use L</select> to switch the active Redis database on an already-open
  646: connection.
  647: 
  648: =back
  649: 
  650: =head3 Behaviour parameters
  651: 
  652: =over 4
  653: 
  654: =item * C<no_entry>
  655: 
  656: Set to C<1> when the table has no key column (standard CSVs, for example).
  657: Default is C<0> (keyed on C<entry>).
  658: 
  659: =item * C<id>
  660: 
  661: Name of the key column.  Default is C<entry>.
  662: 
  663: =item * C<sep_char>
  664: 
  665: Field separator for CSV/PSV files.
  666: Default is C<!> - pass C<< sep_char => ',' >>
  667: for standard comma-separated files.
  668: 
  669: =item * C<max_slurp_size>
  670: 
  671: Files smaller than this (in bytes) are loaded entirely into memory for fast
  672: lookups.  Default is 16 KB.  Set to C<0> to force SQL mode for all sizes.
  673: 
  674: =item * C<no_fixate>
  675: 
  676: Set to C<1> to return mutable arrays.  Default is C<0> (arrays are made
  677: read-only via L<Data::Reuse>).
  678: 
  679: =item * C<auto_load>
  680: 
  681: Set to C<0> to disable the AUTOLOAD column shortcut.  Default is C<1>
  682: (enabled).
  683: 
  684: =item * C<html_table_index>
  685: 
  686: Zero-based index of the HTML C<< <table> >> to extract when the C<url>
  687: backend is used.  Default is C<0> (the first table on the page).
  688: 
  689: =item * C<infer_types>
  690: 
  691: Set to C<1> to enable heuristic type inference in C<schema()> for
  692: slurp-backed sources (CSV, JSON, XLSX, XML, HTML URL, DBM::Deep).
  693: Default is C<0> (off; all columns reported as C<TEXT> for backward
  694: compatibility).
  695: 
  696: When enabled, C<schema()> scans the first 100 rows and promotes column
  697: types: all-integer values => C<INTEGER>; all-floating-point values =>
  698: C<REAL>; all ISO-8601 timestamps => C<TIMESTAMP>; all ISO-8601 dates =>
  699: C<DATE>; otherwise C<TEXT>.  C<NULL> (C<undef> or empty string) values
  700: are skipped during the scan.
  701: 
  702: =item * C<base_criteria>
  703: 
  704: A hashref of column-value pairs that is ANDed into B<every> SELECT
  705: automatically.  Callers do not need to repeat these criteria on each
  706: call.  Common use cases:
  707: 
  708: =over 4
  709: 
  710: =item * Row-level security: C<< base_criteria => { tenant_id => $tid } >>
  711: 
  712: =item * Soft-delete filtering: C<< base_criteria => { deleted_at => undef } >>
  713: 
  714: =item * Status gates: C<< base_criteria => { active => 1 } >>
  715: 
  716: =back
  717: 
  718: The hashref is shallow-copied at construction time so later mutations to
  719: the original do not affect the object.  Column names are validated
  720: against the same identifier rules as the C<id> parameter.  C<-or> and
  721: C<-and> groupings are allowed as keys.
  722: 
  723: B<SQL path>: the criteria are merged into the C<WHERE> clause before
  724: the caller-supplied criteria (caller values win on key collision).
  725: 
  726: B<Slurp/in-memory path>: the criteria are applied as an additional
  727: filter.  The C<fetchrow_hashref> entry-key fast path checks
  728: C<base_criteria> against the returned row before returning it.
  729: 
  730: B<Query builder>: C<base_criteria> are merged into the C<WHERE> clause
  731: generated by C<_build_sql>, so C<< $db->query->where(...)->all() >>
  732: also respects them.
  733: 
  734: =back
  735: 
  736: =head3 Caching and logging
  737: 
  738: =over 4
  739: 
  740: =item * C<cache>
  741: 
  742: A L<CHI>-compatible cache object.  When set, query results are stored and
  743: retrieved from the cache.
  744: 
  745: =item * C<cache_duration> / C<expires_in>
  746: 
  747: TTL for cached results.  Default is C<'1 hour'>.  C<expires_in> is a
  748: synonym for compatibility with L<CHI>.
  749: 
  750: =item * C<logger>
  751: 
  752: An object that understands C<warn()> and C<trace()> (e.g.
  753: L<Log::Log4perl>, L<Log::Any>), a code reference, or a filename.
  754: 
  755: =item * C<config_file>
  756: 
  757: Path to a YAML, XML, or INI configuration file whose keys are merged into
  758: the constructor arguments.  Loaded via L<Object::Configure>.
  759: 
  760: =back
  761: 
  762: =head3 Notes
  763: 
  764: =over 4
  765: 
  766: =item *
  767: 
  768: If no arguments are set, class-level defaults set via C<init()> or C<use>
  769: are used.
  770: 
  771: =item *
  772: 
  773: Slurp mode assumes the key column (C<entry>) is unique.  If it is not,
  774: searches will be incomplete - disable slurp mode by setting
  775: C<< max_slurp_size => 0 >>.
  776: 
  777: =item *
  778: 
  779: Passing an existing object as C<$class> clones it, merging any new
  780: arguments.
  781: 
  782: =back
  783: 
  784: =cut
  785: 
  786: sub new {
●787 → 793 → 799  787: 	my $class = shift;
  788: 	my %args;
  789: 
  790: 	Class::Abstract::check_abstract($class);	# enforces abstract contract
  791: 
  792: 	# Handle hash or hashref arguments
  793: 	if((scalar(@_) == 1) && !ref($_[0])) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  794: 		$args{'directory'} = $_[0];
  795: 	} elsif(my $params = Params::Get::get_params(undef, @_)) {
  796: 		%args = %{$params};
  797: 	}
  798: 
●799 → 799 → 826  799: 	if(!defined($class)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  800: 		if((scalar keys %args) > 0) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
  801: 			# Using Database::Abstraction->new(), not Database::Abstraction::new()
  802: 			carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
  803: 			return;
  804: 		}
  805: 		# FIXME: this only works when no arguments are given
  806: 		$class = __PACKAGE__;
  807: 	} elsif($class eq __PACKAGE__) {
  808: 		croak("$class: abstract class");
  809: 	} elsif(Scalar::Util::blessed($class)) {
  810: 		# If $class is an object, clone it with new arguments.
  811: 		# Validate 'id' and 'table' before merging — the validation block below is
  812: 		# skipped by this early return, so hostile clone args would otherwise bypass
  813: 		# all guards and be interpolated directly into SQL.
  814: 		if(defined $args{'id'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  815: 			croak(ref($class), ": unsafe id column name '$args{id}'")
  816: 				unless $args{'id'} =~ $SAFE_IDENTIFIER;
  817: 		}
  818: 		if(defined $args{'table'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  819: 			croak(ref($class), ": unsafe table name '$args{table}'")
  820: 				unless $args{'table'} =~ $SAFE_QUALIFIED;
  821: 		}
  822: 		return bless { %{$class}, %args }, ref($class);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  823: 	}
  824: 
  825: 	# Load the configuration from a config file, if provided
●826 → 830 → 834  826: 	%args = %{Object::Configure::configure($class, \%args)};
  827: 
  828: 	# Normalise logger: wrap code-refs, filenames, and strings in Log::Abstraction
  829: 	# so that the rest of the code can always call ->$level(...) uniformly.
  830: 	if(defined $args{'logger'} && !Scalar::Util::blessed($args{'logger'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  831: 		$args{'logger'} = Log::Abstraction->new($args{'logger'});
  832: 	}
  833: 
●834 → 834 → 846  834: 	unless($args{'dsn'} || $defaults{'dsn'} || $args{'url'} || $defaults{'url'} || $args{'database'} || $defaults{'database'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  835: 		croak("$class: where are the files?") unless($args{'directory'} || $defaults{'directory'});
  836: 
  837: 		# Skip the local -d check only for genuinely remote hosts.
  838: 		# localhost / 127.0.0.1 / current hostname are treated as local.
  839: 		my $given_host = $args{'host'} // $defaults{'host'};
  840: 		unless($given_host && !$class->_is_local_host($given_host)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  841: 			croak("$class: ", $args{'directory'} || $defaults{'directory'}, ' is not a directory') unless(-d ($args{'directory'} || $defaults{'directory'}));
  842: 		}
  843: 	}
  844: 
  845: 	# Validate the primary-key column name to prevent SQL injection via ORDER BY / WHERE
●846 → 846 → 897  846: 	for my $src (\%defaults, \%args) {
  847: 		if(defined $src->{'id'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  848: 			croak("$class: unsafe id column name '$src->{id}'")
  849: 				unless $src->{'id'} =~ $SAFE_IDENTIFIER;
  850: 		}
  851: 		if(defined $src->{'host'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  852: 			croak("$class: unsafe host '$src->{host}'")
  853: 				unless $src->{'host'} =~ /\A
  854: 					(?:                   # optional "user\@" prefix
  855: 						[a-zA-Z0-9]       # username: first char must be alnum
  856: 						[a-zA-Z0-9._-]*   # username: rest may include dots and hyphens
  857: 						\@                # literal at-sign; \@ prevents array interpolation
  858: 					)?
  859: 					[a-zA-Z0-9:]          # first char of host or IP; colon allows IPv6
  860: 					[a-zA-Z0-9._:-]*      # rest: hostname, dotted IPv4, or IPv6 hex groups
  861: 				\z/x;
  862: 		}
  863: 		if(defined $src->{'url'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  864: 			croak("$class: unsafe url '$src->{url}'")
  865: 				unless $src->{'url'} =~ m{\Ahttps?://}i;
  866: 		}
  867: 		if(defined $src->{'database'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  868: 			croak("$class: unsafe database '$src->{database}'")
  869: 				unless $src->{'database'} =~ m{\Aredis://}i;
  870: 		}
  871: 		if(defined $src->{'table'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  872: 			croak("$class: unsafe table name '$src->{table}'")
  873: 				unless $src->{'table'} =~ $SAFE_QUALIFIED;
  874: 		}
  875: 		# redis_key: the literal Redis key name used for lookups.  It is
  876: 		# intentionally NOT validated as a SQL identifier — Redis key names
  877: 		# may contain colons, hyphens and other non-SQL characters.  Only
  878: 		# accepted when a database (redis://) URL is also present so it
  879: 		# cannot be injected into non-Redis SQL paths.
  880: 		if(defined $src->{'redis_key'} && !defined $src->{'database'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  881: 			croak("$class: redis_key is only valid with a redis:// database URL");
  882: 		}
  883: 		if(defined $src->{'base_criteria'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  884: 			my $bc = $src->{'base_criteria'};
  885: 			croak("$class: base_criteria must be a hashref")
  886: 				unless ref($bc) eq 'HASH';
  887: 			for my $k (keys %{$bc}) {
  888: 				next if $k =~ /\A-/;	# allow -or/-and groupings
  889: 				croak("$class: unsafe base_criteria key '$k'")
  890: 					unless $k =~ $SAFE_QUALIFIED;
  891: 			}
  892: 			$src->{'base_criteria'} = { %{$bc} };	# shallow copy for safety
  893: 		}
  894: 	}
  895: 
  896: 	# Defaults are set first so that %args keys override them
  897: 	return bless {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  898: 		no_entry => 0,
  899: 		no_fixate => 0,
  900: 		id => 'entry',
  901: 		cache_duration => '1 hour',
  902: 		max_slurp_size => DEFAULT_MAX_SLURP_SIZE,
  903: 		%defaults,
  904: 		%args,
  905: 	}, $class;
  906: }
  907: 
  908: =head2	set_logger
  909: 
  910: Sets the class, code reference, or file that will be used for logging.
  911: 
  912: =cut
  913: 
  914: sub set_logger
  915: {
●916 → 919 → 927  916: 	my $self = shift;
  917: 	my $params = Params::Get::get_params('logger', @_);
  918: 
  919: 	if(my $logger = $params->{'logger'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  920: 		if(Scalar::Util::blessed($logger)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  921: 			$self->{'logger'} = $logger;
  922: 		} else {
  923: 			$self->{'logger'} = Log::Abstraction->new($logger);
  924: 		}
  925: 		return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  926: 	}
  927: 	Carp::croak('Usage: set_logger(logger => $logger)')
  928: }
  929: 
  930: =head2	select
  931: 
  932: Select a Redis database by number (0-15).  Clears the in-memory data cache so
  933: the next query re-slurps from the newly selected database.  Returns C<$self>
  934: for chaining.  Croaks if the object is not backed by a Redis connection.
  935: 
  936:     $db->select(3);          # switch to Redis DB 3
  937:     my $count = $db->count;  # queries the new DB
  938: 
  939: =cut
  940: 
  941: sub select
  942: {
  943: 	my $self = shift;
  944: 	my $db_num = Params::Get::get_params('database', \@_)->{'database'};
  945: 
  946: 	Carp::croak(ref($self), ': select: db number must be a non-negative integer')
  947: 		unless defined($db_num) && $db_num =~ /\A\d+\z/;
  948: 
  949: 	$self->_open_table({});
  950: 	Carp::croak(ref($self), ': select: not a Redis connection')
  951: 		unless $self->{'_redis'};
  952: 
  953: 	$self->{'_redis'}->select(int($db_num));
  954: 
  955: 	# Clear cached data so next query re-slurps from the new database
  956: 	delete $self->{'data'};
  957: 	delete $self->{'_columns'};
  958: 	delete $self->{'_schema'};
  959: 
  960: 	return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  961: }
  962: 
  963: # Open the database connection based on the specified type (e.g., SQLite, CSV).
  964: # Read the data into memory or establish a connection to the database file.
  965: # column_names allows the column names to be overridden on CSV files
  966: 
  967: sub _open :Protected
  968: {
  969: 	# Enforce that _open is only reachable from within this class hierarchy;
  970: 	# caller() returns the calling package name as a plain string.
●971 → 990 → 1022  971: 	do { my $c = (caller)[0]; Carp::croak('Illegal Operation: _open may only be called within ', __PACKAGE__) unless $c && $c->isa(__PACKAGE__) };
  972: 
  973: 	my $self = shift;
  974: 	my $params = Params::Get::get_params(undef, \@_);
  975: 
  976: 	$params->{'sep_char'} ||= $self->{'sep_char'} ? $self->{'sep_char'} : '!';
  977: 	my $max_slurp_size = $params->{'max_slurp_size'} || $self->{'max_slurp_size'};
  978: 
  979: 	my $table = $self->{'table'} || ref($self);
  980: 	$table =~ s/\A.*:://;
  981: 
  982: 	$self->_trace(ref($self), ": _open $table");
  983: 
  984: 	return if($self->{$table});
  985: 
  986: 	# Read in the database
  987: 	my $dbh;
  988: 
  989: 	# DSN-based connection bypasses file detection entirely
  990: 	if(my $dsn = $self->{'dsn'} || $defaults{'dsn'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  991: 		my $dialect = 'generic';
  992: 		if    ($dsn =~ /\Adbi:SQLite:/i) { $dialect = 'sqlite'   }
  Mutants (Total: 1, Killed: 1, Survived: 0)
  993: 		elsif ($dsn =~ /\Adbi:Pg:/i)     { $dialect = 'postgres' }
  994: 		elsif ($dsn =~ /\Adbi:mysql:/i)  { $dialect = 'mysql'    }
  995: 		$self->{'_dialect'} = $dialect;
  996: 
  997: 		$dbh = DBI->connect(
  998: 			$dsn,
  999: 			$self->{'username'},
 1000: 			$self->{'password'},
 1001: 			{ RaiseError => 1, AutoCommit => 1 },
 1002: 		) or Carp::croak(ref($self), ": cannot connect: $DBI::errstr");
 1003: 
 1004: 		if($dialect eq 'sqlite') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1004_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1005: 			$dbh->do('PRAGMA synchronous = OFF');
 1006: 			$dbh->do('PRAGMA cache_size = -4096');
 1007: 			$dbh->do('PRAGMA journal_mode = OFF');
 1008: 			$dbh->do('PRAGMA temp_store = MEMORY');
 1009: 			$dbh->do('PRAGMA mmap_size = 1048576');
 1010: 			$dbh->sqlite_busy_timeout(100000);
 1011: 		}
 1012: 
 1013: 		$self->{'type'} = 'DBI';
 1014: 		$self->{$table} = $dbh;
 1015: 		$self->{'_updated'} = time();
 1016: 		return $self;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1016_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1016_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1017: 	}
 1018: 
 1019: 	# Redis backend — connects to a Redis server and slurps hash keys matching
 1020: 	# "tablename:*" into memory, mirroring the DBM::Deep slurp structure.
 1021: 	# Lazily loads Redis::Fast (preferred) or Redis.
●1022 → 1022 → 1113 1022: 	if(my $db_url = $self->{'database'} || $defaults{'database'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1023: 		# Parse redis://[userinfo@]host[:port][/db_index]
 1024: 		my ($userinfo, $host, $port, $db_idx) =
 1025: 			$db_url =~ m{\Aredis://(?:([^@]*)@)?([^/:]*)?(?::(\d+))?(?:/(\d+))?\z}i;
 1026: 		$host   //= 'localhost';
 1027: 		$port   //= 6379;
 1028: 		$db_idx //= 0;
 1029: 		my $password;
 1030: 		if(defined $userinfo) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1031: 			$password = ($userinfo =~ /:(.*)/) ? $1 : (length($userinfo) ? $userinfo : undef);
 1032: 		}
 1033: 
 1034: 		unless($self->{'_redis'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1035: 			my $redis_class;
 1036: 			eval { require Redis::Fast; $redis_class = 'Redis::Fast' };
 1037: 			if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1038: 				require Redis;
 1039: 				$redis_class = 'Redis';
 1040: 			}
 1041: 			$self->{'_redis'} = $redis_class->new(server => "$host:$port", reconnect => 2, every => 100);
 1042: 			$self->{'_redis'}->auth($password) if defined $password && length $password;
 1043: 		}
 1044: 		$self->{'_redis'}->select($db_idx) if $db_idx;
 1045: 
 1046: 		my $id        = $self->{'id'};
 1047: 		# redis_key overrides table for the actual Redis key lookup so that
 1048: 		# callers can pass an arbitrary key name (colons, hyphens, etc.) without
 1049: 		# it needing to pass the SQL-identifier check on the table parameter.
 1050: 		my $redis_key = $self->{'redis_key'} // $table;
 1051: 		my @keys = $self->{'_redis'}->keys("${redis_key}:*");
 1052: 
 1053: 		if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1054: 			my @data;
 1055: 			for my $key (@keys) {
 1056: 				my %fields = $self->{'_redis'}->hgetall($key);
 1057: 				push @data, \%fields if %fields;
 1058: 			}
 1059: 			$self->{'data'} = @data ? \@data : undef;
 1060: 		} else {
 1061: 			my %data;
 1062: 			for my $key (@keys) {
 1063: 				(my $entry = $key) =~ s/\A\Q${redis_key}\E://;
 1064: 				my %fields = $self->{'_redis'}->hgetall($key);
 1065: 				$data{$entry} = { $id => $entry, %fields } if %fields;
 1066: 			}
 1067: 			$self->{'data'} = %data ? \%data : undef;
 1068: 		}
 1069: 
 1070: 		# Fallback: if no compound "keyname:entry" sub-keys were found, try
 1071: 		# the key itself as a standalone value.  This supports any Redis data
 1072: 		# structure (hash, list, set, sorted set, string) stored under a plain
 1073: 		# key rather than the keyname:entry compound-key convention.
 1074: 		unless(@keys) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1075: 			my $key_type = lc($self->{'_redis'}->type($redis_key));
 1076: 			if($key_type eq 'hash') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1077: 				my %fields = $self->{'_redis'}->hgetall($redis_key);
 1078: 				if(%fields) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1079: 					$self->{'data'} = $self->{'no_entry'}
 1080: 						? [\%fields]
 1081: 						: { $redis_key => { $id => $redis_key, %fields } };
 1082: 				}
 1083: 			} elsif($key_type eq 'list') {
 1084: 				my @items = $self->{'_redis'}->lrange($redis_key, 0, -1);
 1085: 				my $i = 0;
 1086: 				$self->{'data'} = [map { { index => $i++, value => $_ } } @items];
 1087: 			} elsif($key_type eq 'set') {
 1088: 				my @members = sort $self->{'_redis'}->smembers($redis_key);
 1089: 				$self->{'data'} = [map { { member => $_ } } @members];
 1090: 			} elsif($key_type eq 'zset') {
 1091: 				my @pairs = $self->{'_redis'}->zrange($redis_key, 0, -1, 'WITHSCORES');
 1092: 				my @rows;
 1093: 				while(@pairs) {
 1094: 					my($m, $s) = splice @pairs, 0, 2;
 1095: 					push @rows, { member => $m, score => $s };
 1096: 				}
 1097: 				$self->{'data'} = \@rows;
 1098: 			} elsif($key_type eq 'string') {
 1099: 				my $val = $self->{'_redis'}->get($redis_key);
 1100: 				$self->{'data'} = [{ value => $val }] if defined $val;
 1101: 			}
 1102: 			# 'none': key does not exist -- data stays undef; returns empty below.
 1103: 		}
 1104: 
 1105: 		$self->{'type'}     = 'Redis';
 1106: 		$self->{'_updated'} = time();
 1107: 		return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1108: 	}
 1109: 
 1110: 	# URL-based backend — handles both JSON and HTML table responses.
 1111: 	# LWP::UserAgent::Cached is always required; JSON::MaybeXS and
 1112: 	# HTML::TableExtract are loaded lazily based on the response Content-Type.
●1113 → 1113 → 1204 1113: 	if(my $url = $self->{'url'} || $defaults{'url'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1114: 		require LWP::UserAgent::Cached;
 1115: 
 1116: 		my $ua = $self->{ua} // LWP::UserAgent::Cached->new(timeout => 30, agent => __PACKAGE__ . '/' . $VERSION);
 1117: 		$ua->env_proxy(1);
 1118: 		my $response = $ua->get($url);
 1119: 		Carp::croak(ref($self), ": cannot fetch '$url': ", $response->status_line)
 1120: 			unless $response->is_success;
 1121: 
 1122: 		my $content_type = $response->content_type() // '';
 1123: 		if($content_type =~ m{\bapplication/json\b}i || $url =~ /\.json(?:[?#]|\z)/i) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1124: 			# JSON URL backend — lazy-loads JSON::MaybeXS.
 1125: 			# Detects by Content-Type: application/json or a .json URL suffix.
 1126: 			require JSON::MaybeXS;
 1127: 			my $parsed = JSON::MaybeXS::decode_json($response->decoded_content);
 1128: 			my @data;
 1129: 			if(ref($parsed) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1130: 				@data = @{$parsed};
 1131: 			} elsif(ref($parsed) eq 'HASH') {
 1132: 				# Object keyed by primary-key value — inject id column into each row
 1133: 				my $id_col = $self->{'id'};
 1134: 				for my $k (sort keys %{$parsed}) {
 1135: 					my $row = $parsed->{$k};
 1136: 					if(ref($row) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1137: 						push @data, { $id_col => $k, %{$row} };
 1138: 					} else {
 1139: 						push @data, { $id_col => $k, value => $row };
 1140: 					}
 1141: 				}
 1142: 			} else {
 1143: 				Carp::croak(ref($self), ": JSON URL: unexpected top-level structure from '$url'");
 1144: 			}
 1145: 			if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1146: 				$self->{'data'} = @data ? \@data : undef;
 1147: 			} else {
 1148: 				$self->{'data'} = { map { $_->{$self->{'id'}} => $_ } @data };
 1149: 			}
 1150: 			$self->{'type'} = 'JSON';
 1151: 		} else {
 1152: 			# HTML table backend — lazy-loads HTML::TableExtract.
 1153: 			require HTML::TableExtract;
 1154: 
 1155: 			my $te = HTML::TableExtract->new();
 1156: 			$te->parse($response->decoded_content);
 1157: 
 1158: 			my $tidx = $self->{'html_table_index'} // $defaults{'html_table_index'} // 0;
 1159: 			my @tables = $te->tables;
 1160: 			Carp::croak(ref($self), ": no HTML tables found at '$url'")
 1161: 				unless @tables;
 1162: 			Carp::croak(ref($self), ": html_table_index $tidx out of range (", scalar @tables, " tables) at '$url'")
 1163: 				if $tidx >= @tables;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1164: 
 1165: 			my @rows = $tables[$tidx]->rows;
 1166: 			Carp::croak(ref($self), ": empty HTML table at '$url'")
 1167: 				unless @rows;
 1168: 
 1169: 			my @headers = map { defined($_) ? "$_" : '' } @{$rows[0]};
 1170: 			my $id = $self->{'id'};
 1171: 
 1172: 			if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1173: 				my @data;
 1174: 				for my $i (1 .. $#rows) {
 1175: 					my %row;
 1176: 					@row{@headers} = map { defined($_) ? "$_" : undef } @{$rows[$i]};
 1177: 					push @data, \%row;
 1178: 				}
 1179: 				$self->{'data'} = \@data;
 1180: 			} else {
 1181: 				my %data;
 1182: 				for my $i (1 .. $#rows) {
 1183: 					my %row;
 1184: 					@row{@headers} = map { defined($_) ? "$_" : undef } @{$rows[$i]};
 1185: 					my $key = $row{$id};
 1186: 					next unless defined $key;
 1187: 					$data{$key} = \%row;
 1188: 				}
 1189: 				$self->{'data'} = \%data;
 1190: 			}
 1191: 			$self->{'type'} = 'HTML';
 1192: 		}
 1193: 
 1194: 		$self->{'_updated'} = time();
 1195: 		$self->_fixate($self->{'data'}) if $self->{'data'} && ref($self->{'data'}) eq 'HASH';
 1196: 		$self->{$table} = undef;	# No DBI handle; all queries use the in-memory data path
 1197: 		return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1198: 	}
 1199: 
 1200: 	# Derive the filename stem from the class name, NOT from any $table override.
 1201: 	# This allows table => 'Sheet2' to query a different worksheet within the same
 1202: 	# file (e.g. test1.xlsx with a 'sheet2' worksheet) without needing an explicit
 1203: 	# dbname. When dbname is set explicitly it always wins.
●1204 → 1215 → 1300 1204: 	my $class_stem = ref($self);
 1205: 	$class_stem =~ s/\A.*:://;
 1206: 	my $dbname = $self->{'dbname'} || $defaults{'dbname'} || $class_stem;
 1207: 	# \A/\z (not ^/$) so a trailing newline cannot sneak past the $ anchor.
 1208: 	Carp::croak(ref($self), ": unsafe dbname '$dbname'")
 1209: 		unless $dbname =~ /\A[a-zA-Z0-9_.-]+\z/ && $dbname !~ /\.\./;
 1210: 
 1211: 	# When a remote host is given, fetch all candidate files into a local temp
 1212: 	# directory via File::Slurp::Remote (SSH/SCP).  localhost / 127.0.0.1 / the
 1213: 	# current machine's hostname are treated as local (no SSH, no temp dir).
 1214: 	my $dir;
 1215: 	if(my $host = $self->{'host'} || $defaults{'host'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1216: 		if($self->_is_local_host($host)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1217: 			$self->_debug("host '$host' is local; reading directory directly");
 1218: 			my $raw_dir = $self->{'directory'} || $defaults{'directory'};
 1219: 			Carp::croak(ref($self), ': no directory specified') unless $raw_dir;
 1220: 			$dir = Cwd::abs_path($raw_dir);
 1221: 		} else {
 1222: 			require File::Slurp::Remote;
 1223: 			require POSIX;
 1224: 			my $remote_dir = $self->{'directory'} || $defaults{'directory'};
 1225: 			my $tmpdir_obj = File::Temp->newdir(CLEANUP => 1);
 1226: 			$self->{'_remote_tmpdir'} = $tmpdir_obj;	# auto-cleans on DESTROY
 1227: 			my $tmpdir = $tmpdir_obj->dirname();
 1228: 			my @probe_exts = qw(sql sqlite sqlite3 dbm deep db csv.gz db.gz psv tsv xls xlsx csv xml json);
 1229: 
 1230: 			if(my $filename = $self->{'filename'} || $defaults{'filename'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1231: 				# Explicit filename given — one SSH fetch, no extension probing needed.
 1232: 				# Validate the same way _open() will when it processes the filename later.
 1233: 				Carp::croak(ref($self), ": unsafe filename '$filename'")
 1234: 					unless $filename =~ /\A[a-zA-Z0-9_.-]+\z/ && $filename !~ /\.\./;
 1235: 				my $remote_file = "$remote_dir/$filename";
 1236: 				my $content = eval { scalar File::Slurp::Remote::read_remote_file($host, $remote_file) };
 1237: 				if(defined($content) && length($content)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1238: 					my $local = File::Spec->catfile($tmpdir, $filename);
 1239: 					open(my $fh, '>', $local);
 1240: 					binmode $fh;
 1241: 					print $fh $content;
 1242: 					close $fh;
 1243: 					$self->_debug("fetched remote $host:$remote_file");
 1244: 				}
 1245: 			} else {
 1246: 				# No explicit filename — probe all candidate extensions.
 1247: 				# Fork one child per extension so all SSH calls run concurrently.
 1248: 				# Falls back to sequential for any extension whose fork() fails.
 1249: 				# Children MUST exit via POSIX::_exit(0) to skip Perl's cleanup
 1250: 				# phase; a normal exit(0) would run DESTROY on the inherited
 1251: 				# File::Temp::Dir, deleting the tmpdir while the parent still needs it.
 1252: 				my (@pids, @fallback_exts);
 1253: 				for my $ext (@probe_exts) {
 1254: 					my $pid = eval { fork() };
 1255: 					if(!defined $pid) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1256: 						# fork() failed or unavailable — defer to sequential pass
 1257: 						push @fallback_exts, $ext;
 1258: 						next;
 1259: 					}
 1260: 					if($pid == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1261: 						# child: fetch one extension; eval guards against autodie croaks
 1262: 						eval {
 1263: 							my $remote_file = "$remote_dir/$dbname.$ext";
 1264: 							my $content = File::Slurp::Remote::read_remote_file($host, $remote_file);
 1265: 							if(defined($content) && length($content)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1266: 								my $local = File::Spec->catfile($tmpdir, "$dbname.$ext");
 1267: 								open(my $fh, '>', $local);
 1268: 								binmode $fh;
 1269: 								print $fh $content;
 1270: 								close $fh;
 1271: 							}
 1272: 						};
 1273: 						POSIX::_exit(0);
 1274: 					}
 1275: 					push @pids, $pid;
 1276: 				}
 1277: 				waitpid($_, 0) for @pids;
 1278: 
 1279: 				# Sequential pass for any extensions that couldn't be forked
 1280: 				for my $ext (@fallback_exts) {
 1281: 					my $remote_file = "$remote_dir/$dbname.$ext";
 1282: 					my $content = eval { scalar File::Slurp::Remote::read_remote_file($host, $remote_file) };
 1283: 					next unless defined($content) && length($content);
 1284: 					my $local = File::Spec->catfile($tmpdir, "$dbname.$ext");
 1285: 					open(my $fh, '>', $local);
 1286: 					binmode $fh;
 1287: 					print $fh $content;
 1288: 					close $fh;
 1289: 					$self->_debug("fetched remote $host:$remote_file");
 1290: 				}
 1291: 			}
 1292: 			$dir = $tmpdir;
 1293: 		}
 1294: 	} else {
 1295: 		my $raw_dir = $self->{'directory'} || $defaults{'directory'};
 1296: 		Carp::croak(ref($self), ': no directory specified') unless $raw_dir;
 1297: 		$dir = Cwd::abs_path($raw_dir);
 1298: 	}
 1299: 	# Probe for SQLite files (.sql, .sqlite, .sqlite3)
●1300 → 1301 → 1305 1300: 	my $slurp_file;
 1301: 	for my $ext (qw(sql sqlite sqlite3)) {
 1302: 		my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
 1303: 		if(-r $candidate) { $slurp_file = $candidate; last }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1304: 	}
●1305 → 1312 → 1317 1305: 	$slurp_file //= File::Spec->catfile($dir, "$dbname.sql");
 1306: 
 1307: 	$self->_debug("_open: try to open $slurp_file");
 1308: 
 1309: 	# Probe for DBM::Deep files (.dbm or .deep) before the CSV/BerkeleyDB fallback.
 1310: 	# Loaded lazily so the DBM::Deep module is not required for other backends.
 1311: 	my $deep_file;
 1312: 	for my $ext (qw(dbm deep)) {
 1313: 		my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
 1314: 		if(-r $candidate) { $deep_file = $candidate; last }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1315: 	}
 1316: 	# Also detect DBM::Deep files by magic bytes (covers .db files and arbitrary extensions).
●1317 → 1317 → 1323 1317: 	if(!$deep_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1318: 		my $db_candidate = File::Spec->catfile($dir, "$dbname.db");
 1319: 		$deep_file = $db_candidate if -r $db_candidate && $self->_is_deep_db($db_candidate);
 1320: 	}
 1321: 
 1322: 	# Look at various places to find the file and derive the file type from the file's name
●1323 → 1323 → 1330 1323: 	if(-r $slurp_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1324: 		# SQLite file
 1325: 		require DBD::SQLite::Constants;
 1326: 		$dbh = DBI->connect("dbi:SQLite:dbname=$slurp_file", undef, undef, {
 1327: 			sqlite_open_flags => DBD::SQLite::Constants::SQLITE_OPEN_READONLY(),
 1328: 		});
 1329: 	}
●1330 → 1330 → 1678 1330: 	if($dbh) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1331: 		$dbh->do('PRAGMA synchronous = OFF');
 1332: 		$dbh->do('PRAGMA cache_size = -4096');	# Use 4MB cache - negative = KB)
 1333: 		$dbh->do('PRAGMA journal_mode = OFF');	# Read-only, no journal needed
 1334: 		$dbh->do('PRAGMA temp_store = MEMORY');	# Store temp data in RAM
 1335: 		$dbh->do('PRAGMA mmap_size = 1048576');	# Use 1MB memory-mapped I/O
 1336: 		$dbh->sqlite_busy_timeout(100000);	# 10s
 1337: 		$self->_debug("read in $table from SQLite $slurp_file");
 1338: 		$self->{'type'} = 'DBI';
 1339: 	} elsif($deep_file) {
 1340: 		# DBM::Deep file (.dbm or .deep) — slurp the entire tied hash into a plain
 1341: 		# Perl hash so all existing in-memory fast-paths work without modification.
 1342: 		require DBM::Deep;
 1343: 		my $deep = DBM::Deep->new({ file => $deep_file, read_only => 1 });
 1344: 		my $id = $self->{'id'};
 1345: 		if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1346: 			# Not keyed — produce an ordered arrayref of row hashrefs, same as CSV no_entry.
 1347: 			my @data;
 1348: 			for my $k (sort keys %{$deep}) {
 1349: 				my $row = $deep->{$k};
 1350: 				# Use reftype (not ref) so blessed DBM::Deep::Hash objects are recognised.
 1351: 				# Inject the outer key as the id column so criteria on that column work.
 1352: 				push @data, (Scalar::Util::reftype($row) // '') eq 'HASH'
 1353: 					? { $id => $k, %{$row} }
 1354: 					: { $id => $k, value => $row };
 1355: 			}
 1356: 			$self->{'data'} = @data ? \@data : undef;
 1357: 		} else {
 1358: 			# Keyed on the primary-key column (default: 'entry') for O(1) lookups.
 1359: 			# Each row hash must contain the id column (like CSV rows), so that
 1360: 			# selectall_arrayref and AUTOLOAD can access it by name.
 1361: 			my %data;
 1362: 			for my $k (keys %{$deep}) {
 1363: 				my $row = $deep->{$k};
 1364: 				$data{$k} = (Scalar::Util::reftype($row) // '') eq 'HASH'
 1365: 					? { $id => $k, %{$row} }
 1366: 					: { $id => $k, value => $row };
 1367: 			}
 1368: 			$self->{'data'} = %data ? \%data : undef;
 1369: 		}
 1370: 		$slurp_file = $deep_file;
 1371: 		$self->_debug("read in $table from DBM::Deep $deep_file");
 1372: 		$self->{'type'} = 'Deep';
 1373: 	} elsif($self->_is_berkeley_db(File::Spec->catfile($dir, "$dbname.db"))) {
 1374: 		$self->_debug("$table is a BerkeleyDB file");
 1375: 		$self->{'type'} = 'BerkeleyDB';
 1376: 	} else {
 1377: 		my $fin;
 1378: 		# File::pfopen splits $path on ':' which breaks Windows drive letters
 1379: 		# (C:\foo becomes ['C', '\foo']).  Since we always have a single directory
 1380: 		# we use File::Spec->catfile directly — same behaviour, portable.
 1381: 		my $gz_file;
 1382: 		for my $ext (qw(csv.gz db.gz)) {
 1383: 			my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
 1384: 			next unless -r $candidate;
 1385: 			open($fin, '<', $candidate);
 1386: 			$gz_file = $candidate;
 1387: 			last;
 1388: 		}
 1389: 		if($gz_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1390: 			require Gzip::Faster;
 1391: 
 1392: 			close($fin);
 1393: 			$fin = File::Temp->new(SUFFIX => '.csv', UNLINK => 1, CLEANUP => 1);
 1394: 			print $fin Gzip::Faster::gunzip_file($gz_file);
 1395: 			$fin->flush();
 1396: 			$slurp_file = $fin->filename();
 1397: 			$self->{'_temp_fh'} = $fin;	# Keep object alive; auto-unlinks at DESTROY
 1398: 		} else {
 1399: 			my $psv = File::Spec->catfile($dir, "$dbname.psv");
 1400: 			if(-r $psv) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1401: 				open($fin, '<', $psv);
 1402: 				# Pipe separated file
 1403: 				$slurp_file = $psv;
 1404: 				$params->{'sep_char'} = '|';
 1405: 			} else {
 1406: 				my $tsv = File::Spec->catfile($dir, "$dbname.tsv");
 1407: 				if(-r $tsv) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1408: 					open($fin, '<', $tsv);
 1409: 					# Tab separated file
 1410: 					$slurp_file = $tsv;
 1411: 					$params->{'sep_char'} = "\t";
 1412: 				} else {
 1413: 					# CSV or BerkeleyDB-extension file
 1414: 					for my $ext (qw(csv db)) {
 1415: 						my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
 1416: 						next unless -r $candidate;
 1417: 						open($fin, '<', $candidate);
 1418: 						$slurp_file = $candidate;
 1419: 						last;
 1420: 					}
 1421: 				}
 1422: 			}
 1423: 		}
 1424: 		if(my $filename = $self->{'filename'} || $defaults{'filename'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1425: 			Carp::croak(ref($self), ": unsafe filename '$filename'")
 1426: 				unless $filename =~ /\A[a-zA-Z0-9_.-]+\z/ && $filename !~ /\.\./;
 1427: 			$self->_debug("Looking for $filename in $dir");
 1428: 			$slurp_file = File::Spec->catfile($dir, $filename);
 1429: 		}
 1430: 		if(defined($slurp_file) && (-r $slurp_file)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1431: 			close($fin) if(defined($fin));
 1432: 			my $sep_char = $params->{'sep_char'};
 1433: 
 1434: 			$self->_debug(__LINE__, ' of ', __PACKAGE__, ": slurp_file = $slurp_file, sep_char = $sep_char");
 1435: 
 1436: 			if($params->{'column_names'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1437: 				$dbh = DBI->connect("dbi:CSV:db_name=$slurp_file", undef, undef,
 1438: 					{
 1439: 						csv_sep_char => $sep_char,
 1440: 						csv_tables => {
 1441: 							$table => {
 1442: 								col_names => $params->{'column_names'},
 1443: 							},
 1444: 						},
 1445: 						f_dir      => $dir,
 1446: 						RaiseError => 1,
 1447: 						PrintError => 0
 1448: 					}
 1449: 				);
 1450: 			} else {
 1451: 				$dbh = DBI->connect("dbi:CSV:db_name=$slurp_file", undef, undef, { csv_sep_char => $sep_char, f_dir => $dir, RaiseError => 1 });
 1452: 			}
 1453: 			$dbh->{'RaiseError'} = 1;
 1454: 
 1455: 			$self->_debug("read in $table from CSV $slurp_file");
 1456: 
 1457: 			$dbh->{csv_tables}->{$table} = {
 1458: 				allow_loose_quotes => 1,
 1459: 				blank_is_undef => 1,
 1460: 				empty_is_undef => 1,
 1461: 				binary => 1,
 1462: 				f_file => $slurp_file,
 1463: 				escape_char => '\\',
 1464: 				sep_char => $sep_char,
 1465: 				# Don't do this, causes "Bizarre copy of HASH
 1466: 				#	in scalar assignment in error_diag
 1467: 				#	RT121127
 1468: 				# auto_diag => 1,
 1469: 				auto_diag => 0,
 1470: 				# Don't do this, it causes "Attempt to free unreferenced scalar"
 1471: 				# callbacks => {
 1472: 					# after_parse => sub {
 1473: 						# my ($csv, @rows) = @_;
 1474: 						# my @rc;
 1475: 						# foreach my $row(@rows) {
 1476: 							# if($row->[0] !~ /^#/) {
 1477: 								# push @rc, $row;
 1478: 							# }
 1479: 						# }
 1480: 						# return @rc;
 1481: 					# }
 1482: 				# }
 1483: 			};
 1484: 
 1485: 			# Text::xSV::Slurp cannot override column names, so skip slurp when
 1486: 			# column_names is set — the DBI CSV connection will supply names instead.
 1487: 			if(((-s $slurp_file) <= $max_slurp_size) && !$params->{'column_names'}) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1488: 				if((-s $slurp_file) == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1489: 					# Empty file — mirror what the newline-only path stores so
 1490: 					# fast-path query methods return 0/undef/[] instead of falling
 1491: 					# through to DBI (which croaks on a 0-column table).
 1492: 					$self->{'data'} = $self->{'no_entry'} ? undef : {};
 1493: 				} else {
 1494: 					require Text::xSV::Slurp;
 1495: 
 1496: 					$self->_debug('slurp in');
 1497: 
 1498: 					my $dataref = Text::xSV::Slurp::xsv_slurp(
 1499: 						shape => 'aoh',
 1500: 						text_csv => {
 1501: 							sep_char => $sep_char,
 1502: 							allow_loose_quotes => 1,
 1503: 							blank_is_undef => 1,
 1504: 							empty_is_undef => 1,
 1505: 							binary => 1,
 1506: 							escape_char => '\\',
 1507: 						},
 1508: 						# string => \join('', grep(!/^\s*(#|$)/, <DATA>))
 1509: 						file => $slurp_file
 1510: 					);
 1511: 
 1512: 					# Filter out blank lines and comment rows (lines starting with #)
 1513: 					# Two passes replaced with one: pre-compute id column to avoid N hash
 1514: 				# lookups per element, and combine both conditions into one grep.
 1515: 				my $id_col = $self->{'id'};
 1516: 				my @data = grep { defined($_->{$id_col}) && $_->{$id_col} !~ /\A\s*#/ } @{$dataref};
 1517: 
 1518: 					if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1519: 						# Not keyed on a primary column — keep as ordered list.
 1520: 						# Only store a reference when rows were found; an empty-array ref
 1521: 						# is truthy, which would activate the in-memory fast-path and
 1522: 						# silently return 0 results instead of falling through to SQL.
 1523: 						$self->{'data'} = @data ? \@data : undef;
 1524: 					} else {
 1525: 						# Key the hash by $self->{'id'} for O(1) entry lookups
 1526: 						$self->{'data'} = { map { $_->{$self->{'id'}} => $_ } @data };
 1527: 					}
 1528: 				}
 1529: 			}
 1530: 			$self->{'type'} = 'CSV';
 1531: 		} else {
 1532: 			my $xls_file = File::Spec->catfile($dir, "$dbname.xls");
 1533: 			if(-r $xls_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1534: 				# Old binary XLS format via DBD::Excel (Spreadsheet::ParseExcel).
 1535: 				# All queries go through DBI/SQL; no in-memory slurp path.
 1536: 				require DBD::Excel;
 1537: 				$dbh = DBI->connect("dbi:Excel:file=$xls_file", undef, undef, {
 1538: 					RaiseError => 1,
 1539: 					PrintError => 0,
 1540: 				}) or Carp::croak(ref($self), ": can't open $xls_file: $DBI::errstr");
 1541: 				$self->{'type'} = 'Excel';
 1542: 				$slurp_file = $xls_file;
 1543: 			} else {
 1544: 			my $xlsx_file = File::Spec->catfile($dir, "$dbname.xlsx");
 1545: 			if(-r $xlsx_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1546: 				# Modern OOXML format via Spreadsheet::ParseXLSX — slurped into
 1547: 				# an in-memory hash (keyed) or array (no_entry).  No DBI handle.
 1548: 				require Spreadsheet::ParseXLSX;
 1549: 				my $workbook = Spreadsheet::ParseXLSX->new()->parse($xlsx_file)
 1550: 					or Carp::croak(ref($self), ": can't parse $xlsx_file");
 1551: 				my ($sheet) = grep { $_->get_name() eq $table } $workbook->worksheets();
 1552: 				$sheet //= ($workbook->worksheets())[0];
 1553: 				Carp::croak(ref($self), ": no worksheet in $xlsx_file") unless $sheet;
 1554: 				my ($row_min, $row_max) = $sheet->row_range();
 1555: 				my ($col_min, $col_max) = $sheet->col_range();
 1556: 				my @headers;
 1557: 				for my $c ($col_min .. $col_max) {
 1558: 					my $cell = $sheet->get_cell($row_min, $c);
 1559: 					push @headers, $cell ? $cell->value() : "col$c";
 1560: 				}
 1561: 				my @data;
 1562: 				for my $r ($row_min + 1 .. $row_max) {
 1563: 					my %row;
 1564: 					for my $c ($col_min .. $col_max) {
 1565: 						my $cell = $sheet->get_cell($r, $c);
 1566: 						$row{$headers[$c - $col_min]} = $cell ? $cell->value() : undef;
 1567: 					}
 1568: 					push @data, \%row;
 1569: 				}
 1570: 				if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1571: 					$self->{'data'} = @data ? \@data : undef;
 1572: 				} else {
 1573: 					$self->{'data'} = { map { $_->{$self->{'id'}} => $_ } @data };
 1574: 				}
 1575: 				$self->{'type'} = 'XLSX';
 1576: 				$slurp_file = $xlsx_file;
 1577: 			} else {
 1578: 				$slurp_file = File::Spec->catfile($dir, "$dbname.xml");
 1579: 				if(-r $slurp_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1580: 					if((-s $slurp_file) <= $max_slurp_size) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1581: 						require XML::Simple;
 1582: 
 1583: 						my $xml = XML::Simple::XMLin($slurp_file);
 1584: 						my @keys = keys %{$xml};
 1585: 						my $key = $keys[0];
 1586: 						my @data;
 1587: 						if(ref($xml->{$key}) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1588: 							@data = @{$xml->{$key}};
 1589: 						} elsif(ref($xml) eq 'ARRAY') {
 1590: 							@data = @{$xml};
 1591: 						} elsif((ref($xml) eq 'HASH') && !$self->{'no_entry'}) {
 1592: 							if(scalar(keys %{$xml}) == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1593: 								if($xml->{$table}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1594: 									@data = $xml->{$table};
 1595: 								} else {
 1596: 									Carp::croak('XML slurp: complex documents with an "entry" field are not yet supported');
 1597: 								}
 1598: 							} else {
 1599: 								Carp::croak('XML slurp: multi-key documents are not yet supported');
 1600: 							}
 1601: 						} else {
 1602: 							Carp::croak('XML slurp: cannot handle ', ref($xml), ' structure');
 1603: 						}
 1604: 						if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1605: 							# Not keyed, will need to scan each entry
 1606: 							my $i = 0;
 1607: 							foreach my $d(@data) {
 1608: 								$self->{'data'}->{$i++} = $d;
 1609: 							}
 1610: 						} else {
 1611: 							# keyed on the $self->{'id'} (default: "entry") column
 1612: 							foreach my $d(@data) {
 1613: 								$self->{'data'}->{$d->{$self->{'id'}}} = $d;
 1614: 							}
 1615: 						}
 1616: 					} else {
 1617: 						$dbh = DBI->connect('dbi:XMLSimple(RaiseError=>1):');
 1618: 						$dbh->{'RaiseError'} = 1;
 1619: 						$self->_debug("read in $table from XML $slurp_file");
 1620: 						$dbh->func($table, 'XML', $slurp_file, 'xmlsimple_import');
 1621: 					}
 1622: 				} else {
 1623: 					my $json_file = File::Spec->catfile($dir, "$dbname.json");
 1624: 					if(-r $json_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1625: 						if((-s $json_file) == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1626: 							$self->{'data'} = $self->{'no_entry'} ? undef : {};
 1627: 						} else {
 1628: 							require JSON::MaybeXS;
 1629: 
 1630: 							open(my $jfh, '<', $json_file);
 1631: 							local $/;
 1632: 							my $raw = <$jfh>;
 1633: 							close $jfh;
 1634: 							if(!defined($raw) || $raw =~ /\A\s*\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1635: 								# Whitespace-only — treat as empty, same as zero-byte
 1636: 								$self->{'data'} = $self->{'no_entry'} ? undef : {};
 1637: 							} else {
 1638: 								my $parsed = JSON::MaybeXS::decode_json($raw);
 1639: 								my @data;
 1640: 								if(ref($parsed) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1641: 									@data = @{$parsed};
 1642: 								} elsif(ref($parsed) eq 'HASH') {
 1643: 									# Hash of id => row — inject id column into each row
 1644: 									my $id_col = $self->{'id'};
 1645: 									for my $k (sort keys %{$parsed}) {
 1646: 										my $row = $parsed->{$k};
 1647: 										if(ref($row) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1648: 											push @data, { $id_col => $k, %{$row} };
 1649: 										} else {
 1650: 											push @data, { $id_col => $k, value => $row };
 1651: 										}
 1652: 									}
 1653: 								} else {
 1654: 									Carp::croak(ref($self), ": JSON slurp: unexpected top-level structure in $json_file");
 1655: 								}
 1656: 								if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1657: 									$self->{'data'} = @data ? \@data : undef;
 1658: 								} else {
 1659: 									$self->{'data'} = { map { $_->{$self->{'id'}} => $_ } @data };
 1660: 								}
 1661: 							}
 1662: 						}
 1663: 						$slurp_file = $json_file;
 1664: 						$self->_debug("read in $table from JSON $json_file");
 1665: 						$self->{'type'} = 'JSON';
 1666: 					} else {
 1667: 					# throw Error(-file => "$dir/$table");
 1668: 					$self->_fatal("Can't find a file called '$dbname' for the table $table in $dir");
 1669: 					}
 1670: 				}
 1671: 				$self->{'type'} //= 'XML';
 1672: 			}
 1673: 		}	# end: xlsx else (xml path)
 1674: 		}	# end: xls else
 1675: 	}
 1676: 
 1677: 	# ref() must be called on the variable, not on the result of 'eq'
 1678: 	$self->_fixate($self->{'data'}) if($self->{'data'} && (ref($self->{'data'}) eq 'HASH'));
 1679: 
 1680: 	$self->{$table} = $dbh;
 1681: 	my @statb = stat($slurp_file);
 1682: 	$self->{'_updated'} = $statb[9];
 1683: 
 1684: 	return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1685: }
 1686: 
 1687: # Project columns and/or deduplicate an arrayref of row hashrefs.
 1688: # $rows     - arrayref of hashrefs
 1689: # $cols     - arrayref of column names to keep, or undef for all columns
 1690: # $distinct - true to remove duplicate rows (after projection)
 1691: # Returns a new arrayref; input row hashrefs are not modified.
 1692: sub _apply_distinct {
●1693 → 1698 → 1713 1693: 	my ($rows, $cols, $distinct) = @_;
 1694: 	return $rows unless defined($cols) || $distinct;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1695: 	return $rows unless defined($rows) && @{$rows};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1696: 
 1697: 	my (@out, %seen);
 1698: 	for my $row (@{$rows}) {
 1699: 		my $r;
 1700: 		if(defined $cols) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1701: 			# Use exists() guard: fixate() locks all keys in slurp hashrefs;
 1702: 			# accessing a missing key on a locked hash throws an exception.
 1703: 			$r = { map { $_ => (exists($row->{$_}) ? $row->{$_} : undef) } @{$cols} };
 1704: 		} else {
 1705: 			$r = $row;
 1706: 		}
 1707: 		if($distinct) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1708: 			my $key = join("\x00", map { defined($r->{$_}) ? $r->{$_} : "\x01" } sort keys %{$r});
 1709: 			next if $seen{$key}++;
 1710: 		}
 1711: 		push @out, $r;
 1712: 	}
 1713: 	return \@out;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1714: }
 1715: 
 1716: =head2 selectall_arrayref
 1717: 
 1718: Returns a reference to an array of hash references for every row that
 1719: matches the given criteria, or C<undef> when there are no matches.
 1720: 
 1721:     my $rows = $db->selectall_arrayref();                    # all rows
 1722:     my $rows = $db->selectall_arrayref(status => 'active');  # exact match
 1723:     my $rows = $db->selectall_arrayref(score => { '>' => 8 });  # operator
 1724: 
 1725: The full criteria syntax is described in L</QUERY CRITERIA>.
 1726: 
 1727: Pass a C<join> key to combine with another table:
 1728: 
 1729:     my $rows = $db->selectall_arrayref(
 1730:         dept_name => 'Engineering',
 1731:         join      => { table => 'dept', on => 'e.dept_id = dept.id' },
 1732:     );
 1733: 
 1734: Pass C<limit =E<gt> N> and/or C<offset =E<gt> M> for pagination:
 1735: 
 1736:     my $page = $db->selectall_arrayref(status => 'active', limit => 10, offset => 20);
 1737: 
 1738: Both values must be non-negative integers; invalid values are ignored with a
 1739: C<carp> warning.  When C<offset> is given without C<limit> the SQL backend
 1740: uses C<LIMIT -1> on SQLite (meaning "no upper bound") so the C<OFFSET> clause
 1741: is legal.
 1742: 
 1743: Pass C<sort_by =E<gt> 'col'> (ascending) or C<sort_by =E<gt> ['col', 'DESC']>
 1744: to request a specific sort column and direction instead of the default primary-key
 1745: ordering:
 1746: 
 1747:     my $rows = $db->selectall_arrayref(sort_by => 'name');
 1748:     my $rows = $db->selectall_arrayref(sort_by => ['score', 'DESC']);
 1749: 
 1750: The column name is validated against the same identifier rules as all other
 1751: column parameters.  An unsafe name or an unrecognised direction (anything other
 1752: than C<ASC> or C<DESC>, case-insensitive) is ignored with a C<carp> warning and
 1753: the default sort order is used instead.  Sorting is applied before
 1754: C<limit>/C<offset> pagination.
 1755: 
 1756: Pass C<distinct =E<gt> 1> to return only unique rows (deduplication):
 1757: 
 1758:     my $rows = $db->selectall_arrayref(distinct => 1);
 1759:     my $rows = $db->selectall_arrayref(distinct => 1, columns => [qw(status dept)]);
 1760: 
 1761: Pass C<columns =E<gt> \@cols> to restrict which columns appear in the returned
 1762: rows.  Column names are validated against the same identifier rules as other
 1763: parameters; invalid names are dropped with a C<carp> warning.
 1764: 
 1765: On SQL-capable backends (SQLite, PostgreSQL, MySQL, DBD::CSV E<ge> 0.64)
 1766: C<distinct =E<gt> 1> emits C<SELECT DISTINCT>.  On the slurp (in-memory) path
 1767: C<distinct> without C<columns> is a no-op because each row is already unique.
 1768: 
 1769: B<Order of operations:> sort E<rarr> offset E<rarr> limit E<rarr> C<_apply_distinct>.
 1770: This means C<< limit => N, distinct => 1 >> deduplicates the already-limited
 1771: slice, not the full result set.  If you need N distinct rows from a larger set,
 1772: omit C<limit> and slice the returned arrayref yourself.
 1773: 
 1774: Results are returned in the cache (if configured) and the returned array
 1775: reference is made read-only unless C<no_fixate> was set.
 1776: 
 1777: B<Note:> this always returns all matching rows.  Use L</selectall_array>
 1778: in scalar context, or C<< $db->query->limit(1)->all() >>, to fetch just one row.
 1779: 
 1780: =head3 PSEUDOCODE
 1781: 
 1782:     1. Parse criteria; extract and build any JOIN clause.
 1783:        Extract distinct, columns, limit, offset, sort_by.
 1784:     2. If data is slurped AND no joins AND criteria are simple:
 1785:        a. No criteria -> return all rows as arrayref.
 1786:        b. entry-only lookup -> return [$data{entry}].
 1787:        c. Otherwise -> scan rows in-memory with _match_criterion.
 1788:        In all slurp cases: sort by sort_by column (if given), then apply
 1789:        offset/limit, then _apply_distinct (columns projection + dedup).
 1790:     3. Otherwise build SQL: SELECT [DISTINCT] [columns|*] FROM table
 1791:        [JOIN] [WHERE] ORDER BY sort_by [else id] [LIMIT] [OFFSET].
 1792:        All DBI backends (including DBD::CSV >= 0.64) use native SELECT DISTINCT.
 1793:     4. Check cache; return cached arrayref on HIT.
 1794:     5. prepare_cached + execute; fetch all rows.
 1795:     6. Store result in cache; fixate the array; return arrayref.
 1796: 
 1797: =head3 API SPECIFICATION
 1798: 
 1799: =head4 Arguments
 1800: 
 1801:     %criteria   # optional key-value pairs or operator hashrefs
 1802:     join        => HashRef | ArrayRef  # optional join spec(s)
 1803:     sort_by     => Str | ArrayRef      # optional: 'col' or ['col','DESC']
 1804:     limit       => Int                 # optional: max rows
 1805:     offset      => Int                 # optional: rows to skip
 1806:     distinct    => Bool                # optional: deduplicate rows
 1807:     columns     => ArrayRef[Str]       # optional: restrict output columns
 1808:     no_fixate   => Bool                # optional: skip read-only locking
 1809:     table       => Str                 # optional: override table name
 1810: 
 1811: =head4 Returns
 1812: 
 1813:     ArrayRef[HashRef] | undef
 1814: 
 1815: An arrayref of row hashrefs on success.  Returns C<undef> when no
 1816: rows match.  Each hashref is read-only unless C<no_fixate> was set.
 1817: 
 1818: =cut
 1819: 
 1820: sub selectall_arrayref {
●1821 → 1831 → 1863 1821: 	my $self = shift;
 1822: 
 1823: 	# Fire _open() first so $self->{'berkeley'} is known before we parse @_.
 1824: 	# BerkeleyDB param parsing must use get_params(undef, \@_) so that
 1825: 	# key-value pairs like (join => {...}) are not mangled by the positional
 1826: 	# 'entry' mapping that non-BerkeleyDB paths use.
 1827: 	$self->_open_table({});
 1828: 
 1829: 	my $params;
 1830: 
 1831: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1832: 		$params = Params::Get::get_params(undef, \@_) // {};
 1833: 		my $bl       = delete $params->{'limit'};
 1834: 		my $bo       = delete $params->{'offset'};
 1835: 		my $bdist    = delete $params->{'distinct'};
 1836: 		my $bcols    = delete $params->{'columns'};
 1837: 		my ($bsc, $bsd) = _parse_sort_by(delete($params->{'sort_by'}), 'selectall_arrayref');
 1838: 		if(defined($bl) && $bl !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1839: 			Carp::carp('selectall_arrayref: limit must be a non-negative integer, ignoring');
 1840: 			undef $bl;
 1841: 		}
 1842: 		if(defined($bo) && $bo !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1843: 			Carp::carp('selectall_arrayref: offset must be a non-negative integer, ignoring');
 1844: 			undef $bo;
 1845: 		}
 1846: 		$params = $self->_merge_base_criteria($params);
 1847: 		my $rows = $self->_scan_berkeley($params);
 1848: 		if(defined $bsc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1849: 			if($bsd eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1850: 				@{$rows} = sort { ($b->{$bsc} // '') cmp ($a->{$bsc} // '') } @{$rows};
 1851: 			} else {
 1852: 				@{$rows} = sort { ($a->{$bsc} // '') cmp ($b->{$bsc} // '') } @{$rows};
 1853: 			}
 1854: 		}
 1855: 		if(defined($bl) || defined($bo)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1856: 			splice(@{$rows}, 0, int($bo)) if $bo;
 1857: 			splice(@{$rows}, int($bl))    if defined $bl;
 1858: 		}
 1859: 		$rows = _apply_distinct($rows, $bcols, $bdist) if $bcols || $bdist;
 1860: 		return set_return($rows, { type => 'arrayref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1861: 	}
 1862: 
●1863 → 1863 → 1869 1863: 	if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1864: 		$params = Params::Get::get_params(undef, \@_);
 1865: 	} elsif(scalar(@_)) {
 1866: 		$params = Params::Get::get_params('entry', @_);
 1867: 	}
 1868: 
●1869 → 1874 → 1878 1869: 	my $table = $self->_open_table($params);
 1870: 
 1871: 	$params //= {};
 1872: 
 1873: 	my $join_clause = '';
 1874: 	if(my $join_spec = delete $params->{'join'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1875: 		$join_clause = $self->_build_joins($join_spec);
 1876: 	}
 1877: 
●1878 → 1880 → 1888 1878: 	my $limit  = delete $params->{'limit'};
 1879: 	my $offset = delete $params->{'offset'};
 1880: 	if(defined $limit) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1881: 		if($limit !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1882: 			Carp::carp('selectall_arrayref: limit must be a non-negative integer, ignoring');
 1883: 			undef $limit;
 1884: 		} else {
 1885: 			$limit = int($limit);
 1886: 		}
 1887: 	}
●1888 → 1888 → 1897 1888: 	if(defined $offset) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1889: 		if($offset !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1890: 			Carp::carp('selectall_arrayref: offset must be a non-negative integer, ignoring');
 1891: 			undef $offset;
 1892: 		} else {
 1893: 			$offset = int($offset);
 1894: 		}
 1895: 	}
 1896: 
●1897 → 1901 → 1918 1897: 	my ($sort_col, $sort_dir) = _parse_sort_by(delete($params->{'sort_by'}), 'selectall_arrayref');
 1898: 
 1899: 	my $distinct = delete $params->{'distinct'};
 1900: 	my $columns  = delete $params->{'columns'};
 1901: 	if(defined $columns) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1902: 		if(ref($columns) ne 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1903: 			Carp::carp('selectall_arrayref: columns must be an arrayref, ignoring');
 1904: 			undef $columns;
 1905: 		} else {
 1906: 			my @valid;
 1907: 			for my $c (@{$columns}) {
 1908: 				if(defined($c) && $c =~ $SAFE_QUALIFIED) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1909: 					push @valid, $c;
 1910: 				} else {
 1911: 					Carp::carp("selectall_arrayref: unsafe column name '$c', ignoring");
 1912: 				}
 1913: 			}
 1914: 			$columns = @valid ? \@valid : undef;
 1915: 		}
 1916: 	}
 1917: 
●1918 → 1920 → 2018 1918: 	$params = $self->_merge_base_criteria($params);
 1919: 
 1920: 	if(!$join_clause && $self->{'data'} && !$self->_has_complex_criteria($params)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1921: 		if(scalar(keys %{$params}) == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1922: 			$self->_trace("$table: selectall_arrayref fast track return");
 1923: 			my @rc;
 1924: 			if(ref($self->{'data'}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1925: 				$self->_debug("$table: returning ", scalar keys %{$self->{'data'}}, ' entries');
 1926: 				if(scalar keys %{$self->{'data'}} <= 10) {

					

					
Mutants (Total: 4, Killed: 3, Survived: 1)
					

				
COND_INV_1926_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1927: 					$self->_debug(do { require Data::Dumper; Data::Dumper::Dumper($self->{'data'}) });
 1928: 				}
 1929: 				@rc = values %{$self->{'data'}};
 1930: 			} else {
 1931: 				@rc = @{$self->{'data'}};
 1932: 			}
 1933: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1934: 				if($sort_dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1935: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 1936: 				} else {
 1937: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 1938: 				}
 1939: 			}
 1940: 			if(defined($offset) || defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1941: 				splice(@rc, 0, $offset) if $offset;
 1942: 				splice(@rc, $limit)     if defined $limit;
 1943: 			}
 1944: 			@rc = @{ _apply_distinct(\@rc, $columns, $columns ? $distinct : undef) }
 1945: 				if $columns;
 1946: 			return set_return(\@rc, { type => 'arrayref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1947: 		} elsif((scalar(keys %{$params}) == 1) && defined($params->{'entry'}) && !$self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1948: 			# exists() guard: fixate() locks all keys in the slurp hash; return []
 1949: 			# (not [undef]) when the key is missing so callers get an empty result
 1950: 			return set_return([], { type => 'arrayref' })
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1951: 				unless exists($self->{'data'}->{$params->{'entry'}});
 1952: 			my @rc = ($self->{'data'}->{$params->{'entry'}});
 1953: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1954: 				if($sort_dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1955: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 1956: 				} else {
 1957: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 1958: 				}
 1959: 			}
 1960: 			if(defined($offset) || defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1961: 				splice(@rc, 0, $offset) if $offset;
 1962: 				splice(@rc, $limit)     if defined $limit;
 1963: 			}
 1964: 			@rc = @{ _apply_distinct(\@rc, $columns, $columns ? $distinct : undef) }
 1965: 				if $columns;
 1966: 			return set_return(\@rc, { type => 'arrayref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1967: 		} elsif(ref($self->{'data'}) eq 'HASH') {
 1968: 			# Scan in-memory hash for simple column criteria without touching DBI.
 1969: 			# fixate() locks hash keys, so use exists() to avoid throwing on unknown columns.
 1970: 			$self->_debug("$table: selectall_arrayref in-memory scan with criteria");
 1971: 			# Pre-compute param keys once — avoids re-running keys() inside the inner
 1972: 			# closure on every row iteration (N hash-key extractions → 1).
 1973: 			my @param_keys = keys %{$params};
 1974: 			my @rc = grep {
 1975: 				my $row = $_;
 1976: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}, $_) } @param_keys
 1977: 			} values %{$self->{'data'}};
 1978: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1979: 				if($sort_dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1980: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 1981: 				} else {
 1982: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 1983: 				}
 1984: 			}
 1985: 			if(defined($offset) || defined($limit)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1985_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1986: 				splice(@rc, 0, $offset) if $offset;
 1987: 				splice(@rc, $limit)     if defined $limit;
 1988: 			}
 1989: 			@rc = @{ _apply_distinct(\@rc, $columns, $distinct) } if $columns || $distinct;
 1990: 			return set_return(\@rc, { type => 'arrayref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1991: 		} elsif(ref($self->{'data'}) eq 'ARRAY' && !$self->{$table}) {
 1992: 			# In-memory scan for array-backed no_entry stores (JSON, XLSX, HTML URL)
 1993: 			# where there is no DBI handle.  Mirrors the equivalent path in count().
 1994: 			$self->_debug("$table: selectall_arrayref in-memory array scan with criteria");
 1995: 			my @param_keys = keys %{$params};
 1996: 			my @rc = grep {
 1997: 				my $row = $_;
 1998: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}, $_) } @param_keys
 1999: 			} @{$self->{'data'}};
 2000: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2001: 				if($sort_dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2002: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 2003: 				} else {
 2004: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 2005: 				}
 2006: 			}
 2007: 			if(defined($offset) || defined($limit)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2007_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2008: 				splice(@rc, 0, $offset) if $offset;
 2009: 				splice(@rc, $limit)     if defined $limit;
 2010: 			}
 2011: 			@rc = @{ _apply_distinct(\@rc, $columns, $distinct) } if $columns || $distinct;
 2012: 			return set_return(\@rc, { type => 'arrayref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2013: 		}
 2014: 	}
 2015: 
 2016: 	# Redis backend: when _open found no data (key doesn't exist or is empty),
 2017: 	# avoid crashing on the DBI path which has no handle for a Redis connection.
●2018 → 2025 → 2036 2018: 	return set_return([], { type => 'arrayref' })
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2019: 		if ($self->{'type'} // '') eq 'Redis';
 2020: 
 2021: 	my ($where, $wargs) = $self->_build_where($params);
 2022: 	my @query_args = @{$wargs};
 2023: 
 2024: 	my $select_expr;
 2025: 	if($distinct) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2026: 		if($columns) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2027: 			$select_expr = 'SELECT DISTINCT ' . join(', ', @{$columns});
 2028: 		} else {
 2029: 			$select_expr = 'SELECT DISTINCT *';
 2030: 		}
 2031: 	} elsif($columns) {
 2032: 		$select_expr = 'SELECT ' . join(', ', @{$columns});
 2033: 	} else {
 2034: 		$select_expr = 'SELECT *';
 2035: 	}
●2036 → 2038 → 2047 2036: 	my $query = "$select_expr FROM $table";
 2037: 	$query .= " $join_clause" if $join_clause;
 2038: 	if($join_clause) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2039: 		$query .= " WHERE $where" if $where;
 2040: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 2041: 		my $id = $self->{'id'};
 2042: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 2043: 		$query .= " AND ($where)" if $where;
 2044: 	} else {
 2045: 		$query .= " WHERE $where" if $where;
 2046: 	}
●2047 → 2047 → 2052 2047: 	if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2048: 		$query .= " ORDER BY $sort_col $sort_dir";
 2049: 	} elsif(!$self->{'no_entry'}) {
 2050: 		$query .= ' ORDER BY ' . $self->{'id'};
 2051: 	}
●2052 → 2052 → 2062 2052: 	if(defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2053: 		$query .= ' LIMIT ?';
 2054: 		push @query_args, $limit;
 2055: 	} elsif(defined($offset)) {
 2056: 		# SQLite requires a LIMIT clause when OFFSET is present; -1 means no limit
 2057: 		my $dbh = $self->{$table};
 2058: 		$query .= ' LIMIT -1'
 2059: 			if ($dbh && (($dbh->{Driver}{Name} // '') eq 'SQLite'))
 2060: 			|| (($self->{'_dialect'} // '') eq 'sqlite');
 2061: 	}
●2062 → 2062 → 2067 2062: 	if(defined($offset)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2063: 		$query .= ' OFFSET ?';
 2064: 		push @query_args, $offset;
 2065: 	}
 2066: 
●2067 → 2067 → 2073 2067: 	if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2068: 		$self->_debug("selectall_arrayref $query: ", join(', ', @query_args));
 2069: 	} else {
 2070: 		$self->_debug("selectall_arrayref $query");
 2071: 	}
 2072: 
●2073 → 2075 → 2095 2073: 	my $key;
 2074: 	my $c;
 2075: 	if($c = $self->{cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2076: 		$key = ref($self) . "::$query array";
 2077: 		if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2078: 			$key .= ' ' . join(', ', @query_args);
 2079: 		}
 2080: 		$self->_debug("cache key = '$key'");
 2081: 		if(my $rc = $c->get($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2082: 			$self->_debug('cache HIT');
 2083: 			return $rc;	# We stored a ref to the array
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2084: 
 2085: 			# This use of a temporary variable is to avoid
 2086: 			#	"Implicit scalar context for array in return"
 2087: 			# my @rc = @{$rc};
 2088: 			# return @rc;
 2089: 		}
 2090: 		$self->_debug('cache MISS');
 2091: 	} else {
 2092: 		$self->_debug('cache not used');
 2093: 	}
 2094: 
●2095 → 2095 → 2111 2095: 	if(my $sth = $self->{$table}->prepare_cached($query)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2096: 		$sth->execute(@query_args) || croak("$query: @query_args");
 2097: 
 2098: 		my $rc;
 2099: 		while(my $href = $sth->fetchrow_hashref()) {
 2100: 			push @{$rc}, $href;
 2101: 		}
 2102: 
 2103: 		$c->set($key, $rc, $self->{'cache_duration'}) if $c;
 2104: 
 2105: 		if($rc && !$self->{'no_fixate'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2106: 			$self->_fixate($rc);
 2107: 		}
 2108: 
 2109: 		return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2110: 	}
 2111: 	$self->_warn("selectall_arrayref failure on $query: @query_args");
 2112: 	croak("$query: @query_args");
 2113: }
 2114: 
 2115: =head2 selectall_hashref
 2116: 
 2117: Deprecated alias for L</selectall_arrayref>.  Use C<selectall_arrayref> in
 2118: new code.
 2119: 
 2120: =cut
 2121: 
 2122: sub selectall_hashref
 2123: {
 2124: 	my $self = shift;
 2125: 	return $self->selectall_arrayref(@_);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2126: }
 2127: 
 2128: =head2 each_row
 2129: 
 2130:     $db->each_row(\&callback);
 2131:     $db->each_row(\&callback, status => 'active');
 2132:     $db->each_row(\&callback, sort_by => 'name', limit => 100, offset => 20);
 2133: 
 2134: Iterates over matching rows one at a time, calling C<\&callback> once per
 2135: row with the row hashref as the sole argument.  Uses B<constant memory> on
 2136: the SQL path: rows are fetched from the database one at a time via
 2137: C<fetchrow_hashref> without materialising the full result array.  On the
 2138: slurp/in-memory path data is already in RAM, so memory use is equivalent to
 2139: L</selectall_arrayref>.
 2140: 
 2141: Accepts the same criteria, C<join>, C<sort_by>, C<limit>, and C<offset>
 2142: parameters as L</selectall_arrayref>.
 2143: 
 2144: Returns the number of rows passed to C<\&callback>.
 2145: 
 2146: Exceptions raised inside C<\&callback> abort iteration and propagate to
 2147: the caller; the DBI statement handle is left in a valid state (C<finish()>
 2148: is called on exception).
 2149: 
 2150: B<Note:> rows on the SQL path are not fixated (made read-only) because they
 2151: are discarded after each callback invocation.  Slurp-path rows are already
 2152: fixated from the initial load.
 2153: 
 2154: =head3 API SPECIFICATION
 2155: 
 2156: =head4 Arguments
 2157: 
 2158:     CodeRef     # required: callback receiving one row hashref per call
 2159:     %criteria   # optional: same criteria syntax as selectall_arrayref
 2160:     join        => HashRef | ArrayRef  # optional join spec(s)
 2161:     sort_by     => Str | ArrayRef      # optional sort column
 2162:     limit       => Int                 # optional: max rows to visit
 2163:     offset      => Int                 # optional: rows to skip
 2164: 
 2165: =head4 Returns
 2166: 
 2167:     Int (>= 0)
 2168: 
 2169: The number of rows visited (i.e. the number of times the callback
 2170: was called).  Any exception thrown inside the callback is re-thrown
 2171: after the DBI statement handle is properly finished.
 2172: 
 2173: =cut
 2174: 
 2175: sub each_row
 2176: {
●2177 → 2187 → 2222 2177: 	my $self = shift;
 2178: 	my $callback = shift;
 2179: 
 2180: 	Carp::croak(ref($self), ': each_row: callback must be a code reference')
 2181: 		unless ref($callback) eq 'CODE';
 2182: 
 2183: 	$self->_open_table({});
 2184: 
 2185: 	my $params;
 2186: 
 2187: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2188: 		$params = Params::Get::get_params(undef, \@_) // {};
 2189: 		my $bl = delete $params->{'limit'};
 2190: 		my $bo = delete $params->{'offset'};
 2191: 		my ($bsc, $bsd) = _parse_sort_by(delete($params->{'sort_by'}), 'each_row');
 2192: 		if(defined($bl) && $bl !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2193: 			Carp::carp('each_row: limit must be a non-negative integer, ignoring');
 2194: 			undef $bl;
 2195: 		}
 2196: 		if(defined($bo) && $bo !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2197: 			Carp::carp('each_row: offset must be a non-negative integer, ignoring');
 2198: 			undef $bo;
 2199: 		}
 2200: 		$params = $self->_merge_base_criteria($params);
 2201: 		my $rows = $self->_scan_berkeley($params);
 2202: 		if(defined $bsc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2203: 			if($bsd eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2204: 				@{$rows} = sort { ($b->{$bsc} // '') cmp ($a->{$bsc} // '') } @{$rows};
 2205: 			} else {
 2206: 				@{$rows} = sort { ($a->{$bsc} // '') cmp ($b->{$bsc} // '') } @{$rows};
 2207: 			}
 2208: 		}
 2209: 		if(defined($bl) || defined($bo)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2209_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2210: 			splice(@{$rows}, 0, int($bo)) if $bo;
 2211: 			splice(@{$rows}, int($bl))    if defined $bl;
 2212: 		}
 2213: 		my $n = 0;
 2214: 		for my $row (@{$rows}) {
 2215: 			local $_;
 2216: 			$callback->($row);
 2217: 			$n++;
 2218: 		}
 2219: 		return $n;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2220: 	}
 2221: 
●2222 → 2222 → 2228 2222: 	if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2223: 		$params = Params::Get::get_params(undef, \@_);
 2224: 	} elsif(scalar(@_)) {
 2225: 		$params = Params::Get::get_params('entry', @_);
 2226: 	}
 2227: 
●2228 → 2233 → 2237 2228: 	my $table = $self->_open_table($params);
 2229: 
 2230: 	$params //= {};
 2231: 
 2232: 	my $join_clause = '';
 2233: 	if(my $join_spec = delete $params->{'join'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2234: 		$join_clause = $self->_build_joins($join_spec);
 2235: 	}
 2236: 
●2237 → 2239 → 2247 2237: 	my $limit  = delete $params->{'limit'};
 2238: 	my $offset = delete $params->{'offset'};
 2239: 	if(defined $limit) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2240: 		if($limit !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2241: 			Carp::carp('each_row: limit must be a non-negative integer, ignoring');
 2242: 			undef $limit;
 2243: 		} else {
 2244: 			$limit = int($limit);
 2245: 		}
 2246: 	}
●2247 → 2247 → 2256 2247: 	if(defined $offset) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2248: 		if($offset !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2249: 			Carp::carp('each_row: offset must be a non-negative integer, ignoring');
 2250: 			undef $offset;
 2251: 		} else {
 2252: 			$offset = int($offset);
 2253: 		}
 2254: 	}
 2255: 
●2256 → 2259 → 2303 2256: 	my ($sort_col, $sort_dir) = _parse_sort_by(delete($params->{'sort_by'}), 'each_row');
 2257: 	$params = $self->_merge_base_criteria($params);
 2258: 
 2259: 	if(!$join_clause && $self->{'data'} && !$self->_has_complex_criteria($params)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2260: 		my @rc;
 2261: 		if(scalar(keys %{$params}) == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2262: 			@rc = ref($self->{'data'}) eq 'HASH' ? values %{$self->{'data'}} : @{$self->{'data'}};
 2263: 		} elsif((scalar(keys %{$params}) == 1) && defined($params->{'entry'}) && !$self->{'no_entry'}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
NUM_BOUNDARY_2263_36_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 2264: 			return 0 unless exists($self->{'data'}->{$params->{'entry'}});
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2265: 			@rc = ($self->{'data'}->{$params->{'entry'}});
 2266: 		} elsif(ref($self->{'data'}) eq 'HASH') {
 2267: 			$self->_debug("$table: each_row in-memory scan with criteria");
 2268: 			my @param_keys = keys %{$params};
 2269: 			@rc = grep {
 2270: 				my $row = $_;
 2271: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}, $_) } @param_keys
 2272: 			} values %{$self->{'data'}};
 2273: 		} elsif(ref($self->{'data'}) eq 'ARRAY' && !$self->{$table}) {
 2274: 			$self->_debug("$table: each_row in-memory array scan with criteria");
 2275: 			my @param_keys = keys %{$params};
 2276: 			@rc = grep {
 2277: 				my $row = $_;
 2278: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}, $_) } @param_keys
 2279: 			} @{$self->{'data'}};
 2280: 		}
 2281: 		if(@rc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2282: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2283: 				if($sort_dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2284: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 2285: 				} else {
 2286: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 2287: 				}
 2288: 			}
 2289: 			if(defined($offset) || defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2290: 				splice(@rc, 0, $offset) if $offset;
 2291: 				splice(@rc, $limit)     if defined $limit;
 2292: 			}
 2293: 		}
 2294: 		my $n = 0;
 2295: 		for my $row (@rc) {
 2296: 			local $_;
 2297: 			$callback->($row);
 2298: 			$n++;
 2299: 		}
 2300: 		return $n;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2301: 	}
 2302: 
●2303 → 2308 → 2317 2303: 	my ($where, $wargs) = $self->_build_where($params);
 2304: 	my @query_args = @{$wargs};
 2305: 
 2306: 	my $query = "SELECT * FROM $table";
 2307: 	$query .= " $join_clause" if $join_clause;
 2308: 	if($join_clause) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2308_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2309: 		$query .= " WHERE $where" if $where;
 2310: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 2311: 		my $id = $self->{'id'};
 2312: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 2313: 		$query .= " AND ($where)" if $where;
 2314: 	} else {
 2315: 		$query .= " WHERE $where" if $where;
 2316: 	}
●2317 → 2317 → 2322 2317: 	if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2318: 		$query .= " ORDER BY $sort_col $sort_dir";
 2319: 	} elsif(!$self->{'no_entry'}) {
 2320: 		$query .= ' ORDER BY ' . $self->{'id'};
 2321: 	}
●2322 → 2322 → 2331 2322: 	if(defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2323: 		$query .= ' LIMIT ?';
 2324: 		push @query_args, $limit;
 2325: 	} elsif(defined($offset)) {
 2326: 		my $dbh = $self->{$table};
 2327: 		$query .= ' LIMIT -1'
 2328: 			if ($dbh && (($dbh->{Driver}{Name} // '') eq 'SQLite'))
 2329: 			|| (($self->{'_dialect'} // '') eq 'sqlite');
 2330: 	}
●2331 → 2331 → 2336 2331: 	if(defined($offset)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2332: 		$query .= ' OFFSET ?';
 2333: 		push @query_args, $offset;
 2334: 	}
 2335: 
●2336 → 2336 → 2342 2336: 	if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2337: 		$self->_debug("each_row $query: ", join(', ', @query_args));
 2338: 	} else {
 2339: 		$self->_debug("each_row $query");
 2340: 	}
 2341: 
●2342 → 2354 → 2358 2342: 	my $sth = $self->{$table}->prepare_cached($query)
 2343: 		or Carp::croak(ref($self), ": each_row prepare failed: ", $self->{$table}->errstr());
 2344: 	$sth->execute(@query_args) || croak("$query: @query_args");
 2345: 
 2346: 	my $n = 0;
 2347: 	eval {
 2348: 		while(my $row = $sth->fetchrow_hashref()) {
 2349: 			local $_;
 2350: 			$callback->($row);
 2351: 			$n++;
 2352: 		}
 2353: 	};
 2354: 	if(my $err = $@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2355: 		$sth->finish();
 2356: 		die $err;
 2357: 	}
 2358: 	return $n;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2359: }
 2360: 
 2361: =head2 selectall_array
 2362: 
 2363: Similar to L</selectall_arrayref> but returns a list of hash references
 2364: rather than a reference to an array.
 2365: 
 2366:     my @rows = $db->selectall_array(status => 'active');
 2367: 
 2368: In B<scalar context> it applies C<LIMIT 1> and returns just the first
 2369: matching hash reference - making it more efficient than C<selectall_arrayref>
 2370: when you only need one row.  In B<list context> all matching rows are returned.
 2371: 
 2372: Accepts the same criteria, C<join>, C<limit>, C<offset>, and C<sort_by>
 2373: parameters as L</selectall_arrayref>.  When C<limit> is given in scalar context
 2374: it overrides the implicit C<LIMIT 1>.
 2375: 
 2376: =cut
 2377: 
 2378: sub selectall_array
 2379: {
●2380 → 2384 → 2413 2380: 	my $self = shift;
 2381: 
 2382: 	$self->_open_table({});
 2383: 
 2384: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2385: 		my $params = Params::Get::get_params(undef, \@_) // {};
 2386: 		my $bl = delete $params->{'limit'};
 2387: 		my $bo = delete $params->{'offset'};
 2388: 		my ($bsc, $bsd) = _parse_sort_by(delete($params->{'sort_by'}), 'selectall_array');
 2389: 		if(defined($bl) && $bl !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2390: 			Carp::carp('selectall_array: limit must be a non-negative integer, ignoring');
 2391: 			undef $bl;
 2392: 		}
 2393: 		if(defined($bo) && $bo !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2394: 			Carp::carp('selectall_array: offset must be a non-negative integer, ignoring');
 2395: 			undef $bo;
 2396: 		}
 2397: 		$params = $self->_merge_base_criteria($params);
 2398: 		my $rows = $self->_scan_berkeley($params);
 2399: 		if(defined $bsc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2400: 			if($bsd eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2401: 				@{$rows} = sort { ($b->{$bsc} // '') cmp ($a->{$bsc} // '') } @{$rows};
 2402: 			} else {
 2403: 				@{$rows} = sort { ($a->{$bsc} // '') cmp ($b->{$bsc} // '') } @{$rows};
 2404: 			}
 2405: 		}
 2406: 		if(defined($bl) || defined($bo)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2407: 			splice(@{$rows}, 0, int($bo)) if $bo;
 2408: 			splice(@{$rows}, int($bl))    if defined $bl;
 2409: 		}
 2410: 		return wantarray ? @{$rows} : $rows->[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2411: 	}
 2412: 
●2413 → 2418 → 2422 2413: 	my $params = Params::Get::get_params(undef, \@_);
 2414: 	my $table = $self->_open_table($params);
 2415: 
 2416: 	$params //= {};
 2417: 	my $join_clause = '';
 2418: 	if(my $join_spec = delete $params->{'join'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2419: 		$join_clause = $self->_build_joins($join_spec);
 2420: 	}
 2421: 
●2422 → 2424 → 2432 2422: 	my $limit  = delete $params->{'limit'};
 2423: 	my $offset = delete $params->{'offset'};
 2424: 	if(defined $limit) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2425: 		if($limit !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2426: 			Carp::carp('selectall_array: limit must be a non-negative integer, ignoring');
 2427: 			undef $limit;
 2428: 		} else {
 2429: 			$limit = int($limit);
 2430: 		}
 2431: 	}
●2432 → 2432 → 2441 2432: 	if(defined $offset) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2433: 		if($offset !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2434: 			Carp::carp('selectall_array: offset must be a non-negative integer, ignoring');
 2435: 			undef $offset;
 2436: 		} else {
 2437: 			$offset = int($offset);
 2438: 		}
 2439: 	}
 2440: 
●2441 → 2444 → 2522 2441: 	my ($sort_col, $sort_dir) = _parse_sort_by(delete($params->{'sort_by'}), 'selectall_array');
 2442: 	$params = $self->_merge_base_criteria($params);
 2443: 
 2444: 	if(!$join_clause && $self->{'data'} && !$self->_has_complex_criteria($params)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2445: 		if(scalar(keys %{$params}) == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2446: 			$self->_trace("$table: selectall_array fast track return");
 2447: 			my @rc = ref($self->{'data'}) eq 'HASH'
 2448: 				? values %{$self->{'data'}}
 2449: 				: @{$self->{'data'}};
 2450: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2451: 				if($sort_dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2452: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 2453: 				} else {
 2454: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 2455: 				}
 2456: 			}
 2457: 			if(defined($offset) || defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2458: 				splice(@rc, 0, $offset) if $offset;
 2459: 				splice(@rc, $limit)     if defined $limit;
 2460: 			}
 2461: 			return @rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2462: 		} elsif((scalar(keys %{$params}) == 1) && defined($params->{'entry'}) && !$self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2463: 			# exists() guard: fixate() locks all keys; return empty list (not undef)
 2464: 			# for a missing entry so callers in list context get 0 elements not 1
 2465: 			return () unless exists($self->{'data'}->{$params->{'entry'}});
 2466: 			if(defined($offset) || defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2467: 				# limit/offset: build list, splice, then return context-appropriately
 2468: 				my @rc = ($self->{'data'}->{$params->{'entry'}});
 2469: 				splice(@rc, 0, $offset) if $offset;
 2470: 				splice(@rc, $limit)     if defined $limit;
 2471: 				return wantarray ? @rc : $rc[0];

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_2471_5: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_2471_5: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 2472: 			}
 2473: 			# Preserve original scalar-context behaviour: return the hashref directly
 2474: 			# (not the count of a 1-element list).
 2475: 			return $self->{'data'}->{$params->{'entry'}};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2476: 		} elsif(ref($self->{'data'}) eq 'HASH') {
 2477: 			# Same as selectall_arrayref scan but returns a list
 2478: 			$self->_debug("$table: selectall_array in-memory scan with criteria");
 2479: 			# Pre-compute param keys once — same optimisation as selectall_arrayref:
 2480: 			# avoids N * K hash-key extractions inside the inner closure.
 2481: 			my @param_keys = keys %{$params};
 2482: 			my @rc = grep {
 2483: 				my $row = $_;
 2484: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}, $_) } @param_keys
 2485: 			} values %{$self->{'data'}};
 2486: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2487: 				if($sort_dir eq 'DESC') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2487_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2488: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 2489: 				} else {
 2490: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 2491: 				}
 2492: 			}
 2493: 			if(defined($offset) || defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2494: 				splice(@rc, 0, $offset) if $offset;
 2495: 				splice(@rc, $limit)     if defined $limit;
 2496: 			}
 2497: 			return @rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2498: 		} elsif(ref($self->{'data'}) eq 'ARRAY' && !$self->{$table}) {
 2499: 			# In-memory scan for array-backed no_entry stores (JSON, XLSX, HTML URL)
 2500: 			# where there is no DBI handle.  Mirrors the equivalent path in count().
 2501: 			$self->_debug("$table: selectall_array in-memory array scan with criteria");
 2502: 			my @param_keys = keys %{$params};
 2503: 			my @rc = grep {
 2504: 				my $row = $_;
 2505: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}, $_) } @param_keys
 2506: 			} @{$self->{'data'}};
 2507: 			if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2508: 				if($sort_dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2509: 					@rc = sort { ($b->{$sort_col} // '') cmp ($a->{$sort_col} // '') } @rc;
 2510: 				} else {
 2511: 					@rc = sort { ($a->{$sort_col} // '') cmp ($b->{$sort_col} // '') } @rc;
 2512: 				}
 2513: 			}
 2514: 			if(defined($offset) || defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2515: 				splice(@rc, 0, $offset) if $offset;
 2516: 				splice(@rc, $limit)     if defined $limit;
 2517: 			}
 2518: 			return @rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2519: 		}
 2520: 	}
 2521: 
●2522 → 2527 → 2536 2522: 	my ($where, $wargs) = $self->_build_where($params);
 2523: 	my @query_args = @{$wargs};
 2524: 
 2525: 	my $query = "SELECT * FROM $table";
 2526: 	$query .= " $join_clause" if $join_clause;
 2527: 	if($join_clause) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2528: 		$query .= " WHERE $where" if $where;
 2529: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 2530: 		my $id = $self->{'id'};
 2531: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 2532: 		$query .= " AND ($where)" if $where;
 2533: 	} else {
 2534: 		$query .= " WHERE $where" if $where;
 2535: 	}
●2536 → 2536 → 2541 2536: 	if(defined $sort_col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2537: 		$query .= " ORDER BY $sort_col $sort_dir";
 2538: 	} elsif(!$self->{'no_entry'}) {
 2539: 		$query .= ' ORDER BY ' . $self->{'id'};
 2540: 	}
●2541 → 2541 → 2565 2541: 	if(defined($limit)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2542: 		$query .= ' LIMIT ?';
 2543: 		push @query_args, $limit;
 2544: 		if(defined($offset)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2545: 			$query .= ' OFFSET ?';
 2546: 			push @query_args, $offset;
 2547: 		}
 2548: 	} elsif(!wantarray) {
 2549: 		if(defined($offset)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2550: 			$query .= ' LIMIT 1 OFFSET ?';
 2551: 			push @query_args, $offset;
 2552: 		} else {
 2553: 			$query .= ' LIMIT 1';
 2554: 		}
 2555: 	} elsif(defined($offset)) {
 2556: 		# List context, offset but no limit — SQLite requires LIMIT with OFFSET
 2557: 		my $dbh = $self->{$table};
 2558: 		$query .= ' LIMIT -1'
 2559: 			if ($dbh && (($dbh->{Driver}{Name} // '') eq 'SQLite'))
 2560: 			|| (($self->{'_dialect'} // '') eq 'sqlite');
 2561: 		$query .= ' OFFSET ?';
 2562: 		push @query_args, $offset;
 2563: 	}
 2564: 
●2565 → 2565 → 2571 2565: 	if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2566: 		$self->_debug("selectall_array $query: ", join(', ', @query_args));
 2567: 	} else {
 2568: 		$self->_debug("selectall_array $query");
 2569: 	}
 2570: 
●2571 → 2573 → 2596 2571: 	my $key;
 2572: 	my $c;
 2573: 	if($c = $self->{cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2574: 		$key = ref($self) . '::' . $query;
 2575: 		if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2576: 			$key .= ' array';
 2577: 		}
 2578: 		if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2579: 			$key .= ' ' . join(', ', @query_args);
 2580: 		}
 2581: 		$self->_debug("cache key = '$key'");
 2582: 		if(my $rc = $c->get($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2583: 			$self->_debug('cache HIT');
 2584: 			return wantarray ? @{$rc} : $rc;	# We stored a ref to the array
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2585: 
 2586: 			# This use of a temporary variable is to avoid
 2587: 			#	"Implicit scalar context for array in return"
 2588: 			# my @rc = @{$rc};
 2589: 			# return @rc;
 2590: 		}
 2591: 		$self->_debug('cache MISS');
 2592: 	} else {
 2593: 		$self->_debug('cache not used');
 2594: 	}
 2595: 
●2596 → 2596 → 2619 2596: 	if(my $sth = $self->{$table}->prepare_cached($query)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2597: 		$sth->execute(@query_args) || croak("$query: @query_args");
 2598: 
 2599: 		my $rc;
 2600: 		while(my $href = $sth->fetchrow_hashref()) {
 2601: 			if(!wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2602: 				# Scalar context: return just the first row; cache it too
 2603: 				$sth->finish();
 2604: 				$c->set($key, [$href], $self->{'cache_duration'}) if $c;
 2605: 				return $href;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2606: 			}
 2607: 			push @{$rc}, $href;
 2608: 		}
 2609: 		$c->set($key, $rc, $self->{'cache_duration'}) if $c;
 2610: 
 2611: 		if($rc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2612: 			if(!$self->{'no_fixate'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2613: 				$self->_fixate($rc);
 2614: 			}
 2615: 			return @{$rc};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2616: 		}
 2617: 		return;
 2618: 	}
 2619: 	$self->_warn("selectall_array failure on $query: @query_args");
 2620: 	croak("$query: @query_args");
 2621: }
 2622: 
 2623: =head2 selectall_hash
 2624: 
 2625: Deprecated alias for L</selectall_array>.  Use C<selectall_array> in new
 2626: code.
 2627: 
 2628: =cut
 2629: 
 2630: sub selectall_hash
 2631: {
 2632: 	my $self = shift;
 2633: 	return $self->selectall_array(@_);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2634: }
 2635: 
 2636: =head2 count
 2637: 
 2638: Returns the number of rows matching the given criteria.
 2639: 
 2640:     my $total  = $db->count();
 2641:     my $active = $db->count(status => 'active');
 2642:     my $high   = $db->count(score  => { '>' => 90 });
 2643: 
 2644: Accepts the full criteria syntax described in L</QUERY CRITERIA>.
 2645: 
 2646: =head3 API SPECIFICATION
 2647: 
 2648: =head4 Arguments
 2649: 
 2650:     %criteria   # optional: same criteria syntax as selectall_arrayref
 2651:     join        => HashRef | ArrayRef  # optional join spec(s)
 2652:     table       => Str                 # optional: override table name
 2653: 
 2654: =head4 Returns
 2655: 
 2656:     Int (>= 0)
 2657: 
 2658: The number of rows that match the given criteria.  Returns C<0>
 2659: when no rows match -- never C<undef>.
 2660: 
 2661: =cut
 2662: 
 2663: sub count
 2664: {
●2665 → 2670 → 2675 2665: 	my $self = shift;
 2666: 
 2667: 	$self->_open_table({});
 2668: 
 2669: 	my $params = Params::Get::get_params(undef, \@_) // {};
 2670: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2671: 		$params = $self->_merge_base_criteria($params);
 2672: 		return scalar @{$self->_scan_berkeley($params)};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2673: 	}
 2674: 
●2675 → 2678 → 2705 2675: 	my $table = $self->_open_table($params);
 2676: 	$params = $self->_merge_base_criteria($params // {});
 2677: 
 2678: 	if($self->{'data'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2679: 		if(scalar(keys %{$params}) == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2680: 			$self->_trace("$table: count fast track return");
 2681: 			if(ref($self->{'data'}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2682: 				return scalar keys %{$self->{'data'}};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2683: 			}
 2684: 			return scalar @{$self->{'data'}};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2685: 		} elsif((scalar(keys %{$params}) == 1) && defined($params->{'entry'}) && !$self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2686: 			# exists() guard: fixate() locks all keys in the slurp hash
 2687: 			return (exists($self->{'data'}->{$params->{'entry'}}) && $self->{'data'}->{$params->{'entry'}}) ? 1 : 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2688: 		} elsif(!$self->_has_complex_criteria($params) && !$self->{$table}) {
 2689: 			# General in-memory scan for simple column criteria.
 2690: 			# Only taken when there is no DBI handle ($self->{$table} is undef),
 2691: 			# i.e. slurp-only backends like Deep.  CSV/XML/SQLite have a DBI handle
 2692: 			# and must fall through to the SQL path so that column-name validation
 2693: 			# fires in _build_where_conditions.
 2694: 			$self->_debug("$table: count in-memory scan");
 2695: 			my @param_keys = keys %{$params};
 2696: 			# Pass the row list directly to grep — avoids materialising an
 2697: 			# intermediate @rows array of N references on the stack.
 2698: 			return scalar grep {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2699: 				my $row = $_;
 2700: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}, $_) } @param_keys
 2701: 			} (ref($self->{'data'}) eq 'HASH' ? values %{$self->{'data'}} : @{$self->{'data'}});
 2702: 		}
 2703: 	}
 2704: 
●2705 → 2709 → 2721 2705: 	my ($where, $wargs) = $self->_build_where($params);
 2706: 	my @query_args = @{$wargs};
 2707: 
 2708: 	my $query;
 2709: 	if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2710: 		my $id = $self->{'id'};
 2711: 		$query = "SELECT COUNT(*) FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 2712: 		$query .= " AND ($where)" if $where;
 2713: 	} elsif($self->{'no_entry'}) {
 2714: 		$query = "SELECT COUNT(*) FROM $table";
 2715: 		$query .= " WHERE $where" if $where;
 2716: 	} else {
 2717: 		$query = "SELECT COUNT(" . $self->{'id'} . ") FROM $table";
 2718: 		$query .= " WHERE $where" if $where;
 2719: 	}
 2720: 
●2721 → 2721 → 2727 2721: 	if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2722: 		$self->_debug("count $query: ", join(', ', @query_args));
 2723: 	} else {
 2724: 		$self->_debug("count $query");
 2725: 	}
 2726: 
●2727 → 2729 → 2751 2727: 	my $key;
 2728: 	my $c;
 2729: 	if($c = $self->{'cache'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2730: 		# Opportunistic: if a selectall_arrayref for the same criteria is already
 2731: 		# in cache, derive the count from that array rather than hitting the DB.
 2732: 		# The key is built to match what selectall_arrayref would store.
 2733: 		$key = ref($self) . '::' . $query;
 2734: 		# [^)]+ is a negated character class: O(n) with zero backtracking.
 2735: 		# The former lazy .+? could scan past the first ) in pathological SQL;
 2736: 		# [^)]+ is also semantically correct (COUNT(expr) never contains ) ).
 2737: 		$key =~ s/COUNT\(([^)]+)\)/$1/;
 2738: 		$key .= ' array';
 2739: 		if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2740: 			$key .= ' ' . join(', ', @query_args);
 2741: 		}
 2742: 		if(my $rc = $c->get($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2743: 			$self->_debug('count: cache HIT (selectall array)');
 2744: 			return ref($rc) eq 'ARRAY' ? scalar @{$rc} : 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2745: 		}
 2746: 		$self->_debug('count: cache MISS');
 2747: 	} else {
 2748: 		$self->_debug('cache not used');
 2749: 	}
 2750: 
●2751 → 2751 → 2759 2751: 	if(my $sth = $self->{$table}->prepare_cached($query)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2752: 		$sth->execute(@query_args) || croak("$query: @query_args");
 2753: 
 2754: 		my $count = $sth->fetchrow_arrayref()->[0];
 2755: 		$sth->finish();
 2756: 
 2757: 		return $count;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2758: 	}
 2759: 	$self->_warn("count failure on $query: @query_args");
 2760: 	croak("$query: @query_args");
 2761: }
 2762: 
 2763: =head2 fetchrow_hashref
 2764: 
 2765: Returns a hash reference for the first row matching the given criteria,
 2766: or C<undef> when there is no match.  Always applies C<LIMIT 1>.
 2767: 
 2768:     my $row = $db->fetchrow_hashref(entry => 'key1');
 2769:     my $row = $db->fetchrow_hashref(score => { '>=' => 10 });
 2770: 
 2771: When C<no_entry> is B<not> set you may pass a single bare value and it is
 2772: used as the C<entry> key:
 2773: 
 2774:     my $row = $db->fetchrow_hashref('key1');    # same as entry => 'key1'
 2775: 
 2776: Accepts the full criteria syntax described in L</QUERY CRITERIA>, including
 2777: the C<join> parameter:
 2778: 
 2779:     my $row = $db->fetchrow_hashref(
 2780:         name => 'Alice',
 2781:         join => { table => 'dept', on => 'e.dept_id = dept.id' },
 2782:     );
 2783: 
 2784: Pass C<< table => $other_table >> to query a table other than the one
 2785: derived from the class name.
 2786: 
 2787: =head3 API SPECIFICATION
 2788: 
 2789: =head4 Arguments
 2790: 
 2791:     entry       => Str    # primary-key value to look up (positional first
 2792:                           # arg when no_entry is false)
 2793:     %criteria   # optional additional column filters
 2794:     join        => HashRef | ArrayRef  # optional join spec(s)
 2795:     no_fixate   => Bool                # optional: skip read-only locking
 2796:     table       => Str                 # optional: override table name
 2797: 
 2798: =head4 Returns
 2799: 
 2800:     HashRef | undef
 2801: 
 2802: A single row hashref when exactly one matching row is found.  Returns
 2803: C<undef> when the key is not found or no row matches the criteria.
 2804: The hashref is read-only unless C<no_fixate> was set.
 2805: 
 2806: B<Note:> C<fetchrow_hashref> does B<not> croak when multiple rows
 2807: match the given criteria; it returns whichever row the backend
 2808: delivers first (usually the first row in file/insertion order).
 2809: 
 2810: =cut
 2811: 
 2812: sub fetchrow_hashref {
●2813 → 2819 → 2825 2813: 	my $self = shift;
 2814: 
 2815: 	$self->_trace('Entering fetchrow_hashref');
 2816: 
 2817: 	my $params;
 2818: 
 2819: 	if(!$self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2820: 		$params = Params::Get::get_params('entry', @_);
 2821: 	} else {
 2822: 		$params = Params::Get::get_params(undef, @_);
 2823: 	}
 2824: 
●2825 → 2827 → 2838 2825: 	my $table = $self->_open_table($params);
 2826: 
 2827: 	if($self->{'data'} && (!$self->{'no_entry'}) && (scalar keys(%{$params}) == 1) && defined($params->{'entry'}) && !$self->_has_complex_criteria($params)) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2828: 		$self->_debug('Fast return from slurped data');
 2829: 		# Use exists(), fixate() locks the outer hash; accessing a missing key throws
 2830: 		return undef unless exists($self->{'data'}->{$params->{'entry'}});
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2831: 		my $row = $self->{'data'}->{$params->{'entry'}};
 2832: 		if(my $bc = $self->{'base_criteria'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2833: 			return undef unless all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $bc->{$_}, $_) } keys %{$bc};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2834: 		}
 2835: 		return $row;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2836: 	}
 2837: 
●2838 → 2838 → 2852 2838: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2839: 		if((!$self->{'no_entry'}) && (scalar keys(%{$params}) == 1) && defined($params->{'entry'})) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2840: 			return { entry => $self->{'berkeley'}->{$params->{'entry'}} };
 2841: 		}
 2842: 		my $id = $self->{'id'};
 2843: 		if($self->{'no_entry'} && (scalar keys(%{$params}) == 1) && defined($id) && defined($params->{$id})) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2844: 			if(my $rc = $self->{'berkeley'}->{$params->{$id}}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2845: 				return { $params->{$id} => $rc }	# Return key->value as a hash pair
 2846: 			}
 2847: 			return;
 2848: 		}
 2849: 		Carp::croak(ref($self), ': fetchrow_hashref is meaningless on a NoSQL database');
 2850: 	}
 2851: 
●2852 → 2853 → 2858 2852: 	my $raw_target = delete $params->{'table'};
 2853: 	if(defined $raw_target) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2854: 		$raw_target =~ s/\A.*:://;
 2855: 		Carp::croak(ref($self), ": unsafe table name '$raw_target'")
 2856: 			unless $raw_target =~ $SAFE_QUALIFIED;
 2857: 	}
●2858 → 2867 → 2876 2858: 	my $target = $raw_target // $table;
 2859: 	my $join_spec = delete $params->{'join'};
 2860: 	$params = $self->_merge_base_criteria($params);
 2861: 	my $join_clause = $join_spec ? $self->_build_joins($join_spec) : '';
 2862: 	my ($where, $wargs) = $self->_build_where($params);
 2863: 	my @query_args = @{$wargs};
 2864: 
 2865: 	my $query = "SELECT * FROM $target";
 2866: 	$query .= " $join_clause" if $join_clause;
 2867: 	if($join_clause) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2868: 		$query .= " WHERE $where" if $where;
 2869: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 2870: 		my $id = $self->{'id'};
 2871: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 2872: 		$query .= " AND ($where)" if $where;
 2873: 	} else {
 2874: 		$query .= " WHERE $where" if $where;
 2875: 	}
●2876 → 2877 → 2887 2876: 	$query .= ' LIMIT 1';
 2877: 	if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2878: 		my @call_details = caller(0);
 2879: 		$self->_debug("fetchrow_hashref $query: ", join(', ', @query_args),
 2880: 			' called from ', $call_details[2], ' of ', $call_details[1]);
 2881: 	} else {
 2882: 		$self->_debug("fetchrow_hashref $query");
 2883: 	}
 2884: 	# Premise: $key is only needed when a cache is configured.
 2885: 	# Conclusion: assemble it lazily inside the cache block — no dead store on
 2886: 	# the common (no-cache) path.
●2887 → 2889 → 2908 2887: 	my $c = $self->{'cache'};
 2888: 	my $key;    # declared here so the second if($c) block (cache SET) can see it
 2889: 	if($c) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2890: 		$key = ref($self) . '::';
 2891: 		if(defined($query_args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2892: 			$key .= 'array ' if wantarray;
 2893: 			$key .= "fetchrow $query " . join(', ', @query_args);
 2894: 		} else {
 2895: 			$key .= "fetchrow $query";
 2896: 		}
 2897: 		if(my $rc = $c->get($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2898: 			if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2899: 				if(ref($rc) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2900: 					return @{$rc};	# We stored a ref to the array
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2901: 				}
 2902: 			} else {
 2903: 				return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2904: 			}
 2905: 		}
 2906: 	}
 2907: 
●2908 → 2913 → 2922 2908: 	my $sth = $self->{$table}->prepare_cached($query)
 2909: 		or Carp::croak(ref($self), ": prepare failed: ", $self->{$table}->errstr());
 2910: 	$sth->execute(@query_args) || croak("$query: @query_args");
 2911: 	my $rc = $sth->fetchrow_hashref();
 2912: 	$sth->finish();
 2913: 	if($c) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2914: 		if($rc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2915: 			$self->_debug("stash $key=>$rc in the cache for ", $self->{'cache_duration'});
 2916: 			$self->_debug("returns ", do { require Data::Dumper; Data::Dumper->new([$rc])->Dump() });
 2917: 		} else {
 2918: 			$self->_debug("Stash $key=>undef in the cache for ", $self->{'cache_duration'});
 2919: 		}
 2920: 		$c->set($key, $rc, $self->{'cache_duration'});
 2921: 	}
 2922: 	return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2923: }
 2924: 
 2925: =head2 execute
 2926: 
 2927: Execute a raw SQL query on the underlying database.
 2928: 
 2929:     # Scalar context: returns the first row as a hashref
 2930:     my $row = $db->execute(query => 'SELECT * FROM foo WHERE id = 1');
 2931: 
 2932:     # List context: returns all rows as a list of hashrefs
 2933:     my @rows = $db->execute(query => 'SELECT * FROM foo WHERE score > ?',
 2934:                             args  => [80]);
 2935: 
 2936: The C<FROM E<lt>tableE<gt>> clause is appended automatically if omitted.
 2937: 
 2938: On CSV tables without C<no_entry> it may help to add
 2939: C<WHERE entry IS NOT NULL AND entry NOT LIKE '#%'> to filter comment rows.
 2940: 
 2941: If the data have been slurped into memory this method still hits the actual
 2942: database file directly.
 2943: 
 2944: C<args> is an arrayref of bind values (see L<DBI/execute>).
 2945: 
 2946: =cut
 2947: 
 2948: sub execute
 2949: {
●2950 → 2952 → 2956 2950: 	my $self = shift;
 2951: 
 2952: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2953: 		Carp::croak(ref($self), ': execute is meaningless on a NoSQL database');
 2954: 	}
 2955: 
●2956 → 2978 → 2986 2956: 	my $args = Params::Get::get_params('query', @_);
 2957: 
 2958: 	# Ensure the 'query' parameter is provided
 2959: 	Carp::croak(__PACKAGE__, ': Usage: execute(query => $query)')
 2960: 		unless defined $args->{'query'};
 2961: 
 2962: 	my $table = $self->_open_table($args);
 2963: 
 2964: 	my $query = $args->{'query'};
 2965: 
 2966: 	# Append "FROM <table>" if missing
 2967: 	# \bFROM\b catches the keyword at any word boundary (space, tab, newline),
 2968: 	# unlike the former \sFROM\s which missed forms like "col\tFROM" or leading FROM.
 2969: 	$query .= " FROM $table" unless $query =~ /\bFROM\b/i;
 2970: 
 2971: 	# Log the query if a logger is available
 2972: 	$self->_debug("execute $query");
 2973: 
 2974: 	# Prepare and execute the query
 2975: 	my $sth = $self->{$table}->prepare_cached($query);
 2976: 	# DBI->execute() takes a list; normalise args to an array whether it
 2977: 	# was passed as an arrayref ([30]) or a bare scalar/list (30).
 2978: 	if(exists($args->{'args'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2979: 		my @bind = ref($args->{'args'}) eq 'ARRAY' ? @{$args->{'args'}} : ($args->{'args'});
 2980: 		$sth->execute(@bind) or croak("$query: ", join(', ', @bind));
 2981: 	} else {
 2982: 		$sth->execute() or croak($query);
 2983: 	}
 2984: 
 2985: 	# Fetch the results
●2986 → 2987 → 2996 2986: 	my @results;
 2987: 	while (my $row = $sth->fetchrow_hashref()) {
 2988: 		unless(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2989: 			$sth->finish();
 2990: 			return $row;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2991: 		}
 2992: 		push @results, $row;
 2993: 	}
 2994: 
 2995: 	# Return all rows as an array in list context
 2996: 	return @results;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2997: }
 2998: 
 2999: =head2 updated
 3000: 
 3001: Returns the Unix timestamp of the last database update.
 3002: 
 3003: For file-based backends (CSV, XML, SQLite via C<directory>), this is the
 3004: mtime of the backing file, set at C<new()> time.
 3005: 
 3006: For SQLite DSN connections (C<dbi:SQLite:dbname=...>), the file path is
 3007: extracted from the DSN and C<stat()>-ed live on every call, so callers
 3008: get a current mtime suitable for cache-invalidation even when the database
 3009: was opened via a DSN rather than a C<directory>.
 3010: 
 3011: For all other DSN-based connections (PostgreSQL, MySQL, etc.) and for
 3012: URL-based backends, returns the Unix timestamp of the most recent
 3013: C<new()> call (connection time).
 3014: 
 3015: =cut
 3016: 
 3017: sub updated {
●3018 → 3020 → 3029 3018: 	my $self = shift;
 3019: 
 3020: 	if(($self->{'_dialect'} // '') eq 'sqlite') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3021: 		my $dsn = $self->{'dsn'};
 3022: 		if(defined($dsn) && $dsn =~ /\Adbi:SQLite:(?:dbname=)?(.+)\z/i) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3023: 			my $path = $1;
 3024: 			my @st = stat($path);
 3025: 			return $st[9] if @st;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3026: 		}
 3027: 	}
 3028: 
 3029: 	return $self->{'_updated'};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3030: }
 3031: 
 3032: =head2 columns
 3033: 
 3034: Returns an array reference of column names for the current table.
 3035: 
 3036:     my $cols = $db->columns();    # e.g. ['entry', 'name', 'score', 'status']
 3037: 
 3038: Column names are always returned in alphabetical (lexicographic) order,
 3039: regardless of backend. This makes the result stable and portable when the
 3040: same logical table is backed by different engines (CSV => SQLite, etc.).
 3041: 
 3042: The source of column names varies by backend:
 3043: 
 3044: =over 4
 3045: 
 3046: =item * B<Slurp mode> - keys of the first row in memory.
 3047: 
 3048: =item * B<SQLite / other DBI> - a zero-row C<SELECT *> exposes the driver's
 3049: C<NAME> attribute.
 3050: 
 3051: =item * B<BerkeleyDB> - always returns C<['entry', 'value']>.
 3052: 
 3053: =back
 3054: 
 3055: The result is cached inside the object after the first call.
 3056: 
 3057: =head3 API SPECIFICATION
 3058: 
 3059: =head4 Arguments
 3060: 
 3061: None beyond the implicit invocant.  The result is cached in the
 3062: object after the first call.
 3063: 
 3064: =head4 Returns
 3065: 
 3066:     ArrayRef[Str]
 3067: 
 3068: A sorted (lexicographic, ascending) arrayref of column names.  The
 3069: sort order is identical across all backends, so switching from CSV
 3070: to SQLite does not change the returned order.
 3071: 
 3072: =cut
 3073: 
 3074: sub columns {
●3075 → 3083 → 3087 3075: 	my $self = shift;
 3076: 
 3077: 	return $self->{'_columns'} if $self->{'_columns'};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3078: 
 3079: 	my $table = $self->_open_table({});
 3080: 
 3081: 	my @cols;
 3082: 
 3083: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3084: 		return $self->{'_columns'} = ['entry', 'value'];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3085: 	}
 3086: 
●3087 → 3087 → 3101 3087: 	if(my $data = $self->{'data'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3088: 		if(ref($data) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3089: 			my ($first) = values %{$data};
 3090: 			@cols = sort keys %{$first} if $first;
 3091: 		} elsif(ref($data) eq 'ARRAY' && @{$data}) {
 3092: 			@cols = sort keys %{$data->[0]};
 3093: 		}
 3094: 	} else {
 3095: 		my $sth = $self->{$table}->prepare_cached("SELECT * FROM $table WHERE 1=0");
 3096: 		$sth->execute();
 3097: 		@cols = sort @{$sth->{NAME}};
 3098: 		$sth->finish();
 3099: 	}
 3100: 
 3101: 	return $self->{'_columns'} = \@cols;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3102: }
 3103: 
 3104: =head2 schema
 3105: 
 3106: Returns a hash reference describing the schema of the current table.
 3107: Each key is a column name; each value is a hash reference with these keys:
 3108: 
 3109: =over 4
 3110: 
 3111: =item * C<type> - data type string (e.g. C<TEXT>, C<INTEGER>, C<REAL>)
 3112: 
 3113: =item * C<nullable> - C<1> if the column may be NULL, C<0> if NOT NULL
 3114: 
 3115: =item * C<default> - default value string, or C<undef>
 3116: 
 3117: =item * C<pk> - C<1> if this column is (part of) the primary key, C<0> otherwise
 3118: 
 3119: =back
 3120: 
 3121:     my $schema = $db->schema();
 3122: 
 3123:     for my $col (sort keys %{$schema}) {
 3124:         my $info = $schema->{$col};
 3125:         printf "%s  %s  %s\n",
 3126:             $col,
 3127:             $info->{type},
 3128:             $info->{nullable} ? 'NULL' : 'NOT NULL';
 3129:     }
 3130: 
 3131: The schema is determined by the backend:
 3132: 
 3133: =over 4
 3134: 
 3135: =item * B<SQLite> - C<PRAGMA table_info(table)>
 3136: 
 3137: =item * B<Other DBI drivers> - C<< $dbh->column_info(...) >>
 3138: 
 3139: =item * B<Slurp mode> - inferred from the first row; all columns typed as
 3140: C<TEXT> by default.  When C<< infer_types => 1 >> was passed to the
 3141: constructor, up to 100 rows are scanned per column and the type is
 3142: promoted: all-integer values => C<INTEGER>; all-float values =>
 3143: C<REAL>; all ISO-8601 timestamps (C<YYYY-MM-DDThh:mm>) => C<TIMESTAMP>;
 3144: all ISO-8601 dates (C<YYYY-MM-DD>) => C<DATE>; otherwise C<TEXT>.
 3145: C<undef> and empty-string values are treated as SQL C<NULL> and skipped
 3146: during the scan.
 3147: 
 3148: =item * B<BerkeleyDB> - always returns C<entry> (pk) and C<value>
 3149: 
 3150: =back
 3151: 
 3152: The result is cached inside the object after the first call.
 3153: 
 3154: =head3 API SPECIFICATION
 3155: 
 3156: =head4 Arguments
 3157: 
 3158:     infer_types => Bool  # enable heuristic type inference for slurp backends
 3159:                          # (may also be set at construction time)
 3160: 
 3161: =head4 Returns
 3162: 
 3163:     HashRef[Str => HashRef]
 3164: 
 3165: A hashref keyed by column name.  Each value is a hashref with:
 3166: 
 3167:     type     => Str          # 'TEXT', 'INTEGER', 'REAL', 'TIMESTAMP', 'DATE'
 3168:     nullable => Bool         # 1 if the column may be NULL, 0 if NOT NULL
 3169:     default  => Str | undef  # default value, or undef
 3170:     pk       => Bool         # 1 if (part of) the primary key
 3171: 
 3172: For slurp-mode backends all columns default to type C<TEXT> unless
 3173: C<infer_types> is set.  The result is cached in the object after the
 3174: first call.
 3175: 
 3176: =cut
 3177: 
 3178: sub schema {
●3179 → 3186 → 3193 3179: 	my $self = shift;
 3180: 
 3181: 	return $self->{'_schema'} if $self->{'_schema'};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3182: 
 3183: 	my $table = $self->_open_table({});
 3184: 	my %schema;
 3185: 
 3186: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3187: 		return $self->{'_schema'} = {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3188: 			entry => { type => 'TEXT', nullable => 0, default => undef, pk => 1 },
 3189: 			value => { type => 'TEXT', nullable => 1, default => undef, pk => 0 },
 3190: 		};
 3191: 	}
 3192: 
●3193 → 3193 → 3256 3193: 	if(my $data = $self->{'data'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3194: 		my $first;
 3195: 		my @sample;
 3196: 		if(ref($data) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3197: 			($first) = values %{$data};
 3198: 			if($self->{'infer_types'} && $first) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3199: 				my $n = 0;
 3200: 				for my $row (values %{$data}) {
 3201: 					push @sample, $row;
 3202: 					last if ++$n >= INFER_TYPE_SAMPLE_SIZE;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 3203: 				}
 3204: 			}
 3205: 		} elsif(ref($data) eq 'ARRAY' && @{$data}) {
 3206: 			$first = $data->[0];
 3207: 			if($self->{'infer_types'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3208: 				my $last = $#{$data} < INFER_TYPE_SAMPLE_SIZE - 1 ? $#{$data} : INFER_TYPE_SAMPLE_SIZE - 1;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 3209: 				@sample = @{$data}[0 .. $last];
 3210: 			}
 3211: 		}
 3212: 		if($first) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3213: 			my $id = $self->{'id'};
 3214: 			for my $col (keys %{$first}) {
 3215: 				my $type = @sample
 3216: 					? _infer_type([map { exists($_->{$col}) ? $_->{$col} : undef } @sample])
 3217: 					: 'TEXT';
 3218: 				$schema{$col} = {
 3219: 					type     => $type,
 3220: 					nullable => ($col eq $id ? 0 : 1),
 3221: 					default  => undef,
 3222: 					pk       => ($col eq $id ? 1 : 0),
 3223: 				};
 3224: 			}
 3225: 		}
 3226: 	} else {
 3227: 		my $driver = $self->{$table}->{'Driver'}{'Name'} // '';
 3228: 		if($driver eq 'SQLite') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3229: 			my $sth = $self->{$table}->prepare_cached("PRAGMA table_info($table)");
 3230: 			$sth->execute();
 3231: 			while(my $row = $sth->fetchrow_hashref()) {
 3232: 				$schema{$row->{'name'}} = {
 3233: 					type     => $row->{'type'},
 3234: 					nullable => !$row->{'notnull'},
 3235: 					default  => $row->{'dflt_value'},
 3236: 					pk       => $row->{'pk'},
 3237: 				};
 3238: 			}
 3239: 			$sth->finish();
 3240: 		} else {
 3241: 			my $sth = $self->{$table}->column_info(undef, undef, $table, '%');
 3242: 			if($sth) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3243: 				while(my $row = $sth->fetchrow_hashref()) {
 3244: 					$schema{$row->{'COLUMN_NAME'}} = {
 3245: 						type     => $row->{'TYPE_NAME'},
 3246: 						nullable => $row->{'NULLABLE'},
 3247: 						default  => $row->{'COLUMN_DEF'},
 3248: 						pk       => 0,
 3249: 					};
 3250: 				}
 3251: 				$sth->finish();
 3252: 			}
 3253: 		}
 3254: 	}
 3255: 
 3256: 	return $self->{'_schema'} = \%schema;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3257: }
 3258: 
 3259: =head2 dbi_source
 3260: 
 3261: Returns a hashref C<{ dbh =E<gt> $dbh, table =E<gt> $name }> when the backend
 3262: is a live SQLite connection, or C<undef> for every other backend (slurp-mode
 3263: CSV, JSON, XLSX, HTML URL, DBM::Deep, BerkeleyDB, PostgreSQL, MySQL, ...).
 3264: 
 3265: The hashref is consumed by C<Database::Join> to perform a zero-copy
 3266: C<ATTACH DATABASE> so rows never pass through Perl.
 3267: Nested C<Database::Join> objects that are themselves SQLite-backed expose themselves
 3268: as attachable sources to parent joins through the same interface.
 3269: 
 3270: Subclasses may override this method to expose non-SQLite DBI connections
 3271: if their join layer supports them.
 3272: 
 3273: =head3 API SPECIFICATION
 3274: 
 3275: =head4 Arguments
 3276: 
 3277: None beyond the implicit invocant.
 3278: 
 3279: =head4 Returns
 3280: 
 3281: A hashref C<{ dbh =E<gt> DBI::db, table =E<gt> Str }> on a SQLite-backed
 3282: instance, or C<undef> on all other backends.
 3283: 
 3284: =cut
 3285: 
 3286: sub dbi_source
 3287: {
 3288: 	my $self = shift;
 3289: 
 3290: 	my $table = $self->_open_table({});
 3291: 	my $dbh   = $self->{$table};
 3292: 
 3293: 	return undef unless $dbh && ref($dbh) && (($dbh->{Driver}{Name} // '') eq 'SQLite');
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3294: 
 3295: 	return { dbh => $dbh, table => $table };
 3296: }
 3297: 
 3298: =head2 aggregate
 3299: 
 3300: Groups matching rows and computes aggregate measures over each group.
 3301: Pushes C<GROUP BY> SQL to the backend when a DBI handle is available;
 3302: otherwise folds rows in Perl (BerkeleyDB, DBM::Deep, XLSX, JSON, HTML, Redis).
 3303: 
 3304:     my $rows = $db->aggregate(
 3305:         by       => ['region', 'month'],
 3306:         measures => [
 3307:             { col => 'amount', fn => 'sum',   as => 'revenue' },
 3308:             {                  fn => 'count', as => 'orders'  },
 3309:         ],
 3310:         status => 'active',
 3311:     );
 3312: 
 3313:     # Grand total (no 'by')
 3314:     my $row = $db->aggregate(
 3315:         measures => [{ col => 'score', fn => 'avg', as => 'mean_score' }],
 3316:     )->[0];
 3317: 
 3318: Reserved parameter keys (extracted before the rest is treated as WHERE criteria):
 3319: C<by>, C<measures>, C<having>, C<sort_by>, C<limit>, C<offset>, C<table>, C<join>.
 3320: 
 3321: Always returns an B<arrayref of hashrefs> (never C<undef>); returns C<[]> when
 3322: no group qualifies.  Row keys are the C<by> column names (in declaration order)
 3323: followed by the measure aliases.
 3324: 
 3325: =head3 Measure specification
 3326: 
 3327: Each measure hashref:
 3328: 
 3329:     { col => 'amount', fn => 'sum',           as => 'revenue'   }
 3330:     {                  fn => 'count',         as => 'orders'    }  # COUNT(*)
 3331:     { col => 'amount', fn => 'count',         as => 'paid'      }  # COUNT(col)
 3332:     { col => 'customer', fn => 'count_distinct', as => 'customers' }
 3333: 
 3334: C<fn> must be one of C<sum>, C<avg>, C<min>, C<max>, C<count>, C<count_distinct>,
 3335: C<median>, C<stddev> (case-insensitive).  C<col> is required for every function
 3336: except plain C<count>.  C<as> (the result key) must be a valid SQL identifier
 3337: and must not duplicate another alias or a C<by> column name.
 3338: 
 3339: C<median> computes the median (middle value of sorted values; average of two
 3340: middle values for even count).  C<stddev> computes the sample standard deviation
 3341: (using N-1 denominator).  Both are computed in Perl (no SQL pushdown); on SQL
 3342: backends the full result set is fetched first and then folded in memory.
 3343: 
 3344: Empty-set normalisation: C<median> and C<stddev> become C<undef> when no rows
 3345: are present; C<stddev> on a single-row group returns C<0>.
 3346: 
 3347: =head3 HAVING
 3348: 
 3349: Pass C<< having => { alias_or_by_col => criterion } >> to filter groups
 3350: after aggregation.  Accepts the full criteria syntax.
 3351: 
 3352:     having => { revenue => { '>' => 1000 } }
 3353: 
 3354: =head3 PSEUDOCODE
 3355: 
 3356:     1. _open_table; croak if JOIN requested on no-DBI backend.
 3357:     2. _validate_aggregate_spec: extract/validate by/measures/having/
 3358:        sort_by/limit/offset; remainder of params is WHERE criteria.
 3359:     3. Merge base_criteria.
 3360:     4. SQL path (DBI handle): _build_aggregate_sql; prepare_cached+execute;
 3361:        normalise empty-set values; cache; fixate; return.
 3362:     5. Perl fold: selectall_arrayref(criteria); _fold_aggregate;
 3363:        HAVING via _match_criteria; sort; offset; limit; fixate; return.
 3364: 
 3365: =head3 Backend notes
 3366: 
 3367: On slurp-only backends all matching rows are materialised before folding.
 3368: Use a SQL backend (SQLite DSN, PostgreSQL, MySQL) for large datasets.
 3369: 
 3370: =head3 API SPECIFICATION
 3371: 
 3372: =head4 Arguments
 3373: 
 3374:     by         => ArrayRef[Str]     # optional: GROUP BY column names
 3375:     measures   => ArrayRef[HashRef] # required: one or more measure specs
 3376:     having     => HashRef           # optional: post-group filter criteria
 3377:     sort_by    => Str | ArrayRef    # optional: sort column (Str) or [col,dir]
 3378:     limit      => Int               # optional: max rows to return
 3379:     offset     => Int               # optional: rows to skip before returning
 3380:     join       => HashRef | ArrayRef # optional: join spec(s) -- SQL path only
 3381:     no_fixate  => Bool              # optional: skip read-only locking
 3382:     %criteria                       # optional: WHERE filter before grouping
 3383: 
 3384: Each element of C<measures> is a hashref with keys:
 3385: 
 3386:     col  => Str    # column to aggregate; omit only for plain count()
 3387:     fn   => Str    # one of: sum avg min max count count_distinct median stddev
 3388:     as   => Str    # result key name (required; valid SQL identifier)
 3389: 
 3390: =head4 Returns
 3391: 
 3392:     ArrayRef[HashRef]
 3393: 
 3394: An arrayref of hashrefs.  Each hashref has one key per C<by> column
 3395: and one key per measure C<as> alias.  Returns C<[]> (empty arrayref)
 3396: when no groups match -- never C<undef>.
 3397: 
 3398: Empty-set normalisation: C<sum>/C<count>/C<count_distinct> become
 3399: C<0>; C<avg>/C<min>/C<max>/C<median>/C<stddev> become C<undef> when no rows
 3400: are present.
 3401: 
 3402: =cut
 3403: 
 3404: sub aggregate
 3405: {
●3406 → 3411 → 3416 3406: 	my $self = shift;
 3407: 
 3408: 	$self->_open_table({});
 3409: 
 3410: 	my $params;
 3411: 	if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3412: 		$params = Params::Get::get_params(undef, \@_);
 3413: 	} elsif(scalar(@_)) {
 3414: 		$params = Params::Get::get_params('entry', @_);
 3415: 	}
●3416 → 3424 → 3428 3416: 	$params //= {};
 3417: 
 3418: 	my $table     = $self->_open_table($params);
 3419: 	my $no_fixate = delete $params->{'no_fixate'};
 3420: 	my $join_spec = delete $params->{'join'};
 3421: 	delete $params->{'table'};
 3422: 
 3423: 	my $join_clause = '';
 3424: 	if($join_spec) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3425: 		$join_clause = $self->_build_joins($join_spec);
 3426: 	}
 3427: 
●3428 → 3430 → 3435 3428: 	my $spec = $self->_validate_aggregate_spec($params);
 3429: 
 3430: 	if($join_clause && !$self->{$table}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3431: 		my $backend = $self->{'berkeley'} ? 'BerkeleyDB' : ($self->{'type'} // 'slurp');
 3432: 		Carp::croak(ref($self), ": aggregate: cannot aggregate a JOIN on the $backend backend");
 3433: 	}
 3434: 
●3435 → 3440 → 3496 3435: 	$spec->{'criteria'} = $self->_merge_base_criteria($spec->{'criteria'});
 3436: 
 3437: 	# median and stddev are computed in Perl; skip SQL pushdown for them.
 3438: 	my $has_perl_only = grep { $PERL_ONLY_AGG_FNS{$_->{'fn'}} } @{$spec->{'measures'}};
 3439: 
 3440: 	if($self->{$table} && !$has_perl_only) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3441: 		my ($sql, $args) = $self->_build_aggregate_sql($spec, $join_clause, $table, $self->{$table});
 3442: 
 3443: 		if(defined($args->[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3444: 			$self->_debug("aggregate $sql: ", join(', ', @{$args}));
 3445: 		} else {
 3446: 			$self->_debug("aggregate $sql");
 3447: 		}
 3448: 
 3449: 		my ($key, $c);
 3450: 		if($c = $self->{'cache'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3451: 			$key = ref($self) . "::$sql aggregate";
 3452: 			$key .= ' ' . join(', ', @{$args}) if defined($args->[0]);
 3453: 			$self->_debug("aggregate cache key = '$key'");
 3454: 			if(my $rc = $c->get($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3455: 				$self->_debug('aggregate: cache HIT');
 3456: 				return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3457: 			}
 3458: 			$self->_debug('aggregate: cache MISS');
 3459: 		} else {
 3460: 			$self->_debug('aggregate cache not used');
 3461: 		}
 3462: 
 3463: 		my $sth = $self->{$table}->prepare_cached($sql)
 3464: 			or do {
 3465: 				$self->_warn("aggregate prepare failed on $sql");
 3466: 				Carp::croak(ref($self), ': prepare failed: ', $self->{$table}->errstr());
 3467: 			};
 3468: 		$sth->execute(@{$args}) or Carp::croak("$sql: @{$args}");
 3469: 
 3470: 		my @rows;
 3471: 		while(my $row = $sth->fetchrow_hashref()) {
 3472: 			push @rows, $row;
 3473: 		}
 3474: 
 3475: 		# Empty-set normalisation (§5.3 of design spec):
 3476: 		# sum / count / count_distinct → 0; avg / min / max stay undef.
 3477: 		for my $row (@rows) {
 3478: 			for my $m (@{$spec->{'measures'}}) {
 3479: 				my $as = $m->{'as'};
 3480: 				my $fn = $m->{'fn'};
 3481: 				if(!defined($row->{$as})
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3482: 					&& ($fn eq 'sum' || $fn eq 'count' || $fn eq 'count_distinct')) {
 3483: 					$row->{$as} = 0;
 3484: 				}
 3485: 			}
 3486: 		}
 3487: 
 3488: 		$c->set($key, \@rows, $self->{'cache_duration'}) if $c;
 3489: 		$self->_fixate(\@rows) unless $no_fixate;
 3490: 		return set_return(\@rows, { type => 'arrayref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3491: 	}
 3492: 
 3493: 	# Perl fold path: fetch matching rows then group and aggregate in memory.
 3494: 	# BerkeleyDB rows arrive via _scan_berkeley inside selectall_arrayref;
 3495: 	# all other no-DBI backends (XLSX, Deep, JSON, HTML, Redis) have slurped data.
●3496 → 3499 → 3503 3496: 	my $rows = $self->selectall_arrayref(%{$spec->{'criteria'}});
 3497: 	my $out  = $self->_fold_aggregate($rows, $spec);
 3498: 
 3499: 	if(my $hav = $spec->{'having'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3500: 		$out = [ grep { $self->_match_criteria($_, $hav) } @{$out} ];
 3501: 	}
 3502: 
●3503 → 3504 → 3525 3503: 	my @by_names = map { $_->{'name'} } @{$spec->{'by'}};
 3504: 	if(my $s = $spec->{'sort'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3505: 		my ($scol, $sdir) = @{$s};
 3506: 		my $desc       = ($sdir eq 'DESC');
 3507: 		my $is_measure = $spec->{'aliases'}{$scol};
 3508: 		@{$out} = sort {
 3509: 			my ($av, $bv) = ($a->{$scol} // '', $b->{$scol} // '');
 3510: 			$desc
 3511: 				? ($is_measure ? ($bv <=> $av) : ($bv cmp $av))
 3512: 				: ($is_measure ? ($av <=> $bv) : ($av cmp $bv))
 3513: 		} @{$out};
 3514: 	} elsif(@by_names) {
 3515: 		@{$out} = sort {
 3516: 			my $cmp = 0;
 3517: 			for my $bn (@by_names) {
 3518: 				$cmp = (($a->{$bn} // '') cmp ($b->{$bn} // ''));
 3519: 				last if $cmp;
 3520: 			}
 3521: 			$cmp;
 3522: 		} @{$out};
 3523: 	}
 3524: 
 3525: 	splice(@{$out}, 0, $spec->{'offset'}) if $spec->{'offset'};
 3526: 	splice(@{$out}, $spec->{'limit'})     if defined $spec->{'limit'};
 3527: 
 3528: 	$self->_fixate($out) unless $no_fixate;
 3529: 	return set_return($out, { type => 'arrayref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3530: }
 3531: 
 3532: # Validate and extract aggregate spec from %params (mutates $params in place,
 3533: # deleting aggregate control keys; the remainder becomes the WHERE criteria).
 3534: # Returns \%spec on success; croaks on invalid input.
 3535: # No database access — pure validation, trivially unit-testable.
 3536: sub _validate_aggregate_spec
 3537: {
●3538 → 3552 → 3559 3538: 	my ($self, $params) = @_;
 3539: 
 3540: 	my $by      = delete $params->{'by'};
 3541: 	my $meas    = delete $params->{'measures'};
 3542: 	my $having  = delete $params->{'having'};
 3543: 	my $sort_by = delete $params->{'sort_by'};
 3544: 	my $limit   = delete $params->{'limit'};
 3545: 	my $offset  = delete $params->{'offset'};
 3546: 
 3547: 	$by //= [];
 3548: 	Carp::croak(ref($self), ": aggregate: 'by' must be an arrayref of column names")
 3549: 		unless ref($by) eq 'ARRAY';
 3550: 
 3551: 	my (@by_names, %by_name_set);
 3552: 	for my $col (@{$by}) {
 3553: 		Carp::croak(ref($self), ": aggregate: unsafe group-by column '". ($col // '') ."'")
 3554: 			unless defined($col) && $col =~ $SAFE_QUALIFIED;
 3555: 		push @by_names, $col;
 3556: 		$by_name_set{$col} = 1;
 3557: 	}
 3558: 
●3559 → 3563 → 3610 3559: 	Carp::croak(ref($self), ": aggregate: 'measures' must be a non-empty arrayref")
 3560: 		unless ref($meas) eq 'ARRAY' && scalar(@{$meas}) > 0;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 3561: 
 3562: 	my (@measure_specs, %alias_set);
 3563: 	for my $m (@{$meas}) {
 3564: 		Carp::croak(ref($self), ": aggregate: measure must be a hashref, got ", (ref($m) || 'scalar'))
 3565: 			unless ref($m) eq 'HASH';
 3566: 
 3567: 		my $fn  = lc($m->{'fn'} // '');
 3568: 		my $col = $m->{'col'};
 3569: 		my $as  = $m->{'as'};
 3570: 
 3571: 		Carp::croak(ref($self), ": aggregate: unknown measure function '$fn'")
 3572: 			unless $VALID_AGG_FNS{$fn};
 3573: 
 3574: 		if($fn ne 'count') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3575: 			Carp::croak(ref($self), ": aggregate: measure column is required for function '$fn'")
 3576: 				unless defined($col) && length($col);
 3577: 		}
 3578: 		if(defined($col) && length($col)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3579: 			Carp::croak(ref($self), ": aggregate: unsafe measure column '$col'")
 3580: 				unless $col =~ $SAFE_QUALIFIED;
 3581: 		}
 3582: 
 3583: 		Carp::croak(ref($self), ": aggregate: measure 'as' is required")
 3584: 			unless defined($as) && length($as);
 3585: 		Carp::croak(ref($self), ": aggregate: unsafe measure alias '$as'")
 3586: 			unless $as =~ $SAFE_IDENTIFIER;
 3587: 		Carp::croak(ref($self), ": aggregate: duplicate measure alias '$as'")
 3588: 			if $alias_set{$as};
 3589: 		Carp::croak(ref($self), ": aggregate: measure alias '$as' collides with a group-by column")
 3590: 			if $by_name_set{$as};
 3591: 
 3592: 		$alias_set{$as} = 1;
 3593: 
 3594: 		my $sql_expr;
 3595: 		if($fn eq 'count' && !(defined($col) && length($col))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3596: 			$sql_expr = 'COUNT(*)';
 3597: 		} elsif($fn eq 'count_distinct') {
 3598: 			$sql_expr = "COUNT(DISTINCT $col)";
 3599: 		} elsif($fn eq 'median') {
 3600: 			$sql_expr = "MEDIAN($col)";   # Perl-fold path only; SQL expr unused
 3601: 		} elsif($fn eq 'stddev') {
 3602: 			$sql_expr = "STDDEV($col)";   # Perl-fold path only; SQL expr unused
 3603: 		} else {
 3604: 			$sql_expr = uc($fn) . "($col)";
 3605: 		}
 3606: 
 3607: 		push @measure_specs, { fn => $fn, col => $col, as => $as, sql => $sql_expr };
 3608: 	}
 3609: 
●3610 → 3610 → 3620 3610: 	if(defined $having) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3611: 		Carp::croak(ref($self), ": aggregate: 'having' must be a hashref")
 3612: 			unless ref($having) eq 'HASH';
 3613: 		for my $k (keys %{$having}) {
 3614: 			next if $k eq '-or' || $k eq '-and';
 3615: 			Carp::croak(ref($self), ": aggregate: having key '$k' is not a group-by column or measure alias")
 3616: 				unless $by_name_set{$k} || $alias_set{$k};
 3617: 		}
 3618: 	}
 3619: 
●3620 → 3621 → 3632 3620: 	my ($sort_col, $sort_dir);
 3621: 	if(defined $sort_by) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3622: 		($sort_col, $sort_dir) = ref($sort_by) eq 'ARRAY'
 3623: 			? ($sort_by->[0], $sort_by->[1])
 3624: 			: ($sort_by, 'ASC');
 3625: 		$sort_dir = defined($sort_dir) ? uc($sort_dir) : 'ASC';
 3626: 		Carp::croak(ref($self), ": aggregate: sort_by names '". ($sort_col // '') ."', which is not a group-by column or measure alias")
 3627: 			unless defined($sort_col) && ($by_name_set{$sort_col} || $alias_set{$sort_col});
 3628: 		Carp::croak(ref($self), ": aggregate: sort_by names '". ($sort_col // '') ."', which is not a group-by column or measure alias")
 3629: 			unless $sort_dir eq 'ASC' || $sort_dir eq 'DESC';
 3630: 	}
 3631: 
●3632 → 3632 → 3640 3632: 	if(defined $limit) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3633: 		if($limit !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3634: 			Carp::carp('aggregate: limit must be a non-negative integer, ignoring');
 3635: 			undef $limit;
 3636: 		} else {
 3637: 			$limit = int($limit);
 3638: 		}
 3639: 	}
●3640 → 3640 → 3649 3640: 	if(defined $offset) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3641: 		if($offset !~ /\A\d+\z/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3642: 			Carp::carp('aggregate: offset must be a non-negative integer, ignoring');
 3643: 			undef $offset;
 3644: 		} else {
 3645: 			$offset = int($offset);
 3646: 		}
 3647: 	}
 3648: 
 3649: 	return {
 3650: 		by       => [ map { { name => $_ } } @by_names ],
 3651: 		measures => \@measure_specs,
 3652: 		aliases  => \%alias_set,
 3653: 		by_names => \%by_name_set,
 3654: 		having   => $having,
 3655: 		criteria => $params,
 3656: 		sort     => defined($sort_col) ? [ $sort_col, $sort_dir ] : undef,
 3657: 		limit    => $limit,
 3658: 		offset   => $offset,
 3659: 	};
 3660: }
 3661: 
 3662: # Build the GROUP BY aggregate SQL query and bind-value list.
 3663: # Returns ($sql, \@bind_args).
 3664: sub _build_aggregate_sql
 3665: {
●3666 → 3682 → 3693 3666: 	my ($self, $spec, $join_clause, $table, $dbh) = @_;
 3667: 
 3668: 	my @by_names = map { $_->{'name'} } @{$spec->{'by'}};
 3669: 	my @meas     = @{$spec->{'measures'}};
 3670: 
 3671: 	# SELECT: by columns then "expr AS alias" for each measure.
 3672: 	my @sel;
 3673: 	push @sel, @by_names;
 3674: 	push @sel, map { "$_->{'sql'} AS $_->{'as'}" } @meas;
 3675: 	my $sql = 'SELECT ' . join(', ', @sel) . " FROM $table";
 3676: 	$sql .= " $join_clause" if $join_clause;
 3677: 
 3678: 	# WHERE: criteria + CSV comment-row guard.
 3679: 	my ($where, $wargs) = $self->_build_where($spec->{'criteria'});
 3680: 	my @args = @{$wargs};
 3681: 
 3682: 	if($join_clause) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3683: 		$sql .= " WHERE $where" if $where;
 3684: 	} elsif(($self->{'type'} // '') eq 'CSV' && !$self->{'no_entry'}) {
 3685: 		my $id = $self->{'id'};
 3686: 		$sql .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 3687: 		$sql .= " AND ($where)" if $where;
 3688: 	} else {
 3689: 		$sql .= " WHERE $where" if $where;
 3690: 	}
 3691: 
 3692: 	# GROUP BY.
●3693 → 3697 → 3707 3693: 	$sql .= ' GROUP BY ' . join(', ', @by_names) if @by_names;
 3694: 
 3695: 	# HAVING: substitute measure aliases with their SQL expressions so the
 3696: 	# query is valid on PostgreSQL (which forbids output-column aliases in HAVING).
 3697: 	if(my $hav = $spec->{'having'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3698: 		my %a2s = map { $_->{'as'} => $_->{'sql'} } @meas;
 3699: 		my ($hfrag, $hargs) = $self->_build_having_fragment($hav, \%a2s);
 3700: 		if($hfrag) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3701: 			$sql .= " HAVING $hfrag";
 3702: 			push @args, @{$hargs};
 3703: 		}
 3704: 	}
 3705: 
 3706: 	# ORDER BY: explicit sort_by takes precedence; default is by-columns ASC.
●3707 → 3707 → 3714 3707: 	if(my $s = $spec->{'sort'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3708: 		$sql .= " ORDER BY $s->[0] $s->[1]";
 3709: 	} elsif(@by_names) {
 3710: 		$sql .= ' ORDER BY ' . join(', ', @by_names);
 3711: 	}
 3712: 
 3713: 	# LIMIT / OFFSET.
●3714 → 3714 → 3723 3714: 	if(defined $spec->{'limit'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3715: 		$sql .= ' LIMIT ?';
 3716: 		push @args, $spec->{'limit'};
 3717: 	} elsif(defined $spec->{'offset'}) {
 3718: 		# SQLite requires a LIMIT clause before OFFSET; -1 means no upper bound.
 3719: 		$sql .= ' LIMIT -1'
 3720: 			if ($dbh && (($dbh->{Driver}{Name} // '') eq 'SQLite'))
 3721: 			|| (($self->{'_dialect'} // '') eq 'sqlite');
 3722: 	}
●3723 → 3723 → 3728 3723: 	if(defined $spec->{'offset'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3724: 		$sql .= ' OFFSET ?';
 3725: 		push @args, $spec->{'offset'};
 3726: 	}
 3727: 
 3728: 	return ($sql, \@args);
 3729: }
 3730: 
 3731: # Build a HAVING clause fragment, substituting measure aliases with their SQL
 3732: # expressions (PostgreSQL forbids output-column aliases in HAVING).
 3733: # $alias_to_sql maps alias → SQL expression (e.g. revenue → SUM(amount)).
 3734: # Mirrors _build_where_conditions but uses pre-validated SQL expressions as LHS
 3735: # for measure keys, so the $SAFE_QUALIFIED identifier check is skipped there.
 3736: #
 3737: # SQLite 3.51+ regression: bound parameters compared to aggregate expressions
 3738: # (SUM, AVG, etc.) in HAVING are not type-coerced to numeric automatically,
 3739: # causing numeric comparisons to return 0 rows.  When the LHS was substituted
 3740: # from an alias (i.e. it is an aggregate expression, not a bare column name),
 3741: # wrap all numeric bind placeholders in CAST(? AS REAL) so SQLite performs the
 3742: # comparison correctly.  CAST(? AS REAL) is valid SQL in SQLite, PostgreSQL and
 3743: # MySQL and is a no-op on those dialects where type coercion already works.
 3744: #
 3745: # Returns ($fragment, \@bind_values).
 3746: sub _build_having_fragment
 3747: {
●3748 → 3751 → 3804 3748: 	my ($self, $having, $alias_to_sql) = @_;
 3749: 
 3750: 	my (@clauses, @args);
 3751: 	for my $k (sort keys %{$having}) {
 3752: 		my $agg_expr = $alias_to_sql->{$k};
 3753: 		my $lhs      = $agg_expr // $k;
 3754: 		my $val      = $having->{$k};
 3755: 
 3756: 		# ph() returns the right placeholder: CAST(? AS REAL) for aggregate
 3757: 		# expression LHS (numeric result), bare ? for group-by column LHS.
 3758: 		my $ph = defined($agg_expr) ? 'CAST(? AS REAL)' : '?';
 3759: 
 3760: 		if(ref($val) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3761: 			for my $op (keys %{$val}) {
 3762: 				my $operand = $val->{$op};
 3763: 				if($op eq '-in' || $op eq '-not_in') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3764: 					my $sql_op = $op eq '-in' ? 'IN' : 'NOT IN';
 3765: 					my $phs = join(', ', ($ph) x scalar(@{$operand}));
 3766: 					push @clauses, "$lhs $sql_op ($phs)";
 3767: 					push @args, @{$operand};
 3768: 				} elsif($op eq '-between') {
 3769: 					push @clauses, "$lhs BETWEEN $ph AND $ph";
 3770: 					push @args, $operand->[0], $operand->[1];
 3771: 				} elsif($op eq '-like') {
 3772: 					push @clauses, "$lhs LIKE ?";
 3773: 					push @args, $operand;
 3774: 				} elsif($op eq '-not_like') {
 3775: 					push @clauses, "$lhs NOT LIKE ?";
 3776: 					push @args, $operand;
 3777: 				} elsif($op eq '!=') {
 3778: 					if(!defined($operand)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3779: 						push @clauses, "$lhs IS NOT NULL";
 3780: 					} else {
 3781: 						push @clauses, "$lhs != $ph";
 3782: 						push @args, $operand;
 3783: 					}
 3784: 				} elsif($op =~ /\A[<>]=?\z/) {
 3785: 					push @clauses, "$lhs $op $ph";
 3786: 					push @args, $operand;
 3787: 				} else {
 3788: 					Carp::croak("Unknown operator '$op' in having for key '$k'");
 3789: 				}
 3790: 			}
 3791: 		} elsif(ref($val)) {
 3792: 			Carp::croak("$k: expected scalar or operator hashref, got ", ref($val));
 3793: 		} elsif(!defined($val)) {
 3794: 			push @clauses, "$lhs IS NULL";
 3795: 		} elsif($val =~ /[%_]/) {
 3796: 			push @clauses, "$lhs LIKE ?";
 3797: 			push @args, $val;
 3798: 		} else {
 3799: 			push @clauses, "$lhs = $ph";
 3800: 			push @args, $val;
 3801: 		}
 3802: 	}
 3803: 
 3804: 	return (join(' AND ', @clauses), \@args);
 3805: }
 3806: 
 3807: # Recursive in-memory criterion matcher supporting -or/-and groupings.
 3808: # Used by aggregate()'s Perl fold path for HAVING evaluation.
 3809: # Leaf comparisons are delegated to _match_criterion.
 3810: # Uses exists() guards for fixated slurp hashrefs (see Data::Reuse notes).
 3811: sub _match_criteria
 3812: {
●3813 → 3815 → 3834 3813: 	my ($self, $row, $criteria) = @_;
 3814: 
 3815: 	for my $k (keys %{$criteria}) {
 3816: 		if($k eq '-or') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3817: 			my $found = 0;
 3818: 			for my $sub (@{$criteria->{$k}}) {
 3819: 				if($self->_match_criteria($row, $sub)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3820: 					$found = 1;
 3821: 					last;
 3822: 				}
 3823: 			}
 3824: 			return 0 unless $found;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3825: 		} elsif($k eq '-and') {
 3826: 			for my $sub (@{$criteria->{$k}}) {
 3827: 				return 0 unless $self->_match_criteria($row, $sub);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3828: 			}
 3829: 		} else {
 3830: 			my $row_val = exists($row->{$k}) ? $row->{$k} : undef;
 3831: 			return 0 unless $self->_match_criterion($row_val, $criteria->{$k}, $k);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3832: 		}
 3833: 	}
 3834: 	return 1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3835: }
 3836: 
 3837: # Group an arrayref of rows and compute aggregate measures in Perl.
 3838: # Used by aggregate() when no DBI handle is available (slurp-only backends).
 3839: # All matching rows are materialised by the caller before this is called.
 3840: # Returns an arrayref of group rows (unsorted; sorting happens in aggregate()).
 3841: sub _fold_aggregate
 3842: {
●3843 → 3862 → 3960 3843: 	my ($self, $rows, $spec) = @_;
 3844: 
 3845: 	my @by_specs = @{$spec->{'by'}};
 3846: 	my @meas     = @{$spec->{'measures'}};
 3847: 
 3848: 	# Pre-compute per-measure numeric flag from cached schema (only when already
 3849: 	# populated by a prior schema() call — never triggers a PRAGMA round-trip).
 3850: 	my @meas_numeric = map {
 3851: 		my $col = $_->{'col'};
 3852: 		($col && $self->{'_schema'})
 3853: 			? do {
 3854: 				my $t = ($self->{'_schema'}{$col} // {})->{'type'} // 'TEXT';
 3855: 				($t eq 'INTEGER' || $t eq 'REAL') ? 1 : 0;
 3856: 			  }
 3857: 			: 0;
 3858: 	} @meas;
 3859: 
 3860: 	my (%groups, @group_order);
 3861: 
 3862: 	for my $row (@{$rows}) {
 3863: 		# Build group key: NUL-separated by-column values ('undef' → '').
 3864: 		my $key = join("\x00",
 3865: 			map { exists($row->{$_->{'name'}}) ? ($row->{$_->{'name'}} // '') : '' }
 3866: 			@by_specs
 3867: 		);
 3868: 
 3869: 		unless(exists $groups{$key}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3870: 			push @group_order, $key;
 3871: 			my %g;
 3872: 			# Seed group with by-column values from the first row seen.
 3873: 			for my $b (@by_specs) {
 3874: 				$g{$b->{'name'}} = exists($row->{$b->{'name'}}) ? $row->{$b->{'name'}} : undef;
 3875: 			}
 3876: 			# Initialise per-measure accumulator state.
 3877: 			for my $m (@meas) {
 3878: 				my $fn = $m->{'fn'};
 3879: 				my $as = $m->{'as'};
 3880: 				if($fn eq 'sum') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3881: 					$g{"__agg_$as"} = { sum => 0, bad => 0, first_bad => undef };
 3882: 				} elsif($fn eq 'avg') {
 3883: 					$g{"__agg_$as"} = { sum => 0, cnt => 0, bad => 0, first_bad => undef };
 3884: 				} elsif($fn eq 'min' || $fn eq 'max') {
 3885: 					$g{"__agg_$as"} = { val => undef };
 3886: 				} elsif($fn eq 'count') {
 3887: 					$g{"__agg_$as"} = { cnt => 0 };
 3888: 				} elsif($fn eq 'count_distinct') {
 3889: 					$g{"__agg_$as"} = { seen => {} };
 3890: 				} elsif($fn eq 'median' || $fn eq 'stddev') {
 3891: 					$g{"__agg_$as"} = { vals => [] };
 3892: 				}
 3893: 			}
 3894: 			$groups{$key} = \%g;
 3895: 		}
 3896: 
 3897: 		my $g  = $groups{$key};
 3898: 		my $mi = 0;
 3899: 		for my $m (@meas) {
 3900: 			my $fn      = $m->{'fn'};
 3901: 			my $col     = $m->{'col'};
 3902: 			my $as      = $m->{'as'};
 3903: 			my $numeric = $meas_numeric[$mi++];
 3904: 			my $acc     = $g->{"__agg_$as"};
 3905: 			my $val = (defined($col) && exists($row->{$col})) ? $row->{$col} : undef;
 3906: 
 3907: 			if($fn eq 'sum') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3908: 				if(defined($val) && length($val) && Scalar::Util::looks_like_number($val)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3909: 					$acc->{'sum'} += $val;
 3910: 				} elsif(defined($val) && length($val)) {
 3911: 					$acc->{'bad'}++;
 3912: 					$acc->{'first_bad'} //= $val;
 3913: 				}
 3914: 			} elsif($fn eq 'avg') {
 3915: 				if(defined($val) && length($val) && Scalar::Util::looks_like_number($val)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3916: 					$acc->{'sum'} += $val;
 3917: 					$acc->{'cnt'}++;
 3918: 				} elsif(defined($val) && length($val)) {
 3919: 					$acc->{'bad'}++;
 3920: 					$acc->{'first_bad'} //= $val;
 3921: 				}
 3922: 			} elsif($fn eq 'min') {
 3923: 				if(defined($val)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3924: 					if(!defined($acc->{'val'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3925: 						$acc->{'val'} = $val;
 3926: 					} elsif($numeric ? ($val < $acc->{'val'}) : ($val lt $acc->{'val'})) {
  Mutants (Total: 3, Killed: 3, Survived: 0)
 3927: 						$acc->{'val'} = $val;
 3928: 					}
 3929: 				}
 3930: 			} elsif($fn eq 'max') {
 3931: 				if(defined($val)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3932: 					if(!defined($acc->{'val'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3933: 						$acc->{'val'} = $val;
 3934: 					} elsif($numeric ? ($val > $acc->{'val'}) : ($val gt $acc->{'val'})) {
  Mutants (Total: 3, Killed: 3, Survived: 0)
 3935: 						$acc->{'val'} = $val;
 3936: 					}
 3937: 				}
 3938: 			} elsif($fn eq 'count') {
 3939: 				if(defined $col) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3940: 					$acc->{'cnt'}++ if defined($val);
 3941: 				} else {
 3942: 					$acc->{'cnt'}++;
 3943: 				}
 3944: 			} elsif($fn eq 'count_distinct') {
 3945: 				$acc->{'seen'}{$val}++ if defined($val);
 3946: 			} elsif($fn eq 'median' || $fn eq 'stddev') {
 3947: 				if(defined($val) && length($val) && Scalar::Util::looks_like_number($val)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3948: 					push @{$acc->{'vals'}}, $val + 0;
 3949: 				} elsif(defined($val) && length($val)) {
 3950: 					$acc->{'bad'}++;
 3951: 					$acc->{'first_bad'} //= $val;
 3952: 				}
 3953: 			}
 3954: 		}
 3955: 	}
 3956: 
 3957: 	# Finalise groups: derive final result values from accumulators.
 3958: 	# %warned tracks which measure aliases have already had their non-numeric
 3959: 	# warning emitted; the warning fires at most once per measure per call.
●3960 → 3961 → 4023 3960: 	my (%warned, @out);
 3961: 	for my $key (@group_order) {
 3962: 		my $g = $groups{$key};
 3963: 		my %result;
 3964: 		for my $b (@by_specs) {
 3965: 			$result{$b->{'name'}} = $g->{$b->{'name'}};
 3966: 		}
 3967: 		for my $m (@meas) {
 3968: 			my $fn  = $m->{'fn'};
 3969: 			my $as  = $m->{'as'};
 3970: 			my $col = $m->{'col'};
 3971: 			my $acc = $g->{"__agg_$as"};
 3972: 			my $val;
 3973: 			if($fn eq 'sum') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3974: 				if($acc->{'bad'} && !$warned{$as}++) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3975: 					Carp::carp("aggregate: column '$col' has $acc->{'bad'} non-numeric value(s), skipped, e.g. '$acc->{'first_bad'}'");
 3976: 				}
 3977: 				$val = $acc->{'sum'};
 3978: 			} elsif($fn eq 'avg') {
 3979: 				if($acc->{'bad'} && !$warned{$as}++) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3980: 					Carp::carp("aggregate: column '$col' has $acc->{'bad'} non-numeric value(s), skipped, e.g. '$acc->{'first_bad'}'");
 3981: 				}
 3982: 				$val = $acc->{'cnt'} ? ($acc->{'sum'} / $acc->{'cnt'}) : undef;
 3983: 			} elsif($fn eq 'min' || $fn eq 'max') {
 3984: 				$val = $acc->{'val'};
 3985: 			} elsif($fn eq 'count') {
 3986: 				$val = $acc->{'cnt'};
 3987: 			} elsif($fn eq 'count_distinct') {
 3988: 				$val = scalar(keys %{$acc->{'seen'}});
 3989: 			} elsif($fn eq 'median') {
 3990: 				if($acc->{'bad'} && !$warned{$as}++) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 3991: 					Carp::carp("aggregate: column '$col' has $acc->{'bad'} non-numeric value(s), skipped, e.g. '$acc->{'first_bad'}'");
 3992: 				}
 3993: 				my @sorted = sort { $a <=> $b } @{$acc->{'vals'}};
 3994: 				my $n = scalar @sorted;
 3995: 				if($n == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 3996: 					$val = undef;
 3997: 				} elsif($n % 2) {
 3998: 					$val = $sorted[int($n / 2)];
 3999: 				} else {
 4000: 					$val = ($sorted[$n / 2 - 1] + $sorted[$n / 2]) / 2;
 4001: 				}
 4002: 			} elsif($fn eq 'stddev') {
 4003: 				if($acc->{'bad'} && !$warned{$as}++) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_4003_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 4004: 					Carp::carp("aggregate: column '$col' has $acc->{'bad'} non-numeric value(s), skipped, e.g. '$acc->{'first_bad'}'");
 4005: 				}
 4006: 				my $n = scalar @{$acc->{'vals'}};
 4007: 				if($n < 2) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 4008: 					$val = $n == 1 ? 0 : undef;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4009: 				} else {
 4010: 					my $mean = 0;
 4011: 					$mean += $_ for @{$acc->{'vals'}};
 4012: 					$mean /= $n;
 4013: 					my $sq_sum = 0;
 4014: 					$sq_sum += ($_ - $mean) ** 2 for @{$acc->{'vals'}};
 4015: 					$val = sqrt($sq_sum / ($n - 1));
 4016: 				}
 4017: 			}
 4018: 			$result{$as} = $val;
 4019: 		}
 4020: 		push @out, \%result;
 4021: 	}
 4022: 
 4023: 	return \@out;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4024: }
 4025: 
 4026: =head2 query
 4027: 
 4028: Returns a new L<Database::Abstraction::Query> builder object bound to this
 4029: database instance, for fluent method-chaining queries.
 4030: 
 4031:     # All active rows with high scores, newest first, max 10
 4032:     my $rows = $db->query
 4033:         ->where(status => 'active')
 4034:         ->where(score  => { '>' => 80 })
 4035:         ->order_by('score DESC')
 4036:         ->limit(10)
 4037:         ->all();
 4038: 
 4039:     # Single row
 4040:     my $row = $db->query->where(name => 'Alice')->first();
 4041: 
 4042:     # Just a count
 4043:     my $n = $db->query->where(status => 'active')->count();
 4044: 
 4045: See L<Database::Abstraction::Query> for the full API.
 4046: 
 4047: =cut
 4048: 
 4049: sub query
 4050: {
 4051: 	my $self = shift;
 4052: 	require Database::Abstraction::Query;
 4053: 	return Database::Abstraction::Query->new(_db => $self);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4054: }
 4055: 
 4056: =head2 AUTOLOAD - column shortcut
 4057: 
 4058: Calling an unknown method whose name matches a column name performs a column
 4059: lookup.  The method name is the column you want; the arguments are criteria.
 4060: 
 4061:     # Scalar context: return the first match
 4062:     my $name = $db->name(entry => 'key1');
 4063: 
 4064:     # List context: return all matching values
 4065:     my @names = $db->name();
 4066: 
 4067:     # Shortcut when the table has an 'entry' key column
 4068:     my $name = $db->name('key1');    # same as name(entry => 'key1')
 4069: 
 4070:     # Unique/distinct values
 4071:     my @statuses = $db->status(distinct => 1);
 4072: 
 4073: B<In list context> the full column is returned (all rows), ordered by the
 4074: column value.  B<In scalar context> only the first match is returned
 4075: (C<LIMIT 1>).
 4076: 
 4077: Results come from the slurp cache when available.
 4078: 
 4079: Throws an error if the column does not exist (slurp mode) or if AUTOLOAD
 4080: has been disabled with C<< auto_load => 0 >>.
 4081: 
 4082: =head3 PSEUDOCODE
 4083: 
 4084:     1. Extract column name from $AUTOLOAD; guard on DESTROY.
 4085:     2. Croak if auto_load => 0.
 4086:     3. Validate $column against /^[a-zA-Z_][a-zA-Z0-9_]*$/.
 4087:     4. If data is slurped:
 4088:        a. List context, no params -> map column over all rows (exists guard).
 4089:        b. entry-only param -> direct hash lookup (exists guard).
 4090:        c. No params, scalar -> first value in hash.
 4091:        d. no_entry set -> scan array for matching key/value pair.
 4092:        e. Other params -> scan keyed hash for matching column.
 4093:     5. If not slurped, build SQL:
 4094:        - List:   SELECT column FROM table [WHERE ...] ORDER BY column
 4095:        - Scalar: SELECT DISTINCT column FROM table [WHERE ...] LIMIT 1
 4096:     6. Check cache; return on HIT.
 4097:     7. prepare_cached + execute; fetch result.
 4098:     8. Store in cache; fixate; return.
 4099: 
 4100: =cut
 4101: 
 4102: sub AUTOLOAD {
●4103 → 4122 → 4134 4103: 	our $AUTOLOAD;
 4104: 	my ($column) = $AUTOLOAD =~ /::([A-Za-z_]\w*)\z/;
 4105: 
 4106: 	return if($column eq 'DESTROY');
 4107: 	return if($column =~ /\A_/);	# never treat private method names as column lookups
 4108: 
 4109: 	my $self = shift or return;
 4110: 
 4111: 	Carp::croak(__PACKAGE__, ": Unknown column $column") if(!ref($self));
 4112: 
 4113: 	# Allow the AUTOLOAD feature to be disabled
 4114: 	Carp::croak(__PACKAGE__, ": AUTOLOAD disabled (auto_load => 0)") if(exists($self->{'auto_load'}) && !$self->{'auto_load'});
 4115: 
 4116: 	# Validate column name - only allow safe column name
 4117: 	Carp::croak(__PACKAGE__, ": Invalid column name: $column") unless $column =~ $SAFE_IDENTIFIER;
 4118: 
 4119: 	my $table = $self->_open_table();
 4120: 
 4121: 	my %params;
 4122: 	if(ref($_[0]) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4123: 		%params = %{$_[0]};
 4124: 	} elsif((scalar(@_) % 2) == 0) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4125: 		%params = @_;
 4126: 	} elsif(scalar(@_) == 1) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4127: 		# Don't error on key-value databases, since there's no idea of columns
 4128: 		if($self->{'no_entry'} && !$self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4129: 			Carp::croak(ref($self), "::($_[0]): ", $self->{'id'}, ' is not a column');
 4130: 		}
 4131: 		$params{'entry'} = shift;
 4132: 	}
 4133: 
●4134 → 4134 → 4141 4134: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4135: 		if(my $id = $self->{'id'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4136: 			return $self->{'berkeley'}->{$params{$id}};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4137: 		}
 4138: 		return $self->{'berkeley'}->{$params{'entry'}};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4139: 	}
 4140: 
●4141 → 4146 → 4252 4141: 	croak('Where did the data come from?') if(!defined($self->{'type'}));
 4142: 	my $query;
 4143: 	my $done_where = 0;
 4144: 	my $distinct = delete($params{'distinct'}) || delete($params{'unique'});
 4145: 
 4146: 	if(wantarray && !$distinct) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4147: 		if(((scalar keys %params) == 0) && (my $data = $self->{'data'})) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4148: 			# Return all column values from the in-memory hash.
 4149: 			# Use exists() because fixate() locks inner row hashes —
 4150: 			# accessing a disallowed key would throw without the guard.
 4151: 			# Handle both HASH (keyed data) and ARRAY (no_entry CSV slurp).
 4152: 			my @_rows = ref($data) eq 'ARRAY' ? @{$data} : values %{$data};
 4153: 			return map { exists($_->{$column}) ? $_->{$column} : undef } @_rows;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4154: 		}
 4155: 		if($self->{'data'} && !$self->{$table} && !$self->_has_complex_criteria(\%params)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4156: 			# Non-DBI backends (JSON, XLSX, HTML URL): scan in-memory data with criteria.
 4157: 			my @param_keys = keys %params;
 4158: 			my @_rows = ref($self->{'data'}) eq 'ARRAY' ? @{$self->{'data'}} : values %{$self->{'data'}};
 4159: 			return map { exists($_->{$column}) ? $_->{$column} : undef }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4160: 			       grep {
 4161: 			           my $row = $_;
 4162: 			           all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params{$_}, $_) } @param_keys
 4163: 			       } @_rows;
 4164: 		}
 4165: 		my $id = $self->{'id'};
 4166: 		if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4167: 			$query = "SELECT $column FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 4168: 			$done_where = 1;
 4169: 		} else {
 4170: 			$query = "SELECT $column FROM $table";
 4171: 		}
 4172: 	} else {
 4173: 		if(my $data = $self->{'data'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4174: 			# The data has been read in using Text::xSV::Slurp,
 4175: 			#	so no need to do any SQL
 4176: 			$self->_debug('AUTOLOAD using slurped data');
 4177: 			if($self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4178: 				$self->_debug('no_entry is set');
 4179: 				my ($key, $value) = %params;
 4180: 				if(defined($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4181: 					$self->_debug("key = $key, value = $value, column = $column");
 4182: 					foreach my $row(@{$data}) {
 4183: 						# exists() guards: fixate() locks row hashes recursively
 4184: 						next unless exists($row->{$key}) && defined($row->{$key}) && $row->{$key} eq $value;
 4185: 						my $rc = exists($row->{$column}) ? $row->{$column} : undef;
 4186: 						$self->_trace(__LINE__, ": AUTOLOAD $key: return ", defined($rc) ? "'$rc'" : 'undef', ' from slurped data');
 4187: 						return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4188: 					}
 4189: 					$self->_debug('not found in slurped data');
 4190: 				}
 4191: 			} elsif(((scalar keys %params) == 1) && defined(my $key = $params{'entry'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4192: 				# Look up a single entry by its key.
 4193: 				# Use exists() before accessing — fixate() locks the outer hash and
 4194: 				# dereferencing a missing key on a locked hash throws an exception.
 4195: 				my $rc;
 4196: 				if(exists($data->{$key}) && defined(my $hash = $data->{$key})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4197: 					if(!exists($hash->{$column})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4198: 						Carp::croak(__PACKAGE__, ": There is no column $column in $table");
 4199: 					}
 4200: 					$rc = $hash->{$column};
 4201: 				}
 4202: 				if(defined($rc)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4203: 					$self->_trace(__LINE__, ": AUTOLOAD $key: return '$rc' from slurped data");
 4204: 				} else {
 4205: 					$self->_trace(__LINE__, ": AUTOLOAD $key: return undef from slurped data");
 4206: 				}
 4207: 				return $rc
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4208: 			} elsif((scalar keys %params) == 0) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4209: 				if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4210: 					if($distinct) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4211: 						# Single pass instead of three (map→grep→map): avoids three
 4212: 						# intermediate lists of size N on the stack.
 4213: 						my %h;
 4214: 						for my $r (values %{$data}) {
 4215: 							my $v = exists($r->{$column}) ? $r->{$column} : undef;
 4216: 							$h{$v} = 1 if defined $v;
 4217: 						}
 4218: 						return keys %h;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4219: 					}
 4220: 					# DEAD CODE: unreachable because the outer `if(wantarray && !$distinct)`
 4221: 					# handles the wantarray+!distinct case. In this else branch, wantarray
 4222: 					# implies $distinct (which returns above), so this line is never executed.
 4223: 					# return map { exists($_->{$column}) ? $_->{$column} : undef } values %{$data}
 4224: 				}
 4225: 				# Scalar: return the first value found without building a full list
 4226: 				foreach my $v (values %{$data}) {
 4227: 					return exists($v->{$column}) ? $v->{$column} : undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4228: 				}
 4229: 			} else {
 4230: 				# Keyed data but filtering on a non-key column
 4231: 				my ($key, $value) = %params;
 4232: 				foreach my $row (values %{$data}) {
 4233: 					next unless exists($row->{$key}) && defined($row->{$key}) && $row->{$key} eq $value;
 4234: 					next unless exists($row->{$column});
 4235: 					if(my $rc = $row->{$column}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4236: 						$self->_trace(__LINE__, ": AUTOLOAD $key: return '$rc' from slurped data");
 4237: 						return $rc
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4238: 					}
 4239: 				}
 4240: 			}
 4241: 			return
 4242: 		}
 4243: 		# Data has not been slurped in
 4244: 		my $id = $self->{'id'};
 4245: 		if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4246: 			$query = "SELECT DISTINCT $column FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 4247: 			$done_where = 1;
 4248: 		} else {
 4249: 			$query = "SELECT DISTINCT $column FROM $table";
 4250: 		}
 4251: 	}
●4252 → 4254 → 4269 4252: 	my @args;
 4253: 	# Avoid `each` — it carries hidden iterator state across calls
 4254: 	for my $k (sort keys %params) {
 4255: 		# Guard against SQL injection via column names — same rule as _build_where_conditions
 4256: 		Carp::croak(__PACKAGE__, ": unsafe column name '$k'")
 4257: 			unless $k =~ $SAFE_QUALIFIED;
 4258: 		my $value = $params{$k};
 4259: 		$self->_debug(__PACKAGE__, ": AUTOLOAD adding key/value pair $k=>", defined($value) ? $value : 'NULL');
 4260: 		if(defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4261: 			$query .= $done_where ? " AND $k = ?" : " WHERE $k = ?";
 4262: 			$done_where = 1;
 4263: 			push @args, $value;
 4264: 		} else {
 4265: 			$query .= $done_where ? " AND $k IS NULL" : " WHERE $k IS NULL";
 4266: 			$done_where = 1;
 4267: 		}
 4268: 	}
●4269 → 4269 → 4274 4269: 	if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4270: 		$query .= " ORDER BY $column";
 4271: 	} else {
 4272: 		$query .= ' LIMIT 1';
 4273: 	}
●4274 → 4274 → 4279 4274: 	if(scalar(@args) && $args[0]) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4275: 		$self->_debug("AUTOLOAD $query: ", join(', ', @args));
 4276: 	} else {
 4277: 		$self->_debug("AUTOLOAD $query");
 4278: 	}
●4279 → 4281 → 4298 4279: 	my $cache;
 4280: 	my $key = ref($self) . '::';
 4281: 	if($cache = $self->{cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4282: 		if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4283: 			$key .= 'array ';
 4284: 		}
 4285: 		if(defined($args[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4286: 			$key .= "fetchrow $query " . join(', ', @args);
 4287: 		} else {
 4288: 			$key .= "fetchrow $query";
 4289: 		}
 4290: 		if(my $rc = $cache->get($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4291: 			$self->_debug('cache HIT');
 4292: 			return wantarray ? @{$rc} : $rc;	# We stored a ref to the array
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4293: 		}
 4294: 		$self->_debug('cache MISS');
 4295: 	} else {
 4296: 		$self->_debug('cache not used');
 4297: 	}
●4298 → 4301 → 4311 4298: 	my $sth = $self->{$table}->prepare_cached($query) || croak($query);
 4299: 	$sth->execute(@args) || croak($query);
 4300: 
 4301: 	if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4302: 		# fetchall_arrayref([0]) asks DBI to project column 0 server-side, so each
 4303: 		# returned row is [$col0] instead of the full row — less memory, same result.
 4304: 		my @rc = map { $_->[0] } @{$sth->fetchall_arrayref([0])};
 4305: 		if($cache) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4306: 			$cache->set($key, \@rc, $self->{'cache_duration'});	# Store a ref to the array
 4307: 		}
 4308: 		Database::Abstraction::_fixate($self, \@rc) if(scalar(@rc) && !$self->{'no_fixate'});
 4309: 		return @rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4310: 	}
●4311 → 4313 → 4317 4311: 	my $rc = $sth->fetchrow_array();	# Return the first match only
 4312: 	$sth->finish();
 4313: 	if($cache) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4314: 		# Store the value, then return it — cache->set() return value is unreliable
 4315: 		$cache->set($key, $rc, $self->{'cache_duration'});
 4316: 	}
 4317: 	return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4318: }
 4319: 
 4320: sub DESTROY
 4321: {
●4322 → 4322 → 4326 4322: 	if(defined($^V) && ($^V ge 'v5.14.0')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4323: 		return if ${^GLOBAL_PHASE} eq 'DESTRUCT';	# >= 5.14.0 only
 4324: 	}
 4325: 
●4326 → 4330 → 4338 4326: 	my $self = shift;
 4327: 
 4328: 	# Clean up temporary files — deleting File::Temp objects triggers auto-unlink/rmdir
 4329: 	# If that doesn't happen for some reason, explicitly unlink
 4330: 	if(defined $self->{'_temp_fh'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4331: 		my $temp_fh = $self->{'_temp_fh'};
 4332: 		my $temp_path = eval { $temp_fh->filename() };
 4333: 		delete $self->{'_temp_fh'};
 4334: 		undef $temp_fh;	# Release the local strong reference
 4335: 		# Fallback explicit unlink if File::Temp didn't clean up
 4336: 		unlink($temp_path) if defined($temp_path) && -f $temp_path;
 4337: 	}
●4338 → 4341 → 4346 4338: 	delete $self->{'_remote_tmpdir'};
 4339: 
 4340: 	# Disconnect Redis
 4341: 	if(my $redis = delete $self->{'_redis'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4342: 		eval { $redis->quit() };
 4343: 	}
 4344: 
 4345: 	# Clean up database handles
●4346 → 4349 → 4355 4346: 	my $table_name = $self->{'table'} || ref($self);
 4347: 	$table_name =~ s/\A.*:://;
 4348: 
 4349: 	if(my $dbh = delete $self->{$table_name}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4350: 		$dbh->disconnect() if $dbh->can('disconnect');
 4351: 		$dbh->finish() if $dbh->can('finish');
 4352: 	}
 4353: 
 4354: 	# Clean up Berkeley DB
●4355 → 4355 → 4363 4355: 	if($self->{'berkeley'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4356: 		eval {
 4357: 			untie %{$self->{'berkeley'}};
 4358: 		};
 4359: 		delete $self->{'berkeley'};
 4360: 	}
 4361: 
 4362: 	# Clear all other attributes to break potential circular references
●4363 → 4363 → 0 4363: 	foreach my $key (keys %$self) {
 4364: 		delete $self->{$key};
 4365: 	}
 4366: }
 4367: 
 4368: # Build the JOIN clause(s) from a single join hashref or arrayref of hashrefs.
 4369: # Each spec needs keys: table (required), on (required), type (default INNER).
 4370: sub _build_joins
 4371: {
●4372 → 4377 → 4387 4372: 	my ($self, $join_spec) = @_;
 4373: 
 4374: 	my @specs = ref($join_spec) eq 'ARRAY' ? @{$join_spec} : ($join_spec);
 4375: 	my @clauses;
 4376: 
 4377: 	for my $j (@specs) {
 4378: 		my $type  = uc($j->{'type'}  // 'INNER');
 4379: 		my $jtable = $j->{'table'} or Carp::croak('join: missing "table"');
 4380: 		Carp::croak("join: unsafe table name '$jtable'")
 4381: 			unless $jtable =~ $SAFE_QUALIFIED;
 4382: 		my $on     = $j->{'on'}    or Carp::croak('join: missing "on" condition');
 4383: 		Carp::croak("Invalid JOIN type: $type") unless $VALID_JOIN_TYPES{$type};
 4384: 		push @clauses, "$type JOIN $jtable ON ($on)";
 4385: 	}
 4386: 
 4387: 	return join(' ', @clauses);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4388: }
 4389: 
 4390: # Infer a SQL type token from an arrayref of sample values for one column.
 4391: # Returns 'INTEGER', 'REAL', 'TIMESTAMP', 'DATE', or 'TEXT' (the default).
 4392: # undef and empty-string values are treated as NULL and skipped; a column
 4393: # whose entire sample is NULL is typed TEXT (most permissive safe default).
 4394: # Order of checks: INTEGER before REAL (integers also match REAL); TIMESTAMP
 4395: # before DATE (timestamps start like dates but have a time component).
 4396: sub _infer_type
 4397: {
 4398: 	my ($vals) = @_;
 4399: 	my @non_null = grep { defined($_) && $_ ne '' } @{$vals};
 4400: 	return 'TEXT' unless @non_null;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4401: 	return 'INTEGER'   if all { $_ =~ $INFER_INT_RE  } @non_null;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4402: 	return 'REAL'      if all { $_ =~ $INFER_REAL_RE } @non_null;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4403: 	return 'TIMESTAMP' if all { $_ =~ $INFER_TS_RE   } @non_null;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4404: 	return 'DATE'      if all { $_ =~ $INFER_DATE_RE } @non_null;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4405: 	return 'TEXT';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4406: }
 4407: 
 4408: # Merge $self->{'base_criteria'} into a caller-supplied $params hashref.
 4409: # Returns a new hashref with base_criteria keys added; caller keys WIN on collision
 4410: # so callers can always further restrict.  Returns $params unchanged when no
 4411: # base_criteria is set, avoiding an extra allocation on the common code path.
 4412: sub _merge_base_criteria :Private {
 4413: 	my ($self, $params) = @_;
 4414: 	my $bc = $self->{'base_criteria'};
 4415: 	return $params unless $bc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4416: 	return { %{$bc}, %{$params} };
 4417: }
 4418: 
 4419: # Parse a sort_by parameter value into ($col, $dir).
 4420: # Accepts: scalar column name (ASC), or [$col, $dir] arrayref.
 4421: # Validates column against $SAFE_QUALIFIED and direction as ASC/DESC.
 4422: # Carps and returns (undef, 'ASC') on invalid input so callers fall back
 4423: # to the default id-column sort.
 4424: sub _parse_sort_by
 4425: {
●4426 → 4430 → 4434 4426: 	my ($sb, $method) = @_;
 4427: 	return (undef, 'ASC') unless defined $sb;
 4428: 	my ($col, $dir) = ref($sb) eq 'ARRAY' ? @{$sb}[0, 1] : ($sb, undef);
 4429: 	$dir = defined($dir) ? uc($dir) : 'ASC';
 4430: 	unless(defined($col) && $col =~ $SAFE_QUALIFIED) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4431: 		Carp::carp("$method: unsafe sort_by column, ignoring");
 4432: 		return (undef, 'ASC');
 4433: 	}
●4434 → 4434 → 4438 4434: 	unless($dir eq 'ASC' || $dir eq 'DESC') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4435: 		Carp::carp("$method: invalid sort_by direction '$dir', ignoring");
 4436: 		return (undef, 'ASC');
 4437: 	}
 4438: 	return ($col, $dir);
 4439: }
 4440: 
 4441: # Return true when $params contains operator hashrefs, -or, or -and groupings
 4442: # that the simple slurp fast-path cannot handle.
 4443: sub _has_complex_criteria
 4444: {
 4445: 	my ($self, $params) = @_;
 4446: 	return 0 unless defined $params;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4447: 	# -or / -and keys short-circuit immediately: no value scan needed.
 4448: 	return 1 if exists $params->{'-or'} || exists $params->{'-and'};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4449: 	# LOGICAL INVARIANT: when this returns false, NO value in %$params is a
 4450: 	# reference.  This is the Boolean gate that makes _match_criterion's
 4451: 	# hashref branch provably unreachable from the public select API:
 4452: 	#   Premise A — in-memory scan path requires: !_has_complex_criteria(params)
 4453: 	#   Premise B — _has_complex_criteria returns true if any value is a ref
 4454: 	#   Conclusion — inside the in-memory scan, every crit_val is a scalar/undef
 4455: 	# any() short-circuits on the first truthy element; the for-loop equivalent
 4456: 	# would iterate through all values before returning false in the common case.
 4457: 	return (any { ref($_) } values %{$params}) ? 1 : 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4458: }
 4459: 
 4460: # Build the WHERE clause body (everything after "WHERE") from a criteria hash.
 4461: # Handles -or / -and groupings then delegates per-column work to _build_where_conditions.
 4462: # Returns ($sql_fragment, \@bind_values).
 4463: # Wrapper around Data::Reuse::fixate() that suppresses the spurious
 4464: # "Use of uninitialized value in hash slice" warning.  Data::Alias's XS
 4465: # hash-aliasing code does not fully initialise key SVs on older Perl
 4466: # versions when the source hash contains undef values (NULL columns).
 4467: # Data::Reuse still fixates correctly; the warning is a false positive.
 4468: # $struct must be the hashref or arrayref to fixate.
 4469: sub _fixate :Private
 4470: {
 4471: 	my (undef, $struct) = @_;
 4472: 	return unless defined $struct;
 4473: 	# Clear stale address→canonical mappings from prior fixate calls before
 4474: 	# fixating $struct.  Without this, freed hashref addresses from a previous
 4475: 	# object's slurp or DBI result can be reused by the allocator for new
 4476: 	# hashrefs; fixate() would then find the stale entry and alias the new
 4477: 	# hashref to the wrong canonical, silently substituting one row's data for
 4478: 	# another.  This is the same stale-address hazard that affects DBI paths
 4479: 	# (see selectall_arrayref / selectall_array) but also affects the slurp
 4480: 	# fixate when earlier objects go out of scope before a new slurp runs.
 4481: 	Data::Reuse::forget();
 4482: 	# Suppress the benign "Use of uninitialized value in hash slice" warning
 4483: 	# that Data::Reuse/Data::Alias emits on some Perl < 5.34 builds when a
 4484: 	# row has undef columns.  All other warnings are re-emitted verbatim so
 4485: 	# unrelated problems remain visible.  This is intentional, not debug code.
 4486: 	local $SIG{__WARN__} = sub {
 4487: 		warn @_ unless
 4488: 			index($_[0], 'Use of uninitialized value') == 0
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4489: 			&& index($_[0], 'in hash slice') >= 0;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 4490: 	};
 4491: 	&Data::Reuse::fixate($struct);
 4492: }
 4493: 
 4494: sub _build_where
 4495: {
●4496 → 4509 → 4517 4496: 	my ($self, $params) = @_;
 4497: 
 4498: 	$params //= {};
 4499: 	my @clauses;
 4500: 	my @args;
 4501: 
 4502: 	# Avoid an O(K) hash copy in the common case where neither -or nor -and is
 4503: 	# present.  Only copy when we actually need to delete grouping keys, so the
 4504: 	# plain-criteria path (the vast majority of queries) passes $params through
 4505: 	# directly to _build_where_conditions without any allocation.
 4506: 	my $or_list  = $params->{'-or'};
 4507: 	my $and_list = $params->{'-and'};
 4508: 	my $plain;
 4509: 	if(defined($or_list) || defined($and_list)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4510: 		my %p = %{$params};
 4511: 		delete @p{qw(-or -and)};
 4512: 		$plain = \%p;
 4513: 	} else {
 4514: 		$plain = $params;
 4515: 	}
 4516: 
●4517 → 4517 → 4531 4517: 	if($or_list) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4518: 		my (@sub_clauses, @sub_args);
 4519: 		for my $cond (@{$or_list}) {
 4520: 			my ($s, $a) = $self->_build_where_conditions($cond);
 4521: 			if($s) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4522: 				push @sub_clauses, "($s)";
 4523: 				push @sub_args, @{$a};
 4524: 			}
 4525: 		}
 4526: 		if(@sub_clauses) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4527: 			push @clauses, '(' . join(' OR ', @sub_clauses) . ')';
 4528: 			push @args, @sub_args;
 4529: 		}
 4530: 	}
●4531 → 4531 → 4546 4531: 	if($and_list) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4532: 		my (@sub_clauses, @sub_args);
 4533: 		for my $cond (@{$and_list}) {
 4534: 			my ($s, $a) = $self->_build_where_conditions($cond);
 4535: 			if($s) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4536: 				push @sub_clauses, "($s)";
 4537: 				push @sub_args, @{$a};
 4538: 			}
 4539: 		}
 4540: 		if(@sub_clauses) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4541: 			push @clauses, '(' . join(' AND ', @sub_clauses) . ')';
 4542: 			push @args, @sub_args;
 4543: 		}
 4544: 	}
 4545: 
●4546 → 4547 → 4552 4546: 	my ($more, $margs) = $self->_build_where_conditions($plain);
 4547: 	if($more) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4548: 		push @clauses, $more;
 4549: 		push @args, @{$margs};
 4550: 	}
 4551: 
 4552: 	return (join(' AND ', @clauses), \@args);
 4553: }
 4554: 
 4555: # Build a WHERE-body fragment for a flat col => val hash.
 4556: # Values may be plain scalars (= / LIKE / IS NULL) or operator hashrefs
 4557: # ({ '>' => n }, { -in => [...] }, { -between => [lo,hi] }, etc.).
 4558: sub _build_where_conditions
 4559: {
●4560 → 4565 → 4618 4560: 	my ($self, $params) = @_;
 4561: 
 4562: 	my @clauses;
 4563: 	my @args;
 4564: 
 4565: 	for my $col (sort keys %{$params}) {
 4566: 		my $val = $params->{$col};
 4567: 
 4568: 		# Guard against SQL injection via column names; allow table.column notation for JOINs
 4569: 		Carp::croak("_build_where_conditions: unsafe column name '$col'")
 4570: 			unless $col =~ $SAFE_QUALIFIED;
 4571: 
 4572: 		if(ref($val) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4573: 			for my $op (keys %{$val}) {    # no sort — operator hashes typically have 1-2 keys; sort adds O(K log K) overhead
 4574: 				my $operand = $val->{$op};
 4575: 				if($op eq '-in' || $op eq '-not_in') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4576: 					my $sql_op = $op eq '-in' ? 'IN' : 'NOT IN';
 4577: 					my $ph = join(', ', ('?') x scalar(@{$operand}));
 4578: 					push @clauses, "$col $sql_op ($ph)";
 4579: 					push @args, @{$operand};
 4580: 				} elsif($op eq '-between') {
 4581: 					push @clauses, "$col BETWEEN ? AND ?";
 4582: 					push @args, $operand->[0], $operand->[1];
 4583: 				} elsif($op eq '-like') {
 4584: 					push @clauses, "$col LIKE ?";
 4585: 					push @args, $operand;
 4586: 				} elsif($op eq '-not_like') {
 4587: 					push @clauses, "$col NOT LIKE ?";
 4588: 					push @args, $operand;
 4589: 				} elsif($op eq '!=') {
 4590: 					if(!defined($operand)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4591: 						push @clauses, "$col IS NOT NULL";
 4592: 					} else {
 4593: 						push @clauses, "$col != ?";
 4594: 						push @args, $operand;
 4595: 					}
 4596: 				# [<>]=? matches >, <, >=, <= as a single character class — no alternation
 4597: 				# overhead, no backtracking, and self-documenting.
 4598: 				} elsif($op =~ /\A[<>]=?\z/) {
 4599: 					push @clauses, "$col $op ?";
 4600: 					push @args, $operand;
 4601: 				} else {
 4602: 					Carp::croak("Unknown operator '$op' for column '$col'");
 4603: 				}
 4604: 			}
 4605: 		} elsif(ref($val)) {
 4606: 			Carp::croak("$col: expected scalar or operator hashref, got ", ref($val));
 4607: 		} elsif(!defined($val)) {
 4608: 			push @clauses, "$col IS NULL";
 4609: 		} elsif($val =~ /[%_]/) {
 4610: 			push @clauses, "$col LIKE ?";
 4611: 			push @args, $val;
 4612: 		} else {
 4613: 			push @clauses, "$col = ?";
 4614: 			push @args, $val;
 4615: 		}
 4616: 	}
 4617: 
 4618: 	return (join(' AND ', @clauses), \@args);
 4619: }
 4620: 
 4621: # Test a single in-memory row value against a criteria value.
 4622: # $crit_val may be a plain scalar or an operator hashref.
 4623: # Returns true when the row value satisfies the criterion.
 4624: # Scan the entire BerkeleyDB tied hash, building rows as {entry=>$k, value=>$v},
 4625: # and filter by $params criteria using _match_criterion.
 4626: # Croaks when JOINs or -or/-and groupings are requested (unsupported for key-value stores).
 4627: sub _scan_berkeley
 4628: {
●4629 → 4637 → 4642 4629: 	my ($self, $params) = @_;
 4630: 	$params //= {};
 4631: 
 4632: 	# TODO: Data Flow Anomaly - Mutation side effect: delete mutates the caller's
 4633: 	# $params hashref in-place.  All current callers (selectall_arrayref,
 4634: 	# selectall_array, count) do not reuse $params after this call, so it is safe;
 4635: 	# but a future caller that reuses $params would silently lose the 'join' key.
 4636: 	# Fix: use exists($params->{'join'}) to check; copy params before deleting.
 4637: 	if(delete $params->{'join'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4638: 		Carp::croak(ref($self), ': BerkeleyDB does not support JOINs');
 4639: 	}
 4640: 	# any() short-circuits: once the first -or/-and key is found the croak fires
 4641: 	# without scanning the remaining keys — O(1) best case vs O(K) for grep.
●4642 → 4642 → 4646 4642: 	if(any { $_ eq '-or' || $_ eq '-and' } keys %{$params}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4643: 		Carp::croak(ref($self), ': BerkeleyDB does not support -or/-and groupings');
 4644: 	}
 4645: 
●4646 → 4650 → 4668 4646: 	my $bdb = $self->{'berkeley'};
 4647: 	my @cols = keys %{$params};
 4648: 	my @rows;
 4649: 
 4650: 	if(@cols) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4651: 		# Single-pass build+filter: avoids materialising the full N-row list
 4652: 		# before filtering.  Peak memory is O(matching rows) instead of O(N).
 4653: 		for my $k (keys %{$bdb}) {
 4654: 			my $row = { entry => $k, value => $bdb->{$k} };
 4655: 			my $match = 1;
 4656: 			for my $col (@cols) {
 4657: 				unless($self->_match_criterion($row->{$col}, $params->{$col}, $col)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4658: 					$match = 0;
 4659: 					last;
 4660: 				}
 4661: 			}
 4662: 			push @rows, $row if $match;
 4663: 		}
 4664: 	} else {
 4665: 		@rows = map { { entry => $_, value => $bdb->{$_} } } keys %{$bdb};
 4666: 	}
 4667: 
 4668: 	return \@rows;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4669: }
 4670: 
 4671: # SQL LIKE match — case-insensitive, ReDoS-safe, no catastrophic backtracking.
 4672: # % matches any sequence of chars; _ matches exactly one char.
 4673: #
 4674: # Fast paths cover the four most common LIKE shapes using O(1) string ops:
 4675: #   '%'        → always true
 4676: #   no wildcard → lc eq comparison
 4677: #   '%suffix'  → ends-with check via substr
 4678: #   'prefix%'  → starts-with check via index
 4679: #   '%mid%'    → contains check via index  (single inner literal, no _ wildcards)
 4680: #
 4681: # Full DP uses O(m) memory (two 1-D rolling arrays) instead of the O(m*n) 2-D
 4682: # table the naive approach allocates.  Character access uses substr() instead of
 4683: # split(//) so no per-character scalar objects are created.
 4684: sub _like_match
 4685: {
●4686 → 4702 → 4737 4686: 	my ($str, $pattern) = @_;
 4687: 
 4688: 	# Fast path 1: bare '%' — matches any string regardless of content.
 4689: 	return 1 if $pattern eq '%';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4690: 
 4691: 	my $lc_str = lc($str);
 4692: 	my $lc_pat = lc($pattern);
 4693: 	my $pat_len = length($lc_pat);
 4694: 	my $str_len = length($lc_str);
 4695: 
 4696: 	# Fast path 2: no wildcard characters — plain case-insensitive equality.
 4697: 	return ($lc_str eq $lc_pat)
 4698: 		if index($lc_pat, '%') == -1 && index($lc_pat, '_') == -1;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4699: 
 4700: 	# Fast paths 3-5 apply only when the pattern has no '_' wildcards.
 4701: 	# (Patterns with '_' need per-character DP to enforce the single-char rule.)
 4702: 	if(index($lc_pat, '_') == -1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4703: 		my $first_pct = index($lc_pat, '%');
 4704: 		my $last_pct  = rindex($lc_pat, '%');
 4705: 
 4706: 		# Fast path 3: '%suffix' — exactly one '%', at the start.
 4707: 		if($first_pct == 0 && $last_pct == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4708: 			my $sfx = substr($lc_pat, 1);
 4709: 			my $sfx_len = length($sfx);
 4710: 			return $str_len >= $sfx_len

					

					
Mutants (Total: 5, Killed: 2, Survived: 3)
					

				
NUM_BOUNDARY_4710_20_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4710_20_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_4710_20_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 4711: 				&& substr($lc_str, $str_len - $sfx_len) eq $sfx;
 4712: 		}
 4713: 
 4714: 		# Fast path 4: 'prefix%' — exactly one '%', at the end.
 4715: 		if($last_pct == $pat_len - 1 && $first_pct == $pat_len - 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4716: 			my $pfx = substr($lc_pat, 0, $pat_len - 1);
 4717: 			return index($lc_str, $pfx) == 0;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 4718: 		}
 4719: 
 4720: 		# Fast path 5: '%literal%' — '%' at both ends, no inner '%'.
 4721: 		# pat_len >= 3 ensures there are two distinct '%' characters.
 4722: 		# Only return here when the middle segment is free of further wildcards;
 4723: 		# if it contains '%' (e.g. '%a%b%'), fall through to the full DP.
 4724: 		if($first_pct == 0 && $last_pct == $pat_len - 1 && $pat_len >= 3) {
  Mutants (Total: 5, Killed: 5, Survived: 0)
 4725: 			my $needle = substr($lc_pat, 1, $pat_len - 2);
 4726: 			if(index($needle, '%') == -1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4727: 				return index($lc_str, $needle) >= 0;
  Mutants (Total: 5, Killed: 5, Survived: 0)
 4728: 			}
 4729: 		}
 4730: 	}
 4731: 
 4732: 	# Full DP — O(m*n) time, O(m) memory.
 4733: 	# Two 1-D arrayrefs (@$prev, @$curr) replace the O(m*n) 2-D table.
 4734: 	# substr() replaces split(//) — no per-char scalar allocation.
 4735: 	# Ref-swap ($prev,$curr) = ($curr,$prev) at the end of each outer iteration
 4736: 	# avoids the O(m) array copy that "@prev = @curr" would perform.
●4737 → 4742 → 4758 4737: 	my $m = $str_len;
 4738: 	my $n = $pat_len;
 4739: 
 4740: 	my ($prev, $curr) = ([1, (0) x $m], [(0) x ($m + 1)]);
 4741: 
 4742: 	for my $i (1 .. $n) {
 4743: 		@{$curr} = (0) x ($m + 1);    # zero in-place — reuses existing allocation
 4744: 		my $pc = substr($lc_pat, $i - 1, 1);
 4745: 		if($pc eq '%') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4746: 			$curr->[0] = $prev->[0];
 4747: 			for my $j (1 .. $m) {
 4748: 				$curr->[$j] = ($prev->[$j] || $curr->[$j - 1]) ? 1 : 0;
 4749: 			}
 4750: 		} else {
 4751: 			for my $j (1 .. $m) {
 4752: 				$curr->[$j] = ($prev->[$j - 1]
 4753: 					&& ($pc eq '_' || $pc eq substr($lc_str, $j - 1, 1))) ? 1 : 0;
 4754: 			}
 4755: 		}
 4756: 		($prev, $curr) = ($curr, $prev);    # O(1) ref swap — no array copy
 4757: 	}
 4758: 	return $prev->[$m];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4759: }
 4760: 
 4761: sub _match_criterion
 4762: {
●4763 → 4774 → 4816 4763: 	my ($self, $row_val, $crit_val, $col) = @_;
 4764: 
 4765: 	# Use numeric equality/membership operators when the schema (if already
 4766: 	# cached) reports the column as INTEGER or REAL.  The numeric ordering
 4767: 	# operators (>, <, >=, <=, -between) already use Perl's numeric context
 4768: 	# regardless; only equality-family operators need the type-aware path.
 4769: 	my $numeric = ($col && $self->{'_schema'})
 4770: 		? do { my $t = ($self->{'_schema'}{$col} // {})->{'type'} // 'TEXT';
 4771: 		       $t eq 'INTEGER' || $t eq 'REAL' }
 4772: 		: 0;
 4773: 
 4774: 	if(ref($crit_val) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4775: 		for my $op (keys %{$crit_val}) {
 4776: 			my $operand = $crit_val->{$op};
 4777: 			if($op eq '-in') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4778: 				return 0 unless defined($row_val)
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4779: 					&& ($numeric
 4780: 						? grep { $row_val == $_ } @{$operand}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4781: 						: grep { $row_val eq $_ } @{$operand});
 4782: 			} elsif($op eq '-not_in') {
 4783: 				return 0 if defined($row_val)
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4784: 					&& ($numeric
 4785: 						? grep { $row_val == $_ } @{$operand}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4786: 						: grep { $row_val eq $_ } @{$operand});
 4787: 			} elsif($op eq '-between') {
 4788: 				return 0 unless defined($row_val) && $row_val >= $operand->[0] && $row_val <= $operand->[1];
  Mutants (Total: 8, Killed: 8, Survived: 0)
 4789: 			} elsif($op eq '-like') {
 4790: 				return 0 unless defined($row_val);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4791: 				return 0 unless _like_match($row_val, $operand);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4792: 			} elsif($op eq '-not_like') {
 4793: 				return 0 unless defined($row_val);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4794: 				return 0 if _like_match($row_val, $operand);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4795: 			} elsif($op eq '!=') {
 4796: 				if(!defined($operand)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4797: 					return 0 unless defined($row_val);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4798: 				} elsif($numeric) {
 4799: 					return 0 unless defined($row_val) && $row_val != $operand;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 4800: 				} else {
 4801: 					return 0 unless defined($row_val) && $row_val ne $operand;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4802: 				}
 4803: 			} elsif($op eq '>') {
 4804: 				return 0 unless defined($row_val) && $row_val > $operand;
  Mutants (Total: 5, Killed: 5, Survived: 0)
 4805: 			} elsif($op eq '<') {
 4806: 				return 0 unless defined($row_val) && $row_val < $operand;
  Mutants (Total: 5, Killed: 5, Survived: 0)
 4807: 			} elsif($op eq '>=') {
 4808: 				return 0 unless defined($row_val) && $row_val >= $operand;
  Mutants (Total: 5, Killed: 5, Survived: 0)
 4809: 			} elsif($op eq '<=') {
 4810: 				return 0 unless defined($row_val) && $row_val <= $operand;
  Mutants (Total: 5, Killed: 5, Survived: 0)
 4811: 			}
 4812: 		}
 4813: 		return 1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4814: 	}
 4815: 
 4816: 	return !defined($row_val) && !defined($crit_val) ? 1
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4817: 		: !defined($row_val) || !defined($crit_val) ? 0
 4818: 		: $numeric ? $row_val == $crit_val
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4819: 		: $row_val eq $crit_val;
 4820: }
 4821: 
 4822: # Determine the table and open the database
 4823: sub _open_table
 4824: {
●4825 → 4831 → 4846 4825: 	my($self, $params) = @_;
 4826: 
 4827: 	# Derive the table name, caching the result in '_table_name' for the common
 4828: 	# case of no caller-supplied 'table' override.  Avoids repeating ref()+regex
 4829: 	# on every query when the same object makes many calls.
 4830: 	my $table;
 4831: 	if($params->{'table'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4832: 		($table = $params->{'table'}) =~ s/\A.*:://;
 4833: 		Carp::croak(ref($self), ": unsafe table name '$table'")
 4834: 			unless $table =~ $SAFE_QUALIFIED;
 4835: 	} else {
 4836: 		$table = $self->{'_table_name'} //= do {
 4837: 			my $t = $self->{'table'} || ref($self);
 4838: 			$t =~ s/\A.*:://;
 4839: 			$t;
 4840: 		};
 4841: 	}
 4842: 
 4843: 	# Open a connection if it's not already open.
 4844: 	# BerkeleyDB never sets $self->{$table} (no DBI handle) or $self->{'data'},
 4845: 	# so we also guard on $self->{'berkeley'} to avoid re-tying on every call.
 4846: 	$self->_open() if(!$self->{$table} && !$self->{'data'} && !$self->{'berkeley'});
 4847: 
 4848: 	return $table;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4849: }
 4850: 
 4851: # Quote a SQL identifier using the current connection's dialect rules.
 4852: # Falls back to ANSI double-quoting when no connection is available.
 4853: sub _quote_identifier
 4854: {
●4855 → 4859 → 4862 4855: 	my ($self, $name) = @_;
 4856: 
 4857: 	my $table = $self->{'table'} || ref($self);
 4858: 	$table =~ s/\A.*:://;
 4859: 	if(my $dbh = $self->{$table}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4860: 		return $dbh->quote_identifier($name);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4861: 	}
 4862: 	return qq{"$name"};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4863: }
 4864: 
 4865: # Determine whether a given file is a valid Berkeley DB file.
 4866: # It combines a fast preliminary check with a more thorough validation step for accuracy.
 4867: # It looks for the magic number at both byte 0 and byte 12.
 4868: sub _is_berkeley_db {
●4869 → 4880 → 4892 4869: 	my ($self, $file) = @_;
 4870: 
 4871: 	# Step 1: Check magic number
 4872: 	# no autodie here: the file may not exist, and we want a silent false return
 4873: 	my $fh;
 4874: 	do { no autodie qw(open); open $fh, '<', $file } or return 0;
 4875: 	binmode $fh;
 4876: 
 4877: 	my $is_db = $self->_has_bdb_magic($fh);
 4878: 	close $fh;
 4879: 
 4880: 	if($is_db) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4881: 		# Step 2: Attempt to open as Berkeley DB
 4882: 
 4883: 		require DB_File;
 4884: 
 4885: 		my %bdb;
 4886: 		if(tie %bdb, 'DB_File', $file, O_RDONLY, 0644, $DB_File::DB_HASH) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4887: 			# untie %db;
 4888: 			$self->{'berkeley'} = \%bdb;
 4889: 			return 1;	# Successfully identified as a Berkeley DB file
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4890: 		}
 4891: 	}
 4892: 	return 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4893: }
 4894: 
 4895: # Check for Berkeley DB magic bytes at offsets 0 and 12.
 4896: # Returns true if either location contains a recognised BDB magic number.
 4897: sub _has_bdb_magic {
 4898: 	my ($self, $fh) = @_;
 4899: 
 4900: 	# Offset 0: 32-bit magic number in both endian forms
 4901: 	read($fh, my $buf, 4) == 4 or return 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4902: 	my %magic = map { $_ => 1 } (0x00061561, 0x00053162, 0x00042253, 0x00052444);
 4903: 	return 1 if $magic{unpack('N', $buf)} || $magic{unpack('V', $buf)};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4904: 
 4905: 	# Offset 12: Btree magic prefix (fallback for some BDB file variants)
 4906: 	seek $fh, 12, 0 or return 0;
 4907: 	read($fh, $buf, 4) or return 0;
 4908: 	my $hex12 = substr(unpack('H*', $buf), 0, 4);
 4909: 	return($hex12 eq '6115' || $hex12 eq '1561');
 4910: }
 4911: 
 4912: # Return true if $host refers to the current machine (localhost, loopback, or
 4913: # the machine's own hostname).  Strips an optional user@ prefix first.
 4914: # Used by new() and _open() to decide whether to use local file access instead
 4915: # of File::Slurp::Remote, so the caller never loads that module unnecessarily.
 4916: sub _is_local_host {
 4917: 	my ($self, $host) = @_;
 4918: 
 4919: 	# Strip optional user@ prefix.  \A (not ^) so a newline cannot split the match.
 4920: 	(my $bare = $host) =~ s/\A[^@]*@//;
 4921: 
 4922: 	# \z anchors at true end-of-string; $ would match before a trailing newline.
 4923: 	return 1 if $bare =~ /\A(?:localhost|127\.0\.0\.1|::1)\z/i;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4924: 
 4925: 	require Sys::Hostname;
 4926: 	my $me = lc(Sys::Hostname::hostname());
 4927: 	my $lc_bare = lc($bare);
 4928: 	return 1 if $lc_bare eq $me;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 4929: 
 4930: 	# Match on short hostname: 'mybox' matches 'mybox.example.com' and vice-versa
 4931: 	(my $me_short   = $me)      =~ s/\..*//;
 4932: 	(my $bare_short = $lc_bare) =~ s/\..*//;
 4933: 	return($bare_short eq $me_short);
 4934: }
 4935: 
 4936: # Determine whether a given file is a DBM::Deep file by checking its magic bytes.
 4937: # The standard DBM::Deep magic is 'DPDB' (0x44 0x50 0x44 0x42); 'DPDP' (0x44 0x50 0x44 0x50)
 4938: # is also accepted for compatibility with files created by alternative tooling.
 4939: # Returns 1 if the first 4 bytes match a known DBM::Deep signature, 0 otherwise.
 4940: sub _is_deep_db {
 4941: 	my ($self, $file) = @_;
 4942: 
 4943: 	my $fh;
 4944: 	do { no autodie qw(open); open $fh, '<', $file } or return 0;
 4945: 	binmode $fh;
 4946: 	my $n = read($fh, my $magic, 4);
 4947: 	close $fh;
 4948: 	return 0 unless defined($n) && $n == 4;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 4949: 
 4950: 	return($magic eq 'DPDB' || $magic eq 'DPDP');
 4951: }
 4952: 
 4953: # Log and remember a message
 4954: sub _log
 4955: {
●4956 → 4963 → 0 4956: 	my ($self, $level, @messages) = @_;
 4957: 
 4958: 	# FIXME: add caller's function
 4959: 	# if(($level eq 'warn') || ($level eq 'notice')) {
 4960: 		push @{$self->{'messages'}}, { level => $level, message => join('', grep defined, @messages) };
 4961: 	# }
 4962: 
 4963: 	if(scalar(@messages) && (my $logger = $self->{'logger'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 4964: 		$self->{'logger'}->$level(join('', grep defined, @messages));
 4965: 	}
 4966: }
 4967: 
 4968: sub _debug {
 4969: 	my $self = shift;
 4970: 	$self->_log('debug', @_);
 4971: }
 4972: 
 4973: sub _trace {
 4974: 	my $self = shift;
 4975: 	$self->_log('trace', @_);
 4976: }
 4977: 
 4978: # Emit a warning message somewhere
 4979: sub _warn {
 4980: 	my $self = shift;
 4981: 	my $params = Params::Get::get_params('warning', \@_);
 4982: 
 4983: 	$self->_log('warn', $params->{'warning'});
 4984: 	Carp::carp(join('', grep defined, $params->{'warning'}));
 4985: }
 4986: 
 4987: # Die
 4988: sub _fatal {
 4989: 	my $self = shift;
 4990: 	my $params = Params::Get::get_params('warning', \@_);
 4991: 
 4992: 	$self->_log('error', $params->{'warning'});
 4993: 	Carp::croak(join('', grep defined, $params->{'warning'}));
 4994: }
 4995: 
 4996: =head1 AUTHOR
 4997: 
 4998: Nigel Horne, C<< <njh at nigelhorne.com> >>
 4999: 
 5000: =head1 SUPPORT
 5001: 
 5002: This module is provided as-is without any warranty.
 5003: 
 5004: Please report any bugs or feature requests to C<bug-database-abstraction at rt.cpan.org>,
 5005: or through the web interface at
 5006: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Database-Abstraction>.
 5007: I will be notified, and then you'll
 5008: automatically be notified of progress on your bug as I make changes.
 5009: 
 5010: =head1 MESSAGES
 5011: 
 5012: The table below lists every error that the module can croak or carp, what
 5013: triggers it, and how to resolve it.
 5014: 
 5015: =over 4
 5016: 
 5017: =item C<< I<Class>: abstract class >>
 5018: 
 5019: Direct instantiation of C<Database::Abstraction> was attempted.
 5020: Create a subclass and instantiate that instead.
 5021: 
 5022: =item C<< I<Class>: where are the files? >>
 5023: 
 5024: Neither C<directory> nor C<dsn> was supplied to C<new()>.
 5025: 
 5026: =item C<< I<Class>: I</path> is not a directory >>
 5027: 
 5028: The C<directory> argument exists on disk but is not a directory.
 5029: 
 5030: =item C<< I<Class>: cannot connect: I<$DBI::errstr> >>
 5031: 
 5032: DBI failed to connect to the given C<dsn>.  Check credentials and host.
 5033: 
 5034: =item C<< Can't find a file called 'I<name>' for the table I<T> in I<dir> >>
 5035: 
 5036: None of the probe extensions (C<.sql>, C<.sqlite>, C<.sqlite3>, C<.psv>, C<.tsv>, C<.csv>, C<.xlsx>, C<.db>, C<.xml>)
 5037: matched in C<directory>.
 5038: 
 5039: =item C<< I<Class>: prepare failed: I<$errstr> >>
 5040: 
 5041: C<prepare_cached()> returned false.  Usually a syntax error in an internally
 5042: built query; file a bug if you see this from a normal API call.
 5043: 
 5044: =item C<< _build_where_conditions: unsafe column name 'I<name>' >>
 5045: 
 5046: A criteria key contained characters outside C<[A-Za-z0-9_.]>.
 5047: This is a SQL-injection guard.  Use only valid SQL identifier characters.
 5048: 
 5049: =item C<< join: missing "table" >> / C<< join: missing "on" condition >>
 5050: 
 5051: A join spec hashref is incomplete.  Both C<table> and C<on> are required.
 5052: 
 5053: =item C<< Invalid JOIN type: I<TYPE> >>
 5054: 
 5055: C<type> in a join spec was not one of C<INNER LEFT RIGHT FULL CROSS>.
 5056: 
 5057: =item C<< I<Class>: Unknown column I<col> >> / C<< I<Class>: AUTOLOAD disabled >>
 5058: 
 5059: An AUTOLOAD call was made for a column that does not exist, or AUTOLOAD
 5060: was disabled with C<< auto_load => 0 >>.
 5061: 
 5062: =item C<< Usage: set_logger(logger => $logger) >>
 5063: 
 5064: C<set_logger()> was called without a C<logger> argument.
 5065: 
 5066: =item C<< Usage: execute(query => $query) >>
 5067: 
 5068: C<execute()> was called without a C<query> argument.
 5069: 
 5070: =item C<< XML slurp: I<...> is not yet supported >>
 5071: 
 5072: The XML file structure is too complex for slurp mode.
 5073: Use C<< max_slurp_size => 0 >> to force the DBI/XMLSimple SQL path.
 5074: 
 5075: =item C<< I<Class>: I<method> is meaningless on a NoSQL database >>
 5076: 
 5077: A relational method (C<selectall_arrayref>, C<count>, C<execute>, etc.)
 5078: was called on a BerkeleyDB backend, which only supports key-value lookup
 5079: via C<fetchrow_hashref>.
 5080: 
 5081: =item C<< I<Class>: aggregate: 'measures' must be a non-empty arrayref >>
 5082: 
 5083: C<aggregate()> was called without a C<measures> arrayref, or with an empty one.
 5084: 
 5085: =item C<< I<Class>: aggregate: measure must be a hashref, got I<ref> >>
 5086: 
 5087: An element of the C<measures> arrayref is not a hashref.
 5088: 
 5089: =item C<< I<Class>: aggregate: unknown measure function 'I<fn>' >>
 5090: 
 5091: C<fn> must be one of C<sum>, C<avg>, C<min>, C<max>, C<count>, C<count_distinct>,
 5092: C<median>, C<stddev>.
 5093: 
 5094: =item C<< I<Class>: aggregate: measure column is required for function 'I<fn>' >>
 5095: 
 5096: C<col> was omitted for a function that requires it.  Only plain C<count> (COUNT(*)) accepts a missing C<col>.
 5097: 
 5098: =item C<< I<Class>: aggregate: unsafe measure column 'I<col>' >>
 5099: 
 5100: The C<col> value is not a valid SQL identifier.
 5101: 
 5102: =item C<< I<Class>: aggregate: measure 'as' is required >>
 5103: 
 5104: The C<as> alias was missing from a measure hashref.
 5105: 
 5106: =item C<< I<Class>: aggregate: unsafe measure alias 'I<as>' >>
 5107: 
 5108: The C<as> value is not a valid SQL identifier.
 5109: 
 5110: =item C<< I<Class>: aggregate: duplicate measure alias 'I<as>' >>
 5111: 
 5112: Two measure hashrefs share the same C<as> alias.
 5113: 
 5114: =item C<< I<Class>: aggregate: measure alias 'I<as>' collides with a group-by column >>
 5115: 
 5116: A measure alias duplicates a name in the C<by> list.
 5117: 
 5118: =item C<< I<Class>: aggregate: 'by' must be an arrayref of column names >>
 5119: 
 5120: The C<by> parameter was not an arrayref.
 5121: 
 5122: =item C<< I<Class>: aggregate: unsafe group-by column 'I<col>' >>
 5123: 
 5124: A C<by> element is not a valid SQL identifier.
 5125: 
 5126: =item C<< I<Class>: aggregate: having key 'I<key>' is not a group-by column or measure alias >>
 5127: 
 5128: A C<having> key does not match any C<by> column name or measure C<as> alias.
 5129: 
 5130: =item C<< I<Class>: aggregate: sort_by names 'I<name>', which is not a group-by column or measure alias >>
 5131: 
 5132: The C<sort_by> column is not one of the C<by> columns or measure aliases.
 5133: 
 5134: =item C<< I<Class>: aggregate: cannot aggregate a JOIN on the I<backend> backend >>
 5135: 
 5136: C<join> was passed to C<aggregate()> on a slurp-only backend that has no DBI handle.
 5137: 
 5138: =item C<< Database::Abstraction::Query: count() is not available once measure() has been called >>
 5139: 
 5140: C<count()> was called on a query builder that has measures set.  Use C<all()> and check C<scalar @{$rows}>.
 5141: 
 5142: =back
 5143: 
 5144: =head1 COMMON PITFALLS
 5145: 
 5146: The following mistakes cause unexpected behaviour in common usage.
 5147: Read this section before filing a bug report.
 5148: 
 5149: =over 4
 5150: 
 5151: =item B<Default CSV separator is C<!>, not C<,>>
 5152: 
 5153: For historical reasons the module defaults to bang (C<!>) as the
 5154: field separator for CSV files.  Standard RFC 4180 comma-separated
 5155: files require you to pass C<< sep_char => ',' >> in your subclass
 5156: constructor.
 5157: 
 5158:     sub new {
 5159:         my ($class, %args) = @_;
 5160:         return $class->SUPER::new(sep_char => ',', %args);
 5161:     }
 5162: 
 5163: =item B<Primary key column is named C<entry>, not C<key>>
 5164: 
 5165: The default primary-key column name is C<entry> because C<key> is
 5166: a reserved word in SQL.  If your data uses a different column name
 5167: (e.g. C<id>, C<customer_id>), pass C<< id => 'customer_id' >> to
 5168: C<new()>.
 5169: 
 5170: =item B<Duplicate primary keys silently overwrite earlier rows>
 5171: 
 5172: In slurp mode the entire data file is loaded into a Perl hash keyed
 5173: by the C<entry> column.  If two rows share the same key value the
 5174: second row replaces the first.  To keep duplicates either disable
 5175: slurp with C<< max_slurp_size => 0 >> or switch to a C<no_entry>
 5176: schema.
 5177: 
 5178: =item B<Operator-hash criteria do not work on no-DBI backends>
 5179: 
 5180: No-DBI backends (XLSX, DBM::Deep, JSON, HTML URL, Redis) have no SQL
 5181: engine.  Criteria that use operator hashes (e.g.
 5182: C<< score => { '>=' => 80 } >>) trigger the SQL path and will croak
 5183: with a "meaningless on a NoSQL database" error.  Use simple scalar
 5184: criteria (C<< score => 80 >>) on these backends.
 5185: 
 5186: =item B<Read-only results: do not modify returned hashrefs>
 5187: 
 5188: Unless you pass C<< no_fixate => 1 >>, every hashref returned by
 5189: C<selectall_arrayref>, C<fetchrow_hashref>, and similar methods is
 5190: made read-only by C<Data::Reuse>.  Attempting to assign a value to
 5191: a key in the returned hashref will throw an exception.  If you need
 5192: to modify a row, either copy it first (C<my %row = %{$orig_row}>) or
 5193: construct the object with C<< no_fixate => 1 >>.
 5194: 
 5195: =item B<C<where()> calls in the query builder use AND semantics>
 5196: 
 5197: Each call to C<< $q->where(...) >> adds an additional required
 5198: condition.  Two separate C<where()> calls do NOT produce OR
 5199: semantics.  To express OR, pass C<< -or => [...] >> inside a single
 5200: C<where()> call:
 5201: 
 5202:     # Wrong: this is AND, not OR
 5203:     $q->where(status => 'active')->where(status => 'pending');
 5204: 
 5205:     # Correct: OR grouping inside one where() call
 5206:     $q->where(-or => [{ status => 'active' }, { status => 'pending' }]);
 5207: 
 5208: =item B<C<aggregate()> C<sort_by> must name a grouped or aliased column>
 5209: 
 5210: The C<sort_by> parameter for C<aggregate()> only accepts column names
 5211: from the C<by> list or measure C<as> aliases.  You cannot sort
 5212: aggregate results by a raw data column that is not part of the group.
 5213: This restriction applies equally to the C<< ->order_by() >> call on a
 5214: query builder that has C<measure()> methods set.
 5215: 
 5216: =item B<C<sort_by> is not an argument to the query builder's C<all()>>
 5217: 
 5218: When using the fluent query builder to build an aggregate query, set
 5219: the sort column via C<< ->order_by('col') >> before calling
 5220: C<< ->all() >>.  Passing C<< ->all(sort_by => 'col') >> has no
 5221: effect because the C<all()> terminal method ignores extra arguments.
 5222: 
 5223: =item B<C<Params::Get> positional mapping with C<no_entry = 0>>
 5224: 
 5225: When C<no_entry> is false (the default), the first positional argument
 5226: to C<selectall_arrayref> and C<fetchrow_hashref> is silently mapped to
 5227: the C<entry> key.  Passing an operator-hash criteria in that position
 5228: (e.g. C<selectall_arrayref(status => { '!=' => 'x' })>) causes
 5229: C<status> to be treated as the entry value rather than a column name,
 5230: which will produce wrong results.  Always pass a hashref of criteria
 5231: as a single reference, or use C<no_entry => 1> in your subclass.
 5232: 
 5233: =back
 5234: 
 5235: =head1 ENCODING
 5236: 
 5237: =over 4
 5238: 
 5239: =item B<Column names> must match the pattern C<[a-zA-Z_][a-zA-Z0-9_.]*>.
 5240: Only ASCII letters, digits, underscores, and dots (for qualified names
 5241: such as C<table.column>) are accepted.  Non-ASCII Unicode characters
 5242: in column names will cause a croak with an "unsafe column name" error.
 5243: 
 5244: =item B<Column values> (data stored in your rows) are passed through
 5245: unchanged.  Full UTF-8 strings, emoji, and any valid Perl string are
 5246: safe as values in criteria and are stored and returned as-is.  The
 5247: exact encoding depends on your backend:
 5248: 
 5249: =over 4
 5250: 
 5251: =item * B<SQLite / DBI backends> -- DBD::SQLite stores strings as
 5252: UTF-8 internally.  Enable C<< sqlite_unicode => 1 >> in your DSN
 5253: or connect attributes if you want Perl to receive decoded Unicode
 5254: scalars rather than raw UTF-8 bytes.
 5255: 
 5256: =item * B<CSV / PSV / TSV> -- Text::CSV and DBD::CSV pass bytes
 5257: through unchanged.  If your file is UTF-8-encoded, strings are
 5258: returned as UTF-8 byte strings.  You may need to decode them with
 5259: C<Encode::decode('UTF-8', $val)> in your application.
 5260: 
 5261: =item * B<JSON> -- JSON::MaybeXS decodes JSON strings to Perl Unicode
 5262: scalars automatically.  UTF-8 and emoji in JSON values are fully
 5263: supported.
 5264: 
 5265: =item * B<XML> -- XML::Simple decodes the file with the XML encoding
 5266: declaration.  UTF-8 encoded XML (the default) produces Perl Unicode
 5267: scalars.
 5268: 
 5269: =item * B<XLSX> -- Spreadsheet::ParseXLSX decodes strings to Perl
 5270: Unicode scalars.  Emoji in cell values are fully supported.
 5271: 
 5272: =item * B<HTML URL> -- LWP::UserAgent fetches bytes; HTML::TableExtract
 5273: returns them as-is.  Decode with Encode if the page is UTF-8.
 5274: 
 5275: =back
 5276: 
 5277: =item B<File paths> are handled by C<File::Spec::catfile> and work
 5278: on any platform.  On Linux and macOS, UTF-8 directory and file names
 5279: are fully supported.
 5280: 
 5281: =back
 5282: 
 5283: =head1 KNOWN LIMITATIONS
 5284: 
 5285: =over 4
 5286: 
 5287: =item *
 5288: 
 5289: B<Read-only.>  No INSERT, UPDATE, or DELETE is provided.  C<execute()>
 5290: runs raw read-only SQL.
 5291: 
 5292: =item *
 5293: 
 5294: B<Default CSV separator is C<!>>, not C<,>, for historical reasons.
 5295: Pass C<< sep_char => ',' >> for standard RFC 4180 files.
 5296: 
 5297: =item *
 5298: 
 5299: B<Primary-key column is named C<entry>>, not C<key>, because C<key>
 5300: is a SQL reserved word.  Override with the C<id> parameter.
 5301: 
 5302: =item *
 5303: 
 5304: B<XML slurp is limited.>  Only simple flat XML structures are supported
 5305: in slurp mode.  Multi-key or deeply nested documents will croak.
 5306: Force SQL mode with C<< max_slurp_size => 0 >> if slurp fails.
 5307: 
 5308: =item *
 5309: 
 5310: B<Unique key assumption in slurp mode.>  Duplicate values in the key
 5311: column silently overwrite earlier rows.  Disable slurp with
 5312: C<< max_slurp_size => 0 >> if duplicates are expected.
 5313: 
 5314: =item *
 5315: 
 5316: B<BerkeleyDB does not support joins or the chained query builder.>
 5317: 
 5318: =item *
 5319: 
 5320: B<Column names must be valid SQL identifiers> (letters, digits,
 5321: underscores, and a single dot for C<table.column> join notation).
 5322: Other characters will cause a croak.
 5323: 
 5324: =item *
 5325: 
 5326: B<count() cache is opportunistic.>  Count results are served from cache
 5327: only when a prior C<selectall_arrayref()> or C<count()> call with the
 5328: same criteria has already populated it.
 5329: 
 5330: =back
 5331: 
 5332: =head1 SEE ALSO
 5333: 
 5334: =over 4
 5335: 
 5336: =item * L<Database::Abstraction::Query> - chained query builder
 5337: 
 5338: =item * L<Configure an Object at Runtime|Object::Configure>
 5339: 
 5340: =item * L<JSON::MaybeXS> - JSON backend (optional; install for C<.json> support)
 5341: 
 5342: =item * L<Test Dashboard|https://nigelhorne.github.io/Database-Abstraction/coverage/>
 5343: 
 5344: =back
 5345: 
 5346: =head1 FORMAL SPECIFICATION
 5347: 
 5348: The following section uses Z-notation to describe the key state
 5349: transitions and invariants for the module.  Z is a formal
 5350: specification language based on set theory and predicate logic.
 5351: Unicode is used here as permitted by the documentation skill.
 5352: 
 5353: =head2 Database object state
 5354: 
 5355:     State == [
 5356:         data       : TABLE_NAME --> (ENTRY --> ROW) | seq ROW | undef,
 5357:         dbh        : TABLE_NAME --> DBI_HANDLE | undef,
 5358:         type       : Str | undef,
 5359:         base_crit  : CRITERIA,
 5360:         _columns   : seq Str | undef,
 5361:         _schema    : NAME --> COL_INFO | undef,
 5362:         _destroyed : Bool
 5363:     ]
 5364: 
 5365:     Initial state S0 == [
 5366:         data?        = undef,
 5367:         dbh?         = undef,
 5368:         type?        = undef,
 5369:         base_crit?   = {},
 5370:         _columns?    = undef,
 5371:         _schema?     = undef,
 5372:         _destroyed?  = false
 5373:     ]
 5374: 
 5375: =head2 _open_table
 5376: 
 5377:     _open_table ___________________________________________
 5378:     DeltaState
 5379:     class? : CLASS
 5380:     dir?   : DIRPATH | undef
 5381:     ────────────────────────────────────────────────────
 5382:     pre:  _destroyed = false
 5383:     pre:  dbh(table) = undef AND data(table) = undef
 5384:     post: (EXISTS f : FILE_FORMATS WITH f.probe(dir) = true
 5385:            IMPLIES (f.slurp? IMPLIES data'(table) != undef)
 5386:                 AND (f.dbi?  IMPLIES dbh'(table)  != undef))
 5387: 
 5388: =head2 selectall_arrayref
 5389: 
 5390:     selectall_arrayref __________________________________
 5391:     XiState  (read-only; state unchanged except cache)
 5392:     criteria? : CRITERIA
 5393:     ────────────────────────────────────────────────────
 5394:     pre:  _destroyed = false
 5395:     result == (data != undef AND simple(criteria)
 5396:                IMPLIES { r : data | match(r, criteria) }
 5397:                ELSE    dbh != undef
 5398:                IMPLIES SQL_SELECT(dbh, criteria))
 5399:     post: result : seq ROW UNION {undef}
 5400: 
 5401: =head2 aggregate
 5402: 
 5403:     aggregate ____________________________________________
 5404:     XiState
 5405:     by?       : seq COLNAME
 5406:     measures? : seq MEASURE_SPEC
 5407:     criteria? : CRITERIA
 5408:     ────────────────────────────────────────────────────
 5409:     pre:  measures != empty
 5410:     pre:  FORALL m : measures WITH m.as NOT IN by
 5411:     pre:  sort_by != undef IMPLIES sort_by IN ran(by) UNION aliases(measures)
 5412:     result == (dbh != undef
 5413:                IMPLIES SQL_GROUP_BY(dbh, by, measures, criteria)
 5414:                ELSE    PERL_FOLD(selectall_arrayref(criteria), by, measures))
 5415:     post: result : seq ROW (keys = by UNION aliases(measures))
 5416:     post: FORALL r : result WITH
 5417:               r.count != undef IMPLIES r.count >= 0
 5418:             AND r.sum = undef IMPLIES no rows in that group
 5419: 
 5420: =head2 DESTROY
 5421: 
 5422:     DESTROY ______________________________________________
 5423:     DeltaState
 5424:     ────────────────────────────────────────────────────
 5425:     post: _destroyed' = true
 5426:     post: dbh'      = undef  (DBI handles disconnected)
 5427:     post: data'     = undef
 5428:     post: _columns' = undef
 5429:     post: _schema'  = undef
 5430: 
 5431: =head1 STATE DIAGRAM
 5432: 
 5433: The following ASCII diagram shows every valid state the object can
 5434: occupy and the transitions between them.  Transitions are labelled
 5435: with the method call or event that triggers them.  Actions are shown
 5436: in parentheses.
 5437: 
 5438:     .-----------------------------------------------------------.
 5439:     |                  S1: CONSTRUCTED                          |
 5440:     |  dbh=undef, data=undef, type=undef                        |
 5441:     '---.-------.-------.-------.-------.-----.---.-------------'
 5442:         |       |       |       |       |     |   |
 5443:         | first query call triggers _open_table()
 5444:         |       |       |       |       |     |   |
 5445:         v       v       v       v       v     v   v
 5446:     .------. .------. .------. .------. .--. .--. .--.
 5447:     | S2   | | S3   | | S4   | | S5   | |S6| |S7| |S8|
 5448:     | DBI  | | CSV  | | XML  | | JSON | |Xls| |Bk| |Dp|
 5449:     '---^--' '--^---' '--^---' '--^---' '-^-' '-^-' '-^-'
 5450:         |       |       |       |       |   |   |   |
 5451:         |       |       '-------'-------'   |   |   |
 5452:         |       |         slurp path        |   |   |
 5453:         |       '-----------+---------------'   |   |
 5454:         |                   |                   |   |
 5455:         |         (data populated,              |   |
 5456:         |          _columns/_schema undef)      |   |
 5457:         |                                       |   |
 5458:         | (dbh populated,                       |   |
 5459:         |  data undef)                          |   |
 5460:         |                                       |   |
 5461:         +-------+--------+-----------+----------+   |
 5462:                 |        |           |              |
 5463:           selectall   fetchrow    aggregate      fetchrow
 5464:           count       _hashref    query->all     _hashref
 5465:           each_row    AUTOLOAD    AUTOLOAD        AUTOLOAD
 5466:                 |        |           |              |
 5467:                 v        v           v              v
 5468:     .-----------------------------------------------------------.
 5469:     |                  (result returned to caller)              |
 5470:     |          state is unchanged; only cache may be updated    |
 5471:     '-----------------------------------------------------------'
 5472:                                 |
 5473:                     DESTROY (or object goes out of scope)
 5474:                                 |
 5475:                                 v
 5476:     .-----------------------------------------------------------.
 5477:     |                  S_DEAD: DESTROYED                        |
 5478:     |  _destroyed=true; all handles disconnected;               |
 5479:     |  temp files unlinked; _remote_tmpdir removed              |
 5480:     '-----------------------------------------------------------'
 5481: 
 5482:     State labels:
 5483:       S1  CONSTRUCTED  - new() returned; no I/O done yet (lazy open)
 5484:       S2  DBI          - live DBI handle (SQLite file, DSN, DBD::CSV)
 5485:       S3  CSV_SLURP    - small CSV/PSV/TSV/gzip-CSV slurped into RAM hash
 5486:       S4  XML_SLURP    - XML file slurped into RAM hash
 5487:       S5  JSON_SLURP   - JSON file slurped into RAM hash
 5488:       S6  XLSX_SLURP   - XLSX file slurped (type='XLSX', no DBI handle)
 5489:       S7  BERKELEYDB   - BerkeleyDB key-value file open (berkeley flag set)
 5490:       S8  DEEP_SLURP   - DBM::Deep file slurped into plain RAM hash
 5491: 
 5492:     Blocked transitions (croak before state changes):
 5493:       S1 -> any  if constructor arguments are invalid
 5494:                  (unsafe id/table/host/url)
 5495:       S* -> S*   aggregate() with join on S3/S4/S5/S6/S7/S8
 5496:                  (no DBI handle)
 5497:       S7 -> S*   join() or select()-projection on BerkeleyDB
 5498:       S8 -> S*   join() on DBM::Deep
 5499: 
 5500: =head1 LICENSE AND COPYRIGHT
 5501: 
 5502: Copyright 2015-2026 Nigel Horne.
 5503: 
 5504: Usage is subject to the GPL2 licence terms.
 5505: If you use it,
 5506: please let me know.
 5507: 
 5508: =cut
 5509: 
 5510: 1;