lib/Database/Abstraction.pm

Index Next ➡
Structural Coverage (Approximate)

TER1 (Statement): 79.25%
TER2 (Branch): 71.97%
TER3 (LCSAJ): 100.0% (85/85)
Approximate LCSAJ segments: 743

LCSAJ Legend

● Covered — this LCSAJ path was executed during testing.

● Not covered — this LCSAJ path was never executed. These are the paths to focus on.

Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows: 

        start → end → jump

Uncovered paths show [NOT COVERED] in the tooltip.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation 
    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: # TODO:	Add redis database - could be of use for Geo::Coder::Free
   13: #	use select() to select a database - use the table arg
   14: #	new(database => 'redis://servername');
   15: # TODO:	Add a "key" property, defaulting to "entry", which would be the name of the key
   16: # TODO:	The maximum number to return should be tuneable (as a LIMIT)
   17: # TODO:	Add full CRUD support
   18: # TODO:	It would be better for the default sep_char to be ',' rather than '!'
   19: # TODO:	Other databases e.g., Redis, noSQL, remote databases such as MySQL, PostgreSQL
   20: # TODO: The no_entry/entry terminology is confusing.  Replace with no_id/id_column
   21: # TODO: Log queries and the time that they took to execute per database
   22: 
   23: use warnings;
   24: use strict;
   25: use autodie qw(:all);
   26: 
   27: use boolean;
   28: use Carp;
   29: use Class::Abstract;
   30: use Data::Reuse;
   31: use DBI;
   32: use Fcntl;	# For O_RDONLY
   33: use Cwd;
   34: use File::Spec;
   35: use File::Temp;
   36: use List::Util qw(all);
   37: use Log::Abstraction 0.33;
   38: use Object::Configure 0.16;
   39: use Params::Get 0.17;
   40: use Return::Set qw(set_return);
   41: use Scalar::Util;
   42: use Sub::Private;
   43: use Sub::Protected;
   44: 
   45: # File::Slurp::Remote is loaded lazily in _open() when host => '...' is given.
   46: 
   47: our %defaults;
   48: use constant	DEFAULT_MAX_SLURP_SIZE => 16 * 1024;	# CSV files <= than this size are read into memory
   49: 
   50: # Compiled once at module load; reused in every identifier-safety check.
   51: # Using \A/\z (true string anchors) rather than ^/$ which match around \n.
   52: # SAFE_IDENTIFIER: bare SQL identifier — letters, digits, underscore.
   53: # SAFE_QUALIFIED:  allows a single dot for table.column notation in JOINs.
   54: my $SAFE_IDENTIFIER = qr/\A[a-zA-Z_][a-zA-Z0-9_]*\z/;
   55: my $SAFE_QUALIFIED  = qr/\A[a-zA-Z_][a-zA-Z0-9_.]*\z/;
   56: 
   57: # Module-level constant: valid JOIN types after uc() normalisation.
   58: # Built once at compile time; reused by every _build_joins call.
   59: my %VALID_JOIN_TYPES = map { $_ => 1 } qw(INNER LEFT RIGHT FULL CROSS);
   60: 
   61: =head1 NAME
   62: 
   63: Database::Abstraction - Read-only Database Abstraction Layer (ORM)
   64: 
   65: =head1 VERSION
   66: 
   67: Version 0.41
   68: 
   69: =cut
   70: 
   71: our $VERSION = '0.41';
   72: 
   73: =head1 DESCRIPTION
   74: 
   75: C<Database::Abstraction> is a read-only ORM for Perl that gives a uniform
   76: interface over CSV, PSV, XML, SQLite, DBM::Deep, BerkeleyDB, and Excel (XLSX)
   77: files - local, remote (via SSH), or fetched from a URL - without writing any
   78: SQL.
   79: 
   80: Key features:
   81: 
   82: =over 4
   83: 
   84: =item *
   85: 
   86: B<No SQL required.>  Use plain Perl method calls for simple lookups and
   87: scans; switch storage formats without changing application code.
   88: 
   89: =item *
   90: 
   91: B<Rich query criteria.>  Pass plain values, SQL wildcards, C<undef> (IS NULL),
   92: comparison operators (C<< > >> C<< < >> C<< >= >> C<< <= >> C<!=>), pattern
   93: operators (C<-like>, C<-not_like>), set operators (C<-in>, C<-not_in>,
   94: C<-between>), and logical groupings (C<-or>, C<-and>).
   95: 
   96: =item *
   97: 
   98: B<Automatic joins.>  Add a C<join> parameter to any select method to
   99: combine tables with INNER, LEFT, RIGHT, FULL, or CROSS joins.
  100: 
  101: =item *
  102: 
  103: B<Chained query builder.>  The C<query()> method returns a
  104: L<Database::Abstraction::Query> object for fluent, composable queries:
  105: C<< $db->query->where(...)->order_by(...)->limit(...)->all() >>.
  106: 
  107: =item *
  108: 
  109: B<Schema introspection.>  C<columns()> lists column names; C<schema()>
  110: returns full type/nullability metadata, using native driver introspection
  111: (C<PRAGMA table_info> for SQLite, C<column_info> for others).
  112: 
  113: =item *
  114: 
  115: B<DSN portability.>  Pass a C<dsn> (plus optional C<username>/C<password>)
  116: to connect to any DBI-supported database (SQLite, PostgreSQL, MySQL, ...)
  117: instead of pointing at a local file.
  118: 
  119: =item *
  120: 
  121: B<Performance.>  Small files are slurped into a RAM hash for sub-millisecond
  122: lookups.  All DBI statement handles are cached with C<prepare_cached()>.
  123: A CHI-compatible cache layer is also supported.
  124: 
  125: =back
  126: 
  127: =head1 SYNOPSIS
  128: 
  129:     # 1. Create a thin subclass for your table (e.g. Database/Foo.pm)
  130:     package Database::Foo;
  131:     use parent 'Database::Abstraction';
  132: 
  133:     # 2. Open the database - file is auto-detected from the class name
  134:     #    (looks for foo.sql / foo.psv / foo.csv / foo.xlsx / foo.xml / foo.db)
  135:     my $db = Database::Foo->new(directory => '/path/to/data');
  136: 
  137:     # 3. Simple lookups -----------------------------------------------
  138: 
  139:     # Fetch one row
  140:     my $row = $db->fetchrow_hashref(entry => 'key1');
  141: 
  142:     # Fetch all rows matching a criterion
  143:     my $rows = $db->selectall_arrayref(status => 'active');
  144: 
  145:     # Column shortcut via AUTOLOAD
  146:     my $name = $db->name(entry => 'key1');
  147: 
  148:     # 4. Rich criteria ------------------------------------------------
  149: 
  150:     # Comparison operators
  151:     my $high = $db->selectall_arrayref(score => { '>' => 90 });
  152: 
  153:     # Set membership
  154:     my $selected = $db->selectall_arrayref(
  155:         name => { -in => ['Alice', 'Bob'] }
  156:     );
  157: 
  158:     # Range
  159:     my $mid = $db->selectall_arrayref(
  160:         score => { -between => [60, 80] }
  161:     );
  162: 
  163:     # OR grouping
  164:     my $either = $db->selectall_arrayref(
  165:         -or => [
  166:             { status => 'active'    },
  167:             { score  => { '>' => 95 } },
  168:         ]
  169:     );
  170: 
  171:     # 5. Joins --------------------------------------------------------
  172: 
  173:     my $joined = $db->selectall_arrayref(
  174:         join => { table => 'dept', on => 'foo.dept_id = dept.id', type => 'LEFT' }
  175:     );
  176: 
  177:     # 6. Chained query builder ----------------------------------------
  178: 
  179:     my $results = $db->query
  180:         ->where(status => 'active')
  181:         ->where(score  => { '>=' => 80 })
  182:         ->order_by('score DESC')
  183:         ->limit(10)
  184:         ->all();
  185: 
  186:     my $first = $db->query->where(name => 'Alice')->first();
  187:     my $count = $db->query->where(status => 'active')->count();
  188: 
  189:     # 7. Connect via DSN (PostgreSQL, MySQL, SQLite, ...) ---------------
  190: 
  191:     my $db2 = Database::Foo->new(
  192:         dsn      => 'dbi:Pg:dbname=mydb;host=db.example.com',
  193:         username => 'myuser',
  194:         password => 's3cret',
  195:     );
  196: 
  197:     # 8. Schema introspection -----------------------------------------
  198: 
  199:     my $cols   = $db->columns();  # ['entry', 'name', 'score', ...]
  200:     my $schema = $db->schema();   # { name => { type=>'TEXT', nullable=>1, ... }, ... }
  201: 
  202: =head1 QUICK START EXAMPLE
  203: 
  204: If F</var/dat/foo.csv> contains:
  205: 
  206:     "customer_id","name"
  207:     "plugh","John"
  208:     "xyzzy","Jane"
  209: 
  210: Create a driver in F<.../Database/foo.pm>:
  211: 
  212:     package Database::foo;
  213:     use parent 'Database::Abstraction';
  214: 
  215:     # Regular CSV: no entry column, comma-separated
  216:     sub new {
  217:         my ($class, %args) = @_;
  218:         return $class->SUPER::new(no_entry => 1, sep_char => ',', %args);
  219:     }
  220: 
  221: Then query it:
  222: 
  223:     my $foo = Database::foo->new(directory => '/var/dat');
  224: 
  225:     # Prints "John"
  226:     print 'Customer: ', $foo->name(customer_id => 'plugh'), "\n";
  227: 
  228:     # Returns { customer_id => 'xyzzy', name => 'Jane' }
  229:     my $row = $foo->fetchrow_hashref(customer_id => 'xyzzy');
  230: 
  231: =head1 FILE FORMATS
  232: 
  233: The module probes the C<directory> for files in this priority order:
  234: 
  235: =over 4
  236: 
  237: =item 1. C<SQLite>
  238: 
  239: File ending C<.sql>
  240: 
  241: =item 2. C<Deep>
  242: 
  243: DBM::Deep file ending C<.dbm> or C<.deep>.  The entire file is slurped
  244: into a plain Perl hash on open; all in-memory fast-paths apply.
  245: Requires L<DBM::Deep> (loaded lazily).
  246: 
  247: =item 3. C<PSV>
  248: 
  249: Pipe-separated file, ending C<.psv>
  250: 
  251: =item 4. C<CSV>
  252: 
  253: Comma (or custom) separated file, ending C<.csv> or C<.db>; can be
  254: gzipped.  B<Note:> the default separator is C<!> not C<,> for historical
  255: reasons - pass C<< sep_char => ',' >> for standard CSVs.
  256: 
  257: =item 5. C<Excel>
  258: 
  259: Excel workbook ending C<.xlsx>.  Each worksheet is a separate SQL table;
  260: the active worksheet is determined by the class-derived table name (or the
  261: C<table> constructor parameter - see L</SUBROUTINES/METHODS>).  Requires
  262: L<DBD::Excel> (loaded lazily); L<Spreadsheet::ParseXLSX> is used
  263: automatically for modern C<.xlsx> files when installed.  No slurp path:
  264: C<max_slurp_size> has no effect on the Excel backend.
  265: 
  266: =item 6. C<XML>
  267: 
  268: File ending C<.xml>
  269: 
  270: =item 7. C<BerkeleyDB>
  271: 
  272: Binary key-value file ending C<.db>
  273: 
  274: =item 8. C<HTML>
  275: 
  276: Remote HTML page fetched via a URL.  Pass C<url> instead of C<directory>; the
  277: module fetches the page with L<LWP::UserAgent>, parses all C<< <table> >>
  278: elements with L<HTML::TableExtract>, and slurps the first (or
  279: C<html_table_index>-selected) table into memory.  The first row of the table
  280: is treated as column headers.  Both modules are loaded lazily and are not
  281: required for other backends.
  282: 
  283: =back
  284: 
  285: Pass C<dsn> to bypass file detection entirely and connect via any DBI driver.
  286: Pass C<url> to fetch and slurp a remote HTML table without a local directory.
  287: 
  288: =head1 QUERY CRITERIA
  289: 
  290: All select methods (C<selectall_arrayref>, C<selectall_array>,
  291: C<fetchrow_hashref>, C<count>) accept the same criteria syntax.
  292: 
  293: =head2 Plain value
  294: 
  295:     status => 'active'          # status = 'active'
  296:     name   => undef             # name IS NULL
  297: 
  298: Values containing C<%> or C<_> are matched with C<LIKE>:
  299: 
  300:     name => 'A%'                # name LIKE 'A%'
  301: 
  302: =head2 Comparison operator hashref
  303: 
  304:     score => { '>'  => 90  }   # score > 90
  305:     score => { '<'  => 50  }   # score < 50
  306:     score => { '>=' => 80  }   # score >= 80
  307:     score => { '<=' => 100 }   # score <= 100
  308:     score => { '!=' => 0   }   # score != 0
  309: 
  310: Multiple operators on one column are ANDed:
  311: 
  312:     score => { '>' => 60, '<' => 90 }   # 60 < score < 90
  313: 
  314: =head2 Pattern matching
  315: 
  316:     name => { -like     => 'A%'  }   # name LIKE 'A%'
  317:     name => { -not_like => 'Z%'  }   # name NOT LIKE 'Z%'
  318: 
  319: =head2 Set membership
  320: 
  321:     name => { -in     => ['Alice', 'Bob'] }   # name IN (...)
  322:     name => { -not_in => ['Alice', 'Bob'] }   # name NOT IN (...)
  323: 
  324: =head2 Range
  325: 
  326:     score => { -between => [60, 90] }   # score BETWEEN 60 AND 90
  327: 
  328: =head2 Logical groupings
  329: 
  330: C<-or> and C<-and> take an arrayref of condition hashrefs:
  331: 
  332:     -or => [
  333:         { status => 'active'        },
  334:         { score  => { '>' => 95 }   },
  335:     ]
  336: 
  337:     -and => [
  338:         { status => 'active'        },
  339:         { score  => { '>=' => 80 }  },
  340:     ]
  341: 
  342: =head2 Joins
  343: 
  344: Any select method accepts a C<join> key with a hashref (or arrayref of
  345: hashrefs) describing the join:
  346: 
  347:     join => {
  348:         table => 'dept',
  349:         on    => 'employees.dept_id = dept.id',
  350:         type  => 'LEFT',    # INNER (default) | LEFT | RIGHT | FULL | CROSS
  351:     }
  352: 
  353:     # Multiple joins
  354:     join => [
  355:         { table => 'dept',    on => 'e.dept_id   = dept.id'   },
  356:         { table => 'country', on => 'e.country_id = country.id' },
  357:     ]
  358: 
  359: =head1 SUBROUTINES/METHODS
  360: 
  361: =head2 init
  362: 
  363: Set class-level defaults shared by all instances.
  364: 
  365:     Database::Abstraction::init(directory => '../data');
  366: 
  367: Accepts the same parameters as L</new>.  Returns a reference to the
  368: current defaults hash, so you can read them back:
  369: 
  370:     my $defaults = Database::Abstraction::init();
  371:     print $defaults->{'directory'}, "\n";
  372: 
  373: =cut
  374: 
  375: # Subroutine to initialize with args
  376: sub init
  377: {
●378 → 378 → 388  378: 	if(my $params = Params::Get::get_params(undef, @_)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  379: 		if(($params->{'expires_in'} && !$params->{'cache_duration'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  380: 			# Compatibility with CHI
  381: 			$params->{'cache_duration'} = $params->{'expires_in'};
  382: 		}
  383: 
  384: 		%defaults = (%defaults, %{$params});
  385: 		$defaults{'cache_duration'} ||= '1 hour';
  386: 	}
  387: 
  388: 	return \%defaults

  Mutants (Total: 2, Killed: 2, Survived: 0)
  389: }
  390: 
  391: =head2 import
  392: 
  393: The module can be initialised by the C<use> directive.
  394: 
  395:     use Database::Abstraction 'directory' => '/etc/data';
  396: 
  397: or
  398: 
  399:     use Database::Abstraction { 'directory' => '/etc/data' };
  400: 
  401: =cut
  402: 
  403: sub import
  404: {
●405 → 407 → 0  405: 	my $pkg = shift;
  406: 
  407: 	if((scalar(@_) == 0) && (ref($pkg) eq 'HASH')) {

					

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

  408: 		init(Object::Configure::configure(__PACKAGE__, $pkg));
  409: 	} elsif((scalar(@_) % 2) == 0) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  410: 		my %h = @_;
  411: 		init(Object::Configure::configure($pkg, \%h));
  412: 	} elsif((scalar(@_) == 1) && (ref($_[0]) eq 'HASH')) {

					

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

  413: 		init(Object::Configure::configure($pkg, $_[0]));
  414: 	} elsif(scalar(@_) > 0) {	# >= 3 would also work here

					

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

  415: 		init(\@_);
  416: 	}
  417: }
  418: 
  419: =head2 new
  420: 
  421: Create an object pointing to a read-only database.
  422: 
  423: Accepts arguments as a hash, a hashref, or - as a shortcut - a single bare
  424: string which is taken to be C<directory>.
  425: 
  426: =head3 Connection parameters
  427: 
  428: =over 4
  429: 
  430: =item * C<directory>
  431: 
  432: Directory containing the data files.  The module probes this directory for
  433: files named after the subclass (see L</FILE FORMATS>).  Required unless
  434: C<dsn> is given.
  435: 
  436: =item * C<dsn>
  437: 
  438: A DBI data-source string (e.g. C<dbi:SQLite:dbname=/path/to/db> or
  439: C<dbi:Pg:dbname=mydb;host=db.example.com>).  When present, file detection
  440: is skipped entirely and the DSN is used directly.  The SQL dialect is
  441: inferred from the DSN prefix (C<sqlite>, C<postgres>, C<mysql>).
  442: 
  443: =item * C<username>
  444: 
  445: Database username.  Used only with C<dsn>; ignored for file-based backends.
  446: 
  447: =item * C<password>
  448: 
  449: Database password.  Used only with C<dsn>; ignored for file-based backends.
  450: 
  451: =item * C<dbname>
  452: 
  453: Override the filename stem searched in C<directory> (default: the table
  454: name derived from the class name).
  455: 
  456: =item * C<table>
  457: 
  458: Override the table (or worksheet) name used in SQL queries for this object.
  459: Default is the class-name-derived table name (e.g. C<Database::Foo> =>
  460: C<foo>).  Particularly useful for Excel workbooks where a single F<.xlsx>
  461: file contains multiple worksheets: pass C<< table => 'Summary' >> to query
  462: the C<Summary> worksheet without creating a dedicated subclass.  Also works
  463: with SQLite/DSN connections to select a table other than the class-derived
  464: default.  The filename stem (C<dbname>) continues to fall back to the class
  465: name, so the correct file is opened regardless of this override.  The value
  466: is validated against C<$SAFE_QUALIFIED> at construction time.
  467: 
  468: =item * C<filename>
  469: 
  470: Override the full filename (relative to C<directory>).  Takes precedence
  471: over C<dbname>.
  472: 
  473: =item * C<host>
  474: 
  475: Remote hostname (or C<user@host>) from which to fetch the data file(s) via
  476: SSH/SCP.  When present, each candidate filename is fetched with
  477: L<File::Slurp::Remote> into a local temporary directory; the existing
  478: extension-based file-type detection then runs against that directory.
  479: C<directory> is treated as the remote path (no local canonicalization is
  480: applied).  Using C<filename> together with C<host> avoids probing multiple
  481: extensions and is therefore more efficient.  L<File::Slurp::Remote> must be
  482: installed; it is loaded lazily (only when C<host> is given).
  483: 
  484: =item * C<url>
  485: 
  486: A URL (C<http://> or C<https://>) pointing to an HTML page that contains one
  487: or more C<< <table> >> elements.  When present, C<directory> is not required.
  488: The first row of the selected table is used as column headers.
  489: Requires L<LWP::UserAgent> and L<HTML::TableExtract> (both loaded lazily).
  490: 
  491: =back
  492: 
  493: =head3 Behaviour parameters
  494: 
  495: =over 4
  496: 
  497: =item * C<no_entry>
  498: 
  499: Set to C<1> when the table has no key column (standard CSVs, for example).
  500: Default is C<0> (keyed on C<entry>).
  501: 
  502: =item * C<id>
  503: 
  504: Name of the key column.  Default is C<entry>.
  505: 
  506: =item * C<sep_char>
  507: 
  508: Field separator for CSV/PSV files.
  509: Default is C<!> - pass C<< sep_char => ',' >>
  510: for standard comma-separated files.
  511: 
  512: =item * C<max_slurp_size>
  513: 
  514: Files smaller than this (in bytes) are loaded entirely into memory for fast
  515: lookups.  Default is 16 KB.  Set to C<0> to force SQL mode for all sizes.
  516: 
  517: =item * C<no_fixate>
  518: 
  519: Set to C<1> to return mutable arrays.  Default is C<0> (arrays are made
  520: read-only via L<Data::Reuse>).
  521: 
  522: =item * C<auto_load>
  523: 
  524: Set to C<0> to disable the AUTOLOAD column shortcut.  Default is C<1>
  525: (enabled).
  526: 
  527: =item * C<html_table_index>
  528: 
  529: Zero-based index of the HTML C<< <table> >> to extract when the C<url>
  530: backend is used.  Default is C<0> (the first table on the page).
  531: 
  532: =back
  533: 
  534: =head3 Caching and logging
  535: 
  536: =over 4
  537: 
  538: =item * C<cache>
  539: 
  540: A L<CHI>-compatible cache object.  When set, query results are stored and
  541: retrieved from the cache.
  542: 
  543: =item * C<cache_duration> / C<expires_in>
  544: 
  545: TTL for cached results.  Default is C<'1 hour'>.  C<expires_in> is a
  546: synonym for compatibility with L<CHI>.
  547: 
  548: =item * C<logger>
  549: 
  550: An object that understands C<warn()> and C<trace()> (e.g.
  551: L<Log::Log4perl>, L<Log::Any>), a code reference, or a filename.
  552: 
  553: =item * C<config_file>
  554: 
  555: Path to a YAML, XML, or INI configuration file whose keys are merged into
  556: the constructor arguments.  Loaded via L<Object::Configure>.
  557: 
  558: =back
  559: 
  560: =head3 Notes
  561: 
  562: =over 4
  563: 
  564: =item *
  565: 
  566: If no arguments are set, class-level defaults set via C<init()> or C<use>
  567: are used.
  568: 
  569: =item *
  570: 
  571: Slurp mode assumes the key column (C<entry>) is unique.  If it is not,
  572: searches will be incomplete - disable slurp mode by setting
  573: C<< max_slurp_size => 0 >>.
  574: 
  575: =item *
  576: 
  577: Passing an existing object as C<$class> clones it, merging any new
  578: arguments.
  579: 
  580: =back
  581: 
  582: =cut
  583: 
  584: sub new {
●585 → 591 → 597  585: 	my $class = shift;
  586: 	my %args;
  587: 
  588: 	Class::Abstract::check_abstract($class);	# enforces abstract contract
  589: 
  590: 	# Handle hash or hashref arguments
  591: 	if((scalar(@_) == 1) && !ref($_[0])) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
  592: 		$args{'directory'} = $_[0];
  593: 	} elsif(my $params = Params::Get::get_params(undef, @_)) {
  594: 		%args = %{$params};
  595: 	}
  596: 
●597 → 597 → 624  597: 	if(!defined($class)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  598: 		if((scalar keys %args) > 0) {

					

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

  599: 			# Using Database::Abstraction->new(), not Database::Abstraction::new()
  600: 			carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
  601: 			return;
  602: 		}
  603: 		# FIXME: this only works when no arguments are given
  604: 		$class = __PACKAGE__;
  605: 	} elsif($class eq __PACKAGE__) {
  606: 		croak("$class: abstract class");
  607: 	} elsif(Scalar::Util::blessed($class)) {
  608: 		# If $class is an object, clone it with new arguments.
  609: 		# Validate 'id' and 'table' before merging — the validation block below is
  610: 		# skipped by this early return, so hostile clone args would otherwise bypass
  611: 		# all guards and be interpolated directly into SQL.
  612: 		if(defined $args{'id'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  613: 			croak(ref($class), ": unsafe id column name '$args{id}'")
  614: 				unless $args{'id'} =~ $SAFE_IDENTIFIER;
  615: 		}
  616: 		if(defined $args{'table'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  617: 			croak(ref($class), ": unsafe table name '$args{table}'")
  618: 				unless $args{'table'} =~ $SAFE_QUALIFIED;
  619: 		}
  620: 		return bless { %{$class}, %args }, ref($class);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  621: 	}
  622: 
  623: 	# Load the configuration from a config file, if provided
●624 → 628 → 632  624: 	%args = %{Object::Configure::configure($class, \%args)};
  625: 
  626: 	# Normalise logger: wrap code-refs, filenames, and strings in Log::Abstraction
  627: 	# so that the rest of the code can always call ->$level(...) uniformly.
  628: 	if(defined $args{'logger'} && !Scalar::Util::blessed($args{'logger'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  629: 		$args{'logger'} = Log::Abstraction->new($args{'logger'});
  630: 	}
  631: 
●632 → 632 → 644  632: 	unless($args{'dsn'} || $defaults{'dsn'} || $args{'url'} || $defaults{'url'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  633: 		croak("$class: where are the files?") unless($args{'directory'} || $defaults{'directory'});
  634: 
  635: 		# Skip the local -d check only for genuinely remote hosts.
  636: 		# localhost / 127.0.0.1 / current hostname are treated as local.
  637: 		my $given_host = $args{'host'} // $defaults{'host'};
  638: 		unless($given_host && !$class->_is_local_host($given_host)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  639: 			croak("$class: ", $args{'directory'} || $defaults{'directory'}, ' is not a directory') unless(-d ($args{'directory'} || $defaults{'directory'}));
  640: 		}
  641: 	}
  642: 
  643: 	# Validate the primary-key column name to prevent SQL injection via ORDER BY / WHERE
●644 → 644 → 672  644: 	for my $src (\%defaults, \%args) {
  645: 		if(defined $src->{'id'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  646: 			croak("$class: unsafe id column name '$src->{id}'")
  647: 				unless $src->{'id'} =~ $SAFE_IDENTIFIER;
  648: 		}
  649: 		if(defined $src->{'host'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  650: 			croak("$class: unsafe host '$src->{host}'")
  651: 				unless $src->{'host'} =~ /\A
  652: 					(?:                   # optional "user\@" prefix
  653: 						[a-zA-Z0-9]       # username: first char must be alnum
  654: 						[a-zA-Z0-9._-]*   # username: rest may include dots and hyphens
  655: 						\@                # literal at-sign; \@ prevents array interpolation
  656: 					)?
  657: 					[a-zA-Z0-9:]          # first char of host or IP; colon allows IPv6
  658: 					[a-zA-Z0-9._:-]*      # rest: hostname, dotted IPv4, or IPv6 hex groups
  659: 				\z/x;
  660: 		}
  661: 		if(defined $src->{'url'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  662: 			croak("$class: unsafe url '$src->{url}'")
  663: 				unless $src->{'url'} =~ /\Ahttps?:\/\//i;
  664: 		}
  665: 		if(defined $src->{'table'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  666: 			croak("$class: unsafe table name '$src->{table}'")
  667: 				unless $src->{'table'} =~ $SAFE_QUALIFIED;
  668: 		}
  669: 	}
  670: 
  671: 	# Defaults are set first so that %args keys override them
  672: 	return bless {

  Mutants (Total: 2, Killed: 2, Survived: 0)
  673: 		no_entry => 0,
  674: 		no_fixate => 0,
  675: 		id => 'entry',
  676: 		cache_duration => '1 hour',
  677: 		max_slurp_size => DEFAULT_MAX_SLURP_SIZE,
  678: 		%defaults,
  679: 		%args,
  680: 	}, $class;
  681: }
  682: 
  683: =head2	set_logger
  684: 
  685: Sets the class, code reference, or file that will be used for logging.
  686: 
  687: =cut
  688: 
  689: sub set_logger
  690: {
●691 → 694 → 702  691: 	my $self = shift;
  692: 	my $params = Params::Get::get_params('logger', @_);
  693: 
  694: 	if(my $logger = $params->{'logger'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  695: 		if(Scalar::Util::blessed($logger)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  696: 			$self->{'logger'} = $logger;
  697: 		} else {
  698: 			$self->{'logger'} = Log::Abstraction->new($logger);
  699: 		}
  700: 		return $self;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  701: 	}
  702: 	Carp::croak('Usage: set_logger(logger => $logger)')
  703: }
  704: 
  705: # Open the database connection based on the specified type (e.g., SQLite, CSV).
  706: # Read the data into memory or establish a connection to the database file.
  707: # column_names allows the column names to be overridden on CSV files
  708: 
  709: sub _open :Protected
  710: {
  711: 	# Enforce that _open is only reachable from within this class hierarchy;
  712: 	# caller() returns the calling package name as a plain string.
●713 → 732 → 763  713: 	do { my $c = (caller)[0]; Carp::croak('Illegal Operation: _open may only be called within ', __PACKAGE__) unless $c && $c->isa(__PACKAGE__) };
  714: 
  715: 	my $self = shift;
  716: 	my $params = Params::Get::get_params(undef, @_);
  717: 
  718: 	$params->{'sep_char'} ||= $self->{'sep_char'} ? $self->{'sep_char'} : '!';
  719: 	my $max_slurp_size = $params->{'max_slurp_size'} || $self->{'max_slurp_size'};
  720: 
  721: 	my $table = $self->{'table'} || ref($self);
  722: 	$table =~ s/\A.*:://;
  723: 
  724: 	$self->_trace(ref($self), ": _open $table");
  725: 
  726: 	return if($self->{$table});
  727: 
  728: 	# Read in the database
  729: 	my $dbh;
  730: 
  731: 	# DSN-based connection bypasses file detection entirely
  732: 	if(my $dsn = $self->{'dsn'} || $defaults{'dsn'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  733: 		my $dialect = 'generic';
  734: 		if    ($dsn =~ /^dbi:SQLite:/i) { $dialect = 'sqlite'   }

  Mutants (Total: 1, Killed: 1, Survived: 0)
  735: 		elsif ($dsn =~ /^dbi:Pg:/i)     { $dialect = 'postgres' }
  736: 		elsif ($dsn =~ /^dbi:mysql:/i)  { $dialect = 'mysql'    }
  737: 		$self->{'_dialect'} = $dialect;
  738: 
  739: 		$dbh = DBI->connect(
  740: 			$dsn,
  741: 			$self->{'username'},
  742: 			$self->{'password'},
  743: 			{ RaiseError => 1, AutoCommit => 1 },
  744: 		) or Carp::croak(ref($self), ": cannot connect: $DBI::errstr");
  745: 
  746: 		if($dialect eq 'sqlite') {

					

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

  747: 			$dbh->do('PRAGMA synchronous = OFF');
  748: 			$dbh->do('PRAGMA cache_size = -4096');
  749: 			$dbh->do('PRAGMA journal_mode = OFF');
  750: 			$dbh->do('PRAGMA temp_store = MEMORY');
  751: 			$dbh->do('PRAGMA mmap_size = 1048576');
  752: 			$dbh->sqlite_busy_timeout(100000);
  753: 		}
  754: 
  755: 		$self->{'type'} = 'DBI';
  756: 		$self->{$table} = $dbh;
  757: 		$self->{'_updated'} = time();
  758: 		return $self;

					

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

  759: 	}
  760: 
  761: 	# URL-based HTML table backend — lazy-loads LWP::UserAgent and HTML::TableExtract.
  762: 	# Both modules are optional; they are not required for file-based backends.
●763 → 763 → 821  763: 	if(my $url = $self->{'url'} || $defaults{'url'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  764: 		require LWP::UserAgent::Cached;
  765: 		require HTML::TableExtract;
  766: 
  767: 		my $ua = $self->{ua} // LWP::UserAgent::Cached->new(timeout => 30, agent => __PACKAGE__ . '/' . $VERSION);
  768: 		$ua->env_proxy(1);
  769: 		my $response = $ua->get($url);
  770: 		Carp::croak(ref($self), ": cannot fetch '$url': ", $response->status_line)
  771: 			unless $response->is_success;
  772: 
  773: 		my $te = HTML::TableExtract->new();
  774: 		$te->parse($response->decoded_content);
  775: 
  776: 		my $tidx = $self->{'html_table_index'} // $defaults{'html_table_index'} // 0;
  777: 		my @tables = $te->tables;
  778: 		Carp::croak(ref($self), ": no HTML tables found at '$url'")
  779: 			unless @tables;
  780: 		Carp::croak(ref($self), ": html_table_index $tidx out of range (", scalar @tables, " tables) at '$url'")
  781: 			if $tidx >= @tables;

  Mutants (Total: 3, Killed: 3, Survived: 0)
  782: 
  783: 		my @rows = $tables[$tidx]->rows;
  784: 		Carp::croak(ref($self), ": empty HTML table at '$url'")
  785: 			unless @rows;
  786: 
  787: 		my @headers = map { defined($_) ? "$_" : '' } @{$rows[0]};
  788: 		my $id = $self->{'id'};
  789: 
  790: 		if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  791: 			my @data;
  792: 			for my $i (1 .. $#rows) {
  793: 				my %row;
  794: 				@row{@headers} = map { defined($_) ? "$_" : undef } @{$rows[$i]};
  795: 				push @data, \%row;
  796: 			}
  797: 			$self->{'data'} = \@data;
  798: 		} else {
  799: 			my %data;
  800: 			for my $i (1 .. $#rows) {
  801: 				my %row;
  802: 				@row{@headers} = map { defined($_) ? "$_" : undef } @{$rows[$i]};
  803: 				my $key = $row{$id};
  804: 				next unless defined $key;
  805: 				$data{$key} = \%row;
  806: 			}
  807: 			$self->{'data'} = \%data;
  808: 		}
  809: 
  810: 		$self->{'type'} = 'HTML';
  811: 		$self->{'_updated'} = time();
  812: 		$self->_fixate($self->{'data'}) if $self->{'data'} && ref($self->{'data'}) eq 'HASH';
  813: 		$self->{$table} = undef;	# No DBI handle; all queries use the in-memory data path
  814: 		return $self;

					

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

  815: 	}
  816: 
  817: 	# Derive the filename stem from the class name, NOT from any $table override.
  818: 	# This allows table => 'Sheet2' to query a different worksheet within the same
  819: 	# file (e.g. test1.xlsx with a 'sheet2' worksheet) without needing an explicit
  820: 	# dbname. When dbname is set explicitly it always wins.
●821 → 832 → 858  821: 	my $class_stem = ref($self);
  822: 	$class_stem =~ s/\A.*:://;
  823: 	my $dbname = $self->{'dbname'} || $defaults{'dbname'} || $class_stem;
  824: 	# \A/\z (not ^/$) so a trailing newline cannot sneak past the $ anchor.
  825: 	Carp::croak(ref($self), ": unsafe dbname '$dbname'")
  826: 		unless $dbname =~ /\A[a-zA-Z0-9_.-]+\z/ && $dbname !~ /\.\./;
  827: 
  828: 	# When a remote host is given, fetch all candidate files into a local temp
  829: 	# directory via File::Slurp::Remote (SSH/SCP).  localhost / 127.0.0.1 / the
  830: 	# current machine's hostname are treated as local (no SSH, no temp dir).
  831: 	my $dir;
  832: 	if(my $host = $self->{'host'} || $defaults{'host'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  833: 		if($self->_is_local_host($host)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  834: 			$self->_debug("host '$host' is local; reading directory directly");
  835: 			$dir = Cwd::abs_path($self->{'directory'} || $defaults{'directory'});
  836: 		} else {
  837: 			require File::Slurp::Remote;
  838: 			my $remote_dir = $self->{'directory'} || $defaults{'directory'};
  839: 			my $tmpdir_obj = File::Temp->newdir(CLEANUP => 1);
  840: 			$self->{'_remote_tmpdir'} = $tmpdir_obj;	# auto-cleans on DESTROY
  841: 			my $tmpdir = $tmpdir_obj->dirname();
  842: 			for my $ext (qw(sql dbm deep db csv.gz db.gz psv xlsx csv xml)) {
  843: 				my $remote_file = "$remote_dir/$dbname.$ext";
  844: 				my $content = eval { scalar File::Slurp::Remote::read_remote_file($host, $remote_file) };
  845: 				next unless defined($content) && length($content);
  846: 				my $local = File::Spec->catfile($tmpdir, "$dbname.$ext");
  847: 				open(my $fh, '>', $local);
  848: 				binmode $fh;
  849: 				print $fh $content;
  850: 				close $fh;
  851: 				$self->_debug("fetched remote $host:$remote_file");
  852: 			}
  853: 			$dir = $tmpdir;
  854: 		}
  855: 	} else {
  856: 		$dir = Cwd::abs_path($self->{'directory'} || $defaults{'directory'});
  857: 	}
●858 → 865 → 870  858: 	my $slurp_file = File::Spec->catfile($dir, "$dbname.sql");
  859: 
  860: 	$self->_debug("_open: try to open $slurp_file");
  861: 
  862: 	# Probe for DBM::Deep files (.dbm or .deep) before the CSV/BerkeleyDB fallback.
  863: 	# Loaded lazily so the DBM::Deep module is not required for other backends.
  864: 	my $deep_file;
  865: 	for my $ext (qw(dbm deep)) {
  866: 		my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
  867: 		if(-r $candidate) { $deep_file = $candidate; last }

  Mutants (Total: 1, Killed: 1, Survived: 0)
  868: 	}
  869: 	# Also detect DBM::Deep files by magic bytes (covers .db files and arbitrary extensions).
●870 → 870 → 876  870: 	if(!$deep_file) {

					

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

  871: 		my $db_candidate = File::Spec->catfile($dir, "$dbname.db");
  872: 		$deep_file = $db_candidate if -r $db_candidate && $self->_is_deep_db($db_candidate);
  873: 	}
  874: 
  875: 	# Look at various places to find the file and derive the file type from the file's name
●876 → 876 → 883  876: 	if(-r $slurp_file) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  877: 		# SQLite file
  878: 		require DBD::SQLite::Constants;
  879: 		$dbh = DBI->connect("dbi:SQLite:dbname=$slurp_file", undef, undef, {
  880: 			sqlite_open_flags => DBD::SQLite::Constants::SQLITE_OPEN_READONLY(),
  881: 		});
  882: 	}
●883 → 883 → 1141  883: 	if($dbh) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  884: 		$dbh->do('PRAGMA synchronous = OFF');
  885: 		$dbh->do('PRAGMA cache_size = -4096');	# Use 4MB cache - negative = KB)
  886: 		$dbh->do('PRAGMA journal_mode = OFF');	# Read-only, no journal needed
  887: 		$dbh->do('PRAGMA temp_store = MEMORY');	# Store temp data in RAM
  888: 		$dbh->do('PRAGMA mmap_size = 1048576');	# Use 1MB memory-mapped I/O
  889: 		$dbh->sqlite_busy_timeout(100000);	# 10s
  890: 		$self->_debug("read in $table from SQLite $slurp_file");
  891: 		$self->{'type'} = 'DBI';
  892: 	} elsif($deep_file) {
  893: 		# DBM::Deep file (.dbm or .deep) — slurp the entire tied hash into a plain
  894: 		# Perl hash so all existing in-memory fast-paths work without modification.
  895: 		require DBM::Deep;
  896: 		my $deep = DBM::Deep->new({ file => $deep_file, read_only => 1 });
  897: 		my $id = $self->{'id'};
  898: 		if($self->{'no_entry'}) {

					

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

  899: 			# Not keyed — produce an ordered arrayref of row hashrefs, same as CSV no_entry.
  900: 			my @data;
  901: 			for my $k (sort keys %{$deep}) {
  902: 				my $row = $deep->{$k};
  903: 				# Use reftype (not ref) so blessed DBM::Deep::Hash objects are recognised.
  904: 				# Inject the outer key as the id column so criteria on that column work.
  905: 				push @data, (Scalar::Util::reftype($row) // '') eq 'HASH'
  906: 					? { $id => $k, %{$row} }
  907: 					: { $id => $k, value => $row };
  908: 			}
  909: 			$self->{'data'} = @data ? \@data : undef;
  910: 		} else {
  911: 			# Keyed on the primary-key column (default: 'entry') for O(1) lookups.
  912: 			# Each row hash must contain the id column (like CSV rows), so that
  913: 			# selectall_arrayref and AUTOLOAD can access it by name.
  914: 			my %data;
  915: 			for my $k (keys %{$deep}) {
  916: 				my $row = $deep->{$k};
  917: 				$data{$k} = (Scalar::Util::reftype($row) // '') eq 'HASH'
  918: 					? { $id => $k, %{$row} }
  919: 					: { $id => $k, value => $row };
  920: 			}
  921: 			$self->{'data'} = %data ? \%data : undef;
  922: 		}
  923: 		$slurp_file = $deep_file;
  924: 		$self->_debug("read in $table from DBM::Deep $deep_file");
  925: 		$self->{'type'} = 'Deep';
  926: 	} elsif($self->_is_berkeley_db(File::Spec->catfile($dir, "$dbname.db"))) {
  927: 		$self->_debug("$table is a BerkeleyDB file");
  928: 		$self->{'type'} = 'BerkeleyDB';
  929: 	} else {
  930: 		my $fin;
  931: 		# File::pfopen splits $path on ':' which breaks Windows drive letters
  932: 		# (C:\foo becomes ['C', '\foo']).  Since we always have a single directory
  933: 		# we use File::Spec->catfile directly — same behaviour, portable.
  934: 		my $gz_file;
  935: 		for my $ext (qw(csv.gz db.gz)) {
  936: 			my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
  937: 			next unless -r $candidate;
  938: 			open($fin, '<', $candidate);
  939: 			$gz_file = $candidate;
  940: 			last;
  941: 		}
  942: 		if($gz_file) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  943: 			require Gzip::Faster;
  944: 
  945: 			close($fin);
  946: 			$fin = File::Temp->new(SUFFIX => '.csv', UNLINK => 1, CLEANUP => 1);
  947: 			print $fin Gzip::Faster::gunzip_file($gz_file);
  948: 			$fin->flush();
  949: 			$slurp_file = $fin->filename();
  950: 			$self->{'_temp_fh'} = $fin;	# Keep object alive; auto-unlinks at DESTROY
  951: 		} else {
  952: 			my $psv = File::Spec->catfile($dir, "$dbname.psv");
  953: 			if(-r $psv) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  954: 				open($fin, '<', $psv);
  955: 				# Pipe separated file
  956: 				$slurp_file = $psv;
  957: 				$params->{'sep_char'} = '|';
  958: 			} else {
  959: 				# CSV or BerkeleyDB-extension file
  960: 				for my $ext (qw(csv db)) {
  961: 					my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
  962: 					next unless -r $candidate;
  963: 					open($fin, '<', $candidate);
  964: 					$slurp_file = $candidate;
  965: 					last;
  966: 				}
  967: 			}
  968: 		}
  969: 		if(my $filename = $self->{'filename'} || $defaults{'filename'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  970: 			Carp::croak(ref($self), ": unsafe filename '$filename'")
  971: 				unless $filename =~ /\A[a-zA-Z0-9_.-]+\z/ && $filename !~ /\.\./;
  972: 			$self->_debug("Looking for $filename in $dir");
  973: 			$slurp_file = File::Spec->catfile($dir, $filename);
  974: 		}
  975: 		if(defined($slurp_file) && (-r $slurp_file)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  976: 			close($fin) if(defined($fin));
  977: 			my $sep_char = $params->{'sep_char'};
  978: 
  979: 			$self->_debug(__LINE__, ' of ', __PACKAGE__, ": slurp_file = $slurp_file, sep_char = $sep_char");
  980: 
  981: 			if($params->{'column_names'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  982: 				$dbh = DBI->connect("dbi:CSV:db_name=$slurp_file", undef, undef,
  983: 					{
  984: 						csv_sep_char => $sep_char,
  985: 						csv_tables => {
  986: 							$table => {
  987: 								col_names => $params->{'column_names'},
  988: 							},
  989: 						},
  990: 						f_dir      => $dir,
  991: 						RaiseError => 1,
  992: 						PrintError => 0
  993: 					}
  994: 				);
  995: 			} else {
  996: 				$dbh = DBI->connect("dbi:CSV:db_name=$slurp_file", undef, undef, { csv_sep_char => $sep_char, f_dir => $dir, RaiseError => 1 });
  997: 			}
  998: 			$dbh->{'RaiseError'} = 1;
  999: 
 1000: 			$self->_debug("read in $table from CSV $slurp_file");
 1001: 
 1002: 			$dbh->{csv_tables}->{$table} = {
 1003: 				allow_loose_quotes => 1,
 1004: 				blank_is_undef => 1,
 1005: 				empty_is_undef => 1,
 1006: 				binary => 1,
 1007: 				f_file => $slurp_file,
 1008: 				escape_char => '\\',
 1009: 				sep_char => $sep_char,
 1010: 				# Don't do this, causes "Bizarre copy of HASH
 1011: 				#	in scalar assignment in error_diag
 1012: 				#	RT121127
 1013: 				# auto_diag => 1,
 1014: 				auto_diag => 0,
 1015: 				# Don't do this, it causes "Attempt to free unreferenced scalar"
 1016: 				# callbacks => {
 1017: 					# after_parse => sub {
 1018: 						# my ($csv, @rows) = @_;
 1019: 						# my @rc;
 1020: 						# foreach my $row(@rows) {
 1021: 							# if($row->[0] !~ /^#/) {
 1022: 								# push @rc, $row;
 1023: 							# }
 1024: 						# }
 1025: 						# return @rc;
 1026: 					# }
 1027: 				# }
 1028: 			};
 1029: 
 1030: 			# Text::xSV::Slurp cannot override column names, so skip slurp when
 1031: 			# column_names is set — the DBI CSV connection will supply names instead.
 1032: 			if(((-s $slurp_file) <= $max_slurp_size) && !$params->{'column_names'}) {

  Mutants (Total: 4, Killed: 4, Survived: 0)
 1033: 				if((-s $slurp_file) == 0) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1034: 					# Empty file
 1035: 					$self->{'data'} = ();
 1036: 				} else {
 1037: 					require Text::xSV::Slurp;
 1038: 
 1039: 					$self->_debug('slurp in');
 1040: 
 1041: 					my $dataref = Text::xSV::Slurp::xsv_slurp(
 1042: 						shape => 'aoh',
 1043: 						text_csv => {
 1044: 							sep_char => $sep_char,
 1045: 							allow_loose_quotes => 1,
 1046: 							blank_is_undef => 1,
 1047: 							empty_is_undef => 1,
 1048: 							binary => 1,
 1049: 							escape_char => '\\',
 1050: 						},
 1051: 						# string => \join('', grep(!/^\s*(#|$)/, <DATA>))
 1052: 						file => $slurp_file
 1053: 					);
 1054: 
 1055: 					# Filter out blank lines and comment rows (lines starting with #)
 1056: 					# Two passes replaced with one: pre-compute id column to avoid N hash
 1057: 				# lookups per element, and combine both conditions into one grep.
 1058: 				my $id_col = $self->{'id'};
 1059: 				my @data = grep { defined($_->{$id_col}) && $_->{$id_col} !~ /\A\s*#/ } @{$dataref};
 1060: 
 1061: 					if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1062: 						# Not keyed on a primary column — keep as ordered list.
 1063: 						# Only store a reference when rows were found; an empty-array ref
 1064: 						# is truthy, which would activate the in-memory fast-path and
 1065: 						# silently return 0 results instead of falling through to SQL.
 1066: 						$self->{'data'} = @data ? \@data : undef;
 1067: 					} else {
 1068: 						# Key the hash by $self->{'id'} for O(1) entry lookups
 1069: 						$self->{'data'} = { map { $_->{$self->{'id'}} => $_ } @data };
 1070: 					}
 1071: 				}
 1072: 			}
 1073: 			$self->{'type'} = 'CSV';
 1074: 		} else {
 1075: 			my $xlsx_file = File::Spec->catfile($dir, "$dbname.xlsx");
 1076: 			if(-r $xlsx_file) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1077: 				# Excel workbook via DBD::Excel — each worksheet is a SQL table.
 1078: 				# Loaded lazily; not required for any other backend.
 1079: 				require DBD::Excel;
 1080: 				$dbh = DBI->connect("dbi:Excel:file=$xlsx_file", undef, undef, {
 1081: 					RaiseError => 1,
 1082: 					PrintError => 0,
 1083: 				}) or Carp::croak(ref($self), ": can't open $xlsx_file: $DBI::errstr");
 1084: 				$self->{'type'} = 'Excel';
 1085: 				$slurp_file = $xlsx_file;
 1086: 			} else {
 1087: 				$slurp_file = File::Spec->catfile($dir, "$dbname.xml");
 1088: 				if(-r $slurp_file) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1089: 					if((-s $slurp_file) <= $max_slurp_size) {

					

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

 1090: 						require XML::Simple;
 1091: 
 1092: 						my $xml = XML::Simple::XMLin($slurp_file);
 1093: 						my @keys = keys %{$xml};
 1094: 						my $key = $keys[0];
 1095: 						my @data;
 1096: 						if(ref($xml->{$key}) eq 'ARRAY') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1097: 							@data = @{$xml->{$key}};
 1098: 						} elsif(ref($xml) eq 'ARRAY') {
 1099: 							@data = @{$xml};
 1100: 						} elsif((ref($xml) eq 'HASH') && !$self->{'no_entry'}) {
 1101: 							if(scalar(keys %{$xml}) == 1) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1102: 								if($xml->{$table}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1103: 									@data = $xml->{$table};
 1104: 								} else {
 1105: 									Carp::croak('XML slurp: complex documents with an "entry" field are not yet supported');
 1106: 								}
 1107: 							} else {
 1108: 								Carp::croak('XML slurp: multi-key documents are not yet supported');
 1109: 							}
 1110: 						} else {
 1111: 							Carp::croak('XML slurp: cannot handle ', ref($xml), ' structure');
 1112: 						}
 1113: 						if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1114: 							# Not keyed, will need to scan each entry
 1115: 							my $i = 0;
 1116: 							foreach my $d(@data) {
 1117: 								$self->{'data'}->{$i++} = $d;
 1118: 							}
 1119: 						} else {
 1120: 							# keyed on the $self->{'id'} (default: "entry") column
 1121: 							foreach my $d(@data) {
 1122: 								$self->{'data'}->{$d->{$self->{'id'}}} = $d;
 1123: 							}
 1124: 						}
 1125: 					} else {
 1126: 						$dbh = DBI->connect('dbi:XMLSimple(RaiseError=>1):');
 1127: 						$dbh->{'RaiseError'} = 1;
 1128: 						$self->_debug("read in $table from XML $slurp_file");
 1129: 						$dbh->func($table, 'XML', $slurp_file, 'xmlsimple_import');
 1130: 					}
 1131: 				} else {
 1132: 					# throw Error(-file => "$dir/$table");
 1133: 					$self->_fatal("Can't find a file called '$dbname' for the table $table in $dir");
 1134: 				}
 1135: 				$self->{'type'} = 'XML';
 1136: 			}
 1137: 		}
 1138: 	}
 1139: 
 1140: 	# ref() must be called on the variable, not on the result of 'eq'
 1141: 	$self->_fixate($self->{'data'}) if($self->{'data'} && (ref($self->{'data'}) eq 'HASH'));
 1142: 
 1143: 	$self->{$table} = $dbh;
 1144: 	my @statb = stat($slurp_file);
 1145: 	$self->{'_updated'} = $statb[9];
 1146: 
 1147: 	return $self;

					

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

 1148: }
 1149: 
 1150: =head2 selectall_arrayref
 1151: 
 1152: Returns a reference to an array of hash references for every row that
 1153: matches the given criteria, or C<undef> when there are no matches.
 1154: 
 1155:     my $rows = $db->selectall_arrayref();                    # all rows
 1156:     my $rows = $db->selectall_arrayref(status => 'active');  # exact match
 1157:     my $rows = $db->selectall_arrayref(score => { '>' => 8 });  # operator
 1158: 
 1159: The full criteria syntax is described in L</QUERY CRITERIA>.
 1160: 
 1161: Pass a C<join> key to combine with another table:
 1162: 
 1163:     my $rows = $db->selectall_arrayref(
 1164:         dept_name => 'Engineering',
 1165:         join      => { table => 'dept', on => 'e.dept_id = dept.id' },
 1166:     );
 1167: 
 1168: Results are returned in the cache (if configured) and the returned array
 1169: reference is made read-only unless C<no_fixate> was set.
 1170: 
 1171: B<Note:> this always returns all matching rows.  Use L</selectall_array>
 1172: in scalar context, or C<< $db->query->limit(1)->all() >>, to fetch just one row.
 1173: 
 1174: =head3 PSEUDOCODE
 1175: 
 1176:     1. Parse criteria; extract and build any JOIN clause.
 1177:     2. If data is slurped AND no joins AND criteria are simple:
 1178:        a. No criteria -> return all rows as arrayref.
 1179:        b. entry-only lookup -> return [$data{entry}].
 1180:        c. Otherwise -> scan rows in-memory with _match_criterion.
 1181:     3. Otherwise build SQL: SELECT * FROM table [JOIN] [WHERE] ORDER BY id.
 1182:     4. Check cache; return cached arrayref on HIT.
 1183:     5. prepare_cached + execute; fetch all rows.
 1184:     6. Store result in cache; fixate the array; return arrayref.
 1185: 
 1186: =cut
 1187: 
 1188: sub selectall_arrayref {
●1189 → 1199 → 1204 1189: 	my $self = shift;
 1190: 
 1191: 	# Fire _open() first so $self->{'berkeley'} is known before we parse @_.
 1192: 	# BerkeleyDB param parsing must use get_params(undef, \@_) so that
 1193: 	# key-value pairs like (join => {...}) are not mangled by the positional
 1194: 	# 'entry' mapping that non-BerkeleyDB paths use.
 1195: 	$self->_open_table({});
 1196: 
 1197: 	my $params;
 1198: 
 1199: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1200: 		$params = Params::Get::get_params(undef, \@_) // {};
 1201: 		return set_return($self->_scan_berkeley($params), { type => 'arrayref' });

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1202: 	}
 1203: 
●1204 → 1204 → 1210 1204: 	if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1205: 		$params = Params::Get::get_params(undef, \@_);
 1206: 	} elsif(scalar(@_)) {
 1207: 		$params = Params::Get::get_params('entry', @_);
 1208: 	}
 1209: 
●1210 → 1215 → 1219 1210: 	my $table = $self->_open_table($params);
 1211: 
 1212: 	$params //= {};
 1213: 
 1214: 	my $join_clause = '';
 1215: 	if(my $join_spec = delete $params->{'join'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1216: 		$join_clause = $self->_build_joins($join_spec);
 1217: 	}
 1218: 
●1219 → 1219 → 1252 1219: 	if(!$join_clause && $self->{'data'} && !$self->_has_complex_criteria($params)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1220: 		if(scalar(keys %{$params}) == 0) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1221: 			$self->_trace("$table: selectall_arrayref fast track return");
 1222: 			if(ref($self->{'data'}) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1223: 				$self->_debug("$table: returning ", scalar keys %{$self->{'data'}}, ' entries');
 1224: 				if(scalar keys %{$self->{'data'}} <= 10) {

					

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

 1225: 					$self->_debug(do { require Data::Dumper; Data::Dumper::Dumper($self->{'data'}) });
 1226: 				}
 1227: 				my @rc = values %{$self->{'data'}};
 1228: 				return set_return(\@rc, { type => 'arrayref' });

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1229: 			}
 1230: 			return set_return($self->{'data'}, { type => 'arrayref'});

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1231: 		} elsif((scalar(keys %{$params}) == 1) && defined($params->{'entry'}) && !$self->{'no_entry'}) {

					

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

 1232: 			# exists() guard: fixate() locks all keys in the slurp hash; return []
 1233: 			# (not [undef]) when the key is missing so callers get an empty result
 1234: 			return set_return([], { type => 'arrayref' })

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1235: 				unless exists($self->{'data'}->{$params->{'entry'}});
 1236: 			return set_return([$self->{'data'}->{$params->{'entry'}}], { type => 'arrayref' });

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1237: 		} elsif(ref($self->{'data'}) eq 'HASH') {
 1238: 			# Scan in-memory hash for simple column criteria without touching DBI.
 1239: 			# fixate() locks hash keys, so use exists() to avoid throwing on unknown columns.
 1240: 			$self->_debug("$table: selectall_arrayref in-memory scan with criteria");
 1241: 			# Pre-compute param keys once — avoids re-running keys() inside the inner
 1242: 			# closure on every row iteration (N hash-key extractions → 1).
 1243: 			my @param_keys = keys %{$params};
 1244: 			my @rc = grep {
 1245: 				my $row = $_;
 1246: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}) } @param_keys
 1247: 			} values %{$self->{'data'}};
 1248: 			return set_return(\@rc, { type => 'arrayref' });

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1249: 		}
 1250: 	}
 1251: 
●1252 → 1257 → 1266 1252: 	my ($where, $wargs) = $self->_build_where($params);
 1253: 	my @query_args = @{$wargs};
 1254: 
 1255: 	my $query = "SELECT * FROM $table";
 1256: 	$query .= " $join_clause" if $join_clause;
 1257: 	if($join_clause) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1258: 		$query .= " WHERE $where" if $where;
 1259: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 1260: 		my $id = $self->{'id'};
 1261: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1262: 		$query .= " AND ($where)" if $where;
 1263: 	} else {
 1264: 		$query .= " WHERE $where" if $where;
 1265: 	}
●1266 → 1266 → 1270 1266: 	if(!$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1267: 		$query .= ' ORDER BY ' . $self->{'id'};
 1268: 	}
 1269: 
●1270 → 1270 → 1276 1270: 	if(defined($query_args[0])) {

					

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

 1271: 		$self->_debug("selectall_arrayref $query: ", join(', ', @query_args));
 1272: 	} else {
 1273: 		$self->_debug("selectall_arrayref $query");
 1274: 	}
 1275: 
●1276 → 1278 → 1298 1276: 	my $key;
 1277: 	my $c;
 1278: 	if($c = $self->{cache}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1279: 		$key = ref($self) . "::$query array";
 1280: 		if(defined($query_args[0])) {

					

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

 1281: 			$key .= ' ' . join(', ', @query_args);
 1282: 		}
 1283: 		$self->_debug("cache key = '$key'");
 1284: 		if(my $rc = $c->get($key)) {

					

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

 1285: 			$self->_debug('cache HIT');
 1286: 			return $rc;	# We stored a ref to the array

					

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

 1287: 
 1288: 			# This use of a temporary variable is to avoid
 1289: 			#	"Implicit scalar context for array in return"
 1290: 			# my @rc = @{$rc};
 1291: 			# return @rc;
 1292: 		}
 1293: 		$self->_debug('cache MISS');
 1294: 	} else {
 1295: 		$self->_debug('cache not used');
 1296: 	}
 1297: 
●1298 → 1298 → 1313 1298: 	if(my $sth = $self->{$table}->prepare_cached($query)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1299: 		$sth->execute(@query_args) || croak("$query: @query_args");
 1300: 
 1301: 		my $rc;
 1302: 		while(my $href = $sth->fetchrow_hashref()) {
 1303: 			push @{$rc}, $href if %{$href};
 1304: 		}
 1305: 		$c->set($key, $rc, $self->{'cache_duration'}) if $c;
 1306: 
 1307: 		if($rc && !$self->{'no_fixate'}) {

					

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

 1308: 			$self->_fixate($rc);
 1309: 		}
 1310: 
 1311: 		return $rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1312: 	}
 1313: 	$self->_warn("selectall_arrayref failure on $query: @query_args");
 1314: 	croak("$query: @query_args");
 1315: }
 1316: 
 1317: =head2 selectall_hashref
 1318: 
 1319: Deprecated alias for L</selectall_arrayref>.  Use C<selectall_arrayref> in
 1320: new code.
 1321: 
 1322: =cut
 1323: 
 1324: sub selectall_hashref
 1325: {
 1326: 	my $self = shift;
 1327: 	return $self->selectall_arrayref(@_);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1328: }
 1329: 
 1330: =head2 selectall_array
 1331: 
 1332: Similar to L</selectall_arrayref> but returns a list of hash references
 1333: rather than a reference to an array.
 1334: 
 1335:     my @rows = $db->selectall_array(status => 'active');
 1336: 
 1337: In B<scalar context> it applies C<LIMIT 1> and returns just the first
 1338: matching hash reference - making it more efficient than C<selectall_arrayref>
 1339: when you only need one row.  In B<list context> all matching rows are returned.
 1340: 
 1341: Accepts the same criteria and C<join> parameter as L</selectall_arrayref>.
 1342: 
 1343: =cut
 1344: 
 1345: sub selectall_array
 1346: {
●1347 → 1351 → 1357 1347: 	my $self = shift;
 1348: 
 1349: 	$self->_open_table({});
 1350: 
 1351: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1352: 		my $params = Params::Get::get_params(undef, \@_) // {};
 1353: 		my $rows = $self->_scan_berkeley($params);
 1354: 		return wantarray ? @{$rows} : $rows->[0];

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1355: 	}
 1356: 
●1357 → 1362 → 1366 1357: 	my $params = Params::Get::get_params(undef, \@_);
 1358: 	my $table = $self->_open_table($params);
 1359: 
 1360: 	$params //= {};
 1361: 	my $join_clause = '';
 1362: 	if(my $join_spec = delete $params->{'join'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1363: 		$join_clause = $self->_build_joins($join_spec);
 1364: 	}
 1365: 
●1366 → 1366 → 1392 1366: 	if(!$join_clause && $self->{'data'} && !$self->_has_complex_criteria($params)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1367: 		if(scalar(keys %{$params}) == 0) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1368: 			$self->_trace("$table: selectall_array fast track return");
 1369: 			if(ref($self->{'data'}) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1370: 				return values %{$self->{'data'}};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1371: 			}
 1372: 			return @{$self->{'data'}};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1373: 		} elsif((scalar(keys %{$params}) == 1) && defined($params->{'entry'}) && !$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1374: 			# exists() guard: fixate() locks all keys; return empty list (not undef)
 1375: 			# for a missing entry so callers in list context get 0 elements not 1
 1376: 			return () unless exists($self->{'data'}->{$params->{'entry'}});
 1377: 			return $self->{'data'}->{$params->{'entry'}};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1378: 		} elsif(ref($self->{'data'}) eq 'HASH') {
 1379: 			# Same as selectall_arrayref scan but returns a list
 1380: 			$self->_debug("$table: selectall_array in-memory scan with criteria");
 1381: 			# Pre-compute param keys once — same optimisation as selectall_arrayref:
 1382: 			# avoids N * K hash-key extractions inside the inner closure.
 1383: 			my @param_keys = keys %{$params};
 1384: 			my @rc = grep {
 1385: 				my $row = $_;
 1386: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}) } @param_keys
 1387: 			} values %{$self->{'data'}};
 1388: 			return @rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1389: 		}
 1390: 	}
 1391: 
●1392 → 1397 → 1406 1392: 	my ($where, $wargs) = $self->_build_where($params);
 1393: 	my @query_args = @{$wargs};
 1394: 
 1395: 	my $query = "SELECT * FROM $table";
 1396: 	$query .= " $join_clause" if $join_clause;
 1397: 	if($join_clause) {

					

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

 1398: 		$query .= " WHERE $where" if $where;
 1399: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 1400: 		my $id = $self->{'id'};
 1401: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1402: 		$query .= " AND ($where)" if $where;
 1403: 	} else {
 1404: 		$query .= " WHERE $where" if $where;
 1405: 	}
●1406 → 1406 → 1409 1406: 	if(!$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1407: 		$query .= ' ORDER BY ' . $self->{'id'};
 1408: 	}
●1409 → 1409 → 1413 1409: 	if(!wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1410: 		$query .= ' LIMIT 1';
 1411: 	}
 1412: 
●1413 → 1413 → 1419 1413: 	if(defined($query_args[0])) {

					

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

 1414: 		$self->_debug("selectall_array $query: ", join(', ', @query_args));
 1415: 	} else {
 1416: 		$self->_debug("selectall_array $query");
 1417: 	}
 1418: 
●1419 → 1421 → 1444 1419: 	my $key;
 1420: 	my $c;
 1421: 	if($c = $self->{cache}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1422: 		$key = ref($self) . '::' . $query;
 1423: 		if(wantarray) {

					

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

 1424: 			$key .= ' array';
 1425: 		}
 1426: 		if(defined($query_args[0])) {

					

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

 1427: 			$key .= ' ' . join(', ', @query_args);
 1428: 		}
 1429: 		$self->_debug("cache key = '$key'");
 1430: 		if(my $rc = $c->get($key)) {

					

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

 1431: 			$self->_debug('cache HIT');
 1432: 			return wantarray ? @{$rc} : $rc;	# We stored a ref to the array

					

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

 1433: 
 1434: 			# This use of a temporary variable is to avoid
 1435: 			#	"Implicit scalar context for array in return"
 1436: 			# my @rc = @{$rc};
 1437: 			# return @rc;
 1438: 		}
 1439: 		$self->_debug('cache MISS');
 1440: 	} else {
 1441: 		$self->_debug('cache not used');
 1442: 	}
 1443: 
●1444 → 1444 → 1467 1444: 	if(my $sth = $self->{$table}->prepare_cached($query)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1445: 		$sth->execute(@query_args) || croak("$query: @query_args");
 1446: 
 1447: 		my $rc;
 1448: 		while(my $href = $sth->fetchrow_hashref()) {
 1449: 			if(!wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1450: 				# Scalar context: return just the first row; cache it too
 1451: 				$sth->finish();
 1452: 				$c->set($key, [$href], $self->{'cache_duration'}) if $c;
 1453: 				return $href;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1454: 			}
 1455: 			push @{$rc}, $href;
 1456: 		}
 1457: 		$c->set($key, $rc, $self->{'cache_duration'}) if $c;
 1458: 
 1459: 		if($rc) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1460: 			if(!$self->{'no_fixate'}) {

					

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

 1461: 				$self->_fixate($rc);
 1462: 			}
 1463: 			return @{$rc};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1464: 		}
 1465: 		return;
 1466: 	}
 1467: 	$self->_warn("selectall_array failure on $query: @query_args");
 1468: 	croak("$query: @query_args");
 1469: }
 1470: 
 1471: =head2 selectall_hash
 1472: 
 1473: Deprecated alias for L</selectall_array>.  Use C<selectall_array> in new
 1474: code.
 1475: 
 1476: =cut
 1477: 
 1478: sub selectall_hash
 1479: {
 1480: 	my $self = shift;
 1481: 	return $self->selectall_array(@_);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1482: }
 1483: 
 1484: =head2 count
 1485: 
 1486: Returns the number of rows matching the given criteria.
 1487: 
 1488:     my $total  = $db->count();
 1489:     my $active = $db->count(status => 'active');
 1490:     my $high   = $db->count(score  => { '>' => 90 });
 1491: 
 1492: Accepts the full criteria syntax described in L</QUERY CRITERIA>.
 1493: 
 1494: =cut
 1495: 
 1496: sub count
 1497: {
●1498 → 1502 → 1507 1498: 	my $self = shift;
 1499: 
 1500: 	$self->_open_table({});
 1501: 
 1502: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1503: 		my $params = Params::Get::get_params(undef, \@_) // {};
 1504: 		return scalar @{$self->_scan_berkeley($params)};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1505: 	}
 1506: 
●1507 → 1510 → 1537 1507: 	my $params = Params::Get::get_params(undef, \@_);
 1508: 	my $table = $self->_open_table($params);
 1509: 
 1510: 	if($self->{'data'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1511: 		if(scalar(keys %{$params}) == 0) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1512: 			$self->_trace("$table: count fast track return");
 1513: 			if(ref($self->{'data'}) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1514: 				return scalar keys %{$self->{'data'}};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1515: 			}
 1516: 			return scalar @{$self->{'data'}};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1517: 		} elsif((scalar(keys %{$params}) == 1) && defined($params->{'entry'}) && !$self->{'no_entry'}) {

					

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

 1518: 			# exists() guard: fixate() locks all keys in the slurp hash
 1519: 			return (exists($self->{'data'}->{$params->{'entry'}}) && $self->{'data'}->{$params->{'entry'}}) ? 1 : 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1520: 		} elsif(!$self->_has_complex_criteria($params) && !$self->{$table}) {
 1521: 			# General in-memory scan for simple column criteria.
 1522: 			# Only taken when there is no DBI handle ($self->{$table} is undef),
 1523: 			# i.e. slurp-only backends like Deep.  CSV/XML/SQLite have a DBI handle
 1524: 			# and must fall through to the SQL path so that column-name validation
 1525: 			# fires in _build_where_conditions.
 1526: 			$self->_debug("$table: count in-memory scan");
 1527: 			my @param_keys = keys %{$params};
 1528: 			# Pass the row list directly to grep — avoids materialising an
 1529: 			# intermediate @rows array of N references on the stack.
 1530: 			return scalar grep {

					

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

 1531: 				my $row = $_;
 1532: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}) } @param_keys
 1533: 			} (ref($self->{'data'}) eq 'HASH' ? values %{$self->{'data'}} : @{$self->{'data'}});
 1534: 		}
 1535: 	}
 1536: 
●1537 → 1541 → 1553 1537: 	my ($where, $wargs) = $self->_build_where($params);
 1538: 	my @query_args = @{$wargs};
 1539: 
 1540: 	my $query;
 1541: 	if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1542: 		my $id = $self->{'id'};
 1543: 		$query = "SELECT COUNT(*) FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1544: 		$query .= " AND ($where)" if $where;
 1545: 	} elsif($self->{'no_entry'}) {
 1546: 		$query = "SELECT COUNT(*) FROM $table";
 1547: 		$query .= " WHERE $where" if $where;
 1548: 	} else {
 1549: 		$query = "SELECT COUNT(" . $self->{'id'} . ") FROM $table";
 1550: 		$query .= " WHERE $where" if $where;
 1551: 	}
 1552: 
●1553 → 1553 → 1559 1553: 	if(defined($query_args[0])) {

					

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

 1554: 		$self->_debug("count $query: ", join(', ', @query_args));
 1555: 	} else {
 1556: 		$self->_debug("count $query");
 1557: 	}
 1558: 
●1559 → 1561 → 1583 1559: 	my $key;
 1560: 	my $c;
 1561: 	if($c = $self->{'cache'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1562: 		# Opportunistic: if a selectall_arrayref for the same criteria is already
 1563: 		# in cache, derive the count from that array rather than hitting the DB.
 1564: 		# The key is built to match what selectall_arrayref would store.
 1565: 		$key = ref($self) . '::' . $query;
 1566: 		# [^)]+ is a negated character class: O(n) with zero backtracking.
 1567: 		# The former lazy .+? could scan past the first ) in pathological SQL;
 1568: 		# [^)]+ is also semantically correct (COUNT(expr) never contains ) ).
 1569: 		$key =~ s/COUNT\(([^)]+)\)/$1/;
 1570: 		$key .= ' array';
 1571: 		if(defined($query_args[0])) {

					

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

 1572: 			$key .= ' ' . join(', ', @query_args);
 1573: 		}
 1574: 		if(my $rc = $c->get($key)) {

					

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

 1575: 			$self->_debug('count: cache HIT (selectall array)');
 1576: 			return ref($rc) eq 'ARRAY' ? scalar @{$rc} : 0;

					

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

 1577: 		}
 1578: 		$self->_debug('count: cache MISS');
 1579: 	} else {
 1580: 		$self->_debug('cache not used');
 1581: 	}
 1582: 
●1583 → 1583 → 1591 1583: 	if(my $sth = $self->{$table}->prepare_cached($query)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1584: 		$sth->execute(@query_args) || croak("$query: @query_args");
 1585: 
 1586: 		my $count = $sth->fetchrow_arrayref()->[0];
 1587: 		$sth->finish();
 1588: 
 1589: 		return $count;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1590: 	}
 1591: 	$self->_warn("count failure on $query: @query_args");
 1592: 	croak("$query: @query_args");
 1593: }
 1594: 
 1595: =head2 fetchrow_hashref
 1596: 
 1597: Returns a hash reference for the first row matching the given criteria,
 1598: or C<undef> when there is no match.  Always applies C<LIMIT 1>.
 1599: 
 1600:     my $row = $db->fetchrow_hashref(entry => 'key1');
 1601:     my $row = $db->fetchrow_hashref(score => { '>=' => 10 });
 1602: 
 1603: When C<no_entry> is B<not> set you may pass a single bare value and it is
 1604: used as the C<entry> key:
 1605: 
 1606:     my $row = $db->fetchrow_hashref('key1');    # same as entry => 'key1'
 1607: 
 1608: Accepts the full criteria syntax described in L</QUERY CRITERIA>, including
 1609: the C<join> parameter:
 1610: 
 1611:     my $row = $db->fetchrow_hashref(
 1612:         name => 'Alice',
 1613:         join => { table => 'dept', on => 'e.dept_id = dept.id' },
 1614:     );
 1615: 
 1616: Pass C<< table => $other_table >> to query a table other than the one
 1617: derived from the class name.
 1618: 
 1619: =cut
 1620: 
 1621: sub fetchrow_hashref {
●1622 → 1628 → 1634 1622: 	my $self = shift;
 1623: 
 1624: 	$self->_trace('Entering fetchrow_hashref');
 1625: 
 1626: 	my $params;
 1627: 
 1628: 	if(!$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1629: 		$params = Params::Get::get_params('entry', @_);
 1630: 	} else {
 1631: 		$params = Params::Get::get_params(undef, @_);
 1632: 	}
 1633: 
●1634 → 1637 → 1643 1634: 	my $table = $self->_open_table($params);
 1635: 
 1636: 	# ::diag($self->{'type'});
 1637: 	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)
 1638: 		$self->_debug('Fast return from slurped data');
 1639: 		# Use exists(), fixate() locks the outer hash; accessing a missing key throws
 1640: 		return exists($self->{'data'}->{$params->{'entry'}}) ? $self->{'data'}->{$params->{'entry'}} : undef;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1641: 	}
 1642: 
●1643 → 1643 → 1659 1643: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1644: 		# print STDERR ">>>>>>>>>>>>\n";
 1645: 		# ::diag(Data::Dumper->new([$self->{'berkeley'}])->Dump());
 1646: 		if((!$self->{'no_entry'}) && (scalar keys(%{$params}) == 1) && defined($params->{'entry'})) {

					

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

 1647: 			return { entry => $self->{'berkeley'}->{$params->{'entry'}} };
 1648: 		}
 1649: 		my $id = $self->{'id'};
 1650: 		if($self->{'no_entry'} && (scalar keys(%{$params}) == 1) && defined($id) && defined($params->{$id})) {

					

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

 1651: 			if(my $rc = $self->{'berkeley'}->{$params->{$id}}) {

					

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

 1652: 				return { $params->{$id} => $rc }	# Return key->value as a hash pair
 1653: 			}
 1654: 			return;
 1655: 		}
 1656: 		Carp::croak(ref($self), ': fetchrow_hashref is meaningless on a NoSQL database');
 1657: 	}
 1658: 
●1659 → 1667 → 1676 1659: 	my $target = delete($params->{'table'}) // $table;
 1660: 	my $join_spec = delete $params->{'join'};
 1661: 	my $join_clause = $join_spec ? $self->_build_joins($join_spec) : '';
 1662: 	my ($where, $wargs) = $self->_build_where($params);
 1663: 	my @query_args = @{$wargs};
 1664: 
 1665: 	my $query = "SELECT * FROM $target";
 1666: 	$query .= " $join_clause" if $join_clause;
 1667: 	if($join_clause) {

					

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

 1668: 		$query .= " WHERE $where" if $where;
 1669: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 1670: 		my $id = $self->{'id'};
 1671: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1672: 		$query .= " AND ($where)" if $where;
 1673: 	} else {
 1674: 		$query .= " WHERE $where" if $where;
 1675: 	}
●1676 → 1677 → 1688 1676: 	$query .= ' LIMIT 1';
 1677: 	if(defined($query_args[0])) {

					

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

 1678: 		my @call_details = caller(0);
 1679: 		$self->_debug("fetchrow_hashref $query: ", join(', ', @query_args),
 1680: 			' called from ', $call_details[2], ' of ', $call_details[1]);
 1681: 	} else {
 1682: 		$self->_debug("fetchrow_hashref $query");
 1683: 	}
 1684: 	# TODO: Data Flow Anomaly - D~: $key is computed unconditionally (string concat +
 1685: 	# join) even when no cache is configured.  When $self->{cache} is undef the
 1686: 	# assembled string is a dead store.  Cost is trivial but the logic would be
 1687: 	# cleaner inside the if($c) block below.
●1688 → 1689 → 1697 1688: 	my $key = ref($self) . '::';
 1689: 	if(defined($query_args[0])) {

					

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

 1690: 		if(wantarray) {

					

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

 1691: 			$key .= 'array ';
 1692: 		}
 1693: 		$key .= "fetchrow $query " . join(', ', @query_args);
 1694: 	} else {
 1695: 		$key .= "fetchrow $query";
 1696: 	}
●1697 → 1698 → 1710 1697: 	my $c;
 1698: 	if($c = $self->{cache}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1699: 		if(my $rc = $c->get($key)) {

					

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

 1700: 			if(wantarray) {

					

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

 1701: 				if(ref($rc) eq 'ARRAY') {

					

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

 1702: 					return @{$rc};	# We stored a ref to the array

					

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

 1703: 				}
 1704: 			} else {
 1705: 				return $rc;

					

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

 1706: 			}
 1707: 		}
 1708: 	}
 1709: 
●1710 → 1715 → 1724 1710: 	my $sth = $self->{$table}->prepare_cached($query)
 1711: 		or Carp::croak(ref($self), ": prepare failed: ", $self->{$table}->errstr());
 1712: 	$sth->execute(@query_args) || croak("$query: @query_args");
 1713: 	my $rc = $sth->fetchrow_hashref();
 1714: 	$sth->finish();
 1715: 	if($c) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1716: 		if($rc) {

					

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

 1717: 			$self->_debug("stash $key=>$rc in the cache for ", $self->{'cache_duration'});
 1718: 			$self->_debug("returns ", do { require Data::Dumper; Data::Dumper->new([$rc])->Dump() });
 1719: 		} else {
 1720: 			$self->_debug("Stash $key=>undef in the cache for ", $self->{'cache_duration'});
 1721: 		}
 1722: 		$c->set($key, $rc, $self->{'cache_duration'});
 1723: 	}
 1724: 	return $rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1725: }
 1726: 
 1727: =head2 execute
 1728: 
 1729: Execute a raw SQL query on the underlying database.
 1730: 
 1731:     # Scalar context: returns the first row as a hashref
 1732:     my $row = $db->execute(query => 'SELECT * FROM foo WHERE id = 1');
 1733: 
 1734:     # List context: returns all rows as a list of hashrefs
 1735:     my @rows = $db->execute(query => 'SELECT * FROM foo WHERE score > ?',
 1736:                             args  => [80]);
 1737: 
 1738: The C<FROM E<lt>tableE<gt>> clause is appended automatically if omitted.
 1739: 
 1740: On CSV tables without C<no_entry> it may help to add
 1741: C<WHERE entry IS NOT NULL AND entry NOT LIKE '#%'> to filter comment rows.
 1742: 
 1743: If the data have been slurped into memory this method still hits the actual
 1744: database file directly.
 1745: 
 1746: C<args> is an arrayref of bind values (see L<DBI/execute>).
 1747: 
 1748: =cut
 1749: 
 1750: sub execute
 1751: {
●1752 → 1754 → 1758 1752: 	my $self = shift;
 1753: 
 1754: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1755: 		Carp::croak(ref($self), ': execute is meaningless on a NoSQL database');
 1756: 	}
 1757: 
●1758 → 1780 → 1788 1758: 	my $args = Params::Get::get_params('query', @_);
 1759: 
 1760: 	# Ensure the 'query' parameter is provided
 1761: 	Carp::croak(__PACKAGE__, ': Usage: execute(query => $query)')
 1762: 		unless defined $args->{'query'};
 1763: 
 1764: 	my $table = $self->_open_table($args);
 1765: 
 1766: 	my $query = $args->{'query'};
 1767: 
 1768: 	# Append "FROM <table>" if missing
 1769: 	# \bFROM\b catches the keyword at any word boundary (space, tab, newline),
 1770: 	# unlike the former \sFROM\s which missed forms like "col\tFROM" or leading FROM.
 1771: 	$query .= " FROM $table" unless $query =~ /\bFROM\b/i;
 1772: 
 1773: 	# Log the query if a logger is available
 1774: 	$self->_debug("execute $query");
 1775: 
 1776: 	# Prepare and execute the query
 1777: 	my $sth = $self->{$table}->prepare_cached($query);
 1778: 	# DBI->execute() takes a list; normalise args to an array whether it
 1779: 	# was passed as an arrayref ([30]) or a bare scalar/list (30).
 1780: 	if(exists($args->{'args'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1781: 		my @bind = ref($args->{'args'}) eq 'ARRAY' ? @{$args->{'args'}} : ($args->{'args'});
 1782: 		$sth->execute(@bind) or croak("$query: ", join(', ', @bind));
 1783: 	} else {
 1784: 		$sth->execute() or croak($query);
 1785: 	}
 1786: 
 1787: 	# Fetch the results
●1788 → 1789 → 1798 1788: 	my @results;
 1789: 	while (my $row = $sth->fetchrow_hashref()) {
 1790: 		unless(wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1791: 			$sth->finish();
 1792: 			return $row;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1793: 		}
 1794: 		push @results, $row;
 1795: 	}
 1796: 
 1797: 	# Return all rows as an array in list context
 1798: 	return @results;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1799: }
 1800: 
 1801: =head2 updated
 1802: 
 1803: Returns the Unix timestamp of the last database update (mtime for
 1804: file-based backends, or the time of the most recent C<new()> call for
 1805: DSN-based connections).
 1806: 
 1807: =cut
 1808: 
 1809: sub updated {
 1810: 	my $self = shift;
 1811: 
 1812: 	return $self->{'_updated'};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1813: }
 1814: 
 1815: =head2 columns
 1816: 
 1817: Returns an array reference of column names for the current table.
 1818: 
 1819:     my $cols = $db->columns();    # e.g. ['entry', 'name', 'score', 'status']
 1820: 
 1821: The column list is determined by the backend:
 1822: 
 1823: =over 4
 1824: 
 1825: =item * B<Slurp mode> - sorted keys of the first row in memory.
 1826: 
 1827: =item * B<SQLite / other DBI> - a zero-row C<SELECT *> exposes the driver's
 1828: C<NAME> attribute.
 1829: 
 1830: =item * B<BerkeleyDB> - always returns C<['entry', 'value']>.
 1831: 
 1832: =back
 1833: 
 1834: The result is cached inside the object after the first call.
 1835: 
 1836: =cut
 1837: 
 1838: sub columns {
●1839 → 1847 → 1851 1839: 	my $self = shift;
 1840: 
 1841: 	return $self->{'_columns'} if $self->{'_columns'};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1842: 
 1843: 	my $table = $self->_open_table({});
 1844: 
 1845: 	my @cols;
 1846: 
 1847: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1848: 		return $self->{'_columns'} = ['entry', 'value'];

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1849: 	}
 1850: 
●1851 → 1851 → 1865 1851: 	if(my $data = $self->{'data'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1852: 		if(ref($data) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1853: 			my ($first) = values %{$data};
 1854: 			@cols = sort keys %{$first} if $first;
 1855: 		} elsif(ref($data) eq 'ARRAY' && @{$data}) {
 1856: 			@cols = sort keys %{$data->[0]};
 1857: 		}
 1858: 	} else {
 1859: 		my $sth = $self->{$table}->prepare_cached("SELECT * FROM $table WHERE 1=0");
 1860: 		$sth->execute();
 1861: 		@cols = @{$sth->{NAME}};
 1862: 		$sth->finish();
 1863: 	}
 1864: 
 1865: 	return $self->{'_columns'} = \@cols;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1866: }
 1867: 
 1868: =head2 schema
 1869: 
 1870: Returns a hash reference describing the schema of the current table.
 1871: Each key is a column name; each value is a hash reference with these keys:
 1872: 
 1873: =over 4
 1874: 
 1875: =item * C<type> - data type string (e.g. C<TEXT>, C<INTEGER>, C<REAL>)
 1876: 
 1877: =item * C<nullable> - C<1> if the column may be NULL, C<0> if NOT NULL
 1878: 
 1879: =item * C<default> - default value string, or C<undef>
 1880: 
 1881: =item * C<pk> - C<1> if this column is (part of) the primary key, C<0> otherwise
 1882: 
 1883: =back
 1884: 
 1885:     my $schema = $db->schema();
 1886: 
 1887:     for my $col (sort keys %{$schema}) {
 1888:         my $info = $schema->{$col};
 1889:         printf "%s  %s  %s\n",
 1890:             $col,
 1891:             $info->{type},
 1892:             $info->{nullable} ? 'NULL' : 'NOT NULL';
 1893:     }
 1894: 
 1895: The schema is determined by the backend:
 1896: 
 1897: =over 4
 1898: 
 1899: =item * B<SQLite> - C<PRAGMA table_info(table)>
 1900: 
 1901: =item * B<Other DBI drivers> - C<< $dbh->column_info(...) >>
 1902: 
 1903: =item * B<Slurp mode> - inferred from the first row (all columns typed as C<TEXT>)
 1904: 
 1905: =item * B<BerkeleyDB> - always returns C<entry> (pk) and C<value>
 1906: 
 1907: =back
 1908: 
 1909: The result is cached inside the object after the first call.
 1910: 
 1911: =cut
 1912: 
 1913: sub schema {
●1914 → 1921 → 1928 1914: 	my $self = shift;
 1915: 
 1916: 	return $self->{'_schema'} if $self->{'_schema'};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1917: 
 1918: 	my $table = $self->_open_table({});
 1919: 	my %schema;
 1920: 
 1921: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1922: 		return $self->{'_schema'} = {

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1923: 			entry => { type => 'TEXT', nullable => 0, default => undef, pk => 1 },
 1924: 			value => { type => 'TEXT', nullable => 1, default => undef, pk => 0 },
 1925: 		};
 1926: 	}
 1927: 
●1928 → 1928 → 1976 1928: 	if(my $data = $self->{'data'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1929: 		my $first;
 1930: 		if(ref($data) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1931: 			($first) = values %{$data};
 1932: 		} elsif(ref($data) eq 'ARRAY' && @{$data}) {
 1933: 			$first = $data->[0];
 1934: 		}
 1935: 		if($first) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1936: 			my $id = $self->{'id'};
 1937: 			for my $col (keys %{$first}) {
 1938: 				$schema{$col} = {
 1939: 					type     => 'TEXT',
 1940: 					nullable => ($col eq $id ? 0 : 1),
 1941: 					default  => undef,
 1942: 					pk       => ($col eq $id ? 1 : 0),
 1943: 				};
 1944: 			}
 1945: 		}
 1946: 	} else {
 1947: 		my $driver = $self->{$table}->{'Driver'}{'Name'} // '';
 1948: 		if($driver eq 'SQLite') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1949: 			my $sth = $self->{$table}->prepare_cached("PRAGMA table_info($table)");
 1950: 			$sth->execute();
 1951: 			while(my $row = $sth->fetchrow_hashref()) {
 1952: 				$schema{$row->{'name'}} = {
 1953: 					type     => $row->{'type'},
 1954: 					nullable => !$row->{'notnull'},
 1955: 					default  => $row->{'dflt_value'},
 1956: 					pk       => $row->{'pk'},
 1957: 				};
 1958: 			}
 1959: 			$sth->finish();
 1960: 		} else {
 1961: 			my $sth = $self->{$table}->column_info(undef, undef, $table, '%');
 1962: 			if($sth) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1963: 				while(my $row = $sth->fetchrow_hashref()) {
 1964: 					$schema{$row->{'COLUMN_NAME'}} = {
 1965: 						type     => $row->{'TYPE_NAME'},
 1966: 						nullable => $row->{'NULLABLE'},
 1967: 						default  => $row->{'COLUMN_DEF'},
 1968: 						pk       => 0,
 1969: 					};
 1970: 				}
 1971: 				$sth->finish();
 1972: 			}
 1973: 		}
 1974: 	}
 1975: 
 1976: 	return $self->{'_schema'} = \%schema;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1977: }
 1978: 
 1979: =head2 query
 1980: 
 1981: Returns a new L<Database::Abstraction::Query> builder object bound to this
 1982: database instance, for fluent method-chaining queries.
 1983: 
 1984:     # All active rows with high scores, newest first, max 10
 1985:     my $rows = $db->query
 1986:         ->where(status => 'active')
 1987:         ->where(score  => { '>' => 80 })
 1988:         ->order_by('score DESC')
 1989:         ->limit(10)
 1990:         ->all();
 1991: 
 1992:     # Single row
 1993:     my $row = $db->query->where(name => 'Alice')->first();
 1994: 
 1995:     # Just a count
 1996:     my $n = $db->query->where(status => 'active')->count();
 1997: 
 1998: See L<Database::Abstraction::Query> for the full API.
 1999: 
 2000: =cut
 2001: 
 2002: sub query
 2003: {
 2004: 	my $self = shift;
 2005: 	require Database::Abstraction::Query;
 2006: 	return Database::Abstraction::Query->new(_db => $self);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2007: }
 2008: 
 2009: =head2 AUTOLOAD - column shortcut
 2010: 
 2011: Calling an unknown method whose name matches a column name performs a column
 2012: lookup.  The method name is the column you want; the arguments are criteria.
 2013: 
 2014:     # Scalar context: return the first match
 2015:     my $name = $db->name(entry => 'key1');
 2016: 
 2017:     # List context: return all matching values
 2018:     my @names = $db->name();
 2019: 
 2020:     # Shortcut when the table has an 'entry' key column
 2021:     my $name = $db->name('key1');    # same as name(entry => 'key1')
 2022: 
 2023:     # Unique/distinct values
 2024:     my @statuses = $db->status(distinct => 1);
 2025: 
 2026: B<In list context> the full column is returned (all rows), ordered by the
 2027: column value.  B<In scalar context> only the first match is returned
 2028: (C<LIMIT 1>).
 2029: 
 2030: Results come from the slurp cache when available.
 2031: 
 2032: Throws an error if the column does not exist (slurp mode) or if AUTOLOAD
 2033: has been disabled with C<< auto_load => 0 >>.
 2034: 
 2035: =head3 PSEUDOCODE
 2036: 
 2037:     1. Extract column name from $AUTOLOAD; guard on DESTROY.
 2038:     2. Croak if auto_load => 0.
 2039:     3. Validate $column against /^[a-zA-Z_][a-zA-Z0-9_]*$/.
 2040:     4. If data is slurped:
 2041:        a. List context, no params -> map column over all rows (exists guard).
 2042:        b. entry-only param -> direct hash lookup (exists guard).
 2043:        c. No params, scalar -> first value in hash.
 2044:        d. no_entry set -> scan array for matching key/value pair.
 2045:        e. Other params -> scan keyed hash for matching column.
 2046:     5. If not slurped, build SQL:
 2047:        - List:   SELECT column FROM table [WHERE ...] ORDER BY column
 2048:        - Scalar: SELECT DISTINCT column FROM table [WHERE ...] LIMIT 1
 2049:     6. Check cache; return on HIT.
 2050:     7. prepare_cached + execute; fetch result.
 2051:     8. Store in cache; fixate; return.
 2052: 
 2053: =cut
 2054: 
 2055: sub AUTOLOAD {
●2056 → 2075 → 2087 2056: 	our $AUTOLOAD;
 2057: 	my ($column) = $AUTOLOAD =~ /::(\w+)\z/;
 2058: 
 2059: 	return if($column eq 'DESTROY');
 2060: 	return if($column =~ /\A_/);	# never treat private method names as column lookups
 2061: 
 2062: 	my $self = shift or return;
 2063: 
 2064: 	Carp::croak(__PACKAGE__, ": Unknown column $column") if(!ref($self));
 2065: 
 2066: 	# Allow the AUTOLOAD feature to be disabled
 2067: 	Carp::croak(__PACKAGE__, ": AUTOLOAD disabled (auto_load => 0)") if(exists($self->{'auto_load'}) && !$self->{'auto_load'});
 2068: 
 2069: 	# Validate column name - only allow safe column name
 2070: 	Carp::croak(__PACKAGE__, ": Invalid column name: $column") unless $column =~ $SAFE_IDENTIFIER;
 2071: 
 2072: 	my $table = $self->_open_table();
 2073: 
 2074: 	my %params;
 2075: 	if(ref($_[0]) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2076: 		%params = %{$_[0]};
 2077: 	} elsif((scalar(@_) % 2) == 0) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2078: 		%params = @_;
 2079: 	} elsif(scalar(@_) == 1) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2080: 		# Don't error on key-value databases, since there's no idea of columns
 2081: 		if($self->{'no_entry'} && !$self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2082: 			Carp::croak(ref($self), "::($_[0]): ", $self->{'id'}, ' is not a column');
 2083: 		}
 2084: 		$params{'entry'} = shift;
 2085: 	}
 2086: 
●2087 → 2087 → 2094 2087: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2088: 		if(my $id = $self->{'id'}) {

					

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

 2089: 			return $self->{'berkeley'}->{$params{$id}};

					

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

 2090: 		}
 2091: 		return $self->{'berkeley'}->{$params{'entry'}};

					

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

 2092: 	}
 2093: 
●2094 → 2099 → 2195 2094: 	croak('Where did the data come from?') if(!defined($self->{'type'}));
 2095: 	my $query;
 2096: 	my $done_where = 0;
 2097: 	my $distinct = delete($params{'distinct'}) || delete($params{'unique'});
 2098: 
 2099: 	if(wantarray && !$distinct) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2100: 		if(((scalar keys %params) == 0) && (my $data = $self->{'data'})) {

					

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

 2101: 			# Return all column values from the in-memory hash.
 2102: 			# Use exists() because fixate() locks inner row hashes —
 2103: 			# accessing a disallowed key would throw without the guard.
 2104: 			# Handle both HASH (keyed data) and ARRAY (no_entry CSV slurp).
 2105: 			my @_rows = ref($data) eq 'ARRAY' ? @{$data} : values %{$data};
 2106: 			return map { exists($_->{$column}) ? $_->{$column} : undef } @_rows;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2107: 		}
 2108: 		my $id = $self->{'id'};
 2109: 		if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2110: 			$query = "SELECT $column FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 2111: 			$done_where = 1;
 2112: 		} else {
 2113: 			$query = "SELECT $column FROM $table";
 2114: 		}
 2115: 	} else {
 2116: 		if(my $data = $self->{'data'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2117: 			# The data has been read in using Text::xSV::Slurp,
 2118: 			#	so no need to do any SQL
 2119: 			$self->_debug('AUTOLOAD using slurped data');
 2120: 			if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2121: 				$self->_debug('no_entry is set');
 2122: 				my ($key, $value) = %params;
 2123: 				if(defined($key)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2124: 					$self->_debug("key = $key, value = $value, column = $column");
 2125: 					foreach my $row(@{$data}) {
 2126: 						# exists() guards: fixate() locks row hashes recursively
 2127: 						next unless exists($row->{$key}) && defined($row->{$key}) && $row->{$key} eq $value;
 2128: 						my $rc = exists($row->{$column}) ? $row->{$column} : undef;
 2129: 						$self->_trace(__LINE__, ": AUTOLOAD $key: return ", defined($rc) ? "'$rc'" : 'undef', ' from slurped data');
 2130: 						return $rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2131: 					}
 2132: 					$self->_debug('not found in slurped data');
 2133: 				}
 2134: 			} elsif(((scalar keys %params) == 1) && defined(my $key = $params{'entry'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2135: 				# Look up a single entry by its key.
 2136: 				# Use exists() before accessing — fixate() locks the outer hash and
 2137: 				# dereferencing a missing key on a locked hash throws an exception.
 2138: 				my $rc;
 2139: 				if(exists($data->{$key}) && defined(my $hash = $data->{$key})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2140: 					if(!exists($hash->{$column})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2141: 						Carp::croak(__PACKAGE__, ": There is no column $column in $table");
 2142: 					}
 2143: 					$rc = $hash->{$column};
 2144: 				}
 2145: 				if(defined($rc)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2146: 					$self->_trace(__LINE__, ": AUTOLOAD $key: return '$rc' from slurped data");
 2147: 				} else {
 2148: 					$self->_trace(__LINE__, ": AUTOLOAD $key: return undef from slurped data");
 2149: 				}
 2150: 				return $rc

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2151: 			} elsif((scalar keys %params) == 0) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2152: 				if(wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2153: 					if($distinct) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2154: 						# Single pass instead of three (map→grep→map): avoids three
 2155: 						# intermediate lists of size N on the stack.
 2156: 						my %h;
 2157: 						for my $r (values %{$data}) {
 2158: 							my $v = exists($r->{$column}) ? $r->{$column} : undef;
 2159: 							$h{$v} = 1 if defined $v;
 2160: 						}
 2161: 						return keys %h;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2162: 					}
 2163: 					# DEAD CODE: unreachable because the outer `if(wantarray && !$distinct)`
 2164: 					# handles the wantarray+!distinct case. In this else branch, wantarray
 2165: 					# implies $distinct (which returns above), so this line is never executed.
 2166: 					# return map { exists($_->{$column}) ? $_->{$column} : undef } values %{$data}
 2167: 				}
 2168: 				# Scalar: return the first value found without building a full list
 2169: 				foreach my $v (values %{$data}) {
 2170: 					return exists($v->{$column}) ? $v->{$column} : undef;

					

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

 2171: 				}
 2172: 			} else {
 2173: 				# Keyed data but filtering on a non-key column
 2174: 				my ($key, $value) = %params;
 2175: 				foreach my $row (values %{$data}) {
 2176: 					next unless exists($row->{$key}) && defined($row->{$key}) && $row->{$key} eq $value;
 2177: 					next unless exists($row->{$column});
 2178: 					if(my $rc = $row->{$column}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2179: 						$self->_trace(__LINE__, ": AUTOLOAD $key: return '$rc' from slurped data");
 2180: 						return $rc

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2181: 					}
 2182: 				}
 2183: 			}
 2184: 			return
 2185: 		}
 2186: 		# Data has not been slurped in
 2187: 		my $id = $self->{'id'};
 2188: 		if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2189: 			$query = "SELECT DISTINCT $column FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 2190: 			$done_where = 1;
 2191: 		} else {
 2192: 			$query = "SELECT DISTINCT $column FROM $table";
 2193: 		}
 2194: 	}
●2195 → 2197 → 2212 2195: 	my @args;
 2196: 	# Avoid `each` — it carries hidden iterator state across calls
 2197: 	for my $k (sort keys %params) {
 2198: 		# Guard against SQL injection via column names — same rule as _build_where_conditions
 2199: 		Carp::croak(__PACKAGE__, ": unsafe column name '$k'")
 2200: 			unless $k =~ $SAFE_QUALIFIED;
 2201: 		my $value = $params{$k};
 2202: 		$self->_debug(__PACKAGE__, ": AUTOLOAD adding key/value pair $k=>", defined($value) ? $value : 'NULL');
 2203: 		if(defined($value)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2204: 			$query .= $done_where ? " AND $k = ?" : " WHERE $k = ?";
 2205: 			$done_where = 1;
 2206: 			push @args, $value;
 2207: 		} else {
 2208: 			$query .= $done_where ? " AND $k IS NULL" : " WHERE $k IS NULL";
 2209: 			$done_where = 1;
 2210: 		}
 2211: 	}
●2212 → 2212 → 2217 2212: 	if(wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2213: 		$query .= " ORDER BY $column";
 2214: 	} else {
 2215: 		$query .= ' LIMIT 1';
 2216: 	}
●2217 → 2217 → 2222 2217: 	if(scalar(@args) && $args[0]) {

					

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

 2218: 		$self->_debug("AUTOLOAD $query: ", join(', ', @args));
 2219: 	} else {
 2220: 		$self->_debug("AUTOLOAD $query");
 2221: 	}
●2222 → 2224 → 2241 2222: 	my $cache;
 2223: 	my $key = ref($self) . '::';
 2224: 	if($cache = $self->{cache}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2225: 		if(wantarray) {

					

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

 2226: 			$key .= 'array ';
 2227: 		}
 2228: 		if(defined($args[0])) {

					

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

 2229: 			$key .= "fetchrow $query " . join(', ', @args);
 2230: 		} else {
 2231: 			$key .= "fetchrow $query";
 2232: 		}
 2233: 		if(my $rc = $cache->get($key)) {

					

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

 2234: 			$self->_debug('cache HIT');
 2235: 			return wantarray ? @{$rc} : $rc;	# We stored a ref to the array

					

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

 2236: 		}
 2237: 		$self->_debug('cache MISS');
 2238: 	} else {
 2239: 		$self->_debug('cache not used');
 2240: 	}
●2241 → 2244 → 2254 2241: 	my $sth = $self->{$table}->prepare_cached($query) || croak($query);
 2242: 	$sth->execute(@args) || croak($query);
 2243: 
 2244: 	if(wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2245: 		# fetchall_arrayref([0]) asks DBI to project column 0 server-side, so each
 2246: 		# returned row is [$col0] instead of the full row — less memory, same result.
 2247: 		my @rc = map { $_->[0] } @{$sth->fetchall_arrayref([0])};
 2248: 		if($cache) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2249: 			$cache->set($key, \@rc, $self->{'cache_duration'});	# Store a ref to the array
 2250: 		}
 2251: 		Database::Abstraction::_fixate($self, \@rc) if(scalar(@rc) && !$self->{'no_fixate'});
 2252: 		return @rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2253: 	}
●2254 → 2256 → 2260 2254: 	my $rc = $sth->fetchrow_array();	# Return the first match only
 2255: 	$sth->finish();
 2256: 	if($cache) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2257: 		# Store the value, then return it — cache->set() return value is unreliable
 2258: 		$cache->set($key, $rc, $self->{'cache_duration'});
 2259: 	}
 2260: 	return $rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2261: }
 2262: 
 2263: sub DESTROY
 2264: {
●2265 → 2265 → 2269 2265: 	if(defined($^V) && ($^V ge 'v5.14.0')) {

					

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

 2266: 		return if ${^GLOBAL_PHASE} eq 'DESTRUCT';	# >= 5.14.0 only
 2267: 	}
 2268: 
●2269 → 2273 → 2280 2269: 	my $self = shift;
 2270: 
 2271: 	# Clean up temporary files — deleting File::Temp objects triggers auto-unlink/rmdir
 2272: 	# If that doesn't happen for some reason, explicitly unlink
 2273: 	if(defined $self->{'_temp_fh'}) {

					

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

 2274: 		my $temp_fh = $self->{'_temp_fh'};
 2275: 		my $temp_path = eval { $temp_fh->filename() };
 2276: 		delete $self->{'_temp_fh'};
 2277: 		# Fallback explicit unlink if File::Temp didn't clean up
 2278: 		unlink($temp_path) if defined($temp_path) && -f $temp_path;
 2279: 	}
●2280 → 2286 → 2292 2280: 	delete $self->{'_remote_tmpdir'};
 2281: 
 2282: 	# Clean up database handles
 2283: 	my $table_name = $self->{'table'} || ref($self);
 2284: 	$table_name =~ s/\A.*:://;
 2285: 
 2286: 	if(my $dbh = delete $self->{$table_name}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2287: 		$dbh->disconnect() if $dbh->can('disconnect');
 2288: 		$dbh->finish() if $dbh->can('finish');
 2289: 	}
 2290: 
 2291: 	# Clean up Berkeley DB
●2292 → 2292 → 2300 2292: 	if($self->{'berkeley'}) {

					

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

 2293: 		eval {
 2294: 			untie %{$self->{'berkeley'}};
 2295: 		};
 2296: 		delete $self->{'berkeley'};
 2297: 	}
 2298: 
 2299: 	# Clear all other attributes to break potential circular references
●2300 → 2300 → 0 2300: 	foreach my $key (keys %$self) {
 2301: 		delete $self->{$key};
 2302: 	}
 2303: }
 2304: 
 2305: # Build the JOIN clause(s) from a single join hashref or arrayref of hashrefs.
 2306: # Each spec needs keys: table (required), on (required), type (default INNER).
 2307: sub _build_joins
 2308: {
●2309 → 2314 → 2324 2309: 	my ($self, $join_spec) = @_;
 2310: 
 2311: 	my @specs = ref($join_spec) eq 'ARRAY' ? @{$join_spec} : ($join_spec);
 2312: 	my @clauses;
 2313: 
 2314: 	for my $j (@specs) {
 2315: 		my $type  = uc($j->{'type'}  // 'INNER');
 2316: 		my $jtable = $j->{'table'} or Carp::croak('join: missing "table"');
 2317: 		Carp::croak("join: unsafe table name '$jtable'")
 2318: 			unless $jtable =~ $SAFE_QUALIFIED;
 2319: 		my $on     = $j->{'on'}    or Carp::croak('join: missing "on" condition');
 2320: 		Carp::croak("Invalid JOIN type: $type") unless $VALID_JOIN_TYPES{$type};
 2321: 		push @clauses, "$type JOIN $jtable ON ($on)";
 2322: 	}
 2323: 
 2324: 	return join(' ', @clauses);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2325: }
 2326: 
 2327: # Return true when $params contains operator hashrefs, -or, or -and groupings
 2328: # that the simple slurp fast-path cannot handle.
 2329: sub _has_complex_criteria
 2330: {
●2331 → 2334 → 2337 2331: 	my ($self, $params) = @_;
 2332: 	return 0 unless defined $params;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2333: 	return 1 if exists $params->{'-or'} || exists $params->{'-and'};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2334: 	for my $v (values %{$params}) {
 2335: 		return 1 if ref($v);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2336: 	}
 2337: 	return 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2338: }
 2339: 
 2340: # Build the WHERE clause body (everything after "WHERE") from a criteria hash.
 2341: # Handles -or / -and groupings then delegates per-column work to _build_where_conditions.
 2342: # Returns ($sql_fragment, \@bind_values).
 2343: # Wrapper around Data::Reuse::fixate() that suppresses the spurious
 2344: # "Use of uninitialized value in hash slice" warning.  Data::Alias's XS
 2345: # hash-aliasing code does not fully initialise key SVs on older Perl
 2346: # versions when the source hash contains undef values (NULL columns).
 2347: # Data::Reuse still fixates correctly; the warning is a false positive.
 2348: # $struct must be the hashref or arrayref to fixate.
 2349: sub _fixate :Private
 2350: {
 2351: 	my (undef, $struct) = @_;
 2352: 	return unless defined $struct;
 2353: 	# Clear stale address→canonical mappings from prior fixate calls before
 2354: 	# fixating $struct.  Without this, freed hashref addresses from a previous
 2355: 	# object's slurp or DBI result can be reused by the allocator for new
 2356: 	# hashrefs; fixate() would then find the stale entry and alias the new
 2357: 	# hashref to the wrong canonical, silently substituting one row's data for
 2358: 	# another.  This is the same stale-address hazard that affects DBI paths
 2359: 	# (see selectall_arrayref / selectall_array) but also affects the slurp
 2360: 	# fixate when earlier objects go out of scope before a new slurp runs.
 2361: 	Data::Reuse::forget();
 2362: 	local $SIG{__WARN__} = sub {
 2363: 		# Two index() calls replace the former /.*\b/ — no backtracking at all.
 2364: 		# The prefix check is constant-time; the suffix scan is O(n) but stops
 2365: 		# at the first match rather than first matching greedily then retreating.
 2366: 		warn @_ unless
 2367: 			index($_[0], 'Use of uninitialized value') == 0

					

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

 2368: 			&& index($_[0], 'in hash slice') >= 0;

					

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

 2369: 	};
 2370: 	&Data::Reuse::fixate($struct);
 2371: }
 2372: 
 2373: sub _build_where
 2374: {
●2375 → 2388 → 2396 2375: 	my ($self, $params) = @_;
 2376: 
 2377: 	$params //= {};
 2378: 	my @clauses;
 2379: 	my @args;
 2380: 
 2381: 	# Avoid an O(K) hash copy in the common case where neither -or nor -and is
 2382: 	# present.  Only copy when we actually need to delete grouping keys, so the
 2383: 	# plain-criteria path (the vast majority of queries) passes $params through
 2384: 	# directly to _build_where_conditions without any allocation.
 2385: 	my $or_list  = $params->{'-or'};
 2386: 	my $and_list = $params->{'-and'};
 2387: 	my $plain;
 2388: 	if(defined($or_list) || defined($and_list)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2389: 		my %p = %{$params};
 2390: 		delete @p{qw(-or -and)};
 2391: 		$plain = \%p;
 2392: 	} else {
 2393: 		$plain = $params;
 2394: 	}
 2395: 
●2396 → 2396 → 2410 2396: 	if($or_list) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2397: 		my (@sub_clauses, @sub_args);
 2398: 		for my $cond (@{$or_list}) {
 2399: 			my ($s, $a) = $self->_build_where_conditions($cond);
 2400: 			if($s) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2401: 				push @sub_clauses, "($s)";
 2402: 				push @sub_args, @{$a};
 2403: 			}
 2404: 		}
 2405: 		if(@sub_clauses) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2406: 			push @clauses, '(' . join(' OR ', @sub_clauses) . ')';
 2407: 			push @args, @sub_args;
 2408: 		}
 2409: 	}
●2410 → 2410 → 2425 2410: 	if($and_list) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2411: 		my (@sub_clauses, @sub_args);
 2412: 		for my $cond (@{$and_list}) {
 2413: 			my ($s, $a) = $self->_build_where_conditions($cond);
 2414: 			if($s) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2415: 				push @sub_clauses, "($s)";
 2416: 				push @sub_args, @{$a};
 2417: 			}
 2418: 		}
 2419: 		if(@sub_clauses) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2420: 			push @clauses, '(' . join(' AND ', @sub_clauses) . ')';
 2421: 			push @args, @sub_args;
 2422: 		}
 2423: 	}
 2424: 
●2425 → 2426 → 2431 2425: 	my ($more, $margs) = $self->_build_where_conditions($plain);
 2426: 	if($more) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2427: 		push @clauses, $more;
 2428: 		push @args, @{$margs};
 2429: 	}
 2430: 
 2431: 	return (join(' AND ', @clauses), \@args);
 2432: }
 2433: 
 2434: # Build a WHERE-body fragment for a flat col => val hash.
 2435: # Values may be plain scalars (= / LIKE / IS NULL) or operator hashrefs
 2436: # ({ '>' => n }, { -in => [...] }, { -between => [lo,hi] }, etc.).
 2437: sub _build_where_conditions
 2438: {
●2439 → 2444 → 2497 2439: 	my ($self, $params) = @_;
 2440: 
 2441: 	my @clauses;
 2442: 	my @args;
 2443: 
 2444: 	for my $col (sort keys %{$params}) {
 2445: 		my $val = $params->{$col};
 2446: 
 2447: 		# Guard against SQL injection via column names; allow table.column notation for JOINs
 2448: 		Carp::croak("_build_where_conditions: unsafe column name '$col'")
 2449: 			unless $col =~ $SAFE_QUALIFIED;
 2450: 
 2451: 		if(ref($val) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2452: 			for my $op (keys %{$val}) {    # no sort — operator hashes typically have 1-2 keys; sort adds O(K log K) overhead
 2453: 				my $operand = $val->{$op};
 2454: 				if($op eq '-in' || $op eq '-not_in') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2455: 					my $sql_op = $op eq '-in' ? 'IN' : 'NOT IN';
 2456: 					my $ph = join(', ', ('?') x scalar(@{$operand}));
 2457: 					push @clauses, "$col $sql_op ($ph)";
 2458: 					push @args, @{$operand};
 2459: 				} elsif($op eq '-between') {
 2460: 					push @clauses, "$col BETWEEN ? AND ?";
 2461: 					push @args, $operand->[0], $operand->[1];
 2462: 				} elsif($op eq '-like') {
 2463: 					push @clauses, "$col LIKE ?";
 2464: 					push @args, $operand;
 2465: 				} elsif($op eq '-not_like') {
 2466: 					push @clauses, "$col NOT LIKE ?";
 2467: 					push @args, $operand;
 2468: 				} elsif($op eq '!=') {
 2469: 					if(!defined($operand)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2470: 						push @clauses, "$col IS NOT NULL";
 2471: 					} else {
 2472: 						push @clauses, "$col != ?";
 2473: 						push @args, $operand;
 2474: 					}
 2475: 				# [<>]=? matches >, <, >=, <= as a single character class — no alternation
 2476: 				# overhead, no backtracking, and self-documenting.
 2477: 				} elsif($op =~ /\A[<>]=?\z/) {
 2478: 					push @clauses, "$col $op ?";
 2479: 					push @args, $operand;
 2480: 				} else {
 2481: 					Carp::croak("Unknown operator '$op' for column '$col'");
 2482: 				}
 2483: 			}
 2484: 		} elsif(ref($val)) {
 2485: 			Carp::croak("$col: expected scalar or operator hashref, got ", ref($val));
 2486: 		} elsif(!defined($val)) {
 2487: 			push @clauses, "$col IS NULL";
 2488: 		} elsif($val =~ /[%_]/) {
 2489: 			push @clauses, "$col LIKE ?";
 2490: 			push @args, $val;
 2491: 		} else {
 2492: 			push @clauses, "$col = ?";
 2493: 			push @args, $val;
 2494: 		}
 2495: 	}
 2496: 
 2497: 	return (join(' AND ', @clauses), \@args);
 2498: }
 2499: 
 2500: # Test a single in-memory row value against a criteria value.
 2501: # $crit_val may be a plain scalar or an operator hashref.
 2502: # Returns true when the row value satisfies the criterion.
 2503: # Scan the entire BerkeleyDB tied hash, building rows as {entry=>$k, value=>$v},
 2504: # and filter by $params criteria using _match_criterion.
 2505: # Croaks when JOINs or -or/-and groupings are requested (unsupported for key-value stores).
 2506: sub _scan_berkeley
 2507: {
●2508 → 2516 → 2519 2508: 	my ($self, $params) = @_;
 2509: 	$params //= {};
 2510: 
 2511: 	# TODO: Data Flow Anomaly - Mutation side effect: delete mutates the caller's
 2512: 	# $params hashref in-place.  All current callers (selectall_arrayref,
 2513: 	# selectall_array, count) do not reuse $params after this call, so it is safe;
 2514: 	# but a future caller that reuses $params would silently lose the 'join' key.
 2515: 	# Fix: use exists($params->{'join'}) to check; copy params before deleting.
 2516: 	if(delete $params->{'join'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2517: 		Carp::croak(ref($self), ': BerkeleyDB does not support JOINs');
 2518: 	}
●2519 → 2519 → 2523 2519: 	if(grep { $_ eq '-or' || $_ eq '-and' } keys %{$params}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2520: 		Carp::croak(ref($self), ': BerkeleyDB does not support -or/-and groupings');
 2521: 	}
 2522: 
●2523 → 2527 → 2545 2523: 	my $bdb = $self->{'berkeley'};
 2524: 	my @cols = keys %{$params};
 2525: 	my @rows;
 2526: 
 2527: 	if(@cols) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2528: 		# Single-pass build+filter: avoids materialising the full N-row list
 2529: 		# before filtering.  Peak memory is O(matching rows) instead of O(N).
 2530: 		for my $k (keys %{$bdb}) {
 2531: 			my $row = { entry => $k, value => $bdb->{$k} };
 2532: 			my $match = 1;
 2533: 			for my $col (@cols) {
 2534: 				unless($self->_match_criterion($row->{$col}, $params->{$col})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2535: 					$match = 0;
 2536: 					last;
 2537: 				}
 2538: 			}
 2539: 			push @rows, $row if $match;
 2540: 		}
 2541: 	} else {
 2542: 		@rows = map { { entry => $_, value => $bdb->{$_} } } keys %{$bdb};
 2543: 	}
 2544: 
 2545: 	return \@rows;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2546: }
 2547: 
 2548: # SQL LIKE match — case-insensitive, ReDoS-safe, no catastrophic backtracking.
 2549: # % matches any sequence of chars; _ matches exactly one char.
 2550: #
 2551: # Fast paths cover the four most common LIKE shapes using O(1) string ops:
 2552: #   '%'        → always true
 2553: #   no wildcard → lc eq comparison
 2554: #   '%suffix'  → ends-with check via substr
 2555: #   'prefix%'  → starts-with check via index
 2556: #   '%mid%'    → contains check via index  (single inner literal, no _ wildcards)
 2557: #
 2558: # Full DP uses O(m) memory (two 1-D rolling arrays) instead of the O(m*n) 2-D
 2559: # table the naive approach allocates.  Character access uses substr() instead of
 2560: # split(//) so no per-character scalar objects are created.
 2561: sub _like_match
 2562: {
●2563 → 2579 → 2614 2563: 	my ($str, $pattern) = @_;
 2564: 
 2565: 	# Fast path 1: bare '%' — matches any string regardless of content.
 2566: 	return 1 if $pattern eq '%';

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2567: 
 2568: 	my $lc_str = lc($str);
 2569: 	my $lc_pat = lc($pattern);
 2570: 	my $pat_len = length($lc_pat);
 2571: 	my $str_len = length($lc_str);
 2572: 
 2573: 	# Fast path 2: no wildcard characters — plain case-insensitive equality.
 2574: 	return ($lc_str eq $lc_pat)
 2575: 		if index($lc_pat, '%') == -1 && index($lc_pat, '_') == -1;

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2576: 
 2577: 	# Fast paths 3-5 apply only when the pattern has no '_' wildcards.
 2578: 	# (Patterns with '_' need per-character DP to enforce the single-char rule.)
 2579: 	if(index($lc_pat, '_') == -1) {

					

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

 2580: 		my $first_pct = index($lc_pat, '%');
 2581: 		my $last_pct  = rindex($lc_pat, '%');
 2582: 
 2583: 		# Fast path 3: '%suffix' — exactly one '%', at the start.
 2584: 		if($first_pct == 0 && $last_pct == 0) {

					

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

 2585: 			my $sfx = substr($lc_pat, 1);
 2586: 			my $sfx_len = length($sfx);
 2587: 			return $str_len >= $sfx_len

					

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

 2588: 				&& substr($lc_str, $str_len - $sfx_len) eq $sfx;
 2589: 		}
 2590: 
 2591: 		# Fast path 4: 'prefix%' — exactly one '%', at the end.
 2592: 		if($last_pct == $pat_len - 1 && $first_pct == $pat_len - 1) {

					

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

 2593: 			my $pfx = substr($lc_pat, 0, $pat_len - 1);
 2594: 			return index($lc_str, $pfx) == 0;

  Mutants (Total: 3, Killed: 3, Survived: 0)
 2595: 		}
 2596: 
 2597: 		# Fast path 5: '%literal%' — '%' at both ends, no inner '%'.
 2598: 		# pat_len >= 3 ensures there are two distinct '%' characters.
 2599: 		# Only return here when the middle segment is free of further wildcards;
 2600: 		# if it contains '%' (e.g. '%a%b%'), fall through to the full DP.
 2601: 		if($first_pct == 0 && $last_pct == $pat_len - 1 && $pat_len >= 3) {

					

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

 2602: 			my $needle = substr($lc_pat, 1, $pat_len - 2);
 2603: 			if(index($needle, '%') == -1) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2604: 				return index($lc_str, $needle) >= 0;

  Mutants (Total: 5, Killed: 5, Survived: 0)
 2605: 			}
 2606: 		}
 2607: 	}
 2608: 
 2609: 	# Full DP — O(m*n) time, O(m) memory.
 2610: 	# Two 1-D arrayrefs (@$prev, @$curr) replace the O(m*n) 2-D table.
 2611: 	# substr() replaces split(//) — no per-char scalar allocation.
 2612: 	# Ref-swap ($prev,$curr) = ($curr,$prev) at the end of each outer iteration
 2613: 	# avoids the O(m) array copy that "@prev = @curr" would perform.
●2614 → 2619 → 2635 2614: 	my $m = $str_len;
 2615: 	my $n = $pat_len;
 2616: 
 2617: 	my ($prev, $curr) = ([1, (0) x $m], [(0) x ($m + 1)]);
 2618: 
 2619: 	for my $i (1 .. $n) {
 2620: 		@{$curr} = (0) x ($m + 1);    # zero in-place — reuses existing allocation
 2621: 		my $pc = substr($lc_pat, $i - 1, 1);
 2622: 		if($pc eq '%') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2623: 			$curr->[0] = $prev->[0];
 2624: 			for my $j (1 .. $m) {
 2625: 				$curr->[$j] = ($prev->[$j] || $curr->[$j - 1]) ? 1 : 0;
 2626: 			}
 2627: 		} else {
 2628: 			for my $j (1 .. $m) {
 2629: 				$curr->[$j] = ($prev->[$j - 1]
 2630: 					&& ($pc eq '_' || $pc eq substr($lc_str, $j - 1, 1))) ? 1 : 0;
 2631: 			}
 2632: 		}
 2633: 		($prev, $curr) = ($curr, $prev);    # O(1) ref swap — no array copy
 2634: 	}
 2635: 	return $prev->[$m];

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2636: }
 2637: 
 2638: sub _match_criterion
 2639: {
●2640 → 2642 → 2676 2640: 	my ($self, $row_val, $crit_val) = @_;
 2641: 
 2642: 	if(ref($crit_val) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2643: 		for my $op (keys %{$crit_val}) {
 2644: 			my $operand = $crit_val->{$op};
 2645: 			if($op eq '-in') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2646: 				return 0 unless defined($row_val) && grep { $row_val eq $_ } @{$operand};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2647: 			} elsif($op eq '-not_in') {
 2648: 				return 0 if defined($row_val) && grep { $row_val eq $_ } @{$operand};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2649: 			} elsif($op eq '-between') {
 2650: 				return 0 unless defined($row_val) && $row_val >= $operand->[0] && $row_val <= $operand->[1];

  Mutants (Total: 8, Killed: 8, Survived: 0)
 2651: 			} elsif($op eq '-like') {
 2652: 				return 0 unless defined($row_val);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2653: 				return 0 unless _like_match($row_val, $operand);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2654: 			} elsif($op eq '-not_like') {
 2655: 				return 0 unless defined($row_val);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2656: 				return 0 if _like_match($row_val, $operand);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2657: 			} elsif($op eq '!=') {
 2658: 				if(!defined($operand)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2659: 					return 0 unless defined($row_val);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2660: 				} else {
 2661: 					return 0 unless defined($row_val) && $row_val ne $operand;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2662: 				}
 2663: 			} elsif($op eq '>') {
 2664: 				return 0 unless defined($row_val) && $row_val > $operand;

  Mutants (Total: 5, Killed: 5, Survived: 0)
 2665: 			} elsif($op eq '<') {
 2666: 				return 0 unless defined($row_val) && $row_val < $operand;

  Mutants (Total: 5, Killed: 5, Survived: 0)
 2667: 			} elsif($op eq '>=') {
 2668: 				return 0 unless defined($row_val) && $row_val >= $operand;

  Mutants (Total: 5, Killed: 5, Survived: 0)
 2669: 			} elsif($op eq '<=') {
 2670: 				return 0 unless defined($row_val) && $row_val <= $operand;

  Mutants (Total: 5, Killed: 5, Survived: 0)
 2671: 			}
 2672: 		}
 2673: 		return 1;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2674: 	}
 2675: 
 2676: 	return !defined($row_val) && !defined($crit_val) ? 1

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2677: 		: !defined($row_val) || !defined($crit_val) ? 0
 2678: 		: $row_val eq $crit_val;
 2679: }
 2680: 
 2681: # Determine the table and open the database
 2682: sub _open_table
 2683: {
●2684 → 2690 → 2703 2684: 	my($self, $params) = @_;
 2685: 
 2686: 	# Derive the table name, caching the result in '_table_name' for the common
 2687: 	# case of no caller-supplied 'table' override.  Avoids repeating ref()+regex
 2688: 	# on every query when the same object makes many calls.
 2689: 	my $table;
 2690: 	if($params->{'table'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2691: 		($table = $params->{'table'}) =~ s/\A.*:://;
 2692: 	} else {
 2693: 		$table = $self->{'_table_name'} //= do {
 2694: 			my $t = $self->{'table'} || ref($self);
 2695: 			$t =~ s/\A.*:://;
 2696: 			$t;
 2697: 		};
 2698: 	}
 2699: 
 2700: 	# Open a connection if it's not already open.
 2701: 	# BerkeleyDB never sets $self->{$table} (no DBI handle) or $self->{'data'},
 2702: 	# so we also guard on $self->{'berkeley'} to avoid re-tying on every call.
 2703: 	$self->_open() if(!$self->{$table} && !$self->{'data'} && !$self->{'berkeley'});
 2704: 
 2705: 	return $table;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2706: }
 2707: 
 2708: # Quote a SQL identifier using the current connection's dialect rules.
 2709: # Falls back to ANSI double-quoting when no connection is available.
 2710: sub _quote_identifier
 2711: {
●2712 → 2716 → 2719 2712: 	my ($self, $name) = @_;
 2713: 
 2714: 	my $table = $self->{'table'} || ref($self);
 2715: 	$table =~ s/\A.*:://;
 2716: 	if(my $dbh = $self->{$table}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2717: 		return $dbh->quote_identifier($name);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2718: 	}
 2719: 	return qq{"$name"};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2720: }
 2721: 
 2722: # Determine whether a given file is a valid Berkeley DB file.
 2723: # It combines a fast preliminary check with a more thorough validation step for accuracy.
 2724: # It looks for the magic number at both byte 0 and byte 12.
 2725: sub _is_berkeley_db {
●2726 → 2737 → 2749 2726: 	my ($self, $file) = @_;
 2727: 
 2728: 	# Step 1: Check magic number
 2729: 	# no autodie here: the file may not exist, and we want a silent false return
 2730: 	my $fh;
 2731: 	do { no autodie qw(open); open $fh, '<', $file } or return 0;
 2732: 	binmode $fh;
 2733: 
 2734: 	my $is_db = $self->_has_bdb_magic($fh);
 2735: 	close $fh;
 2736: 
 2737: 	if($is_db) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2738: 		# Step 2: Attempt to open as Berkeley DB
 2739: 
 2740: 		require DB_File;
 2741: 
 2742: 		my %bdb;
 2743: 		if(tie %bdb, 'DB_File', $file, O_RDONLY, 0644, $DB_File::DB_HASH) {

					

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

 2744: 			# untie %db;
 2745: 			$self->{'berkeley'} = \%bdb;
 2746: 			return 1;	# Successfully identified as a Berkeley DB file

					

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

 2747: 		}
 2748: 	}
 2749: 	return 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2750: }
 2751: 
 2752: # Check for Berkeley DB magic bytes at offsets 0 and 12.
 2753: # Returns true if either location contains a recognised BDB magic number.
 2754: sub _has_bdb_magic {
 2755: 	my ($self, $fh) = @_;
 2756: 
 2757: 	# Offset 0: 32-bit magic number in both endian forms
 2758: 	read($fh, my $buf, 4) == 4 or return 0;

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2759: 	my %magic = map { $_ => 1 } (0x00061561, 0x00053162, 0x00042253, 0x00052444);
 2760: 	return 1 if $magic{unpack('N', $buf)} || $magic{unpack('V', $buf)};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2761: 
 2762: 	# Offset 12: Btree magic prefix (fallback for some BDB file variants)
 2763: 	seek $fh, 12, 0 or return 0;
 2764: 	read($fh, $buf, 4) or return 0;
 2765: 	my $hex12 = substr(unpack('H*', $buf), 0, 4);
 2766: 	return($hex12 eq '6115' || $hex12 eq '1561');
 2767: }
 2768: 
 2769: # Return true if $host refers to the current machine (localhost, loopback, or
 2770: # the machine's own hostname).  Strips an optional user@ prefix first.
 2771: # Used by new() and _open() to decide whether to use local file access instead
 2772: # of File::Slurp::Remote, so the caller never loads that module unnecessarily.
 2773: sub _is_local_host {
 2774: 	my ($self, $host) = @_;
 2775: 
 2776: 	# Strip optional user@ prefix.  \A (not ^) so a newline cannot split the match.
 2777: 	(my $bare = $host) =~ s/\A[^@]*@//;
 2778: 
 2779: 	# \z anchors at true end-of-string; $ would match before a trailing newline.
 2780: 	return 1 if $bare =~ /\A(?:localhost|127\.0\.0\.1|::1)\z/i;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2781: 
 2782: 	require Sys::Hostname;
 2783: 	my $me = lc(Sys::Hostname::hostname());
 2784: 	my $lc_bare = lc($bare);
 2785: 	return 1 if $lc_bare eq $me;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2786: 
 2787: 	# Match on short hostname: 'mybox' matches 'mybox.example.com' and vice-versa
 2788: 	(my $me_short   = $me)      =~ s/\..*//;
 2789: 	(my $bare_short = $lc_bare) =~ s/\..*//;
 2790: 	return($bare_short eq $me_short);
 2791: }
 2792: 
 2793: # Determine whether a given file is a DBM::Deep file by checking its magic bytes.
 2794: # The standard DBM::Deep magic is 'DPDB' (0x44 0x50 0x44 0x42); 'DPDP' (0x44 0x50 0x44 0x50)
 2795: # is also accepted for compatibility with files created by alternative tooling.
 2796: # Returns 1 if the first 4 bytes match a known DBM::Deep signature, 0 otherwise.
 2797: sub _is_deep_db {
 2798: 	my ($self, $file) = @_;
 2799: 
 2800: 	my $fh;
 2801: 	do { no autodie qw(open); open $fh, '<', $file } or return 0;
 2802: 	binmode $fh;
 2803: 	my $n = read($fh, my $magic, 4);
 2804: 	close $fh;
 2805: 	return 0 unless defined($n) && $n == 4;

  Mutants (Total: 3, Killed: 3, Survived: 0)
 2806: 
 2807: 	return($magic eq 'DPDB' || $magic eq 'DPDP');
 2808: }
 2809: 
 2810: # Log and remember a message
 2811: sub _log
 2812: {
●2813 → 2820 → 0 2813: 	my ($self, $level, @messages) = @_;
 2814: 
 2815: 	# FIXME: add caller's function
 2816: 	# if(($level eq 'warn') || ($level eq 'notice')) {
 2817: 		push @{$self->{'messages'}}, { level => $level, message => join('', grep defined, @messages) };
 2818: 	# }
 2819: 
 2820: 	if(scalar(@messages) && (my $logger = $self->{'logger'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2821: 		$self->{'logger'}->$level(join('', grep defined, @messages));
 2822: 	}
 2823: }
 2824: 
 2825: sub _debug {
 2826: 	my $self = shift;
 2827: 	$self->_log('debug', @_);
 2828: }
 2829: 
 2830: sub _trace {
 2831: 	my $self = shift;
 2832: 	$self->_log('trace', @_);
 2833: }
 2834: 
 2835: # Emit a warning message somewhere
 2836: sub _warn {
 2837: 	my $self = shift;
 2838: 	my $params = Params::Get::get_params('warning', \@_);
 2839: 
 2840: 	$self->_log('warn', $params->{'warning'});
 2841: 	Carp::carp(join('', grep defined, $params->{'warning'}));
 2842: }
 2843: 
 2844: # Die
 2845: sub _fatal {
 2846: 	my $self = shift;
 2847: 	my $params = Params::Get::get_params('warning', \@_);
 2848: 
 2849: 	$self->_log('error', $params->{'warning'});
 2850: 	Carp::croak(join('', grep defined, $params->{'warning'}));
 2851: }
 2852: 
 2853: =head1 AUTHOR
 2854: 
 2855: Nigel Horne, C<< <njh at nigelhorne.com> >>
 2856: 
 2857: =head1 SUPPORT
 2858: 
 2859: This module is provided as-is without any warranty.
 2860: 
 2861: Please report any bugs or feature requests to C<bug-database-abstraction at rt.cpan.org>,
 2862: or through the web interface at
 2863: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Database-Abstraction>.
 2864: I will be notified, and then you'll
 2865: automatically be notified of progress on your bug as I make changes.
 2866: 
 2867: =head1 MESSAGES
 2868: 
 2869: The table below lists every error that the module can croak or carp, what
 2870: triggers it, and how to resolve it.
 2871: 
 2872: =over 4
 2873: 
 2874: =item C<< I<Class>: abstract class >>
 2875: 
 2876: Direct instantiation of C<Database::Abstraction> was attempted.
 2877: Create a subclass and instantiate that instead.
 2878: 
 2879: =item C<< I<Class>: where are the files? >>
 2880: 
 2881: Neither C<directory> nor C<dsn> was supplied to C<new()>.
 2882: 
 2883: =item C<< I<Class>: I</path> is not a directory >>
 2884: 
 2885: The C<directory> argument exists on disk but is not a directory.
 2886: 
 2887: =item C<< I<Class>: cannot connect: I<$DBI::errstr> >>
 2888: 
 2889: DBI failed to connect to the given C<dsn>.  Check credentials and host.
 2890: 
 2891: =item C<< Can't find a file called 'I<name>' for the table I<T> in I<dir> >>
 2892: 
 2893: None of the probe extensions (C<.sql>, C<.psv>, C<.csv>, C<.xlsx>, C<.db>, C<.xml>)
 2894: matched in C<directory>.
 2895: 
 2896: =item C<< I<Class>: prepare failed: I<$errstr> >>
 2897: 
 2898: C<prepare_cached()> returned false.  Usually a syntax error in an internally
 2899: built query; file a bug if you see this from a normal API call.
 2900: 
 2901: =item C<< _build_where_conditions: unsafe column name 'I<name>' >>
 2902: 
 2903: A criteria key contained characters outside C<[A-Za-z0-9_.]>.
 2904: This is a SQL-injection guard.  Use only valid SQL identifier characters.
 2905: 
 2906: =item C<< join: missing "table" >> / C<< join: missing "on" condition >>
 2907: 
 2908: A join spec hashref is incomplete.  Both C<table> and C<on> are required.
 2909: 
 2910: =item C<< Invalid JOIN type: I<TYPE> >>
 2911: 
 2912: C<type> in a join spec was not one of C<INNER LEFT RIGHT FULL CROSS>.
 2913: 
 2914: =item C<< I<Class>: Unknown column I<col> >> / C<< I<Class>: AUTOLOAD disabled >>
 2915: 
 2916: An AUTOLOAD call was made for a column that does not exist, or AUTOLOAD
 2917: was disabled with C<< auto_load => 0 >>.
 2918: 
 2919: =item C<< Usage: set_logger(logger => $logger) >>
 2920: 
 2921: C<set_logger()> was called without a C<logger> argument.
 2922: 
 2923: =item C<< Usage: execute(query => $query) >>
 2924: 
 2925: C<execute()> was called without a C<query> argument.
 2926: 
 2927: =item C<< XML slurp: I<...> is not yet supported >>
 2928: 
 2929: The XML file structure is too complex for slurp mode.
 2930: Use C<< max_slurp_size => 0 >> to force the DBI/XMLSimple SQL path.
 2931: 
 2932: =item C<< I<Class>: I<method> is meaningless on a NoSQL database >>
 2933: 
 2934: A relational method (C<selectall_arrayref>, C<count>, C<execute>, etc.)
 2935: was called on a BerkeleyDB backend, which only supports key-value lookup
 2936: via C<fetchrow_hashref>.
 2937: 
 2938: =back
 2939: 
 2940: =head1 KNOWN LIMITATIONS
 2941: 
 2942: =over 4
 2943: 
 2944: =item *
 2945: 
 2946: B<Read-only.>  No INSERT, UPDATE, or DELETE is provided.  C<execute()>
 2947: runs raw read-only SQL.
 2948: 
 2949: =item *
 2950: 
 2951: B<Default CSV separator is C<!>>, not C<,>, for historical reasons.
 2952: Pass C<< sep_char => ',' >> for standard RFC 4180 files.
 2953: 
 2954: =item *
 2955: 
 2956: B<Primary-key column is named C<entry>>, not C<key>, because C<key>
 2957: is a SQL reserved word.  Override with the C<id> parameter.
 2958: 
 2959: =item *
 2960: 
 2961: B<XML slurp is limited.>  Only simple flat XML structures are supported
 2962: in slurp mode.  Multi-key or deeply nested documents will croak.
 2963: Force SQL mode with C<< max_slurp_size => 0 >> if slurp fails.
 2964: 
 2965: =item *
 2966: 
 2967: B<Unique key assumption in slurp mode.>  Duplicate values in the key
 2968: column silently overwrite earlier rows.  Disable slurp with
 2969: C<< max_slurp_size => 0 >> if duplicates are expected.
 2970: 
 2971: =item *
 2972: 
 2973: B<BerkeleyDB does not support joins or the chained query builder.>
 2974: 
 2975: =item *
 2976: 
 2977: B<Column names must be valid SQL identifiers> (letters, digits,
 2978: underscores, and a single dot for C<table.column> join notation).
 2979: Other characters will cause a croak.
 2980: 
 2981: =item *
 2982: 
 2983: B<count() cache is opportunistic.>  Count results are served from cache
 2984: only when a prior C<selectall_arrayref()> or C<count()> call with the
 2985: same criteria has already populated it.
 2986: 
 2987: =back
 2988: 
 2989: =head1 SEE ALSO
 2990: 
 2991: =over 4
 2992: 
 2993: =item * L<Database::Abstraction::Query> - chained query builder
 2994: 
 2995: =item * L<Configure an Object at Runtime|Object::Configure>
 2996: 
 2997: =item * L<Test Dashboard|https://nigelhorne.github.io/Database-Abstraction/coverage/>
 2998: 
 2999: =back
 3000: 
 3001: =head1 LICENSE AND COPYRIGHT
 3002: 
 3003: Copyright 2015-2026 Nigel Horne.
 3004: 
 3005: Usage is subject to the GPL2 licence terms.
 3006: If you use it,
 3007: please let me know.
 3008: 
 3009: =cut
 3010: 
 3011: 1;