lib/Database/Abstraction.pm

⬅ Previous Index
Structural Coverage (Approximate)

TER1 (Statement): 87.18%
TER2 (Branch): 73.89%
TER3 (LCSAJ): 100.0% (77/77)
Approximate LCSAJ segments: 629

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

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
  345: 			# Compatibility with CHI
  346: 			$params->{'cache_duration'} = $params->{'expires_in'};
  347: 		}
  348: 
  349: 		%defaults = (%defaults, %{$params});
  350: 		$defaults{'cache_duration'} ||= '1 hour';
  351: 	}
  352: 
  353: 	return \%defaults

  Mutants (Total: 2, Killed: 2, Survived: 0)
  354: }
  355: 
  356: =head2 import
  357: 
  358: The module can be initialised by the C<use> directive.
  359: 
  360:     use Database::Abstraction 'directory' => '/etc/data';
  361: 
  362: or
  363: 
  364:     use Database::Abstraction { 'directory' => '/etc/data' };
  365: 
  366: =cut
  367: 
  368: sub import
  369: {
●370 → 372 → 0  370: 	my $pkg = shift;
  371: 
  372: 	if((scalar(@_) % 2) == 0) {

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

					

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

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

					

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

  378: 		init(\@_);
  379: 	}
  380: }
  381: 
  382: =head2 new
  383: 
  384: Create an object pointing to a read-only database.
  385: 
  386: Accepts arguments as a hash, a hashref, or - as a shortcut - a single bare
  387: string which is taken to be C<directory>.
  388: 
  389: =head3 Connection parameters
  390: 
  391: =over 4
  392: 
  393: =item * C<directory>
  394: 
  395: Directory containing the data files.  The module probes this directory for
  396: files named after the subclass (see L</FILE FORMATS>).  Required unless
  397: C<dsn> is given.
  398: 
  399: =item * C<dsn>
  400: 
  401: A DBI data-source string (e.g. C<dbi:SQLite:dbname=/path/to/db> or
  402: C<dbi:Pg:dbname=mydb;host=db.example.com>).  When present, file detection
  403: is skipped entirely and the DSN is used directly.  The SQL dialect is
  404: inferred from the DSN prefix (C<sqlite>, C<postgres>, C<mysql>).
  405: 
  406: =item * C<username>
  407: 
  408: Database username.  Used only with C<dsn>; ignored for file-based backends.
  409: 
  410: =item * C<password>
  411: 
  412: Database password.  Used only with C<dsn>; ignored for file-based backends.
  413: 
  414: =item * C<dbname>
  415: 
  416: Override the filename stem searched in C<directory> (default: the table
  417: name derived from the class name).
  418: 
  419: =item * C<filename>
  420: 
  421: Override the full filename (relative to C<directory>).  Takes precedence
  422: over C<dbname>.
  423: 
  424: =back
  425: 
  426: =head3 Behaviour parameters
  427: 
  428: =over 4
  429: 
  430: =item * C<no_entry>
  431: 
  432: Set to C<1> when the table has no key column (standard CSVs, for example).
  433: Default is C<0> (keyed on C<entry>).
  434: 
  435: =item * C<id>
  436: 
  437: Name of the key column.  Default is C<entry>.
  438: 
  439: =item * C<sep_char>
  440: 
  441: Field separator for CSV/PSV files.
  442: Default is C<!> - pass C<< sep_char => ',' >>
  443: for standard comma-separated files.
  444: 
  445: =item * C<max_slurp_size>
  446: 
  447: Files smaller than this (in bytes) are loaded entirely into memory for fast
  448: lookups.  Default is 16 KB.  Set to C<0> to force SQL mode for all sizes.
  449: 
  450: =item * C<no_fixate>
  451: 
  452: Set to C<1> to return mutable arrays.  Default is C<0> (arrays are made
  453: read-only via L<Data::Reuse>).
  454: 
  455: =item * C<auto_load>
  456: 
  457: Set to C<0> to disable the AUTOLOAD column shortcut.  Default is C<1>
  458: (enabled).
  459: 
  460: =back
  461: 
  462: =head3 Caching and logging
  463: 
  464: =over 4
  465: 
  466: =item * C<cache>
  467: 
  468: A L<CHI>-compatible cache object.  When set, query results are stored and
  469: retrieved from the cache.
  470: 
  471: =item * C<cache_duration> / C<expires_in>
  472: 
  473: TTL for cached results.  Default is C<'1 hour'>.  C<expires_in> is a
  474: synonym for compatibility with L<CHI>.
  475: 
  476: =item * C<logger>
  477: 
  478: An object that understands C<warn()> and C<trace()> (e.g.
  479: L<Log::Log4perl>, L<Log::Any>), a code reference, or a filename.
  480: 
  481: =item * C<config_file>
  482: 
  483: Path to a YAML, XML, or INI configuration file whose keys are merged into
  484: the constructor arguments.  Loaded via L<Object::Configure>.
  485: 
  486: =back
  487: 
  488: =head3 Notes
  489: 
  490: =over 4
  491: 
  492: =item *
  493: 
  494: If no arguments are set, class-level defaults set via C<init()> or C<use>
  495: are used.
  496: 
  497: =item *
  498: 
  499: Slurp mode assumes the key column (C<entry>) is unique.  If it is not,
  500: searches will be incomplete - disable slurp mode by setting
  501: C<< max_slurp_size => 0 >>.
  502: 
  503: =item *
  504: 
  505: Passing an existing object as C<$class> clones it, merging any new
  506: arguments.
  507: 
  508: =back
  509: 
  510: =cut
  511: 
  512: sub new {
●513 → 519 → 525  513: 	my $class = shift;
  514: 	my %args;
  515: 
  516: 	Class::Abstract::check_abstract($class);	# enforces abstract contract
  517: 
  518: 	# Handle hash or hashref arguments
  519: 	if((scalar(@_) == 1) && !ref($_[0])) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
  520: 		$args{'directory'} = $_[0];
  521: 	} elsif(my $params = Params::Get::get_params(undef, @_)) {
  522: 		%args = %{$params};
  523: 	}
  524: 
●525 → 525 → 541  525: 	if(!defined($class)) {

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

					

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

  527: 			# Using Database::Abstraction->new(), not Database::Abstraction::new()
  528: 			carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
  529: 			return;
  530: 		}
  531: 		# FIXME: this only works when no arguments are given
  532: 		$class = __PACKAGE__;
  533: 	} elsif($class eq __PACKAGE__) {
  534: 		croak("$class: abstract class");
  535: 	} elsif(Scalar::Util::blessed($class)) {
  536: 		# If $class is an object, clone it with new arguments
  537: 		return bless { %{$class}, %args }, ref($class);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  538: 	}
  539: 
  540: 	# Load the configuration from a config file, if provided
●541 → 545 → 549  541: 	%args = %{Object::Configure::configure($class, \%args)};
  542: 
  543: 	# Normalise logger: wrap code-refs, filenames, and strings in Log::Abstraction
  544: 	# so that the rest of the code can always call ->$level(...) uniformly.
  545: 	if(defined $args{'logger'} && !Scalar::Util::blessed($args{'logger'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  546: 		$args{'logger'} = Log::Abstraction->new($args{'logger'});
  547: 	}
  548: 
●549 → 549 → 556  549: 	unless($args{'dsn'} || $defaults{'dsn'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  550: 		croak("$class: where are the files?") unless($args{'directory'} || $defaults{'directory'});
  551: 
  552: 		croak("$class: ", $args{'directory'} || $defaults{'directory'}, ' is not a directory') unless(-d ($args{'directory'} || $defaults{'directory'}));
  553: 	}
  554: 
  555: 	# Validate the primary-key column name to prevent SQL injection via ORDER BY / WHERE
●556 → 556 → 564  556: 	for my $src (\%defaults, \%args) {
  557: 		if(defined $src->{'id'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  558: 			croak("$class: unsafe id column name '$src->{id}'")
  559: 				unless $src->{'id'} =~ /^[a-zA-Z_][a-zA-Z0-9_]*$/;
  560: 		}
  561: 	}
  562: 
  563: 	# Defaults are set first so that %args keys override them
  564: 	return bless {

  Mutants (Total: 2, Killed: 2, Survived: 0)
  565: 		no_entry => 0,
  566: 		no_fixate => 0,
  567: 		id => 'entry',
  568: 		cache_duration => '1 hour',
  569: 		max_slurp_size => DEFAULT_MAX_SLURP_SIZE,
  570: 		%defaults,
  571: 		%args,
  572: 	}, $class;
  573: }
  574: 
  575: =head2	set_logger
  576: 
  577: Sets the class, code reference, or file that will be used for logging.
  578: 
  579: =cut
  580: 
  581: sub set_logger
  582: {
●583 → 586 → 594  583: 	my $self = shift;
  584: 	my $params = Params::Get::get_params('logger', @_);
  585: 
  586: 	if(my $logger = $params->{'logger'}) {

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
  588: 			$self->{'logger'} = $logger;
  589: 		} else {
  590: 			$self->{'logger'} = Log::Abstraction->new($logger);
  591: 		}
  592: 		return $self;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  593: 	}
  594: 	Carp::croak('Usage: set_logger(logger => $logger)')
  595: }
  596: 
  597: # Open the database connection based on the specified type (e.g., SQLite, CSV).
  598: # Read the data into memory or establish a connection to the database file.
  599: # column_names allows the column names to be overridden on CSV files
  600: 
  601: sub _open
  602: {
  603: 	# Enforce that _open is only reachable from within this class hierarchy;
  604: 	# caller() returns the calling package name as a plain string.
●605 → 624 → 655  605: 	do { my $c = (caller)[0]; Carp::croak('Illegal Operation: _open may only be called within ', __PACKAGE__) unless $c && $c->isa(__PACKAGE__) };
  606: 
  607: 	my $self = shift;
  608: 	my $params = Params::Get::get_params(undef, @_);
  609: 
  610: 	$params->{'sep_char'} ||= $self->{'sep_char'} ? $self->{'sep_char'} : '!';
  611: 	my $max_slurp_size = $params->{'max_slurp_size'} || $self->{'max_slurp_size'};
  612: 
  613: 	my $table = $self->{'table'} || ref($self);
  614: 	$table =~ s/.*:://;
  615: 
  616: 	$self->_trace(ref($self), ": _open $table");
  617: 
  618: 	return if($self->{$table});
  619: 
  620: 	# Read in the database
  621: 	my $dbh;
  622: 
  623: 	# DSN-based connection bypasses file detection entirely
  624: 	if(my $dsn = $self->{'dsn'} || $defaults{'dsn'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  625: 		require DBI && DBI->import() unless DBI->can('connect');
  626: 
  627: 		my $dialect = 'generic';
  628: 		if    ($dsn =~ /^dbi:SQLite:/i) { $dialect = 'sqlite'   }

  Mutants (Total: 1, Killed: 1, Survived: 0)
  629: 		elsif ($dsn =~ /^dbi:Pg:/i)     { $dialect = 'postgres' }
  630: 		elsif ($dsn =~ /^dbi:mysql:/i)  { $dialect = 'mysql'    }
  631: 		$self->{'_dialect'} = $dialect;
  632: 
  633: 		$dbh = DBI->connect(
  634: 			$dsn,
  635: 			$self->{'username'},
  636: 			$self->{'password'},
  637: 			{ RaiseError => 1, AutoCommit => 1 },
  638: 		) or Carp::croak(ref($self), ": cannot connect: $DBI::errstr");
  639: 
  640: 		if($dialect eq 'sqlite') {

					

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

  641: 			$dbh->do('PRAGMA synchronous = OFF');
  642: 			$dbh->do('PRAGMA cache_size = -4096');
  643: 			$dbh->do('PRAGMA journal_mode = OFF');
  644: 			$dbh->do('PRAGMA temp_store = MEMORY');
  645: 			$dbh->do('PRAGMA mmap_size = 1048576');
  646: 			$dbh->sqlite_busy_timeout(100000);
  647: 		}
  648: 
  649: 		$self->{'type'} = 'DBI';
  650: 		$self->{$table} = $dbh;
  651: 		$self->{'_updated'} = time();
  652: 		return $self;

					

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

  653: 	}
  654: 
●655 → 664 → 673  655: 	my $dir = Cwd::abs_path($self->{'directory'} || $defaults{'directory'});
  656: 	my $dbname = $self->{'dbname'} || $defaults{'dbname'} || $table;
  657: 	Carp::croak(ref($self), ": unsafe dbname '$dbname'")
  658: 		unless $dbname =~ /^[a-zA-Z0-9_.-]+$/ && $dbname !~ /\.\./;
  659: 	my $slurp_file = File::Spec->catfile($dir, "$dbname.sql");
  660: 
  661: 	$self->_debug("_open: try to open $slurp_file");
  662: 
  663: 	# Look at various places to find the file and derive the file type from the file's name
  664: 	if(-r $slurp_file) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  665: 		# SQLite file
  666: 		require DBI && DBI->import() unless DBI->can('connect');
  667: 
  668: 		require DBD::SQLite::Constants;
  669: 		$dbh = DBI->connect("dbi:SQLite:dbname=$slurp_file", undef, undef, {
  670: 			sqlite_open_flags => DBD::SQLite::Constants::SQLITE_OPEN_READONLY(),
  671: 		});
  672: 	}
●673 → 673 → 883  673: 	if($dbh) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  674: 		$dbh->do('PRAGMA synchronous = OFF');
  675: 		$dbh->do('PRAGMA cache_size = -4096');	# Use 4MB cache - negative = KB)
  676: 		$dbh->do('PRAGMA journal_mode = OFF');	# Read-only, no journal needed
  677: 		$dbh->do('PRAGMA temp_store = MEMORY');	# Store temp data in RAM
  678: 		$dbh->do('PRAGMA mmap_size = 1048576');	# Use 1MB memory-mapped I/O
  679: 		$dbh->sqlite_busy_timeout(100000);	# 10s
  680: 		$self->_debug("read in $table from SQLite $slurp_file");
  681: 		$self->{'type'} = 'DBI';
  682: 	} elsif($self->_is_berkeley_db(File::Spec->catfile($dir, "$dbname.db"))) {
  683: 		$self->_debug("$table is a BerkeleyDB file");
  684: 		$self->{'type'} = 'BerkeleyDB';
  685: 	} else {
  686: 		my $fin;
  687: 		# File::pfopen splits $path on ':' which breaks Windows drive letters
  688: 		# (C:\foo becomes ['C', '\foo']).  Since we always have a single directory
  689: 		# we use File::Spec->catfile directly — same behaviour, portable.
  690: 		for my $ext (qw(csv.gz db.gz)) {
  691: 			my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
  692: 			next unless -r $candidate;
  693: 			open($fin, '<', $candidate) or next;
  694: 			$slurp_file = $candidate;
  695: 			last;
  696: 		}
  697: 		if(defined($slurp_file) && (-r $slurp_file)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  698: 			require Gzip::Faster;
  699: 			Gzip::Faster->import();
  700: 
  701: 			close($fin);
  702: 			$fin = File::Temp->new(SUFFIX => '.csv', UNLINK => 1);
  703: 			print $fin gunzip_file($slurp_file);
  704: 			$fin->flush();
  705: 			$slurp_file = $fin->filename();
  706: 			$self->{'_temp_fh'} = $fin;	# Keep object alive; auto-unlinks at DESTROY
  707: 		} else {
  708: 			my $psv = File::Spec->catfile($dir, "$dbname.psv");
  709: 			if(-r $psv && open($fin, '<', $psv)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  710: 				# Pipe separated file
  711: 				$slurp_file = $psv;
  712: 				$params->{'sep_char'} = '|';
  713: 			} else {
  714: 				# CSV or BerkeleyDB-extension file
  715: 				for my $ext (qw(csv db)) {
  716: 					my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
  717: 					next unless -r $candidate;
  718: 					open($fin, '<', $candidate) or next;
  719: 					$slurp_file = $candidate;
  720: 					last;
  721: 				}
  722: 			}
  723: 		}
  724: 		if(my $filename = $self->{'filename'} || $defaults{'filename'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  725: 			Carp::croak(ref($self), ": unsafe filename '$filename'")
  726: 				unless $filename =~ /^[a-zA-Z0-9_.-]+$/ && $filename !~ /\.\./;
  727: 			$self->_debug("Looking for $filename in $dir");
  728: 			$slurp_file = File::Spec->catfile($dir, $filename);
  729: 		}
  730: 		if(defined($slurp_file) && (-r $slurp_file)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  731: 			close($fin) if(defined($fin));
  732: 			my $sep_char = $params->{'sep_char'};
  733: 
  734: 			$self->_debug(__LINE__, ' of ', __PACKAGE__, ": slurp_file = $slurp_file, sep_char = $sep_char");
  735: 
  736: 			if($params->{'column_names'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  737: 				$dbh = DBI->connect("dbi:CSV:db_name=$slurp_file", undef, undef,
  738: 					{
  739: 						csv_sep_char => $sep_char,
  740: 						csv_tables => {
  741: 							$table => {
  742: 								col_names => $params->{'column_names'},
  743: 							},
  744: 						},
  745: 						f_dir      => $dir,
  746: 						RaiseError => 1,
  747: 						PrintError => 0
  748: 					}
  749: 				);
  750: 			} else {
  751: 				$dbh = DBI->connect("dbi:CSV:db_name=$slurp_file", undef, undef, { csv_sep_char => $sep_char, f_dir => $dir, RaiseError => 1 });
  752: 			}
  753: 			$dbh->{'RaiseError'} = 1;
  754: 
  755: 			$self->_debug("read in $table from CSV $slurp_file");
  756: 
  757: 			$dbh->{csv_tables}->{$table} = {
  758: 				allow_loose_quotes => 1,
  759: 				blank_is_undef => 1,
  760: 				empty_is_undef => 1,
  761: 				binary => 1,
  762: 				f_file => $slurp_file,
  763: 				escape_char => '\\',
  764: 				sep_char => $sep_char,
  765: 				# Don't do this, causes "Bizarre copy of HASH
  766: 				#	in scalar assignment in error_diag
  767: 				#	RT121127
  768: 				# auto_diag => 1,
  769: 				auto_diag => 0,
  770: 				# Don't do this, it causes "Attempt to free unreferenced scalar"
  771: 				# callbacks => {
  772: 					# after_parse => sub {
  773: 						# my ($csv, @rows) = @_;
  774: 						# my @rc;
  775: 						# foreach my $row(@rows) {
  776: 							# if($row->[0] !~ /^#/) {
  777: 								# push @rc, $row;
  778: 							# }
  779: 						# }
  780: 						# return @rc;
  781: 					# }
  782: 				# }
  783: 			};
  784: 
  785: 			# Text::xSV::Slurp cannot override column names, so skip slurp when
  786: 			# column_names is set — the DBI CSV connection will supply names instead.
  787: 			if(((-s $slurp_file) <= $max_slurp_size) && !$params->{'column_names'}) {

					

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

  788: 				if((-s $slurp_file) == 0) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
  789: 					# Empty file
  790: 					$self->{'data'} = ();
  791: 				} else {
  792: 					require Text::xSV::Slurp;
  793: 					Text::xSV::Slurp->import();
  794: 
  795: 					$self->_debug('slurp in');
  796: 
  797: 					my $dataref = xsv_slurp(
  798: 						shape => 'aoh',
  799: 						text_csv => {
  800: 							sep_char => $sep_char,
  801: 							allow_loose_quotes => 1,
  802: 							blank_is_undef => 1,
  803: 							empty_is_undef => 1,
  804: 							binary => 1,
  805: 							escape_char => '\\',
  806: 						},
  807: 						# string => \join('', grep(!/^\s*(#|$)/, <DATA>))
  808: 						file => $slurp_file
  809: 					);
  810: 
  811: 					# Filter out blank lines and comment rows (lines starting with #)
  812: 					my @data = grep { $_->{$self->{'id'}} !~ /^\s*#/ } grep { defined($_->{$self->{'id'}}) } @{$dataref};
  813: 
  814: 					if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  815: 						# Not keyed on a primary column — keep as ordered list.
  816: 						# Only store a reference when rows were found; an empty-array ref
  817: 						# is truthy, which would activate the in-memory fast-path and
  818: 						# silently return 0 results instead of falling through to SQL.
  819: 						$self->{'data'} = @data ? \@data : undef;
  820: 					} else {
  821: 						# Key the hash by $self->{'id'} for O(1) entry lookups
  822: 						$self->{'data'} = { map { $_->{$self->{'id'}} => $_ } @data };
  823: 					}
  824: 				}
  825: 			}
  826: 			$self->{'type'} = 'CSV';
  827: 		} else {
  828: 			$slurp_file = File::Spec->catfile($dir, "$dbname.xml");
  829: 			if(-r $slurp_file) {

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

					

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

  831: 					require XML::Simple;
  832: 					XML::Simple->import();
  833: 
  834: 					my $xml = XMLin($slurp_file);
  835: 					my @keys = keys %{$xml};
  836: 					my $key = $keys[0];
  837: 					my @data;
  838: 					if(ref($xml->{$key}) eq 'ARRAY') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  839: 						@data = @{$xml->{$key}};
  840: 					} elsif(ref($xml) eq 'ARRAY') {
  841: 						@data = @{$xml};
  842: 					} elsif((ref($xml) eq 'HASH') && !$self->{'no_entry'}) {
  843: 						if(scalar(keys %{$xml}) == 1) {

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
  845: 								@data = $xml->{$table};
  846: 							} else {
  847: 								Carp::croak('XML slurp: complex documents with an "entry" field are not yet supported');
  848: 							}
  849: 						} else {
  850: 							Carp::croak('XML slurp: multi-key documents are not yet supported');
  851: 						}
  852: 					} else {
  853: 						Carp::croak('XML slurp: cannot handle ', ref($xml), ' structure');
  854: 					}
  855: 					$self->{'data'} = ();
  856: 					if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  857: 						# Not keyed, will need to scan each entry
  858: 						my $i = 0;
  859: 						foreach my $d(@data) {
  860: 							$self->{'data'}->{$i++} = $d;
  861: 						}
  862: 					} else {
  863: 						# keyed on the $self->{'id'} (default: "entry") column
  864: 						foreach my $d(@data) {
  865: 							$self->{'data'}->{$d->{$self->{'id'}}} = $d;
  866: 						}
  867: 					}
  868: 				} else {
  869: 					$dbh = DBI->connect('dbi:XMLSimple(RaiseError=>1):');
  870: 					$dbh->{'RaiseError'} = 1;
  871: 					$self->_debug("read in $table from XML $slurp_file");
  872: 					$dbh->func($table, 'XML', $slurp_file, 'xmlsimple_import');
  873: 				}
  874: 			} else {
  875: 				# throw Error(-file => "$dir/$table");
  876: 				$self->_fatal("Can't find a file called '$dbname' for the table $table in $dir");
  877: 			}
  878: 			$self->{'type'} = 'XML';
  879: 		}
  880: 	}
  881: 
  882: 	# ref() must be called on the variable, not on the result of 'eq'
  883: 	Data::Reuse::fixate(%{$self->{'data'}}) if($self->{'data'} && (ref($self->{'data'}) eq 'HASH'));
  884: 
  885: 	$self->{$table} = $dbh;
  886: 	my @statb = stat($slurp_file);
  887: 	$self->{'_updated'} = $statb[9];
  888: 
  889: 	return $self;

					

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

  890: }
  891: 
  892: =head2 selectall_arrayref
  893: 
  894: Returns a reference to an array of hash references for every row that
  895: matches the given criteria, or C<undef> when there are no matches.
  896: 
  897:     my $rows = $db->selectall_arrayref();                    # all rows
  898:     my $rows = $db->selectall_arrayref(status => 'active');  # exact match
  899:     my $rows = $db->selectall_arrayref(score => { '>' => 8 });  # operator
  900: 
  901: The full criteria syntax is described in L</QUERY CRITERIA>.
  902: 
  903: Pass a C<join> key to combine with another table:
  904: 
  905:     my $rows = $db->selectall_arrayref(
  906:         dept_name => 'Engineering',
  907:         join      => { table => 'dept', on => 'e.dept_id = dept.id' },
  908:     );
  909: 
  910: Results are returned in the cache (if configured) and the returned array
  911: reference is made read-only unless C<no_fixate> was set.
  912: 
  913: B<Note:> this always returns all matching rows.  Use L</selectall_array>
  914: in scalar context, or C<< $db->query->limit(1)->all() >>, to fetch just one row.
  915: 
  916: =head3 PSEUDOCODE
  917: 
  918:     1. Parse criteria; extract and build any JOIN clause.
  919:     2. If data is slurped AND no joins AND criteria are simple:
  920:        a. No criteria -> return all rows as arrayref.
  921:        b. entry-only lookup -> return [$data{entry}].
  922:        c. Otherwise -> scan rows in-memory with _match_criterion.
  923:     3. Otherwise build SQL: SELECT * FROM table [JOIN] [WHERE] ORDER BY id.
  924:     4. Check cache; return cached arrayref on HIT.
  925:     5. prepare_cached + execute; fetch all rows.
  926:     6. Store result in cache; fixate the array; return arrayref.
  927: 
  928: =cut
  929: 
  930: sub selectall_arrayref {
●931 → 941 → 946  931: 	my $self = shift;
  932: 
  933: 	# Fire _open() first so $self->{'berkeley'} is known before we parse @_.
  934: 	# BerkeleyDB param parsing must use get_params(undef, \@_) so that
  935: 	# key-value pairs like (join => {...}) are not mangled by the positional
  936: 	# 'entry' mapping that non-BerkeleyDB paths use.
  937: 	$self->_open_table({});
  938: 
  939: 	my $params;
  940: 
  941: 	if($self->{'berkeley'}) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
  944: 	}
  945: 
●946 → 946 → 952  946: 	if($self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  947: 		$params = Params::Get::get_params(undef, \@_);
  948: 	} elsif(scalar(@_)) {
  949: 		$params = Params::Get::get_params('entry', @_);
  950: 	}
  951: 
●952 → 957 → 961  952: 	my $table = $self->_open_table($params);
  953: 
  954: 	$params //= {};
  955: 
  956: 	my $join_clause = '';
  957: 	if(my $join_spec = delete $params->{'join'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  958: 		$join_clause = $self->_build_joins($join_spec);
  959: 	}
  960: 
●961 → 961 → 991  961: 	if(!$join_clause && $self->{'data'} && !$self->_has_complex_criteria($params)) {

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

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

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

					

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

  967: 					$self->_debug(do { require Data::Dumper; Data::Dumper::Dumper($self->{'data'}) });
  968: 				}
  969: 				my @rc = values %{$self->{'data'}};
  970: 				return set_return(\@rc, { type => 'arrayref' });

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

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

					

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

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

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
  979: 		} elsif(ref($self->{'data'}) eq 'HASH') {
  980: 			# Scan in-memory hash for simple column criteria without touching DBI.
  981: 			# fixate() locks hash keys, so use exists() to avoid throwing on unknown columns.
  982: 			$self->_debug("$table: selectall_arrayref in-memory scan with criteria");
  983: 			my @rc = grep {
  984: 				my $row = $_;
  985: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}) } keys %{$params}
  986: 			} values %{$self->{'data'}};
  987: 			return set_return(\@rc, { type => 'arrayref' });

  Mutants (Total: 2, Killed: 2, Survived: 0)
  988: 		}
  989: 	}
  990: 
●991 → 996 → 1005  991: 	my ($where, $wargs) = $self->_build_where($params);
  992: 	my @query_args = @{$wargs};
  993: 
  994: 	my $query = "SELECT * FROM $table";
  995: 	$query .= " $join_clause" if $join_clause;
  996: 	if($join_clause) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  997: 		$query .= " WHERE $where" if $where;
  998: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
  999: 		my $id = $self->{'id'};
 1000: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1001: 		$query .= " AND ($where)" if $where;
 1002: 	} else {
 1003: 		$query .= " WHERE $where" if $where;
 1004: 	}
●1005 → 1005 → 1009 1005: 	if(!$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1006: 		$query .= ' ORDER BY ' . $self->{'id'};
 1007: 	}
 1008: 
●1009 → 1009 → 1015 1009: 	if(defined($query_args[0])) {

					

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

 1010: 		$self->_debug("selectall_arrayref $query: ", join(', ', @query_args));
 1011: 	} else {
 1012: 		$self->_debug("selectall_arrayref $query");
 1013: 	}
 1014: 
●1015 → 1017 → 1037 1015: 	my $key;
 1016: 	my $c;
 1017: 	if($c = $self->{cache}) {

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

					

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

 1020: 			$key .= ' ' . join(', ', @query_args);
 1021: 		}
 1022: 		$self->_debug("cache key = '$key'");
 1023: 		if(my $rc = $c->get($key)) {

					

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

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

					

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

 1026: 
 1027: 			# This use of a temporary variable is to avoid
 1028: 			#	"Implicit scalar context for array in return"
 1029: 			# my @rc = @{$rc};
 1030: 			# return @rc;
 1031: 		}
 1032: 		$self->_debug('cache MISS');
 1033: 	} else {
 1034: 		$self->_debug('cache not used');
 1035: 	}
 1036: 
●1037 → 1037 → 1057 1037: 	if(my $sth = $self->{$table}->prepare_cached($query)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1038: 		$sth->execute(@query_args) || croak("$query: @query_args");
 1039: 
 1040: 		my $rc;
 1041: 		while(my $href = $sth->fetchrow_hashref()) {
 1042: 			push @{$rc}, $href if(scalar keys %{$href});
 1043: 		}
 1044: 		$c->set($key, $rc, $self->{'cache_duration'}) if $c;
 1045: 
 1046: 		if(!$self->{'no_fixate'}) {

					

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

 1047: 			# forget() clears stale address→canonical mappings from prior calls;
 1048: 			# fixate() then deduplicates values within this result set only.
 1049: 			# Without forget(), freed hashref addresses from previous fixate calls
 1050: 			# can collide with new DBI hashrefs and return wrong canonical rows.
 1051: 			Data::Reuse::forget();
 1052: 			Data::Reuse::fixate(@{$rc});
 1053: 		}
 1054: 
 1055: 		return $rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1056: 	}
 1057: 	$self->_warn("selectall_arrayref failure on $query: @query_args");
 1058: 	croak("$query: @query_args");
 1059: }
 1060: 
 1061: =head2 selectall_hashref
 1062: 
 1063: Deprecated alias for L</selectall_arrayref>.  Use C<selectall_arrayref> in
 1064: new code.
 1065: 
 1066: =cut
 1067: 
 1068: sub selectall_hashref
 1069: {
 1070: 	my $self = shift;
 1071: 	return $self->selectall_arrayref(@_);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1072: }
 1073: 
 1074: =head2 selectall_array
 1075: 
 1076: Similar to L</selectall_arrayref> but returns a list of hash references
 1077: rather than a reference to an array.
 1078: 
 1079:     my @rows = $db->selectall_array(status => 'active');
 1080: 
 1081: In B<scalar context> it applies C<LIMIT 1> and returns just the first
 1082: matching hash reference - making it more efficient than C<selectall_arrayref>
 1083: when you only need one row.  In B<list context> all matching rows are returned.
 1084: 
 1085: Accepts the same criteria and C<join> parameter as L</selectall_arrayref>.
 1086: 
 1087: =cut
 1088: 
 1089: sub selectall_array
 1090: {
●1091 → 1095 → 1101 1091: 	my $self = shift;
 1092: 
 1093: 	$self->_open_table({});
 1094: 
 1095: 	if($self->{'berkeley'}) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1099: 	}
 1100: 
●1101 → 1106 → 1110 1101: 	my $params = Params::Get::get_params(undef, \@_);
 1102: 	my $table = $self->_open_table($params);
 1103: 
 1104: 	$params //= {};
 1105: 	my $join_clause = '';
 1106: 	if(my $join_spec = delete $params->{'join'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1107: 		$join_clause = $self->_build_joins($join_spec);
 1108: 	}
 1109: 
●1110 → 1110 → 1133 1110: 	if(!$join_clause && $self->{'data'} && !$self->_has_complex_criteria($params)) {

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

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

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

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

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

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1122: 		} elsif(ref($self->{'data'}) eq 'HASH') {
 1123: 			# Same as selectall_arrayref scan but returns a list
 1124: 			$self->_debug("$table: selectall_array in-memory scan with criteria");
 1125: 			my @rc = grep {
 1126: 				my $row = $_;
 1127: 				all { $self->_match_criterion(exists($row->{$_}) ? $row->{$_} : undef, $params->{$_}) } keys %{$params}
 1128: 			} values %{$self->{'data'}};
 1129: 			return @rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1130: 		}
 1131: 	}
 1132: 
●1133 → 1138 → 1147 1133: 	my ($where, $wargs) = $self->_build_where($params);
 1134: 	my @query_args = @{$wargs};
 1135: 
 1136: 	my $query = "SELECT * FROM $table";
 1137: 	$query .= " $join_clause" if $join_clause;
 1138: 	if($join_clause) {

					

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

 1139: 		$query .= " WHERE $where" if $where;
 1140: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 1141: 		my $id = $self->{'id'};
 1142: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1143: 		$query .= " AND ($where)" if $where;
 1144: 	} else {
 1145: 		$query .= " WHERE $where" if $where;
 1146: 	}
●1147 → 1147 → 1150 1147: 	if(!$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1148: 		$query .= ' ORDER BY ' . $self->{'id'};
 1149: 	}
●1150 → 1150 → 1154 1150: 	if(!wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1151: 		$query .= ' LIMIT 1';
 1152: 	}
 1153: 
●1154 → 1154 → 1160 1154: 	if(defined($query_args[0])) {

					

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

 1155: 		$self->_debug("selectall_array $query: ", join(', ', @query_args));
 1156: 	} else {
 1157: 		$self->_debug("selectall_array $query");
 1158: 	}
 1159: 
●1160 → 1162 → 1185 1160: 	my $key;
 1161: 	my $c;
 1162: 	if($c = $self->{cache}) {

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

					

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

 1165: 			$key .= ' array';
 1166: 		}
 1167: 		if(defined($query_args[0])) {

					

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

 1168: 			$key .= ' ' . join(', ', @query_args);
 1169: 		}
 1170: 		$self->_debug("cache key = '$key'");
 1171: 		if(my $rc = $c->get($key)) {

					

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

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

					

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

 1174: 
 1175: 			# This use of a temporary variable is to avoid
 1176: 			#	"Implicit scalar context for array in return"
 1177: 			# my @rc = @{$rc};
 1178: 			# return @rc;
 1179: 		}
 1180: 		$self->_debug('cache MISS');
 1181: 	} else {
 1182: 		$self->_debug('cache not used');
 1183: 	}
 1184: 
●1185 → 1185 → 1209 1185: 	if(my $sth = $self->{$table}->prepare_cached($query)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1186: 		$sth->execute(@query_args) || croak("$query: @query_args");
 1187: 
 1188: 		my $rc;
 1189: 		while(my $href = $sth->fetchrow_hashref()) {
 1190: 			if(!wantarray) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1195: 			}
 1196: 			push @{$rc}, $href;
 1197: 		}
 1198: 		$c->set($key, $rc, $self->{'cache_duration'}) if $c;
 1199: 
 1200: 		if($rc) {

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

					

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

 1202: 				Data::Reuse::forget();
 1203: 				Data::Reuse::fixate(@{$rc});
 1204: 			}
 1205: 			return @{$rc};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1206: 		}
 1207: 		return;
 1208: 	}
 1209: 	$self->_warn("selectall_array failure on $query: @query_args");
 1210: 	croak("$query: @query_args");
 1211: }
 1212: 
 1213: =head2 selectall_hash
 1214: 
 1215: Deprecated alias for L</selectall_array>.  Use C<selectall_array> in new
 1216: code.
 1217: 
 1218: =cut
 1219: 
 1220: sub selectall_hash
 1221: {
 1222: 	my $self = shift;
 1223: 	return $self->selectall_array(@_);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1224: }
 1225: 
 1226: =head2 count
 1227: 
 1228: Returns the number of rows matching the given criteria.
 1229: 
 1230:     my $total  = $db->count();
 1231:     my $active = $db->count(status => 'active');
 1232:     my $high   = $db->count(score  => { '>' => 90 });
 1233: 
 1234: Accepts the full criteria syntax described in L</QUERY CRITERIA>.
 1235: 
 1236: =cut
 1237: 
 1238: sub count
 1239: {
●1240 → 1244 → 1249 1240: 	my $self = shift;
 1241: 
 1242: 	$self->_open_table({});
 1243: 
 1244: 	if($self->{'berkeley'}) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1247: 	}
 1248: 
●1249 → 1252 → 1265 1249: 	my $params = Params::Get::get_params(undef, \@_);
 1250: 	my $table = $self->_open_table($params);
 1251: 
 1252: 	if($self->{'data'}) {

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

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

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

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

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

					

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

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1262: 		}
 1263: 	}
 1264: 
●1265 → 1269 → 1281 1265: 	my ($where, $wargs) = $self->_build_where($params);
 1266: 	my @query_args = @{$wargs};
 1267: 
 1268: 	my $query;
 1269: 	if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1270: 		my $id = $self->{'id'};
 1271: 		$query = "SELECT COUNT(*) FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1272: 		$query .= " AND ($where)" if $where;
 1273: 	} elsif($self->{'no_entry'}) {
 1274: 		$query = "SELECT COUNT(*) FROM $table";
 1275: 		$query .= " WHERE $where" if $where;
 1276: 	} else {
 1277: 		$query = "SELECT COUNT(" . $self->{'id'} . ") FROM $table";
 1278: 		$query .= " WHERE $where" if $where;
 1279: 	}
 1280: 
●1281 → 1281 → 1287 1281: 	if(defined($query_args[0])) {

					

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

 1282: 		$self->_debug("count $query: ", join(', ', @query_args));
 1283: 	} else {
 1284: 		$self->_debug("count $query");
 1285: 	}
 1286: 
●1287 → 1289 → 1308 1287: 	my $key;
 1288: 	my $c;
 1289: 	if($c = $self->{'cache'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1290: 		# Opportunistic: if a selectall_arrayref for the same criteria is already
 1291: 		# in cache, derive the count from that array rather than hitting the DB.
 1292: 		# The key is built to match what selectall_arrayref would store.
 1293: 		$key = ref($self) . '::' . $query;
 1294: 		$key =~ s/COUNT\((.+?)\)/$1/;
 1295: 		$key .= ' array';
 1296: 		if(defined($query_args[0])) {

					

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

 1297: 			$key .= ' ' . join(', ', @query_args);
 1298: 		}
 1299: 		if(my $rc = $c->get($key)) {

					

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

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

					

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

 1302: 		}
 1303: 		$self->_debug('count: cache MISS');
 1304: 	} else {
 1305: 		$self->_debug('cache not used');
 1306: 	}
 1307: 
●1308 → 1308 → 1316 1308: 	if(my $sth = $self->{$table}->prepare_cached($query)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1309: 		$sth->execute(@query_args) || croak("$query: @query_args");
 1310: 
 1311: 		my $count = $sth->fetchrow_arrayref()->[0];
 1312: 		$sth->finish();
 1313: 
 1314: 		return $count;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1315: 	}
 1316: 	$self->_warn("count failure on $query: @query_args");
 1317: 	croak("$query: @query_args");
 1318: }
 1319: 
 1320: =head2 fetchrow_hashref
 1321: 
 1322: Returns a hash reference for the first row matching the given criteria,
 1323: or C<undef> when there is no match.  Always applies C<LIMIT 1>.
 1324: 
 1325:     my $row = $db->fetchrow_hashref(entry => 'key1');
 1326:     my $row = $db->fetchrow_hashref(score => { '>=' => 10 });
 1327: 
 1328: When C<no_entry> is B<not> set you may pass a single bare value and it is
 1329: used as the C<entry> key:
 1330: 
 1331:     my $row = $db->fetchrow_hashref('key1');    # same as entry => 'key1'
 1332: 
 1333: Accepts the full criteria syntax described in L</QUERY CRITERIA>, including
 1334: the C<join> parameter:
 1335: 
 1336:     my $row = $db->fetchrow_hashref(
 1337:         name => 'Alice',
 1338:         join => { table => 'dept', on => 'e.dept_id = dept.id' },
 1339:     );
 1340: 
 1341: Pass C<< table => $other_table >> to query a table other than the one
 1342: derived from the class name.
 1343: 
 1344: =cut
 1345: 
 1346: sub fetchrow_hashref {
●1347 → 1353 → 1359 1347: 	my $self = shift;
 1348: 
 1349: 	$self->_trace('Entering fetchrow_hashref');
 1350: 
 1351: 	my $params;
 1352: 
 1353: 	if(!$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1354: 		$params = Params::Get::get_params('entry', @_);
 1355: 	} else {
 1356: 		$params = Params::Get::get_params(undef, @_);
 1357: 	}
 1358: 
●1359 → 1362 → 1368 1359: 	my $table = $self->_open_table($params);
 1360: 
 1361: 	# ::diag($self->{'type'});
 1362: 	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)
 1363: 		$self->_debug('Fast return from slurped data');
 1364: 		# Use exists() — fixate() locks the outer hash; accessing a missing key throws
 1365: 		return exists($self->{'data'}->{$params->{'entry'}}) ? $self->{'data'}->{$params->{'entry'}} : undef;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1366: 	}
 1367: 
●1368 → 1368 → 1384 1368: 	if($self->{'berkeley'}) {

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

					

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

 1372: 			return { entry => $self->{'berkeley'}->{$params->{'entry'}} };
 1373: 		}
 1374: 		my $id = $self->{'id'};
 1375: 		if($self->{'no_entry'} && (scalar keys(%{$params}) == 1) && defined($id) && defined($params->{$id})) {

					

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

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

					

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

 1377: 				return { $params->{$id} => $rc }	# Return key->value as a hash pair
 1378: 			}
 1379: 			return;
 1380: 		}
 1381: 		Carp::croak(ref($self), ': fetchrow_hashref is meaningless on a NoSQL database');
 1382: 	}
 1383: 
●1384 → 1392 → 1401 1384: 	my $target = delete($params->{'table'}) // $table;
 1385: 	my $join_spec = delete $params->{'join'};
 1386: 	my $join_clause = $join_spec ? $self->_build_joins($join_spec) : '';
 1387: 	my ($where, $wargs) = $self->_build_where($params);
 1388: 	my @query_args = @{$wargs};
 1389: 
 1390: 	my $query = "SELECT * FROM $target";
 1391: 	$query .= " $join_clause" if $join_clause;
 1392: 	if($join_clause) {

					

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

 1393: 		$query .= " WHERE $where" if $where;
 1394: 	} elsif(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {
 1395: 		my $id = $self->{'id'};
 1396: 		$query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1397: 		$query .= " AND ($where)" if $where;
 1398: 	} else {
 1399: 		$query .= " WHERE $where" if $where;
 1400: 	}
●1401 → 1402 → 1409 1401: 	$query .= ' LIMIT 1';
 1402: 	if(defined($query_args[0])) {

					

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

 1403: 		my @call_details = caller(0);
 1404: 		$self->_debug("fetchrow_hashref $query: ", join(', ', @query_args),
 1405: 			' called from ', $call_details[2], ' of ', $call_details[1]);
 1406: 	} else {
 1407: 		$self->_debug("fetchrow_hashref $query");
 1408: 	}
●1409 → 1410 → 1418 1409: 	my $key = ref($self) . '::';
 1410: 	if(defined($query_args[0])) {

					

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

 1411: 		if(wantarray) {

					

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

 1412: 			$key .= 'array ';
 1413: 		}
 1414: 		$key .= "fetchrow $query " . join(', ', @query_args);
 1415: 	} else {
 1416: 		$key .= "fetchrow $query";
 1417: 	}
●1418 → 1419 → 1431 1418: 	my $c;
 1419: 	if($c = $self->{cache}) {

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

					

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

 1421: 			if(wantarray) {

					

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

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

					

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

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

					

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

 1424: 				}
 1425: 			} else {
 1426: 				return $rc;

					

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

 1427: 			}
 1428: 		}
 1429: 	}
 1430: 
●1431 → 1436 → 1445 1431: 	my $sth = $self->{$table}->prepare_cached($query)
 1432: 		or Carp::croak(ref($self), ": prepare failed: ", $self->{$table}->errstr());
 1433: 	$sth->execute(@query_args) || croak("$query: @query_args");
 1434: 	my $rc = $sth->fetchrow_hashref();
 1435: 	$sth->finish();
 1436: 	if($c) {

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

					

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

 1438: 			$self->_debug("stash $key=>$rc in the cache for ", $self->{'cache_duration'});
 1439: 			$self->_debug("returns ", do { require Data::Dumper; Data::Dumper->new([$rc])->Dump() });
 1440: 		} else {
 1441: 			$self->_debug("Stash $key=>undef in the cache for ", $self->{'cache_duration'});
 1442: 		}
 1443: 		$c->set($key, $rc, $self->{'cache_duration'});
 1444: 	}
 1445: 	return $rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1446: }
 1447: 
 1448: =head2 execute
 1449: 
 1450: Execute a raw SQL query on the underlying database.
 1451: 
 1452:     # Scalar context: returns the first row as a hashref
 1453:     my $row = $db->execute(query => 'SELECT * FROM foo WHERE id = 1');
 1454: 
 1455:     # List context: returns all rows as a list of hashrefs
 1456:     my @rows = $db->execute(query => 'SELECT * FROM foo WHERE score > ?',
 1457:                             args  => [80]);
 1458: 
 1459: The C<FROM E<lt>tableE<gt>> clause is appended automatically if omitted.
 1460: 
 1461: On CSV tables without C<no_entry> it may help to add
 1462: C<WHERE entry IS NOT NULL AND entry NOT LIKE '#%'> to filter comment rows.
 1463: 
 1464: If the data have been slurped into memory this method still hits the actual
 1465: database file directly.
 1466: 
 1467: C<args> is an arrayref of bind values (see L<DBI/execute>).
 1468: 
 1469: =cut
 1470: 
 1471: sub execute
 1472: {
●1473 → 1475 → 1479 1473: 	my $self = shift;
 1474: 
 1475: 	if($self->{'berkeley'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1476: 		Carp::croak(ref($self), ': execute is meaningless on a NoSQL database');
 1477: 	}
 1478: 
●1479 → 1499 → 1507 1479: 	my $args = Params::Get::get_params('query', @_);
 1480: 
 1481: 	# Ensure the 'query' parameter is provided
 1482: 	Carp::croak(__PACKAGE__, ': Usage: execute(query => $query)')
 1483: 		unless defined $args->{'query'};
 1484: 
 1485: 	my $table = $self->_open_table($args);
 1486: 
 1487: 	my $query = $args->{'query'};
 1488: 
 1489: 	# Append "FROM <table>" if missing
 1490: 	$query .= " FROM $table" unless $query =~ /\sFROM\s/i;
 1491: 
 1492: 	# Log the query if a logger is available
 1493: 	$self->_debug("execute $query");
 1494: 
 1495: 	# Prepare and execute the query
 1496: 	my $sth = $self->{$table}->prepare_cached($query);
 1497: 	# DBI->execute() takes a list; normalise args to an array whether it
 1498: 	# was passed as an arrayref ([30]) or a bare scalar/list (30).
 1499: 	if(exists($args->{'args'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1500: 		my @bind = ref($args->{'args'}) eq 'ARRAY' ? @{$args->{'args'}} : ($args->{'args'});
 1501: 		$sth->execute(@bind) or croak("$query: ", join(', ', @bind));
 1502: 	} else {
 1503: 		$sth->execute() or croak($query);
 1504: 	}
 1505: 
 1506: 	# Fetch the results
●1507 → 1508 → 1517 1507: 	my @results;
 1508: 	while (my $row = $sth->fetchrow_hashref()) {
 1509: 		unless(wantarray) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1512: 		}
 1513: 		push @results, $row;
 1514: 	}
 1515: 
 1516: 	# Return all rows as an array in list context
 1517: 	return @results;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1518: }
 1519: 
 1520: =head2 updated
 1521: 
 1522: Returns the Unix timestamp of the last database update (mtime for
 1523: file-based backends, or the time of the most recent C<new()> call for
 1524: DSN-based connections).
 1525: 
 1526: =cut
 1527: 
 1528: sub updated {
 1529: 	my $self = shift;
 1530: 
 1531: 	return $self->{'_updated'};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1532: }
 1533: 
 1534: =head2 columns
 1535: 
 1536: Returns an array reference of column names for the current table.
 1537: 
 1538:     my $cols = $db->columns();    # e.g. ['entry', 'name', 'score', 'status']
 1539: 
 1540: The column list is determined by the backend:
 1541: 
 1542: =over 4
 1543: 
 1544: =item * B<Slurp mode> - sorted keys of the first row in memory.
 1545: 
 1546: =item * B<SQLite / other DBI> - a zero-row C<SELECT *> exposes the driver's
 1547: C<NAME> attribute.
 1548: 
 1549: =item * B<BerkeleyDB> - always returns C<['entry', 'value']>.
 1550: 
 1551: =back
 1552: 
 1553: The result is cached inside the object after the first call.
 1554: 
 1555: =cut
 1556: 
 1557: sub columns {
●1558 → 1566 → 1570 1558: 	my $self = shift;
 1559: 
 1560: 	return $self->{'_columns'} if $self->{'_columns'};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1561: 
 1562: 	my $table = $self->_open_table({});
 1563: 
 1564: 	my @cols;
 1565: 
 1566: 	if($self->{'berkeley'}) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1568: 	}
 1569: 
●1570 → 1570 → 1582 1570: 	if(my $data = $self->{'data'}) {

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1572: 			my ($first) = values %{$data};
 1573: 			@cols = sort keys %{$first} if $first;
 1574: 		}
 1575: 	} else {
 1576: 		my $sth = $self->{$table}->prepare_cached("SELECT * FROM $table WHERE 1=0");
 1577: 		$sth->execute();
 1578: 		@cols = @{$sth->{NAME}};
 1579: 		$sth->finish();
 1580: 	}
 1581: 
 1582: 	return $self->{'_columns'} = \@cols;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1583: }
 1584: 
 1585: =head2 schema
 1586: 
 1587: Returns a hash reference describing the schema of the current table.
 1588: Each key is a column name; each value is a hash reference with these keys:
 1589: 
 1590: =over 4
 1591: 
 1592: =item * C<type> - data type string (e.g. C<TEXT>, C<INTEGER>, C<REAL>)
 1593: 
 1594: =item * C<nullable> - C<1> if the column may be NULL, C<0> if NOT NULL
 1595: 
 1596: =item * C<default> - default value string, or C<undef>
 1597: 
 1598: =item * C<pk> - C<1> if this column is (part of) the primary key, C<0> otherwise
 1599: 
 1600: =back
 1601: 
 1602:     my $schema = $db->schema();
 1603: 
 1604:     for my $col (sort keys %{$schema}) {
 1605:         my $info = $schema->{$col};
 1606:         printf "%s  %s  %s\n",
 1607:             $col,
 1608:             $info->{type},
 1609:             $info->{nullable} ? 'NULL' : 'NOT NULL';
 1610:     }
 1611: 
 1612: The schema is determined by the backend:
 1613: 
 1614: =over 4
 1615: 
 1616: =item * B<SQLite> - C<PRAGMA table_info(table)>
 1617: 
 1618: =item * B<Other DBI drivers> - C<< $dbh->column_info(...) >>
 1619: 
 1620: =item * B<Slurp mode> - inferred from the first row (all columns typed as C<TEXT>)
 1621: 
 1622: =item * B<BerkeleyDB> - always returns C<entry> (pk) and C<value>
 1623: 
 1624: =back
 1625: 
 1626: The result is cached inside the object after the first call.
 1627: 
 1628: =cut
 1629: 
 1630: sub schema {
●1631 → 1638 → 1645 1631: 	my $self = shift;
 1632: 
 1633: 	return $self->{'_schema'} if $self->{'_schema'};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1634: 
 1635: 	my $table = $self->_open_table({});
 1636: 	my %schema;
 1637: 
 1638: 	if($self->{'berkeley'}) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1640: 			entry => { type => 'TEXT', nullable => 0, default => undef, pk => 1 },
 1641: 			value => { type => 'TEXT', nullable => 1, default => undef, pk => 0 },
 1642: 		};
 1643: 	}
 1644: 
●1645 → 1645 → 1690 1645: 	if(my $data = $self->{'data'}) {

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1647: 			my ($first) = values %{$data};
 1648: 			if($first) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1649: 				my $id = $self->{'id'};
 1650: 				for my $col (keys %{$first}) {
 1651: 					$schema{$col} = {
 1652: 						type     => 'TEXT',
 1653: 						nullable => ($col eq $id ? 0 : 1),
 1654: 						default  => undef,
 1655: 						pk       => ($col eq $id ? 1 : 0),
 1656: 					};
 1657: 				}
 1658: 			}
 1659: 		}
 1660: 	} else {
 1661: 		my $driver = $self->{$table}->{'Driver'}{'Name'} // '';
 1662: 		if($driver eq 'SQLite') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1663: 			my $sth = $self->{$table}->prepare_cached("PRAGMA table_info($table)");
 1664: 			$sth->execute();
 1665: 			while(my $row = $sth->fetchrow_hashref()) {
 1666: 				$schema{$row->{'name'}} = {
 1667: 					type     => $row->{'type'},
 1668: 					nullable => !$row->{'notnull'},
 1669: 					default  => $row->{'dflt_value'},
 1670: 					pk       => $row->{'pk'},
 1671: 				};
 1672: 			}
 1673: 			$sth->finish();
 1674: 		} else {
 1675: 			my $sth = $self->{$table}->column_info(undef, undef, $table, '%');
 1676: 			if($sth) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1677: 				while(my $row = $sth->fetchrow_hashref()) {
 1678: 					$schema{$row->{'COLUMN_NAME'}} = {
 1679: 						type     => $row->{'TYPE_NAME'},
 1680: 						nullable => $row->{'NULLABLE'},
 1681: 						default  => $row->{'COLUMN_DEF'},
 1682: 						pk       => 0,
 1683: 					};
 1684: 				}
 1685: 				$sth->finish();
 1686: 			}
 1687: 		}
 1688: 	}
 1689: 
 1690: 	return $self->{'_schema'} = \%schema;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1691: }
 1692: 
 1693: =head2 query
 1694: 
 1695: Returns a new L<Database::Abstraction::Query> builder object bound to this
 1696: database instance, for fluent method-chaining queries.
 1697: 
 1698:     # All active rows with high scores, newest first, max 10
 1699:     my $rows = $db->query
 1700:         ->where(status => 'active')
 1701:         ->where(score  => { '>' => 80 })
 1702:         ->order_by('score DESC')
 1703:         ->limit(10)
 1704:         ->all();
 1705: 
 1706:     # Single row
 1707:     my $row = $db->query->where(name => 'Alice')->first();
 1708: 
 1709:     # Just a count
 1710:     my $n = $db->query->where(status => 'active')->count();
 1711: 
 1712: See L<Database::Abstraction::Query> for the full API.
 1713: 
 1714: =cut
 1715: 
 1716: sub query
 1717: {
 1718: 	my $self = shift;
 1719: 	require Database::Abstraction::Query;
 1720: 	return Database::Abstraction::Query->new(_db => $self);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1721: }
 1722: 
 1723: =head2 AUTOLOAD - column shortcut
 1724: 
 1725: Calling an unknown method whose name matches a column name performs a column
 1726: lookup.  The method name is the column you want; the arguments are criteria.
 1727: 
 1728:     # Scalar context: return the first match
 1729:     my $name = $db->name(entry => 'key1');
 1730: 
 1731:     # List context: return all matching values
 1732:     my @names = $db->name();
 1733: 
 1734:     # Shortcut when the table has an 'entry' key column
 1735:     my $name = $db->name('key1');    # same as name(entry => 'key1')
 1736: 
 1737:     # Unique/distinct values
 1738:     my @statuses = $db->status(distinct => 1);
 1739: 
 1740: B<In list context> the full column is returned (all rows), ordered by the
 1741: column value.  B<In scalar context> only the first match is returned
 1742: (C<LIMIT 1>).
 1743: 
 1744: Results come from the slurp cache when available.
 1745: 
 1746: Throws an error if the column does not exist (slurp mode) or if AUTOLOAD
 1747: has been disabled with C<< auto_load => 0 >>.
 1748: 
 1749: =head3 PSEUDOCODE
 1750: 
 1751:     1. Extract column name from $AUTOLOAD; guard on DESTROY.
 1752:     2. Croak if auto_load => 0.
 1753:     3. Validate $column against /^[a-zA-Z_][a-zA-Z0-9_]*$/.
 1754:     4. If data is slurped:
 1755:        a. List context, no params -> map column over all rows (exists guard).
 1756:        b. entry-only param -> direct hash lookup (exists guard).
 1757:        c. No params, scalar -> first value in hash.
 1758:        d. no_entry set -> scan array for matching key/value pair.
 1759:        e. Other params -> scan keyed hash for matching column.
 1760:     5. If not slurped, build SQL:
 1761:        - List:   SELECT column FROM table [WHERE ...] ORDER BY column
 1762:        - Scalar: SELECT DISTINCT column FROM table [WHERE ...] LIMIT 1
 1763:     6. Check cache; return on HIT.
 1764:     7. prepare_cached + execute; fetch result.
 1765:     8. Store in cache; fixate; return.
 1766: 
 1767: =cut
 1768: 
 1769: sub AUTOLOAD {
●1770 → 1788 → 1800 1770: 	our $AUTOLOAD;
 1771: 	my ($column) = $AUTOLOAD =~ /::(\w+)$/;
 1772: 
 1773: 	return if($column eq 'DESTROY');
 1774: 
 1775: 	my $self = shift or return;
 1776: 
 1777: 	Carp::croak(__PACKAGE__, ": Unknown column $column") if(!ref($self));
 1778: 
 1779: 	# Allow the AUTOLOAD feature to be disabled
 1780: 	Carp::croak(__PACKAGE__, ": AUTOLOAD disabled (auto_load => 0)") if(exists($self->{'auto_load'}) && !$self->{'auto_load'});
 1781: 
 1782: 	# Validate column name - only allow safe column name
 1783: 	Carp::croak(__PACKAGE__, ": Invalid column name: $column") unless $column =~ /^[a-zA-Z_][a-zA-Z0-9_]*$/;
 1784: 
 1785: 	my $table = $self->_open_table();
 1786: 
 1787: 	my %params;
 1788: 	if(ref($_[0]) eq 'HASH') {

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

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

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1795: 			Carp::croak(ref($self), "::($_[0]): ", $self->{'id'}, ' is not a column');
 1796: 		}
 1797: 		$params{'entry'} = shift;
 1798: 	}
 1799: 
●1800 → 1800 → 1807 1800: 	if($self->{'berkeley'}) {

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

					

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

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

					

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

 1803: 		}
 1804: 		return $self->{'berkeley'}->{$params{'entry'}};

					

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

 1805: 	}
 1806: 
●1807 → 1812 → 1902 1807: 	croak('Where did the data come from?') if(!defined($self->{'type'}));
 1808: 	my $query;
 1809: 	my $done_where = 0;
 1810: 	my $distinct = delete($params{'distinct'}) || delete($params{'unique'});
 1811: 
 1812: 	if(wantarray && !$distinct) {

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

					

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

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

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1823: 			$query = "SELECT $column FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1824: 			$done_where = 1;
 1825: 		} else {
 1826: 			$query = "SELECT $column FROM $table";
 1827: 		}
 1828: 	} else {
 1829: 		if(my $data = $self->{'data'}) {

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

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1837: 					$self->_debug("key = $key, value = $value, column = $column");
 1838: 					foreach my $row(@{$data}) {
 1839: 						# exists() guards: fixate() locks row hashes recursively
 1840: 						next unless exists($row->{$key}) && defined($row->{$key}) && $row->{$key} eq $value;
 1841: 						my $rc = exists($row->{$column}) ? $row->{$column} : undef;
 1842: 						$self->_trace(__LINE__, ": AUTOLOAD $key: return ", defined($rc) ? "'$rc'" : 'undef', ' from slurped data');
 1843: 						return $rc;

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

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

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1854: 						Carp::croak(__PACKAGE__, ": There is no column $column in $table");
 1855: 					}
 1856: 					$rc = $hash->{$column};
 1857: 				}
 1858: 				if(defined($rc)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1859: 					$self->_trace(__LINE__, ": AUTOLOAD $key: return '$rc' from slurped data");
 1860: 				} else {
 1861: 					$self->_trace(__LINE__, ": AUTOLOAD $key: return undef from slurped data");
 1862: 				}
 1863: 				return $rc

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

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

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1867: 						my %h = map { $_ => 1 } grep { defined } map { exists($_->{$column}) ? $_->{$column} : undef } values %{$data};
 1868: 						return keys %h;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1869: 					}
 1870: 					# DEAD CODE: unreachable because the outer `if(wantarray && !$distinct)`
 1871: 					# handles the wantarray+!distinct case. In this else branch, wantarray
 1872: 					# implies $distinct (which returns above), so this line is never executed.
 1873: 					# return map { exists($_->{$column}) ? $_->{$column} : undef } values %{$data}
 1874: 				}
 1875: 				# Scalar: return the first value found without building a full list
 1876: 				foreach my $v (values %{$data}) {
 1877: 					return exists($v->{$column}) ? $v->{$column} : undef;

					

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

 1878: 				}
 1879: 			} else {
 1880: 				# Keyed data but filtering on a non-key column
 1881: 				my ($key, $value) = %params;
 1882: 				foreach my $row (values %{$data}) {
 1883: 					next unless exists($row->{$key}) && defined($row->{$key}) && $row->{$key} eq $value;
 1884: 					next unless exists($row->{$column});
 1885: 					if(my $rc = $row->{$column}) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1888: 					}
 1889: 				}
 1890: 			}
 1891: 			return
 1892: 		}
 1893: 		# Data has not been slurped in
 1894: 		my $id = $self->{'id'};
 1895: 		if(($self->{'type'} eq 'CSV') && !$self->{'no_entry'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1896: 			$query = "SELECT DISTINCT $column FROM $table WHERE $id IS NOT NULL AND $id NOT LIKE '#%'";
 1897: 			$done_where = 1;
 1898: 		} else {
 1899: 			$query = "SELECT DISTINCT $column FROM $table";
 1900: 		}
 1901: 	}
●1902 → 1904 → 1919 1902: 	my @args;
 1903: 	# Avoid `each` — it carries hidden iterator state across calls
 1904: 	for my $k (sort keys %params) {
 1905: 		# Guard against SQL injection via column names — same rule as _build_where_conditions
 1906: 		Carp::croak(__PACKAGE__, ": unsafe column name '$k'")
 1907: 			unless $k =~ /^[a-zA-Z_][a-zA-Z0-9_.]*$/;
 1908: 		my $value = $params{$k};
 1909: 		$self->_debug(__PACKAGE__, ": AUTOLOAD adding key/value pair $k=>", defined($value) ? $value : 'NULL');
 1910: 		if(defined($value)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1911: 			$query .= $done_where ? " AND $k = ?" : " WHERE $k = ?";
 1912: 			$done_where = 1;
 1913: 			push @args, $value;
 1914: 		} else {
 1915: 			$query .= $done_where ? " AND $k IS NULL" : " WHERE $k IS NULL";
 1916: 			$done_where = 1;
 1917: 		}
 1918: 	}
●1919 → 1919 → 1924 1919: 	if(wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1920: 		$query .= " ORDER BY $column";
 1921: 	} else {
 1922: 		$query .= ' LIMIT 1';
 1923: 	}
●1924 → 1924 → 1929 1924: 	if(scalar(@args) && $args[0]) {

					

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

 1925: 		$self->_debug("AUTOLOAD $query: ", join(', ', @args));
 1926: 	} else {
 1927: 		$self->_debug("AUTOLOAD $query");
 1928: 	}
●1929 → 1931 → 1948 1929: 	my $cache;
 1930: 	my $key = ref($self) . '::';
 1931: 	if($cache = $self->{cache}) {

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

					

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

 1933: 			$key .= 'array ';
 1934: 		}
 1935: 		if(defined($args[0])) {

					

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

 1936: 			$key .= "fetchrow $query " . join(', ', @args);
 1937: 		} else {
 1938: 			$key .= "fetchrow $query";
 1939: 		}
 1940: 		if(my $rc = $cache->get($key)) {

					

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

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

					

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

 1943: 		}
 1944: 		$self->_debug('cache MISS');
 1945: 	} else {
 1946: 		$self->_debug('cache not used');
 1947: 	}
●1948 → 1951 → 1959 1948: 	my $sth = $self->{$table}->prepare_cached($query) || croak($query);
 1949: 	$sth->execute(@args) || croak($query);
 1950: 
 1951: 	if(wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1952: 		my @rc = map { $_->[0] } @{$sth->fetchall_arrayref()};
 1953: 		if($cache) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1954: 			$cache->set($key, \@rc, $self->{'cache_duration'});	# Store a ref to the array
 1955: 		}
 1956: 		Data::Reuse::fixate(@rc) if(!$self->{'no_fixate'});
 1957: 		return @rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1958: 	}
●1959 → 1961 → 1965 1959: 	my $rc = $sth->fetchrow_array();	# Return the first match only
 1960: 	$sth->finish();
 1961: 	if($cache) {

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1966: }
 1967: 
 1968: sub DESTROY
 1969: {
●1970 → 1970 → 1973 1970: 	if(defined($^V) && ($^V ge 'v5.14.0')) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1971: 		return if ${^GLOBAL_PHASE} eq 'DESTRUCT';	# >= 5.14.0 only
 1972: 	}
●1973 → 1982 → 1988 1973: 	my $self = shift;
 1974: 
 1975: 	# Clean up temporary file — deleting the File::Temp object triggers auto-unlink
 1976: 	delete $self->{'_temp_fh'};
 1977: 
 1978: 	# Clean up database handles
 1979: 	my $table_name = $self->{'table'} || ref($self);
 1980: 	$table_name =~ s/.*:://;
 1981: 
 1982: 	if(my $dbh = delete $self->{$table_name}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1983: 		$dbh->disconnect() if $dbh->can('disconnect');
 1984: 		$dbh->finish() if $dbh->can('finish');
 1985: 	}
 1986: 
 1987: 	# Clean up Berkeley DB
●1988 → 1988 → 1996 1988: 	if($self->{'berkeley'}) {

					

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

 1989: 		eval {
 1990: 			untie %{$self->{'berkeley'}};
 1991: 		};
 1992: 		delete $self->{'berkeley'};
 1993: 	}
 1994: 
 1995: 	# Clear all other attributes to break potential circular references
●1996 → 1996 → 0 1996: 	foreach my $key (keys %$self) {
 1997: 		delete $self->{$key};
 1998: 	}
 1999: }
 2000: 
 2001: # Build the JOIN clause(s) from a single join hashref or arrayref of hashrefs.
 2002: # Each spec needs keys: table (required), on (required), type (default INNER).
 2003: sub _build_joins
 2004: {
●2005 → 2011 → 2021 2005: 	my ($self, $join_spec) = @_;
 2006: 
 2007: 	my @specs = ref($join_spec) eq 'ARRAY' ? @{$join_spec} : ($join_spec);
 2008: 	my %valid_types = map { $_ => 1 } qw(INNER LEFT RIGHT FULL CROSS);
 2009: 	my @clauses;
 2010: 
 2011: 	for my $j (@specs) {
 2012: 		my $type  = uc($j->{'type'}  // 'INNER');
 2013: 		my $jtable = $j->{'table'} or Carp::croak('join: missing "table"');
 2014: 		Carp::croak("join: unsafe table name '$jtable'")
 2015: 			unless $jtable =~ /^[a-zA-Z_][a-zA-Z0-9_.]*$/;
 2016: 		my $on     = $j->{'on'}    or Carp::croak('join: missing "on" condition');
 2017: 		Carp::croak("Invalid JOIN type: $type") unless $valid_types{$type};
 2018: 		push @clauses, "$type JOIN $jtable ON ($on)";
 2019: 	}
 2020: 
 2021: 	return join(' ', @clauses);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2022: }
 2023: 
 2024: # Return true when $params contains operator hashrefs, -or, or -and groupings
 2025: # that the simple slurp fast-path cannot handle.
 2026: sub _has_complex_criteria
 2027: {
●2028 → 2031 → 2034 2028: 	my ($self, $params) = @_;
 2029: 	return 0 unless defined $params;

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

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

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2033: 	}
 2034: 	return 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2035: }
 2036: 
 2037: # Build the WHERE clause body (everything after "WHERE") from a criteria hash.
 2038: # Handles -or / -and groupings then delegates per-column work to _build_where_conditions.
 2039: # Returns ($sql_fragment, \@bind_values).
 2040: sub _build_where
 2041: {
●2042 → 2049 → 2063 2042: 	my ($self, $params) = @_;
 2043: 
 2044: 	$params //= {};
 2045: 	my %p = %{$params};	# work on a copy so we can delete -or/-and
 2046: 	my @clauses;
 2047: 	my @args;
 2048: 
 2049: 	if(my $or_list = delete $p{'-or'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2050: 		my (@sub_clauses, @sub_args);
 2051: 		for my $cond (@{$or_list}) {
 2052: 			my ($s, $a) = $self->_build_where_conditions($cond);
 2053: 			if($s) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2054: 				push @sub_clauses, "($s)";
 2055: 				push @sub_args, @{$a};
 2056: 			}
 2057: 		}
 2058: 		if(@sub_clauses) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2059: 			push @clauses, '(' . join(' OR ', @sub_clauses) . ')';
 2060: 			push @args, @sub_args;
 2061: 		}
 2062: 	}
●2063 → 2063 → 2078 2063: 	if(my $and_list = delete $p{'-and'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2064: 		my (@sub_clauses, @sub_args);
 2065: 		for my $cond (@{$and_list}) {
 2066: 			my ($s, $a) = $self->_build_where_conditions($cond);
 2067: 			if($s) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2068: 				push @sub_clauses, "($s)";
 2069: 				push @sub_args, @{$a};
 2070: 			}
 2071: 		}
 2072: 		if(@sub_clauses) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2073: 			push @clauses, '(' . join(' AND ', @sub_clauses) . ')';
 2074: 			push @args, @sub_args;
 2075: 		}
 2076: 	}
 2077: 
●2078 → 2079 → 2084 2078: 	my ($more, $margs) = $self->_build_where_conditions(\%p);
 2079: 	if($more) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2080: 		push @clauses, $more;
 2081: 		push @args, @{$margs};
 2082: 	}
 2083: 
 2084: 	return (join(' AND ', @clauses), \@args);
 2085: }
 2086: 
 2087: # Build a WHERE-body fragment for a flat col => val hash.
 2088: # Values may be plain scalars (= / LIKE / IS NULL) or operator hashrefs
 2089: # ({ '>' => n }, { -in => [...] }, { -between => [lo,hi] }, etc.).
 2090: sub _build_where_conditions
 2091: {
●2092 → 2097 → 2148 2092: 	my ($self, $params) = @_;
 2093: 
 2094: 	my @clauses;
 2095: 	my @args;
 2096: 
 2097: 	for my $col (sort keys %{$params}) {
 2098: 		my $val = $params->{$col};
 2099: 
 2100: 		# Guard against SQL injection via column names; allow table.column notation for JOINs
 2101: 		Carp::croak("_build_where_conditions: unsafe column name '$col'")
 2102: 			unless $col =~ /^[a-zA-Z_][a-zA-Z0-9_.]*$/;
 2103: 
 2104: 		if(ref($val) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2105: 			for my $op (sort keys %{$val}) {
 2106: 				my $operand = $val->{$op};
 2107: 				if($op eq '-in' || $op eq '-not_in') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2108: 					my $sql_op = $op eq '-in' ? 'IN' : 'NOT IN';
 2109: 					my $ph = join(', ', ('?') x scalar(@{$operand}));
 2110: 					push @clauses, "$col $sql_op ($ph)";
 2111: 					push @args, @{$operand};
 2112: 				} elsif($op eq '-between') {
 2113: 					push @clauses, "$col BETWEEN ? AND ?";
 2114: 					push @args, $operand->[0], $operand->[1];
 2115: 				} elsif($op eq '-like') {
 2116: 					push @clauses, "$col LIKE ?";
 2117: 					push @args, $operand;
 2118: 				} elsif($op eq '-not_like') {
 2119: 					push @clauses, "$col NOT LIKE ?";
 2120: 					push @args, $operand;
 2121: 				} elsif($op eq '!=') {
 2122: 					if(!defined($operand)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2123: 						push @clauses, "$col IS NOT NULL";
 2124: 					} else {
 2125: 						push @clauses, "$col != ?";
 2126: 						push @args, $operand;
 2127: 					}
 2128: 				} elsif($op =~ /^(?:>|<|>=|<=)$/) {
 2129: 					push @clauses, "$col $op ?";
 2130: 					push @args, $operand;
 2131: 				} else {
 2132: 					Carp::croak("Unknown operator '$op' for column '$col'");
 2133: 				}
 2134: 			}
 2135: 		} elsif(ref($val)) {
 2136: 			Carp::croak("$col: expected scalar or operator hashref, got ", ref($val));
 2137: 		} elsif(!defined($val)) {
 2138: 			push @clauses, "$col IS NULL";
 2139: 		} elsif($val =~ /[%_]/) {
 2140: 			push @clauses, "$col LIKE ?";
 2141: 			push @args, $val;
 2142: 		} else {
 2143: 			push @clauses, "$col = ?";
 2144: 			push @args, $val;
 2145: 		}
 2146: 	}
 2147: 
 2148: 	return (join(' AND ', @clauses), \@args);
 2149: }
 2150: 
 2151: # Test a single in-memory row value against a criteria value.
 2152: # $crit_val may be a plain scalar or an operator hashref.
 2153: # Returns true when the row value satisfies the criterion.
 2154: # Scan the entire BerkeleyDB tied hash, building rows as {entry=>$k, value=>$v},
 2155: # and filter by $params criteria using _match_criterion.
 2156: # Croaks when JOINs or -or/-and groupings are requested (unsupported for key-value stores).
 2157: sub _scan_berkeley
 2158: {
●2159 → 2162 → 2165 2159: 	my ($self, $params) = @_;
 2160: 	$params //= {};
 2161: 
 2162: 	if(delete $params->{'join'}) {

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

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2166: 		Carp::croak(ref($self), ': BerkeleyDB does not support -or/-and groupings');
 2167: 	}
 2168: 
●2169 → 2172 → 2186 2169: 	my $bdb = $self->{'berkeley'};
 2170: 	my @rows = map { { entry => $_, value => $bdb->{$_} } } keys %{$bdb};
 2171: 
 2172: 	if(my @cols = keys %{$params}) {

					

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

 2173: 		@rows = grep {
 2174: 			my $row = $_;
 2175: 			my $match = 1;
 2176: 			for my $col (@cols) {
 2177: 				unless($self->_match_criterion($row->{$col}, $params->{$col})) {

					

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

 2178: 					$match = 0;
 2179: 					last;
 2180: 				}
 2181: 			}
 2182: 			$match;
 2183: 		} @rows;
 2184: 	}
 2185: 
 2186: 	return \@rows;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2187: }
 2188: 
 2189: # SQL LIKE match using dynamic programming (O(m*n), no catastrophic backtracking).
 2190: # % matches any sequence of chars; _ matches exactly one char.  Case-insensitive.
 2191: sub _like_match
 2192: {
●2193 → 2202 → 2215 2193: 	my ($str, $pattern) = @_;
 2194: 	my @s = split //, lc($str);
 2195: 	my @p = split //, lc($pattern);
 2196: 	my $m = scalar @s;
 2197: 	my $n = scalar @p;
 2198: 
 2199: 	my @dp = map { [ (0) x ($m + 1) ] } 0 .. $n;
 2200: 	$dp[0][0] = 1;
 2201: 
 2202: 	for my $i (1 .. $n) {
 2203: 		if($p[$i - 1] eq '%') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2204: 			$dp[$i][0] = $dp[$i - 1][0];
 2205: 			for my $j (1 .. $m) {
 2206: 				$dp[$i][$j] = ($dp[$i - 1][$j] || $dp[$i][$j - 1]) ? 1 : 0;
 2207: 			}
 2208: 		} else {
 2209: 			for my $j (1 .. $m) {
 2210: 				$dp[$i][$j] = ($dp[$i - 1][$j - 1]
 2211: 					&& ($p[$i - 1] eq '_' || $p[$i - 1] eq $s[$j - 1])) ? 1 : 0;
 2212: 			}
 2213: 		}
 2214: 	}
 2215: 	return $dp[$n][$m];

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2216: }
 2217: 
 2218: sub _match_criterion
 2219: {
●2220 → 2222 → 2256 2220: 	my ($self, $row_val, $crit_val) = @_;
 2221: 
 2222: 	if(ref($crit_val) eq 'HASH') {

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

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

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

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

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

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

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

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

					

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

 2237: 			} elsif($op eq '!=') {
 2238: 				if(!defined($operand)) {

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

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

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

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

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

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

  Mutants (Total: 5, Killed: 5, Survived: 0)
 2251: 			}
 2252: 		}
 2253: 		return 1;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2254: 	}
 2255: 
 2256: 	return !defined($row_val) && !defined($crit_val) ? 1

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2257: 		: !defined($row_val) || !defined($crit_val) ? 0
 2258: 		: $row_val eq $crit_val;
 2259: }
 2260: 
 2261: # Determine the table and open the database
 2262: sub _open_table
 2263: {
 2264: 	my($self, $params) = @_;
 2265: 
 2266: 	# Get table name (remove package name prefix if present)
 2267: 	my $table = $params->{'table'} || $self->{'table'} || ref($self);
 2268: 	$table =~ s/.*:://;
 2269: 
 2270: 	# Open a connection if it's not already open.
 2271: 	# BerkeleyDB never sets $self->{$table} (no DBI handle) or $self->{'data'},
 2272: 	# so we also guard on $self->{'berkeley'} to avoid re-tying on every call.
 2273: 	$self->_open() if((!$self->{$table}) && (!$self->{'data'}) && (!$self->{'berkeley'}));
 2274: 
 2275: 	return $table;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2276: }
 2277: 
 2278: # Quote a SQL identifier using the current connection's dialect rules.
 2279: # Falls back to ANSI double-quoting when no connection is available.
 2280: sub _quote_identifier
 2281: {
●2282 → 2286 → 2289 2282: 	my ($self, $name) = @_;
 2283: 
 2284: 	my $table = $self->{'table'} || ref($self);
 2285: 	$table =~ s/.*:://;
 2286: 	if(my $dbh = $self->{$table}) {

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

					

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

 2288: 	}
 2289: 	return qq{"$name"};

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2290: }
 2291: 
 2292: # Determine whether a given file is a valid Berkeley DB file.
 2293: # It combines a fast preliminary check with a more thorough validation step for accuracy.
 2294: # It looks for the magic number at both byte 0 and byte 12
 2295: # TODO: Combine _db_0 and _db_12 as they are very similar routines
 2296: sub _is_berkeley_db {
●2297 → 2308 → 2320 2297: 	my ($self, $file) = @_;
 2298: 
 2299: 	# Step 1: Check magic number
 2300: 	# no autodie here: the file may not exist, and we want a silent false return
 2301: 	my $fh;
 2302: 	do { no autodie qw(open); open $fh, '<', $file } or return 0;
 2303: 	binmode $fh;
 2304: 
 2305: 	my $is_db = (($self->_is_berkeley_db_0($fh)) || ($self->_is_berkeley_db_12($fh)));
 2306: 	close $fh;
 2307: 
 2308: 	if($is_db) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2309: 		# Step 2: Attempt to open as Berkeley DB
 2310: 
 2311: 		require DB_File && DB_File->import();
 2312: 
 2313: 		my %bdb;
 2314: 		if(tie %bdb, 'DB_File', $file, O_RDONLY, 0644, $DB_File::DB_HASH) {

					

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

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

					

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

 2318: 		}
 2319: 	}
 2320: 	return 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 2321: }
 2322: 
 2323: # Determine whether a given file is a valid Berkeley DB file.
 2324: # It combines a fast preliminary check with a more thorough validation step for accuracy.
 2325: sub _is_berkeley_db_0
 2326: {
 2327: 	my ($self, $fh) = @_;
 2328: 
 2329: 	# Read the first 4 bytes (magic number)
 2330: 	read($fh, my $magic_bytes, 4) == 4 or return 0;

					

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

 2331: 
 2332: 	# Unpack both big-endian and little-endian values
 2333: 	my $magic_be = unpack('N', $magic_bytes);	# Big-endian
 2334: 	my $magic_le = unpack('V', $magic_bytes);	# Little-endian
 2335: 
 2336: 	# Known Berkeley DB magic numbers (in both endian formats)
 2337: 	my %known_magic = map { $_ => 1 } (
 2338: 		0x00061561,	# Btree
 2339: 		0x00053162,	# Hash
 2340: 		0x00042253,	# Queue
 2341: 		0x00052444,	# Recno
 2342: 	);
 2343: 
 2344: 	return($known_magic{$magic_be} || $known_magic{$magic_le});
 2345: }
 2346: 
 2347: sub _is_berkeley_db_12
 2348: {
 2349: 	my ($self, $fh) = @_;
 2350: 	my $header;
 2351: 
 2352: 	seek $fh, 12, 0 or return 0;
 2353: 	read($fh, $header, 4) or return 0;
 2354: 
 2355: 	$header = substr(unpack('H*', $header), 0, 4);
 2356: 
 2357: 	# Berkeley DB magic numbers
 2358: 	return($header eq '6115' || $header eq '1561');	# Btree
 2359: }
 2360: 
 2361: # Log and remember a message
 2362: sub _log
 2363: {
●2364 → 2371 → 0 2364: 	my ($self, $level, @messages) = @_;
 2365: 
 2366: 	# FIXME: add caller's function
 2367: 	# if(($level eq 'warn') || ($level eq 'notice')) {
 2368: 		push @{$self->{'messages'}}, { level => $level, message => join('', grep defined, @messages) };
 2369: 	# }
 2370: 
 2371: 	if(scalar(@messages) && (my $logger = $self->{'logger'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 2372: 		$self->{'logger'}->$level(join('', grep defined, @messages));
 2373: 	}
 2374: }
 2375: 
 2376: sub _debug {
 2377: 	my $self = shift;
 2378: 	$self->_log('debug', @_);
 2379: }
 2380: 
 2381: sub _trace {
 2382: 	my $self = shift;
 2383: 	$self->_log('trace', @_);
 2384: }
 2385: 
 2386: # Emit a warning message somewhere
 2387: sub _warn {
 2388: 	my $self = shift;
 2389: 	my $params = Params::Get::get_params('warning', \@_);
 2390: 
 2391: 	$self->_log('warn', $params->{'warning'});
 2392: 	Carp::carp(join('', grep defined, $params->{'warning'}));
 2393: }
 2394: 
 2395: # Die
 2396: sub _fatal {
 2397: 	my $self = shift;
 2398: 	my $params = Params::Get::get_params('warning', \@_);
 2399: 
 2400: 	$self->_log('error', $params->{'warning'});
 2401: 	Carp::croak(join('', grep defined, $params->{'warning'}));
 2402: }
 2403: 
 2404: =head1 AUTHOR
 2405: 
 2406: Nigel Horne, C<< <njh at nigelhorne.com> >>
 2407: 
 2408: =head1 SUPPORT
 2409: 
 2410: This module is provided as-is without any warranty.
 2411: 
 2412: Please report any bugs or feature requests to C<bug-database-abstraction at rt.cpan.org>,
 2413: or through the web interface at
 2414: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Database-Abstraction>.
 2415: I will be notified, and then you'll
 2416: automatically be notified of progress on your bug as I make changes.
 2417: 
 2418: =head1 MESSAGES
 2419: 
 2420: The table below lists every error that the module can croak or carp, what
 2421: triggers it, and how to resolve it.
 2422: 
 2423: =over 4
 2424: 
 2425: =item C<< I<Class>: abstract class >>
 2426: 
 2427: Direct instantiation of C<Database::Abstraction> was attempted.
 2428: Create a subclass and instantiate that instead.
 2429: 
 2430: =item C<< I<Class>: where are the files? >>
 2431: 
 2432: Neither C<directory> nor C<dsn> was supplied to C<new()>.
 2433: 
 2434: =item C<< I<Class>: I</path> is not a directory >>
 2435: 
 2436: The C<directory> argument exists on disk but is not a directory.
 2437: 
 2438: =item C<< I<Class>: cannot connect: I<$DBI::errstr> >>
 2439: 
 2440: DBI failed to connect to the given C<dsn>.  Check credentials and host.
 2441: 
 2442: =item C<< Can't find a file called 'I<name>' for the table I<T> in I<dir> >>
 2443: 
 2444: None of the probe extensions (C<.sql>, C<.psv>, C<.csv>, C<.db>, C<.xml>)
 2445: matched in C<directory>.
 2446: 
 2447: =item C<< I<Class>: prepare failed: I<$errstr> >>
 2448: 
 2449: C<prepare_cached()> returned false.  Usually a syntax error in an internally
 2450: built query; file a bug if you see this from a normal API call.
 2451: 
 2452: =item C<< _build_where_conditions: unsafe column name 'I<name>' >>
 2453: 
 2454: A criteria key contained characters outside C<[A-Za-z0-9_.]>.
 2455: This is a SQL-injection guard.  Use only valid SQL identifier characters.
 2456: 
 2457: =item C<< join: missing "table" >> / C<< join: missing "on" condition >>
 2458: 
 2459: A join spec hashref is incomplete.  Both C<table> and C<on> are required.
 2460: 
 2461: =item C<< Invalid JOIN type: I<TYPE> >>
 2462: 
 2463: C<type> in a join spec was not one of C<INNER LEFT RIGHT FULL CROSS>.
 2464: 
 2465: =item C<< I<Class>: Unknown column I<col> >> / C<< I<Class>: AUTOLOAD disabled >>
 2466: 
 2467: An AUTOLOAD call was made for a column that does not exist, or AUTOLOAD
 2468: was disabled with C<< auto_load => 0 >>.
 2469: 
 2470: =item C<< Usage: set_logger(logger => $logger) >>
 2471: 
 2472: C<set_logger()> was called without a C<logger> argument.
 2473: 
 2474: =item C<< Usage: execute(query => $query) >>
 2475: 
 2476: C<execute()> was called without a C<query> argument.
 2477: 
 2478: =item C<< XML slurp: I<...> is not yet supported >>
 2479: 
 2480: The XML file structure is too complex for slurp mode.
 2481: Use C<< max_slurp_size => 0 >> to force the DBI/XMLSimple SQL path.
 2482: 
 2483: =item C<< I<Class>: I<method> is meaningless on a NoSQL database >>
 2484: 
 2485: A relational method (C<selectall_arrayref>, C<count>, C<execute>, etc.)
 2486: was called on a BerkeleyDB backend, which only supports key-value lookup
 2487: via C<fetchrow_hashref>.
 2488: 
 2489: =back
 2490: 
 2491: =head1 KNOWN LIMITATIONS
 2492: 
 2493: =over 4
 2494: 
 2495: =item *
 2496: 
 2497: B<Read-only.>  No INSERT, UPDATE, or DELETE is provided.  C<execute()>
 2498: runs raw read-only SQL.
 2499: 
 2500: =item *
 2501: 
 2502: B<Default CSV separator is C<!>>, not C<,>, for historical reasons.
 2503: Pass C<< sep_char => ',' >> for standard RFC 4180 files.
 2504: 
 2505: =item *
 2506: 
 2507: B<Primary-key column is named C<entry>>, not C<key>, because C<key>
 2508: is a SQL reserved word.  Override with the C<id> parameter.
 2509: 
 2510: =item *
 2511: 
 2512: B<XML slurp is limited.>  Only simple flat XML structures are supported
 2513: in slurp mode.  Multi-key or deeply nested documents will croak.
 2514: Force SQL mode with C<< max_slurp_size => 0 >> if slurp fails.
 2515: 
 2516: =item *
 2517: 
 2518: B<Unique key assumption in slurp mode.>  Duplicate values in the key
 2519: column silently overwrite earlier rows.  Disable slurp with
 2520: C<< max_slurp_size => 0 >> if duplicates are expected.
 2521: 
 2522: =item *
 2523: 
 2524: B<BerkeleyDB does not support joins or the chained query builder.>
 2525: 
 2526: =item *
 2527: 
 2528: B<Column names must be valid SQL identifiers> (letters, digits,
 2529: underscores, and a single dot for C<table.column> join notation).
 2530: Other characters will cause a croak.
 2531: 
 2532: =item *
 2533: 
 2534: B<count() cache is opportunistic.>  Count results are served from cache
 2535: only when a prior C<selectall_arrayref()> or C<count()> call with the
 2536: same criteria has already populated it.
 2537: 
 2538: =back
 2539: 
 2540: =head1 SEE ALSO
 2541: 
 2542: =over 4
 2543: 
 2544: =item * L<Database::Abstraction::Query> - chained query builder
 2545: 
 2546: =item * L<Configure an Object at Runtime|Object::Configure>
 2547: 
 2548: =item * L<Test Dashboard|https://nigelhorne.github.io/Database-Abstraction/coverage/>
 2549: 
 2550: =back
 2551: 
 2552: =head1 LICENSE AND COPYRIGHT
 2553: 
 2554: Copyright 2015-2026 Nigel Horne.
 2555: 
 2556: Usage is subject to the GPL2 licence terms.
 2557: If you use it,
 2558: please let me know.
 2559: 
 2560: =cut
 2561: 
 2562: 1;