lib/Database/BI/Model/DataSource.pm

        start → end → jump
        

    1: package Database::BI::Model::DataSource;
    2: 
    3: use strict;
    4: use warnings;
    5: use autodie qw(:all);
    6: 
    7: use Carp		qw(croak carp);
    8: use File::Spec		();
    9: use Readonly;
   10: use Scalar::Util	qw(blessed);
   11: use Sub::Protected;
   12: use Params::Validate::Strict qw(validate_strict);
   13: use Params::Get		();
   14: 
   15: our $VERSION = '0.012.0';
   16: 
   17: =head1 NAME
   18: 
   19: Database::BI::Model::DataSource - Table-agnostic adapter around Database::Abstraction
   20: 
   21: =head1 VERSION
   22: 
   23: 0.011.0
   24: 
   25: =head1 SYNOPSIS
   26: 
   27: B<Read all rows from a CSV file:>
   28: 
   29:     use Database::BI::Model::DataSource;
   30: 
   31:     my $source = Database::BI::Model::DataSource->new(
   32:         directory => '/path/to/data',
   33:         table     => 'sales',           # looks for data/sales.csv, tsv, .psv, .sql, .xml, etc.
   34:     );
   35: 
   36:     my $records = $source->fetch_all;   # arrayref of hashrefs -- one hashref per row
   37: 
   38:     for my $row (@{$records}) {
   39:         printf "Product: %s, Amount: %s\n", $row->{product}, $row->{amount};
   40:     }
   41: 
   42: B<Get column names in the original file order (CSV/PSV/TSV only):>
   43: 
   44:     my $cols = $source->columns;        # returns undef for SQLite and XML
   45:     if ($cols) {
   46:         print join(', ', @{$cols}), "\n";
   47:     }
   48: 
   49: B<Find out which column is the primary key:>
   50: 
   51:     print "Primary key column: ", $source->id_column, "\n";
   52: 
   53: B<Open a SQLite file (.sql extension):>
   54: 
   55:     my $source = Database::BI::Model::DataSource->new(
   56:         directory => '/var/data',
   57:         table     => 'inventory',       # looks for /var/data/inventory.sql
   58:     );
   59: 
   60: B<Open a pipe-separated file (.psv extension):>
   61: 
   62:     my $source = Database::BI::Model::DataSource->new(
   63:         directory => '/var/data',
   64:         table     => 'products',        # looks for /var/data/products.psv
   65:     );
   66: 
   67: B<Open a tab-separated file (.tsv extension):>
   68: 
   69:     my $source = Database::BI::Model::DataSource->new(
   70:         directory => '/var/data',
   71:         table     => 'products',        # looks for /var/data/products.tsv
   72:     );
   73: 
   74: B<Use a custom i18n object to translate error messages:>
   75: 
   76:     # The i18n object must have a maketext($key, @args) method.
   77:     my $source = Database::BI::Model::DataSource->new(
   78:         directory => '/path/to/data',
   79:         table     => 'sales',
   80:         i18n      => My::I18N::Handle->new,
   81:     );
   82: 
   83: B<Open a remote HTML table from a URL:>
   84: 
   85:     # Requires LWP::UserAgent::Cached and HTML::TableExtract.
   86:     # The table is fetched and cached in memory; no file is saved to disk.
   87:     my $source = Database::BI::Model::DataSource->new(
   88:         url => 'https://example.com/data-page.html',
   89:     );
   90:     my $records = $source->fetch_all;
   91: 
   92: B<Select a specific table when a page has more than one HTML table:>
   93: 
   94:     my $source = Database::BI::Model::DataSource->new(
   95:         url              => 'https://example.com/page.html',
   96:         html_table_index => 2,   # zero-based: 0 = first table, 2 = third table
   97:     );
   98: 
   99: B<Open one specific internal table from a multi-table SQLite database:>
  100: 
  101:     # A SQLite file may contain more than one table.
  102:     # Use internal_table to say which one you want.
  103:     my $source = Database::BI::Model::DataSource->new(
  104:         directory      => '/var/data',
  105:         table          => 'store',          # looks for store.db, store.sql, etc.
  106:         internal_table => 'customer',       # open just the "customer" table inside
  107:     );
  108:     my $records = $source->fetch_all;
  109: 
  110: B<Check whether a SQLite file has more than one table:>
  111: 
  112:     my $source = Database::BI::Model::DataSource->new(
  113:         directory => '/var/data',
  114:         table     => 'store',
  115:     );
  116:     my $tbl_list = $source->sqlite_tables;   # undef unless it is a multi-table SQLite
  117:     if ($tbl_list && @{$tbl_list} > 1) {
  118:         # let the user choose which table to open
  119:         for my $name (@{$tbl_list}) {
  120:             printf "  table: %s\n", $name;
  121:         }
  122:     }
  123: 
  124: B<Open a remote file over SSH (SFTP):>
  125: 
  126:     # Requires Net::SFTP::Foreign.
  127:     my $source = Database::BI::Model::DataSource->new(
  128:         directory => '/remote/data',
  129:         table     => 'report',
  130:         host      => 'deploy@dbserver.example.com',
  131:         file_ext  => 'log',         # hint: try report.log first, then other exts
  132:     );
  133:     my $records = $source->fetch_all;
  134: 
  135: B<Handle errors gracefully:>
  136: 
  137:     my $source = eval {
  138:         Database::BI::Model::DataSource->new(
  139:             directory => $dir,
  140:             table     => $table,
  141:         );
  142:     };
  143:     if ($@) {
  144:         carp "Could not open table: $@";
  145:         # $@ contains a translated message from %MESSAGES
  146:     }
  147: 
  148:     my $records = eval { $source->fetch_all };
  149:     if ($@) {
  150:         carp "Could not read records: $@";
  151:     }
  152: 
  153: =head1 DESCRIPTION
  154: 
  155: C<Database::BI::Model::DataSource> is a thin, table-agnostic adapter that
  156: wraps L<Database::Abstraction> and exposes three accessors (C<fetch_all>,
  157: C<columns>, C<id_column>) used by the controller.
  158: 
  159: L<Database::Abstraction> is a read-only ORM that discovers data files
  160: (CSV, PSV, TSV, SQLite, XML, etc.) automatically from a directory based on the
  161: calling class name.  C<DataSource> generates an ephemeral subclass at
  162: construction time so callers never interact with L<Database::Abstraction>
  163: directly.  To swap the backend for L<Database::Join> in Phase 2, only the
  164: C<open_table> helper in C<Database::BI> needs to change; the controller and
  165: C<DataSource> are untouched.
  166: 
  167: C<_detect_file_info> peeks at the first header line of CSV/PSV/TSV files to
  168: extract the correct separator character, the primary-key column name, and
  169: the full ordered column list.  Without this, two silent L<Database::Abstraction>
  170: defaults corrupt every result: C<sep_char> defaults to C<'!'> (turning a
  171: comma-separated file into a single-field table) and C<id> defaults to
  172: C<'entry'> (causing every row to be discarded when no C<entry> column
  173: exists).
  174: 
  175: Result filtering (C<eq>, C<contains>, C<gt>, etc.) is performed at the
  176: controller layer by C<Dashboard::_apply_filter_spec> after C<fetch_all>
  177: returns.  C<DataSource> itself is filter-unaware.
  178: 
  179: All user-visible strings and exception messages are keyed through the
  180: C<%MESSAGES> dictionary and routed via C<_msg()>, making every diagnostic
  181: replaceable by an i18n object at instantiation time.
  182: 
  183: =cut
  184: 
  185: =head1 ENCODING
  186: 
  187: =head2 What is safe to put in cell values
  188: 
  189: Cell values (the actual data inside rows) are passed through as Perl
  190: character strings exactly as C<Database::Abstraction> and the underlying
  191: DBI driver return them.  Full Unicode -- including non-ASCII letters,
  192: accented characters, CJK ideographs, and emoji -- is supported in cell
  193: values, provided the source file is encoded in UTF-8 (or the encoding
  194: declared in its HTTP headers for URL-backed tables).
  195: 
  196: =head2 What must stay ASCII
  197: 
  198: The following structural items must contain B<only ASCII characters>:
  199: 
  200: =over 4
  201: 
  202: =item C<table> constructor argument
  203: 
  204: The bare file stem used to look up the file on disk.  Non-ASCII characters
  205: are not valid SQL identifiers and will be silently replaced with underscores
  206: (C<_>) by the sanitization step in C<new()>.
  207: 
  208: =item Column header names (CSV / TSV / PSV first line)
  209: 
  210: Column names are used as hash keys and as SQL identifiers inside
  211: C<Database::Abstraction>.  Non-ASCII headers cause C<DBD::CSV> to
  212: fail or produce garbage keys.  If your source file has non-ASCII
  213: column headers, rename them before opening via C<DataSource>.
  214: 
  215: =item C<host> argument
  216: 
  217: The hostname or C<user@hostname> string for SFTP access.  Must match
  218: C<[A-Za-z0-9._@-]>; anything outside that character set is rejected by
  219: the host-validation regex and produces C<error_backend_init>.
  220: 
  221: =back
  222: 
  223: =head2 URL-backed tables
  224: 
  225: URL-backed tables (the C<url =E<gt>> constructor path) are fetched with
  226: L<LWP::UserAgent::Cached>.  If the remote server declares a charset in its
  227: HTTP headers or in an HTML C<meta> tag, L<Database::Abstraction> uses it
  228: to decode the response body.  If the charset declaration is absent or wrong,
  229: cell values may arrive as raw bytes rather than character strings, and
  230: multi-byte sequences will look garbled.
  231: 
  232: =head2 File-backed tables (CSV / TSV / PSV)
  233: 
  234: For files smaller than 16 KB, L<Text::xSV::Slurp> reads bytes and returns
  235: them without re-encoding; for larger files the L<DBD::CSV> path is used
  236: instead.  In both cases C<DataSource> forces the slurp path (by passing
  237: C<max_slurp_size =E<gt> -s $file>) so that column names with spaces are
  238: preserved as-is.  The caller (the Mojolicious controller) is responsible
  239: for setting the correct C<Content-Type: text/html; charset=UTF-8> response
  240: header.
  241: 
  242: =cut
  243: 
  244: # ---------------------------------------------------------------------------
  245: # I18N message dictionary.
  246: # All user-visible strings and exception messages are keyed here.
  247: # To plug in a real i18n backend (e.g. Locale::Maketext), pass an object
  248: # that responds to maketext($key, @args) as the "i18n" constructor argument;
  249: # it will be called in preference to this table.
  250: # ---------------------------------------------------------------------------
  251: 
  252: Readonly our %MESSAGES => (
  253: 	error_directory_required	=> 'DataSource: argument "directory" is required',
  254: 	error_table_required		=> 'DataSource: argument "table" is required',
  255: 	error_directory_missing		=> 'DataSource: directory "%s" does not exist or is not readable',
  256: 	error_table_name_invalid	=> 'DataSource: table name "%s" contains illegal characters (alphanumeric and underscore only)',
  257: 	error_backend_init		=> 'DataSource: failed to initialise database backend for table "%s": %s',
  258: 	error_fetch_failed		=> 'DataSource: fetch_all failed for table "%s": %s',
  259: 	error_url_invalid		=> 'DataSource: URL "%s" must begin with http:// or https://',
  260: 	error_url_fetch			=> 'DataSource: failed to open HTML table at "%s": %s',
  261: 	error_no_safe_id		=> 'DataSource: table "%s" has no column with a safe identifier name (letters, digits, underscore); rename at least one column header',
  262: 	error_no_tables			=> 'DataSource: SQLite file "%s" contains no user-defined tables',
  263: 	error_table_not_found		=> 'DataSource: SQLite file "%s" does not contain a table named "%s"',
  264: 	error_unsupported_db		=> 'DataSource: "%s" is a Berkeley DB file but the installed DB_File library cannot open it (file may use a newer Berkeley DB format)',
  265: 	error_redis_invalid		=> 'DataSource: Redis URL "%s" must begin with redis://',
  266: 	warn_empty_result		=> 'DataSource: fetch_all returned no records for table "%s"',
  267: 	warn_data_normalised		=> 'DataSource: result from backend was a hashref; converted to arrayref for table "%s"',
  268: );
  269: 
  270: # A table name is a bare SQL-safe identifier: starts with a letter or
  271: # underscore, followed by zero or more alphanumeric/underscore characters.
  272: Readonly my $TABLE_NAME_RE => qr/\A[A-Za-z_][A-Za-z0-9_]*\z/;
  273: 
  274: # ---------------------------------------------------------------------------
  275: # Protected helpers
  276: # ---------------------------------------------------------------------------
  277: 
  278: # _url_label( $url ) -> $string
  279: #
  280: # Derive a safe, lowercase identifier from a URL for use as the table label.
  281: # Takes the last non-empty path component, strips the extension, then replaces
  282: # non-alphanumeric characters with underscores.  Falls back to the hostname
  283: # when the path component is absent or starts with a digit.
  284: sub _url_label {
●285 → 293 → 300  285: 	my $url = $_[0];
  286: 	my ($path) = $url =~ m{https?://[^/?#]+(.*)}i;
  287: 	my @parts  = grep { length } split m{/}, ($path // '');
  288: 	my $last   = @parts ? $parts[-1] : '';
  289: 	# /s: . must cross \n in case a percent-decoded newline hides inside the URL.
  290: 	$last =~ s/[?#].*//s;		# strip query / fragment
  291: 	$last =~ s/\.[^.]+\z//;	# strip file extension (\z: no trailing-\n loophole)
  292: 	$last =~ s/[^A-Za-z0-9_]/_/g;	# sanitize
  293: 	unless (length $last && $last =~ /\A[A-Za-z_]/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  294: 		# No usable path component -- fall back to hostname
  295: 		my ($host) = $url =~ m{https?://([^/:?#]+)};
  296: 		$last = defined $host ? do { (my $h = $host) =~ s/[^A-Za-z0-9_]/_/g; $h } : 'html';
  297: 	}
  298: 	# $last is always non-empty here: the unless-block sets it to either
  299: 	# the sanitized hostname (>= 1 char) or the literal 'html'.
  300: 	return lc($last);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  301: }
  302: 
  303: # _fmt( $key [, @sprintf_args] ) -> $string
  304: #
  305: # Package-level (not a method) i18n formatter. Looks up $key in %MESSAGES and
  306: # applies sprintf if positional arguments are supplied. This function is used
  307: # in new() before the object exists; instance methods should use _msg() instead
  308: # so that a caller-supplied i18n object can override the built-in strings.
  309: sub _fmt :Protected {
  310: 	my ($key, @args) = @_;
  311: 	my $tmpl = $MESSAGES{$key} // "Internal error: unknown message key '$key'";
  312: 	return @args ? sprintf($tmpl, @args) : $tmpl;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  313: }
  314: 
  315: # _msg( $self, $key [, @sprintf_args] ) -> $string
  316: #
  317: # Instance-level i18n formatter. Delegates to the caller-supplied i18n object
  318: # (if any) before falling back to _fmt(). The i18n object must implement
  319: # maketext($key, @args).
  320: sub _msg :Protected {
●321 → 322 → 325  321: 	my ($self, $key, @args) = @_;
  322: 	if (my $i18n = $self->{_i18n}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  323: 		return $i18n->maketext($key, @args);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  324: 	}
  325: 	return _fmt($key, @args);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  326: }
  327: 
  328: # ---------------------------------------------------------------------------
  329: # Constructor
  330: # ---------------------------------------------------------------------------
  331: 
  332: =head1 CONSTRUCTOR
  333: 
  334: =head2 new
  335: 
  336: Creates and returns a new C<Database::BI::Model::DataSource> instance.
  337: 
  338: =head3 API SPECIFICATION
  339: 
  340: =head4 INPUT
  341: 
  342: 	{
  343: 	    directory      => 'string',   # required; local dir, or remote dir when host is set
  344: 	    table          => 'string',   # required; bare file stem (no extension)
  345: 	    host           => 'string',   # optional; "hostname" or "user@hostname" for SFTP access
  346: 	    file_ext       => 'string',   # optional; extension hint when remote file has non-standard suffix (e.g. "log")
  347: 	    internal_table => 'string',   # optional; name of a specific internal SQLite table to open
  348: 	    cache          => 'object',   # optional; CHI cache object for result caching
  349: 	    cache_ttl_url  => 'string',   # optional; CHI TTL string for URL-backed tables (default "15 min")
  350: 	    i18n           => 'object',   # optional; must implement maketext($key, @args) for i18n
  351: 	}
  352: 
  353: C<internal_table> selects a named table inside a multi-table SQLite file.
  354: When omitted, C<DataSource> auto-selects the first user table whose name
  355: matches the filename stem; if no match, it picks the first table found.
  356: Supplying a name that does not exist in the file croaks C<error_table_not_found>.
  357: 
  358: Accepts a flat key/value list, a hashref, or positional arguments via
  359: C<Params::Get>.
  360: 
  361: When C<host> is provided, C<directory> is treated as a path on the remote
  362: host and is not checked with C<-d> locally.  C<DataSource> downloads the
  363: file via SFTP (L<Net::SFTP::Foreign>) to a process-local temporary directory
  364: and then processes the local copy.  The temporary directory persists for the
  365: lifetime of the C<DataSource> object and is cleaned up automatically on
  366: destruction.
  367: 
  368: When C<file_ext> is provided together with C<host>, it is used as the first
  369: candidate extension when probing the remote host for the file.  If the
  370: downloaded file does not have a standard extension (one of C<csv>, C<tsv>,
  371: C<psv>, C<xlsx>, C<xls>, C<sql>, C<sqlite>, C<sqlite3>, C<db>, C<xml>),
  372: the file content is sniffed (SQLite magic bytes, XML preamble, or first-line
  373: field separator) and the file is renamed to the correct standard extension
  374: before further processing.
  375: 
  376: =head4 DOMAIN CONSTRAINTS
  377: 
  378: =over 4
  379: 
  380: =item C<directory>
  381: 
  382: Must satisfy C<-d $directory> (must exist and be a directory).  An empty
  383: string, a non-existent path, or the path to a regular file all produce
  384: C<error_directory_missing>.
  385: 
  386:   Valid partition:   any existing directory path
  387:   Invalid partition: non-existent path, regular file path, empty string ""
  388: 
  389: =item C<table>
  390: 
  391: The bare file stem (no extension).  Characters that are illegal in SQL
  392: identifiers - hyphens, dots, spaces, etc. - are silently replaced with
  393: underscores before the name is used internally.  A stem that starts with a
  394: digit is prefixed with C<_>.  Only a completely empty string croaks.
  395: 
  396:   Valid partition:   "sales", "_tmp", "report_2024",
  397:                      "Transactions-2026-09-08" (hyphens sanitized to underscores),
  398:                      "my.data" (dot sanitized), "1sales" (prefixed to "_1sales")
  399:   Invalid partition: "" (empty string)
  400:   Boundary values:   "a" (length-1 letter, valid), "_" (length-1 underscore,
  401:                      valid), "" (empty string, croaks error_table_name_invalid)
  402: 
  403: =back
  404: 
  405: =head4 OUTPUT
  406: 
  407: Returns C<$self> (a blessed hashref). Croaks on invalid arguments.
  408: 
  409: =head3 MESSAGES
  410: 
  411:   error_directory_required    -- "directory" argument was not supplied
  412:   error_table_required        -- "table" argument was not supplied
  413:   error_directory_missing     -- supplied directory does not exist / is unreadable
  414:   error_table_name_invalid    -- table name contains illegal characters or is empty
  415:   error_no_safe_id            -- no column in the file has a safe SQL identifier name;
  416:                                  rename at least one column header to an alphanumeric name
  417:   error_backend_init          -- backend initialisation failed; sub-cases:
  418:                                    * Net::SFTP::Foreign is not installed
  419:                                    * could not connect to <host> via SFTP
  420:                                    * could not fetch any supported file from <host>:<dir>/<stem>.*
  421:                                    * Database::Abstraction subclass could not be instantiated
  422:   error_no_tables             -- SQLite file opened successfully but contains no user-defined tables
  423:   error_unsupported_db        -- .db file has BerkeleyDB magic bytes but DB_File could not open it
  424:                                  (file likely uses a newer BDB format than the installed libdb supports)
  425:   error_fetch_failed          -- fetch_all raised an exception (wraps the underlying DBI/D::A error)
  426:   error_url_invalid           -- URL passed to the url=> constructor path does not begin
  427:                                  with http:// or https://
  428:   error_url_fetch             -- fetching or parsing the HTML table at a URL failed
  429: 
  430: =cut
  431: 
  432: sub new {
  433: 	# Strategy: normalise the argument list with Params::Get so callers may
  434: 	# pass a hashref or a flat list interchangeably, then validate strictly
  435: 	# with Params::Validate before touching any value.
  436: 	# When a "url" key is present, dispatch to the URL/HTML-table path instead.
  437: 	my $class = shift;
  438: 	my $raw   = Params::Get::get_params(undef, \@_) // {};
  439: 	return $class->_new_from_url($raw)   if exists $raw->{url};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  440: 	return $class->_new_from_redis($raw) if exists $raw->{redis};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  441: 
  442: 	my $args = validate_strict(
  443: 		schema => {
  444: 			directory      => { type => 'string' },
  445: 			table          => { type => 'string' },
  446: 			host           => { type => 'string', optional => 1, default => undef },
  447: 			file_ext       => { type => 'string', optional => 1, default => undef },
  448: 			internal_table => { type => 'string', optional => 1, default => undef },
  449: 			i18n           => { type => 'object', optional => 1, default => undef, can => 'maketext' },
  450: 			cache          => { type => 'object', optional => 1, default => undef },
  451: 			cache_ttl_url  => { type => 'string', optional => 1, default => '15 min' },
  452: 		},
  453: 		input => $raw,
  454: 	);
  455: 
  456: 	# For remote files (host is set), the directory is on the remote host and
  457: 	# cannot be stat()d locally.  Only check local existence when no host is given.
  458: 	croak _fmt('error_directory_missing', $args->{directory})
  459: 		unless defined $args->{host} || -d $args->{directory};
  460: 
  461: 	# Reject path-traversal characters first: '/', '\', and NUL are the only
  462: 	# characters that could let _raw_table escape the intended directory when
  463: 	# D::A constructs "$dir/$dbname.$ext".  Everything else is either safe as a
  464: 	# filename component or will be sanitized below.
  465: 	croak _fmt('error_table_name_invalid', $args->{table})
  466: 		if !length($args->{table}) || $args->{table} =~ m{[/\\\x00]};
  467: 
  468: 	# Silently sanitize table names derived from file stems: replace characters
  469: 	# that are illegal in SQL identifiers (hyphens, dots, spaces, etc.) with
  470: 	# underscores.  A leading digit is prefixed with '_'.  The original name is
  471: 	# kept in _raw_table for filesystem lookup (dbname) so the actual file is
  472: 	# still found; the sanitized name is used only as the internal D::A
  473: 	# identifier and ephemeral package name.
  474: 	my $raw_table = $args->{table};
  475: 	(my $safe_table = $raw_table) =~ s/[^A-Za-z0-9_]/_/g;
  476: 	$safe_table = '_' . $safe_table if $safe_table =~ /\A[0-9]/;
  477: 
  478: 	croak _fmt('error_table_name_invalid', $raw_table)
  479: 		unless $safe_table =~ $TABLE_NAME_RE;
  480: 
  481: 	my $self = bless {
  482: 		_directory      => $args->{directory},
  483: 		_table          => $safe_table,
  484: 		_raw_table      => $raw_table,
  485: 		_host           => $args->{host},
  486: 		_file_ext       => $args->{file_ext},
  487: 		_internal_table => $args->{internal_table},
  488: 		_i18n           => $args->{i18n},
  489: 		_cache          => $args->{cache},
  490: 		_cache_ttl_url  => $args->{cache_ttl_url},
  491: 		_db             => undef,
  492: 	}, $class;
  493: 
  494: 	$self->_init_backend();
  495: 	return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  496: 
  497: }
  498: 
  499: # _new_from_url( $class, \%raw_params ) -> $self
  500: #
  501: # Alternate constructor path for URL-backed HTML tables.
  502: #          Validates the URL scheme, derives a display label from the URL path,
  503: #          then calls _init_url_backend to build the D::A in-memory table.
  504: # Entry:   $raw->{url} must be an http:// or https:// URL.
  505: #          $raw->{html_table_index} (optional, default 0): zero-based table index.
  506: #          $raw->{i18n} (optional): Locale::Maketext-compatible object.
  507: # Exit:    Returns $self.  Croaks on invalid URL scheme or backend init failure.
  508: # Side Effects: Issues an HTTP GET to the URL via LWP::UserAgent.
  509: sub _new_from_url :Protected {
  510: 	my ($class, $raw) = @_;
  511: 
  512: 	my $url = $raw->{url} // croak _fmt('error_url_invalid', '');
  513: 	croak _fmt('error_url_invalid', $url)
  514: 		unless $url =~ m{\Ahttps?://}i;
  515: 
  516: 	my $table_idx = $raw->{html_table_index} // 0;
  517: 	my $self = bless {
  518: 		_url              => $url,
  519: 		_table            => _url_label($url),
  520: 		_i18n             => $raw->{i18n},
  521: 		_cache            => $raw->{cache},
  522: 		_cache_ttl_url    => $raw->{cache_ttl_url} // '15 min',
  523: 		_html_table_index => $table_idx,
  524: 		_id_col           => undef,
  525: 		_columns          => undef,
  526: 		_db               => undef,
  527: 	}, $class;
  528: 
  529: 	$self->_init_url_backend($table_idx);
  530: 	return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  531: }
  532: 
  533: # _init_url_backend( $self, $table_index ) -> void
  534: #
  535: # Purpose: Construct the Database::Abstraction backend for URL/HTML-table mode.
  536: #          D::A fetches the page via LWP::UserAgent, parses it with
  537: #          HTML::TableExtract, and stores all rows (including headers from row 0)
  538: #          as an in-memory arrayref.  Column order is not recoverable after
  539: #          construction (hash keys lose order), so _columns stays undef and
  540: #          _get_columns in the controller falls back to alphabetical sorting.
  541: # Entry:   $self->{_url} is a valid http(s) URL; $table_index is a non-negative int.
  542: # Exit:    Sets $self->{_db}.  Croaks on LWP or HTML::TableExtract failure.
  543: # Side Effects: Network I/O; may take up to LWP's default timeout.
  544: sub _init_url_backend :Protected {
  545: 	my ($self, $table_index) = @_;
  546: 	my $url = $self->{_url};
  547: 
  548: 	require Database::Abstraction;
  549: 
  550: 	# Reuse a single generic package for all URL-backed instances.
  551: 	# The package name is irrelevant for the URL code path -- D::A branches on
  552: 	# the presence of $self->{'url'}, not on the class name.
  553: 	my $pkg = 'Database::BI::_DB::HtmlUrl';
  554: 	{
  555: 		no strict 'refs';
  556: 		push @{"${pkg}::ISA"}, 'Database::Abstraction'
  557: 			unless $pkg->isa('Database::Abstraction');
  558: 	}
  559: 
  560: 	my $db = eval {
  561: 		$pkg->new({
  562: 			url              => $url,
  563: 			html_table_index => $table_index,
  564: 			no_entry         => 1,
  565: 		})
  566: 	};
  567: 	croak $self->_msg('error_url_fetch', $url, $@) if $@;
  568: 
  569: 	$self->{_db} = $db;
  570: 	return;
  571: }
  572: 
  573: # _new_from_redis( $class, \%raw_params ) -> $self
  574: #
  575: # Alternate constructor path for Redis-backed tables.
  576: # Entry:   $raw->{redis} must be a redis:// URL.
  577: #          $raw->{table} (required): table name -- becomes the Redis key prefix
  578: #                         (keys in Redis must follow the pattern tablename:*).
  579: #          $raw->{i18n} (optional): Locale::Maketext-compatible object.
  580: # Exit:    Returns $self.  Croaks on invalid URL or table name.
  581: sub _new_from_redis :Protected {
  582: 	my ($class, $raw) = @_;
  583: 
  584: 	my $redis_url = $raw->{redis} // croak _fmt('error_redis_invalid', '');
  585: 	croak _fmt('error_redis_invalid', $redis_url)
  586: 		unless $redis_url =~ m{\Aredis://}i;
  587: 
  588: 	my $table = $raw->{table} // croak _fmt('error_table_required');
  589: 	croak _fmt('error_table_name_invalid', $table)
  590: 		if !length($table) || $table =~ m{[/\\\x00]};
  591: 
  592: 	my $raw_table = $table;
  593: 	(my $safe_table = $raw_table) =~ s/[^A-Za-z0-9_]/_/g;
  594: 	$safe_table = '_' . $safe_table if $safe_table =~ /\A[0-9]/;
  595: 	croak _fmt('error_table_name_invalid', $raw_table)
  596: 		unless $safe_table =~ $TABLE_NAME_RE;
  597: 
  598: 	my $self = bless {
  599: 		_table         => $safe_table,
  600: 		_raw_table     => $raw_table,
  601: 		_redis_url     => $redis_url,
  602: 		_i18n          => $raw->{i18n},
  603: 		_cache         => $raw->{cache},
  604: 		_cache_ttl_url => $raw->{cache_ttl_url} // '15 min',
  605: 		_id_col        => 'entry',
  606: 		_columns       => undef,
  607: 		_db            => undef,
  608: 	}, $class;
  609: 
  610: 	$self->_init_redis_backend();
  611: 	return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  612: }
  613: 
  614: # _init_redis_backend( $self ) -> void
  615: #
  616: # Purpose: Construct the Database::Abstraction backend for Redis mode.
  617: #          D::A connects to the Redis server lazily (on first data access).
  618: #          We pass redis_key => $raw_table so D::A uses the original key name
  619: #          (which may contain colons, hyphens, etc.) for Redis lookups, while
  620: #          the sanitized $table is used only as the Perl package-name suffix.
  621: #          no_entry => 1 requests array-style rows (no id-keyed hash).
  622: # Entry:   $self->{_redis_url} is a valid redis:// URL.
  623: #          $self->{_table}     is a safe SQL identifier (sanitized key name).
  624: #          $self->{_raw_table} is the original Redis key name.
  625: # Exit:    Sets $self->{_db}.  Croaks when D::A construction fails.
  626: sub _init_redis_backend :Protected {
  627: 	my $self  = shift;
  628: 	my $table = $self->{_table};
  629: 
  630: 	require Database::Abstraction;
  631: 
  632: 	my $pkg = 'Database::BI::_DB::' . ucfirst($table);
  633: 	{
  634: 		no strict 'refs';
  635: 		push @{"${pkg}::ISA"}, 'Database::Abstraction'
  636: 			unless $pkg->isa('Database::Abstraction');
  637: 	}
  638: 
  639: 	my $db = eval { $pkg->new(
  640: 		database  => $self->{_redis_url},
  641: 		table     => $table,
  642: 		redis_key => $self->{_raw_table},
  643: 	) };
  644: 	croak $self->_msg('error_backend_init', $table, $@) if $@;
  645: 
  646: 	$self->{_db} = $db;
  647: 	return;
  648: }
  649: 
  650: # ---------------------------------------------------------------------------
  651: # Protected initialisation
  652: # ---------------------------------------------------------------------------
  653: 
  654: # _detect_file_info( $dir, $table ) -> \%info
  655: #
  656: # Peek at the first header line of a CSV, TSV or PSV file and return a hashref:
  657: #   sep_char => field separator character (',' or '|')
  658: #   id       => first column name (used as Database::Abstraction's id key)
  659: #   columns  => arrayref of all column names in file order
  660: #
  661: # Two non-obvious defaults in Database::Abstraction make this necessary:
  662: #   1. sep_char defaults to '!' -- so a plain CSV is read as one giant field
  663: #      per row, producing a single comma-joined string instead of columns.
  664: #   2. id defaults to 'entry' -- the slurp filter greps on that column; if it
  665: #      doesn't exist every row is silently discarded.
  666: # Returns an empty hashref for non-CSV/TSV/PSV/XLSX/SQLite formats (XML, etc.).
  667: # For SQLite/.db files that can be opened, returns { sqlite_tables => [...] }.
  668: sub _detect_file_info :Protected {
●669 → 734 → 881  669: 	my ($dir, $table) = @_;
  670: 
  671: 	# XLSX: DBD::Excel 0.07 only handles .xls (its source skips files whose
  672: 	# name does not match /\.xls$/i, so .xlsx is silently ignored).  Parse
  673: 	# directly with Spreadsheet::ParseXLSX and return pre-loaded row data so
  674: 	# _init_backend can skip D::A entirely, exactly like the headerless-CSV path.
  675: 	{
  676: 		my $path = File::Spec->catfile($dir, "$table.xlsx");
  677: 		if (-r $path) {
  678: 			my $ok = eval { require Spreadsheet::ParseXLSX; 1 };
  Mutants (Total: 1, Killed: 1, Survived: 0)
  679: 			if ($ok) {
  680: 				my $parser = Spreadsheet::ParseXLSX->new;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  681: 				my $wb     = $parser->parse($path);
  682: 				my $ws     = $wb ? $wb->worksheet(0) : undef;
  683: 
  684: 				unless ($ws) {
  685: 					# Empty workbook or parse failure: sentinel so _init_backend
  Mutants (Total: 1, Killed: 1, Survived: 0)
  686: 					# skips D::A (which would fail with "(no error string)").
  687: 					return { _file_is_empty => 1, file_size => -s $path };
  688: 				}
  689: 
  690: 				my ($rmin, $rmax) = $ws->row_range;
  691: 				my ($cmin, $cmax) = $ws->col_range;
  692: 
  693: 				# No rows at all (blank worksheet).
  694: 				return { _file_is_empty => 1, file_size => -s $path }
  695: 					if $rmax < $rmin;
  696: 
  Mutants (Total: 3, Killed: 3, Survived: 0)
  697: 				# Row 0 = column headers.
  698: 				my @cols;
  699: 				for my $c ($cmin .. $cmax) {
  700: 					my $cell = $ws->get_cell($rmin, $c);
  701: 					push @cols, defined $cell ? ($cell->value // '') : '';
  702: 				}
  703: 				for (@cols) { s/\A[\s"]+//; s/[\s"]+\z// }
  704: 				@cols = grep { length } @cols;
  705: 
  706: 				# No parseable column names.
  707: 				return { _file_is_empty => 1, file_size => -s $path }
  708: 					unless @cols;
  709: 
  710: 				my $safe_re = qr/\A[a-zA-Z_][a-zA-Z0-9_]*\z/;
  711: 				my ($safe_id) = grep { $_ =~ $safe_re } @cols;
  712: 
  713: 				# Data rows.
  714: 				my @rows;
  715: 				for my $r ($rmin + 1 .. $rmax) {
  716: 					my %row;
  717: 					for my $i (0 .. $#cols) {
  718: 						my $cell = $ws->get_cell($r, $cmin + $i);
  719: 						$row{ $cols[$i] } = defined $cell ? ($cell->value // '') : '';
  720: 					}
  721: 					push @rows, \%row;
  722: 				}
  723: 
  724: 				return {
  725: 					columns          => \@cols,
  726: 					id               => $safe_id,
  727: 					_headerless_data => \@rows,
  728: 					file_size        => -s $path,
  729: 				};
  730: 			}
  731: 		}
  732: 	}
  733: 
  734: 	for my $ext (qw(csv psv tsv)) {
  735: 		my $path = File::Spec->catfile($dir, "$table.$ext");
  736: 		next unless -r $path;
  737: 		# "use autodie" makes open() die on failure, so "or next" would be dead
  738: 		# code.  Disable autodie for this open so a vanishing file (race between
  739: 		# the -r probe and the open) results in a clean skip rather than a croak.
  740: 		my $fh;
  741: 		{ no autodie 'open'; open $fh, '<', $path or next }
  742: 		my $line = <$fh>;
  743: 		# 0-byte file: no header, no rows.  Return a sentinel so _init_backend
  744: 		# can skip Database::Abstraction entirely.  If we let D::A see an empty
  745: 		# file it falls through to the DBD::CSV path, whose error handling on
  746: 		# an empty SELECT corrupts DBI's internal Errstr SV; on a DEBUGGING perl
  747: 		# (DBI 1.651 + perl 5.44.0) this triggers an XS assertion at cleanup.
  748: 		unless (defined $line) {
  749: 			close $fh;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  750: 			return { _file_is_empty => 1, file_size => 0 };
  751: 		}
  752: 		chomp $line;
  753: 		$line =~ s/\r\z//;	# strip CR from CRLF files before any split
  754: 
  755: 		my $sep;
  756: 		if($ext eq 'psv') {
  757: 			$sep = '|';
  Mutants (Total: 1, Killed: 1, Survived: 0)
  758: 		} elsif($ext eq 'tsv') {
  759: 			$sep = "\t";
  760: 		} else {
  761: 			# Sniff the separator: Database::Abstraction uses '!' natively and
  762: 			# sometimes stores those files with a .csv extension.  If splitting
  763: 			# on ',' yields a single field that itself contains '!', the real
  764: 			# separator is almost certainly '!'.
  765: 			my @probe = split /,/, $line, -1;
  766: 			$sep = (@probe == 1 && $line =~ /!/) ? '!' : ',';
  767: 		}
  Mutants (Total: 1, Killed: 1, Survived: 0)
  768: 
  769: 		my @cols = split /\Q$sep\E/, $line;
  770: 		# Two separate substitutions: the /g on an anchored alternation wastes
  771: 		# O(N) engine cycles retrying \A (which can only match at position 0).
  772: 		for (@cols) { s/\A[\s"]+//; s/[\s"]+\z// }	# strip whitespace and quotes
  773: 		@cols = grep { length } @cols;
  774: 
  775: 		# A blank first line (e.g. a file containing only "\n") produces an
  776: 		# empty column list.  Treat that the same as a 0-byte file: return the
  777: 		# _file_is_empty sentinel so _init_backend skips D::A entirely.
  778: 		# Attempting to construct D::A with id => undef and an empty columns
  779: 		# list would croak error_no_safe_id -- misleading for what is effectively
  780: 		# an empty file.
  781: 		if (!@cols) {
  782: 			close $fh;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  783: 			return { _file_is_empty => 1, file_size => -s $path };
  784: 		}
  785: 
  786: 		# Database::Abstraction validates id against $SAFE_IDENTIFIER
  787: 		# (/\A[a-zA-Z_][a-zA-Z0-9_]*\z/) at construction time and uses it as
  788: 		# a row-existence sentinel: every data row must have a defined, non-#
  789: 		# value in the id column or D::A drops it (empty_is_undef => 1 makes
  790: 		# truly empty cells undef).
  791: 		#
  792: 		# Strategy: read the first non-empty data row and find the first safe
  793: 		# column whose value in that row is non-empty.  A simple split (same
  794: 		# separator) is used rather than a full CSV parse; it may mis-index
  795: 		# fields that contain the separator inside quotes, but correctly detects
  796: 		# whether a given index position is blank -- sufficient for id selection.
  797: 		# Fall back to the first safe column in the header if the data row
  798: 		# check is inconclusive (e.g. file has only a header line).
  799: 		my $safe_re = qr/\A[a-zA-Z_][a-zA-Z0-9_]*\z/;
  800: 		my ($safe_id) = grep { $_ =~ $safe_re } @cols;	# header-only fallback
  801: 
  802: 		my $data_line;
  803: 		while (defined($data_line = <$fh>)) {
  804: 			chomp $data_line;
  805: 			$data_line =~ s/\r\z//;
  806: 			last if length $data_line;	# skip blank lines between header and data
  807: 		}
  808: 		if (defined $data_line) {
  809: 			my @vals = split /\Q$sep\E/, $data_line, -1;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  810: 			for my $i (0 .. $#cols) {
  811: 				next unless $cols[$i] =~ $safe_re;
  812: 				my $val = $vals[$i] // '';
  813: 				$val =~ s/\A[\s"]+//;
  814: 				$val =~ s/[\s"]+\z//;
  815: 				if (length $val) {
  816: 					$safe_id = $cols[$i];
  Mutants (Total: 1, Killed: 1, Survived: 0)
  817: 					last;
  818: 				}
  819: 			}
  820: 		}
  821: 		# If no safe identifier was found in the header, check whether the first
  822: 		# row looks like data values rather than column names.  A CSV exported
  823: 		# from a bank or accounting system often has no header row at all -- the
  824: 		# first line is already a transaction record.  When that is the case,
  825: 		# synthesize safe column names by inferring the type of each value
  826: 		# (date, amount, description) and pre-read the entire file so
  827: 		# _init_backend can return the rows directly without touching D::A.
  828: 		unless (defined $safe_id) {
  829: 			if (_values_are_data_like(\@cols)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  830: 				my @synth = _synthesize_col_names(\@cols);
  Mutants (Total: 1, Killed: 1, Survived: 0)
  831: 				seek $fh, 0, 0;	# rewind: first line is a data row, not a header
  832: 				my @rows;
  833: 				while (defined(my $dline = <$fh>)) {
  834: 					chomp $dline;
  835: 					$dline =~ s/\r\z//;
  836: 					next unless length $dline;
  837: 					my @vals = split /\Q$sep\E/, $dline, scalar @synth;
  838: 					for (@vals) { s/\A[\s"]+//; s/[\s"]+\z// }
  839: 					my %row;
  840: 					for my $i (0 .. $#synth) {
  841: 						$row{ $synth[$i] } = $vals[$i] // '';
  842: 					}
  843: 					push @rows, \%row;
  844: 				}
  845: 				close $fh;
  846: 				return {
  847: 					sep_char         => $sep,
  848: 					id               => $synth[0],
  849: 					columns          => \@synth,
  850: 					_headerless_data => \@rows,
  851: 					file_size        => -s $path,
  852: 				};
  853: 			}
  854: 		}
  855: 
  856: 		close $fh;
  857: 
  858: 		# Return file_size so _init_backend can pass it as max_slurp_size to
  859: 		# Database::Abstraction.  Without this, files larger than D::A's default
  860: 		# 16 KB threshold go through the DBI/DBD::CSV path, which lowercases
  861: 		# column names and replaces spaces with underscores ("Account Number" ->
  862: 		# "account_number").  The slurp path (Text::xSV::Slurp) preserves the
  863: 		# original header names, so forcing it avoids the mismatch.
  864: 		return {
  865: 			sep_char  => $sep,
  866: 			id        => $safe_id,
  867: 			columns   => \@cols,
  868: 			file_size => -s $path,
  869: 		};
  870: 	}
  871: 
  872: 	# SQLite / Berkeley DB: peek at sqlite_master to discover the internal table
  873: 	# names.  _init_backend uses this list to auto-select the correct table when
  874: 	# the filename stem (dbname) differs from the table name inside the file --
  875: 	# e.g. obituaries.sql whose internal table is called "deceased".  If the
  876: 	# file is not a valid SQLite database (e.g. a Berkeley DB file) the eval
  877: 	# fails; for .db files we then check for BerkeleyDB magic so we can read
  878: 	# the data directly (or return an error sentinel) instead of letting D::A
  879: 	# fall through to its CSV path, which would read a large binary file as text.
  880: 	# .sqlite and .sqlite3 are common alternative SQLite extensions -- treated identically to .sql.
●881 → 882 → 909  881: 	my $non_sqlite_db;	# set to path when a .db file fails the SQLite probe
  882: 	for my $ext (qw(sql sqlite sqlite3 db)) {
  883: 		my $path = File::Spec->catfile($dir, "$table.$ext");
  884: 		next unless -r $path;
  885: 		my $tables = eval {
  886: 			require DBI;
  887: 			my $dbh = DBI->connect(
  888: 				"dbi:SQLite:dbname=$path", q{}, q{},
  889: 				{ RaiseError => 1, PrintError => 0, AutoCommit => 1 });
  890: 			my $t = $dbh->selectcol_arrayref(
  891: 				q{SELECT name FROM sqlite_master }
  892: 				. q{WHERE type='table' AND name NOT LIKE 'sqlite_%' }
  893: 				. q{ORDER BY name});
  894: 			$dbh->disconnect;
  895: 			$t;
  896: 		};
  897: 		# defined $tables means the eval succeeded (even an empty list is valid)
  898: 		return { sqlite_tables => ($tables // []), file_size => -s $path }
  899: 			if defined $tables;
  900: 		$non_sqlite_db = $path if $ext eq 'db';
  901: 		last;	# file found but not SQLite -- do not try the other ext
  902: 	}
  903: 
  904: 	# A .db file that is not SQLite: check for BerkeleyDB magic bytes.
  905: 	# BerkeleyDB Hash/Btree/Queue files begin with a 32-bit magic number either
  906: 	# at offset 0 (big-endian files) or at offset 12 (little-endian files).
  907: 	# If found, try to open via DB_File under a 10-second alarm so a version-
  908: 	# incompatible file does not block the server for minutes.
●909 → 909 → 968  909: 	if (defined $non_sqlite_db) {
  910: 		my $magic_ok = 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  911: 		if (open(my $fh, '<:raw', $non_sqlite_db)) {
  912: 			my $buf = '';
  Mutants (Total: 1, Killed: 1, Survived: 0)
  913: 			if (read($fh, $buf, 4) == 4) {
  914: 				my %MAGIC = map { $_ => 1 }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  915: 					(0x00061561, 0x00053162, 0x00042253, 0x00052444);
  916: 				$magic_ok = 1 if $MAGIC{unpack('N', $buf)} || $MAGIC{unpack('V', $buf)};
  917: 			}
  918: 			unless ($magic_ok) {
  919: 				if (seek $fh, 12, 0) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  920: 					my $b12 = '';
  Mutants (Total: 1, Killed: 1, Survived: 0)
  921: 					if (read($fh, $b12, 4) == 4) {
  922: 						my $hex = substr(unpack('H*', $b12), 0, 4);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  923: 						$magic_ok = 1 if $hex eq '6115' || $hex eq '1561';
  924: 					}
  925: 				}
  926: 			}
  927: 			close $fh;
  928: 		}
  929: 		if ($magic_ok) {
  930: 			my $fsize = -s $non_sqlite_db;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  931: 			# BerkeleyDB magic confirmed.  Attempt to read via DB_File,
  932: 			# but only for reasonably-sized files (<= 100 MB).  Opening a
  933: 			# multi-GB BerkeleyDB file with an incompatible library version
  934: 			# causes multi-minute disk I/O that cannot be interrupted with
  935: 			# alarm() (XS I/O in libdb-5.x ignores SIGALRM via SA_RESTART).
  936: 			# For large files, return the unsupported sentinel immediately.
  937: 			Readonly my $BDB_MAX_BYTES => 100 * 1024 * 1024;	# 100 MB
  938: 			if (defined $fsize && $fsize > $BDB_MAX_BYTES) {
  939: 				return { _unknown_binary_db => 1, file_size => $fsize };
  Mutants (Total: 4, Killed: 4, Survived: 0)
  940: 			}
  941: 			my $data = eval {
  942: 				require DB_File;
  943: 				my %bdb;
  944: 				# Capture the tie object so we can undef it before untie --
  945: 				# DB_File warns "untie while N inner references" if the object
  946: 				# reference count is > 0 when untie fires.
  947: 				my $db_obj = tie %bdb, 'DB_File', $non_sqlite_db,
  948: 					Fcntl::O_RDONLY(), 0644, $DB_File::DB_HASH;
  949: 				return undef unless $db_obj;
  950: 				my @rows = map { { entry => $_, value => $bdb{$_} } } sort keys %bdb;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  951: 				undef $db_obj;
  952: 				untie %bdb;
  953: 				\@rows;
  954: 			};
  955: 			if (defined $data) {
  956: 				return {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  957: 					_headerless_data => $data,
  958: 					columns          => ['entry', 'value'],
  959: 					id               => 'entry',
  960: 					file_size        => $fsize,
  961: 				};
  962: 			}
  963: 			# tie failed: return a sentinel so _init_backend can show a proper
  964: 			# error instead of letting D::A read the binary file as CSV text.
  965: 			return { _unknown_binary_db => 1, file_size => $fsize };
  966: 		}
  967: 	}
  968: 	return {};
  969: }
  970: 
  971: # _values_are_data_like( \@vals ) -> bool
  972: #
  973: # Return true when the values look like actual data (dates, numbers, free text)
  974: # _sniff_data_ext( $path ) -> $ext
  975: #
  976: # Peek at the content of $path and return the standard file extension that best
  977: # describes its format.  Used when a remote file has a non-standard extension
  978: # (e.g. ".log") and we need to rename it so that _detect_file_info and
  979: # Database::Abstraction can discover it automatically.
  980: #
  981: # Detection order:
  982: #   1. SQLite magic bytes ("SQLite format 3") -> 'db'
  983: #   2. XML preamble ("<?xml" or "<" as first non-space character) -> 'xml'
  984: #   3. First data line contains tabs -> 'tsv'
  985: #   4. First data line contains pipes -> 'psv'
  986: #   5. Fallback -> 'csv'
  987: sub _sniff_data_ext {
  988: 	my $path = $_[0];
  989: 	open(my $fh, '<:raw', $path) or return 'csv';
  990: 	my $header = '';
  991: 	read $fh, $header, 20;
  992: 	close $fh;
  993: 	return 'db'  if $header =~ /\ASQLite format/;
  994: 	return 'xml' if $header =~ /\A\s*<\?xml/i;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  995: 	return 'xml' if $header =~ /\A\s*</;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  996: 	open(my $lh, '<', $path) or return 'csv';
  Mutants (Total: 2, Killed: 2, Survived: 0)
  997: 	my $line = <$lh>;
  998: 	close $lh;
  999: 	return 'csv' unless defined $line;
 1000: 	return 'tsv' if $line =~ /\t/;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1001: 	return 'psv' if $line =~ /\|/;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1002: 	return 'csv';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1003: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1004: 
 1005: # _values_are_data_like( \@vals ) -> bool
 1006: #
 1007: # Returns true when the values look like a row of real data (dates / numbers)
 1008: # rather than column headers.  Used to detect header-less CSV files where the
 1009: # first line is a data row.  At least one value must match a date or numeric
 1010: # pattern -- a row of plain hyphenated identifiers (e.g. "First-Name") is NOT
 1011: # considered data-like.
 1012: sub _values_are_data_like {
●1013 → 1014 → 1020 1013: 	my $vals = $_[0];
 1014: 	for my $v (@{$vals}) {
 1015: 		return 1 if $v =~ /\A\d{4}-\d{2}-\d{2}\z/;		# YYYY-MM-DD
 1016: 		return 1 if $v =~ /\A\d{1,2}\/\d{1,2}\/\d{4}\z/;	# M/D/YYYY or D/M/YYYY
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1017: 		return 1 if $v =~ /\A[+\-]\d+(?:\.\d+)?\z/;		# signed numeric (e.g. -75.13)
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1018: 		return 1 if $v =~ /\A\(\d+(?:\.\d+)?\)\z/;		# accounting negative (e.g. (75.13))
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1019: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1020: 	return 0;
 1021: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1022: 
 1023: # _synthesize_col_names( \@vals ) -> @names
 1024: #
 1025: # Infer a safe SQL identifier for each positional value by examining its
 1026: # content: ISO dates become "Date", numeric/currency values become "Amount",
 1027: # and free text becomes "Description".  Duplicate types are disambiguated with
 1028: # a numeric suffix (Date, Date2, Date3, ...).
 1029: sub _synthesize_col_names {
●1030 → 1033 → 1045 1030: 	my $vals = $_[0];
 1031: 	my %type_count;
 1032: 	my @names;
 1033: 	for my $v (@{$vals}) {
 1034: 		my $type;
 1035: 		if ($v =~ /\A\d{4}-\d{2}-\d{2}\z/ || $v =~ /\A\d{1,2}\/\d{1,2}\/\d{4}\z/) {
 1036: 			$type = 'Date';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1037: 		} elsif ($v =~ /\A[+\-]?\d+(?:\.\d+)?\z/ || $v =~ /\A\(\d+(?:\.\d+)?\)\z/) {
 1038: 			$type = 'Amount';
 1039: 		} else {
 1040: 			$type = 'Description';
 1041: 		}
 1042: 		$type_count{$type}++;
 1043: 		push @names, $type_count{$type} == 1 ? $type : $type . $type_count{$type};
 1044: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1045: 	return @names;
 1046: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1047: 
 1048: # _cache_key( $self ) -> $key | undef
 1049: #
 1050: # Purpose: Derive a stable cache key for this DataSource's full result set.
 1051: #          URL tables use a fixed key (TTL handles invalidation).
 1052: #          File tables encode the file's mtime in the key so a changed file
 1053: #          naturally produces a miss -- the stale entry is orphaned and evicts
 1054: #          passively when the CHI driver reclaims memory.
 1055: # Entry:   $self->{_cache} must be defined (caller checks this before calling).
 1056: # Exit:    Returns a non-empty string key, or undef when no key is derivable
 1057: #          (no URL, no file path on disk).
 1058: sub _cache_key :Protected {
●1059 → 1061 → 1068 1059: 	my $self = shift;
 1060: 
 1061: 	if (defined $self->{_url}) {
 1062: 		my $idx = $self->{_html_table_index} // 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1063: 		# Include the table index in the key: a different index on the same URL
 1064: 		# selects a different table from the page and must not share a cache entry.
 1065: 		return 'bi:url:' . $self->{_url} . ':' . $idx;
 1066: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1067: 
●1068 → 1068 → 1075 1068: 	if (defined $self->{_file_path} && -f $self->{_file_path}) {
 1069: 		my $mtime = (stat($self->{_file_path}))[9];
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1070: 		return defined $mtime
 1071: 			? 'bi:file:' . $self->{_file_path} . ':' . $mtime
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1072: 			: undef;
 1073: 	}
 1074: 
 1075: 	return undef;
 1076: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1077: 
 1078: # _init_backend( $self ) -> void
 1079: #
 1080: # Strategy: Database::Abstraction is designed as a base class where the
 1081: # lowercased package name maps to the data file in the directory
 1082: # (e.g. "Database::BI::_DB::Sales" -> data/sales.csv or data/sales.db).
 1083: # We synthesise an ephemeral subclass at runtime so DataSource remains
 1084: # fully table-agnostic and callers never need to touch Database::Abstraction
 1085: # directly. In Phase 2, this method can be replaced with Database::Join
 1086: # instantiation without any change to the public API.
 1087: #
 1088: # no_entry => 1: a BI viewer wants every row; we do not need O(1) keyed
 1089: # lookups on a primary key.  This stores data as an arrayref instead of a
 1090: # hashref, which the fast-track path in selectall_arrayref returns directly.
 1091: sub _init_backend :Protected {
●1092 → 1100 → 1156 1092: 	my $self      = shift;
 1093: 	my $table     = $self->{_table};     # sanitized: used for pkg name and D::A table param
 1094: 	my $raw_table = $self->{_raw_table} // $table;  # original: used for file lookup and dbname
 1095: 	my $dir       = $self->{_directory};
 1096: 
 1097: 	# Remote file path (host is set): download via SFTP to a local temp directory,
 1098: 	# then proceed with normal local processing on the downloaded copy.
 1099: 	# Net::SFTP::Foreign is loaded lazily so non-remote usage has no extra deps.
 1100: 	if (defined $self->{_host}) {
 1101: 		eval { require Net::SFTP::Foreign }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1102: 			or croak $self->_msg('error_backend_init', $table,
 1103: 				'Net::SFTP::Foreign is not installed (required for remote file access)');
 1104: 		require File::Temp;
 1105: 		# Split optional user@host into ($user, $host).
 1106: 		my ($user, $host) = $self->{_host} =~ /\A([^@]+)\@(.+)\z/
 1107: 			? ($1, $2) : (undef, $self->{_host});
 1108: 		my $tmpdir = File::Temp->newdir(CLEANUP => 1);
 1109: 		my @remote_exts = qw(csv tsv psv xlsx xls sql sqlite sqlite3 db xml);
 1110: 		# Try the caller-supplied extension first (e.g. .log), then fall back.
 1111: 		if (defined $self->{_file_ext}) {
 1112: 			my $hint = lc $self->{_file_ext};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1113: 			@remote_exts = ($hint, grep { $_ ne $hint } @remote_exts);
 1114: 		}
 1115: 		# One SFTP connection shared across all extension attempts.
 1116: 		my $sftp = eval { Net::SFTP::Foreign->new($host,
 1117: 			defined $user ? (user => $user) : (),
 1118: 			timeout => 10,
 1119: 		) };
 1120: 		croak $self->_msg('error_backend_init', $table,
 1121: 			"could not connect to $host via SFTP: " . ($@ || ($sftp ? $sftp->error : 'unknown')))
 1122: 			unless defined $sftp && !$sftp->error;
 1123: 		my $fetched_ext;
 1124: 		for my $ext (@remote_exts) {
 1125: 			my $remote_path = "$dir/$raw_table.$ext";
 1126: 			my $local_file  = File::Spec->catfile("$tmpdir", "$raw_table.$ext");
 1127: 			$sftp->get($remote_path, $local_file);
 1128: 			# Verify the file landed on disk; sftp->error may be set on ENOENT.
 1129: 			next if $sftp->error || !-f $local_file || !-s $local_file;
 1130: 			$fetched_ext = $ext;
 1131: 			last;
 1132: 		}
 1133: 		croak $self->_msg('error_backend_init', $table,
 1134: 			"could not fetch any supported file from $self->{_host}:$dir/$raw_table.*")
 1135: 			unless defined $fetched_ext;
 1136: 		$self->{_remote_tmpdir} = $tmpdir;	# prevents cleanup until $self is destroyed
 1137: 
 1138: 		# If the downloaded file has a non-standard extension (e.g. .log), rename
 1139: 		# it to one that _detect_file_info and D::A can discover automatically.
 1140: 		# We do this by sniffing the first bytes/line for format signatures.
 1141: 		my %KNOWN_EXT = map { $_ => 1 }
 1142: 			qw(csv tsv psv xlsx xls sql sqlite sqlite3 db xml);
 1143: 		unless ($KNOWN_EXT{lc $fetched_ext}) {
 1144: 			my $orig_file = File::Spec->catfile("$tmpdir", "$raw_table.$fetched_ext");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1145: 			my $std_ext   = _sniff_data_ext($orig_file);
 1146: 			if ($std_ext ne lc $fetched_ext) {
 1147: 				my $new_file = File::Spec->catfile("$tmpdir", "$raw_table.$std_ext");
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1148: 				{ no autodie; rename $orig_file, $new_file }
 1149: 				$fetched_ext = $std_ext;
 1150: 			}
 1151: 		}
 1152: 
 1153: 		$dir = "$tmpdir";	# switch to local temp dir for all subsequent processing
 1154: 	}
 1155: 
●1156 → 1169 → 1181 1156: 	require Database::Abstraction;
 1157: 
 1158: 	my $pkg = 'Database::BI::_DB::' . ucfirst($table);
 1159: 	{
 1160: 		no strict 'refs';
 1161: 		push @{"${pkg}::ISA"}, 'Database::Abstraction'
 1162: 			unless $pkg->isa('Database::Abstraction');
 1163: 	}
 1164: 
 1165: 	my $info   = _detect_file_info($dir, $raw_table);
 1166: 
 1167: 	# Probe for the actual file on disk so _cache_key can compute its mtime.
 1168: 	# This runs before the early-return paths so even empty files get a path.
 1169: 	for my $e (qw(csv tsv psv sql sqlite sqlite3 xml db xlsx xls)) {
 1170: 		my $p = File::Spec->catfile($dir, "$raw_table.$e");
 1171: 		if (-f $p) {
 1172: 			$self->{_file_path} = File::Spec->rel2abs($p);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1173: 			last;
 1174: 		}
 1175: 	}
 1176: 
 1177: 	# BerkeleyDB file detected by magic bytes, but tie() failed (version
 1178: 	# incompatibility -- e.g. the file uses BDB format 9 but the installed
 1179: 	# libdb only supports an older format).  Croak now so D::A never falls
 1180: 	# through to its CSV path and reads the entire binary file as text.
●1181 → 1181 → 1188 1181: 	if ($info->{_unknown_binary_db}) {
 1182: 		croak $self->_msg('error_unsupported_db', $raw_table);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1183: 	}
 1184: 
 1185: 	# 0-byte file: skip D::A/DBI entirely.  D::A on an empty file falls through
 1186: 	# to DBD::CSV, whose error handling corrupts DBI's Errstr SV and triggers an
 1187: 	# XS assertion failure at cleanup on DEBUGGING perls (DBI 1.651, perl 5.44).
●1188 → 1188 → 1201 1188: 	if ($info->{_file_is_empty}) {
 1189: 		$self->{_columns}       = [];
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1190: 		$self->{_id_col}        = 'entry';
 1191: 		$self->{_file_is_empty} = 1;
 1192: 		return;
 1193: 	}
 1194: 
 1195: 	# Headerless CSV or XLSX: _detect_file_info already pre-loaded all rows.
 1196: 	# MUST check before error_no_safe_id: XLSX files with all-unsafe column
 1197: 	# headers (e.g. "First Name", "Account Number") have id => undef because
 1198: 	# none of the headers match the safe-identifier regex, but the data is
 1199: 	# pre-loaded and the id column is irrelevant for the direct-data fast path.
 1200: 	# Checking error_no_safe_id first would croak spuriously for valid XLSX files.
●1201 → 1201 → 1214 1201: 	if ($info->{_headerless_data}) {
 1202: 		$self->{_id_col}  = $info->{id} // 'entry';
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1203: 		$self->{_columns} = $info->{columns};
 1204: 		$self->{_file_data} = $info->{_headerless_data};
 1205: 		return;
 1206: 	}
 1207: 
 1208: 	# _detect_file_info returns undef for id when every column header contains
 1209: 	# characters that are not safe SQL identifiers (spaces, hyphens, etc.).
 1210: 	# Falling back to the D::A default ('entry') would silently return 0 rows
 1211: 	# since no 'entry' column exists.  Croak with a human-readable message.
 1212: 	# This guard applies only to CSV/TSV/PSV/SQLite/XML -- headerless and XLSX paths
 1213: 	# are handled by the _headerless_data check immediately above.
●1214 → 1234 → 1265 1214: 	croak $self->_msg('error_no_safe_id', $table)
 1215: 		if exists $info->{columns} && !defined $info->{id};
 1216: 	my $id_col = $info->{id} // 'entry';
 1217: 	$self->{_id_col}  = $id_col;
 1218: 	$self->{_columns} = $info->{columns};	# undef for SQLite/XML
 1219: 
 1220: 	# D::A validates dbname as a SQL identifier and rejects names that contain
 1221: 	# spaces or other characters that are illegal in SQL (e.g. "transactions for
 1222: 	# Nigel").  This check fires at query time (inside selectall_arrayref) for
 1223: 	# the DBI path used by XLSX, SQLite, and XML files -- after construction
 1224: 	# succeeds -- so the error surfaces as error_fetch_failed, not error_backend_init.
 1225: 	#
 1226: 	# Fix: when the original filename stem was sanitized (raw_table != table),
 1227: 	# create a temporary directory with a symlink that uses the safe name.
 1228: 	# D::A opens the symlink, sees a space-free dbname, and builds valid SQL.
 1229: 	# The temp-dir object is kept in $self so the symlink persists for the full
 1230: 	# lifetime of this DataSource instance and is cleaned up automatically when
 1231: 	# $self is destroyed.
 1232: 	my $dbname = $raw_table;
 1233: 	my $da_dir = $dir;
 1234: 	if ($raw_table ne $table) {
 1235: 		my $safe_ext;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1236: 		for my $e (qw(xlsx xls db sql sqlite sqlite3 xml csv tsv psv)) {
 1237: 			$safe_ext = $e, last
 1238: 				if -f File::Spec->catfile($dir, "$raw_table.$e");
 1239: 		}
 1240: 		if (defined $safe_ext) {
 1241: 			require File::Temp;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1242: 			my $tmp     = File::Temp->newdir(CLEANUP => 1);
 1243: 			my $abs_src = File::Spec->rel2abs(
 1244: 				File::Spec->catfile($dir, "$raw_table.$safe_ext"));
 1245: 			my $link    = File::Spec->catfile("$tmp", "$table.$safe_ext");
 1246: 			{
 1247: 				no autodie;	# symlink failure gives our message, not autodie's
 1248: 				symlink($abs_src, $link)
 1249: 					or croak $self->_msg('error_backend_init', $table,
 1250: 						"cannot create safe-name symlink for '$raw_table.$safe_ext': $!");
 1251: 			}
 1252: 			$self->{_tmpdir} = $tmp;	# prevents cleanup until $self is destroyed
 1253: 			$dbname = $table;
 1254: 			$da_dir = "$tmp";
 1255: 		}
 1256: 	}
 1257: 
 1258: 	# SQLite: _detect_file_info probed sqlite_master and returned the internal
 1259: 	# table names.  When $dbname (the filename stem or its safe alias) is not
 1260: 	# among those names, auto-select the first user table (or use the caller-
 1261: 	# supplied internal_table) and create a symlink from <target>.<ext> to the
 1262: 	# original file so D::A can issue SQL against the real table name.
 1263: 	# D::A uses 'dbname' to find the file and 'table' for the SELECT statement,
 1264: 	# so both must be set to the actual table name when a mismatch is corrected.
●1265 → 1266 → 1315 1265: 	my $da_table = $table;	# D::A 'table' param -- controls the SQL table name
 1266: 	if (exists $info->{sqlite_tables}) {
 1267: 		my @tbls = @{ $info->{sqlite_tables} };
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1268: 		croak $self->_msg('error_no_tables', $raw_table) unless @tbls;
 1269: 
 1270: 		# Store the full table list so callers (e.g. the tables_view action)
 1271: 		# can detect multi-table databases after construction.
 1272: 		$self->{_sqlite_tables} = \@tbls;
 1273: 
 1274: 		# Determine target table: caller-specified or auto-detected.
 1275: 		my $desired = $self->{_internal_table};
 1276: 		my $target;
 1277: 		if (defined $desired) {
 1278: 			my ($found) = grep { $_ eq $desired } @tbls;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1279: 			croak $self->_msg('error_table_not_found', $raw_table, $desired)
 1280: 				unless defined $found;
 1281: 			$target = $desired;
 1282: 		} else {
 1283: 			my ($match) = grep { $_ eq $dbname } @tbls;
 1284: 			$target = defined $match ? $match : $tbls[0];
 1285: 		}
 1286: 
 1287: 		# When the target differs from dbname, create a symlink so D::A can
 1288: 		# find the file by target name and issue SELECT * FROM <target>.
 1289: 		# Always use a D::A-recognised SQLite extension (.sql, .sqlite, .sqlite3)
 1290: 		# for the symlink name -- D::A does not use the DBI/SQLite backend for
 1291: 		# .db files, so a customer.db symlink would be read as CSV.
 1292: 		if ($target ne $dbname) {
 1293: 			my ($src_ext) = grep { -f File::Spec->catfile($dir, "$raw_table.$_") }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1294: 				qw(sql sqlite sqlite3 db);
 1295: 			$src_ext //= 'sql';
 1296: 			my $link_ext = ($src_ext eq 'db') ? 'sql' : $src_ext;
 1297: 			require File::Temp;
 1298: 			my $tmp     = File::Temp->newdir(CLEANUP => 1);
 1299: 			my $abs_src = File::Spec->rel2abs(
 1300: 				File::Spec->catfile($dir, "$raw_table.$src_ext"));
 1301: 			my $link = File::Spec->catfile("$tmp", "$target.$link_ext");
 1302: 			{
 1303: 				no autodie;
 1304: 				symlink($abs_src, $link)
 1305: 					or croak $self->_msg('error_backend_init', $raw_table,
 1306: 						"cannot create table-name symlink for '$raw_table.$src_ext': $!");
 1307: 			}
 1308: 			$self->{_tmpdir} = $tmp;
 1309: 			$dbname   = $target;		# D::A uses this for the filename stem
 1310: 			$da_table = $target;		# D::A uses this for SELECT * FROM <table>
 1311: 			$da_dir   = "$tmp";
 1312: 		}
 1313: 	}
 1314: 
●1315 → 1340 → 1344 1315: 	my $db = eval {
 1316: 		$pkg->new({
 1317: 			directory      => $da_dir,
 1318: 			table          => $da_table,
 1319: 			# D::A >= 0.41 uses the class-name suffix as dbname, not the table
 1320: 			# parameter, so a package like Database::BI::_DB::Orders would look
 1321: 			# for Orders.csv on a case-sensitive filesystem even when table =>
 1322: 			# 'orders' is passed.  Passing dbname explicitly keeps the filename
 1323: 			# stem correct regardless of the package name or D::A version.
 1324: 			# When the table name was sanitized (spaces, hyphens -> underscores),
 1325: 			# $dbname is the safe name so D::A never sees illegal SQL characters,
 1326: 			# and D::A finds the file via the symlink in $da_dir.
 1327: 			dbname         => $dbname,
 1328: 			id             => $id_col,
 1329: 			no_entry       => 1,
 1330: 			defined($info->{sep_char})  ? (sep_char       => $info->{sep_char})  : (),
 1331: 			# Force the Text::xSV::Slurp path for CSV/TSV/PSV files: D::A's default
 1332: 			# slurp threshold is 16 KB; larger files fall back to DBD::CSV, which
 1333: 			# sanitizes column names (lowercases and replaces spaces with
 1334: 			# underscores).  Passing the actual file size ensures the slurp path
 1335: 			# is always taken, so "Account Number" stays "Account Number" rather
 1336: 			# than becoming "account_number".
 1337: 			defined($info->{file_size}) ? (max_slurp_size => $info->{file_size}) : (),
 1338: 		});
 1339: 	};
 1340: 	if ($@) {
 1341: 		croak $self->_msg('error_backend_init', $table, $@);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1342: 	}
 1343: 
 1344: 	$self->{_db} = $db;
 1345: 	return;
 1346: }
 1347: 
 1348: # ---------------------------------------------------------------------------
 1349: # Public accessors
 1350: # ---------------------------------------------------------------------------
 1351: 
 1352: =head1 ACCESSORS
 1353: 
 1354: =head2 table_name
 1355: 
 1356: Returns the (lowercased) table name this instance was opened against.
 1357: 
 1358: =head3 API SPECIFICATION
 1359: 
 1360: =head4 INPUT
 1361: 
 1362: None.
 1363: 
 1364: =head4 OUTPUT
 1365: 
 1366: Returns a C<SCALAR> string.
 1367: 
 1368: =head3 MESSAGES
 1369: 
 1370: None.
 1371: 
 1372: =cut
 1373: 
 1374: sub table_name {
 1375: 	my $self = shift;
 1376: 	return $self->{_table};
 1377: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1378: 
 1379: =head2 sqlite_tables
 1380: 
 1381: Returns an arrayref of internal table names when the backing file is a
 1382: multi-table SQLite database, or C<undef> for single-table and non-SQLite
 1383: sources.  Set during C<_init_backend> after probing C<sqlite_master>.
 1384: 
 1385: When the return value is a reference to a list with B<more than one
 1386: element>, the caller should redirect the user to the schema browser
 1387: (C</tables>) so they can pick which table to open, rather than
 1388: silently opening the first one.
 1389: 
 1390: Example:
 1391: 
 1392:     my $tbls = $source->sqlite_tables;
 1393:     if ($tbls && @{$tbls} > 1) {
 1394:         # multiple tables -- let the user choose
 1395:         print "Tables: ", join(', ', @{$tbls}), "\n";
 1396:     }
 1397: 
 1398: =head3 API SPECIFICATION
 1399: 
 1400: =head4 INPUT
 1401: 
 1402: None.
 1403: 
 1404: =head4 OUTPUT
 1405: 
 1406:     ARRAYREF of SCALAR    # ['customer', 'product', 'sales'] for a 3-table SQLite file
 1407:     undef                 # for CSV, TSV, PSV, XML, URL-backed, and single-table SQLite
 1408: 
 1409: The arrayref contains the names in the order returned by C<sqlite_master>
 1410: (alphabetical).  It is set once during construction and never changes.
 1411: 
 1412: =head3 MESSAGES
 1413: 
 1414: None.
 1415: 
 1416: =cut
 1417: 
 1418: sub sqlite_tables {
 1419: 	my $self = shift;
 1420: 	return $self->{_sqlite_tables};
 1421: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1422: 
 1423: =head2 columns
 1424: 
 1425: Returns an arrayref of column names in file order, or C<undef> when no order
 1426: is available.
 1427: 
 1428: =over 4
 1429: 
 1430: =item CSV / TSV / PSV / XLSX
 1431: 
 1432: Column names come from the file header (first row).  They are returned in
 1433: the order they appear in the file.  For header-less files (detected
 1434: automatically) the synthesized names (C<Date>, C<Amount>, C<Description>,
 1435: etc.) are returned in the same synthesized order.
 1436: 
 1437: =item SQLite / XML
 1438: 
 1439: Falls back to the underlying C<Database::Abstraction> object's C<columns()>
 1440: method.  This is useful when a C<DataSource> is passed directly to
 1441: C<Database::Join> as a component database.
 1442: 
 1443: =item URL-backed tables
 1444: 
 1445: Always returns C<undef>.  C<Database::Abstraction> fetches URL data lazily,
 1446: so calling C<_db-E<gt>columns()> here would trigger a live network request even
 1447: when the data came from the CHI cache.  The controller derives column order
 1448: from the data records instead (alphabetical fallback).
 1449: 
 1450: =item Redis-backed tables
 1451: 
 1452: Delegates to the underlying C<Database::Abstraction> C<columns()>, which
 1453: triggers a lazy open of the Redis connection on first call and returns the
 1454: column names derived from the first stored row (alphabetical order, includes
 1455: C<entry>).  This is required so that C<Database::Join> can validate the
 1456: join column at construction time.
 1457: 
 1458: =back
 1459: 
 1460: Always check the return value before dereferencing:
 1461: 
 1462:     my $cols = $source->columns;
 1463:     if ($cols) {
 1464:         print join(', ', @{$cols}), "\n";
 1465:     } else {
 1466:         # URL-backed tables: derive columns from the first data row
 1467:     }
 1468: 
 1469: =head3 API SPECIFICATION
 1470: 
 1471: =head4 INPUT
 1472: 
 1473: None.
 1474: 
 1475: =head4 OUTPUT
 1476: 
 1477:     ARRAYREF of SCALAR    # ['id', 'name', 'price', ...] -- original header order
 1478:     undef                 # SQLite, XML, URL-backed tables
 1479: 
 1480: =head3 MESSAGES
 1481: 
 1482: None.
 1483: 
 1484: =cut
 1485: 
 1486: sub columns {
●1487 → 1499 → 1506 1487: 	my $self = shift;
 1488: 	return $self->{_columns} if defined $self->{_columns};
 1489: 	# URL-backed tables have no canonical column order at construction time;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1490: 	# calling _db->columns() would trigger a live HTTP request which may fail.
 1491: 	# Return undef so _get_columns derives column names from fetched data.
 1492: 	return undef if defined $self->{_url};
 1493: 	# Redis-backed tables: delegate to _db->columns() which triggers the lazy
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1494: 	# open() on first call.  D::J requires a real column list at construction
 1495: 	# time so returning undef here would make join validation always fail.
 1496: 	# D::A builds its Redis column list from hgetall fields only and omits the
 1497: 	# entry key (the suffix of the Redis key pattern tablename:entryid).
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1498: 	# Prepend the id column so callers and D::J see a complete column list.
 1499: 	if (defined $self->{_redis_url} && $self->{_db}) {
 1500: 		my $da_cols  = $self->{_db}->columns() // [];
 1501: 		my $id       = $self->{_id_col} // 'entry';
 1502: 		my @full     = ($id, grep { $_ ne $id } @{$da_cols});
 1503: 		$self->{_columns} = \@full;
 1504: 		return $self->{_columns};
 1505: 	}
 1506: 	return $self->{_db} ? $self->{_db}->columns() : undef;
 1507: }
 1508: 
 1509: =head2 dbi_source
 1510: 
 1511: Returns a hashref C<{ dbh =E<gt> $dbh, table =E<gt> $name }> for SQLite-backed
 1512: instances, and C<undef> for everything else.
 1513: 
 1514: C<Database::Join> 0.009.0 probes C<dbi_source> at join-construction time to
 1515: decide whether it can take the zero-copy C<ATTACH> path (avoiding a row-by-row
 1516: spill into a temporary SQLite file).  Without this method, every C</join> on a
 1517: SQLite-backed C<DataSource> uses the spill path regardless of row count.
 1518: 
 1519: Returns C<undef> for:
 1520: 
 1521: =over 4
 1522: 
 1523: =item *
 1524: 
 1525: 0-byte and header-less pre-parsed files (C<_file_is_empty>, C<_file_data> set).
 1526: 
 1527: =item *
 1528: 
 1529: Redis-backed and URL-backed sources (no DBI handle).
 1530: 
 1531: =item *
 1532: 
 1533: Any backend that does not itself implement C<dbi_source>.
 1534: 
 1535: =back
 1536: 
 1537: =head3 API SPECIFICATION
 1538: 
 1539: =head4 INPUT
 1540: 
 1541: None.
 1542: 
 1543: =head4 OUTPUT
 1544: 
 1545:     { dbh => $dbh_object, table => 'table_name' }   # SQLite-backed
 1546:     undef                                            # all other backends
 1547: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1548: =head3 MESSAGES
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1549: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1550: None.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1551: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1552: =cut
 1553: 
 1554: sub dbi_source {
 1555: 	my $self = shift;
 1556: 	return undef if $self->{_file_is_empty};
 1557: 	return undef if $self->{_file_data};
 1558: 	return undef unless $self->{_db};
 1559: 	return undef unless $self->{_db}->can('dbi_source');
 1560: 	return $self->{_db}->dbi_source();
 1561: }
 1562: 
 1563: =head2 aggregate
 1564: 
 1565: Delegates to the inner C<Database::Abstraction> backend's C<aggregate()> method
 1566: (requires C<Database::Abstraction> E<gt>= 0.49).
 1567: 
 1568: Returns C<[]> for in-memory backends (headerless CSV, XLSX, empty files) and for
 1569: URL-backed sources where aggregation is not available.
 1570: 
 1571: Accepts the same C<by>, C<measures>, C<having>, C<sort_by>, C<limit>, C<offset>,
 1572: and WHERE-criteria parameters as C<Database::Abstraction::aggregate()>.
 1573: 
 1574: =head3 API SPECIFICATION
 1575: 
 1576: =head4 INPUT
 1577: 
 1578:   by        arrayref    Column names to GROUP BY.
 1579:   measures  arrayref    Measure descriptors (see Database::Abstraction::aggregate).
 1580:   having    hashref     Optional HAVING criteria.
 1581:   sort_by   string      Optional ORDER BY column.
 1582:   limit     integer     Optional result limit.
 1583:   offset    integer     Optional result offset.
 1584:   (any other key)       WHERE column criteria passed through to D::A.
 1585: 
 1586: =head4 OUTPUT
 1587: 
 1588:   arrayref of hashrefs   -- one row per group.
 1589:   []                     -- in-memory / empty / URL-backed sources.
 1590: 
 1591: =head3 MESSAGES
 1592: 
 1593: None.
 1594: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1595: =cut
 1596: 
 1597: sub aggregate {
 1598: 	my ($self, @args) = @_;
 1599: 	return [] if $self->{_file_is_empty};
 1600: 	return [] if $self->{_file_data};
 1601: 	return [] unless $self->{_db};
 1602: 	return [] unless $self->{_db}->can('aggregate');
 1603: 	return $self->{_db}->aggregate(@args);
 1604: }
 1605: 
 1606: =head2 id_column
 1607: 
 1608: Returns the name of the column used as the primary key and as
 1609: C<Database::Abstraction>'s row-existence anchor.
 1610: 
 1611: For file-backed tables this is the first column in the CSV/TSV/PSV header
 1612: whose name is a valid SQL identifier (letters, digits, underscores only,
 1613: not starting with a digit) B<and> whose value in the first data row is
 1614: non-empty.  C<DataSource> detects this automatically to avoid the
 1615: C<Database::Abstraction> default of C<'entry'>, which would silently
 1616: discard every row in a file that has no C<entry> column.
 1617: 
 1618: Returns C<undef> for URL/HTML-table backends (no primary-key concept applies).
 1619: 
 1620: =head3 API SPECIFICATION
 1621: 
 1622: =head4 INPUT
 1623: 
 1624: None.
 1625: 
 1626: =head4 OUTPUT
 1627: 
 1628:     SCALAR string    # e.g. 'id', 'date', 'sku' -- the first safe-identifier column
 1629:     undef            # URL-backed (HTML table import) sources
 1630: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1631: =head3 MESSAGES
 1632: 
 1633: None.
 1634: 
 1635: =cut
 1636: 
 1637: sub id_column {
 1638: 	my $self = shift;
 1639: 	return $self->{_id_col};
 1640: }
 1641: 
 1642: =head2 source_url
 1643: 
 1644: Returns the source URL for URL/HTML-table-backed instances.
 1645: Returns C<undef> for all file-backed instances (local files and SFTP-fetched
 1646: remote files).
 1647: 
 1648: Use this to distinguish a URL-backed C<DataSource> from a file-backed one
 1649: when you need to decide whether to show a "re-fetch" button to the user.
 1650: 
 1651: =head3 API SPECIFICATION
 1652: 
 1653: =head4 INPUT
 1654: 
 1655: None.
 1656: 
 1657: =head4 OUTPUT
 1658: 
 1659:     SCALAR string    # 'https://example.com/data.html' -- the original URL
 1660:     undef            # file-backed (local or SFTP) sources
 1661: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1662: =head3 MESSAGES
 1663: 
 1664: None.
 1665: 
 1666: =cut
 1667: 
 1668: sub source_url {
 1669: 	my $self = shift;
 1670: 	return $self->{_url};
 1671: }
 1672: 
 1673: =head2 updated
 1674: 
 1675: Returns the Unix epoch timestamp (mtime) of the backing data file, or
 1676: C<undef> for URL-backed tables and for sources whose file cannot be
 1677: C<stat()>-ed.
 1678: 
 1679: C<Database::Join> calls C<updated()> on each component database to
 1680: detect whether its SQLite spill cache is stale.  When a source file changes
 1681: on disk, the mtime increases, the join detects the change, and re-runs the
 1682: join rather than serving stale cached data.
 1683: 
 1684: =head3 API SPECIFICATION
 1685: 
 1686: =head4 INPUT
 1687: 
 1688: None.
 1689: 
 1690: =head4 OUTPUT
 1691: 
 1692:     SCALAR integer   # Unix epoch seconds, e.g. 1728601234
 1693:     undef            # URL-backed tables, or file cannot be stat()-ed
 1694: 
 1695: =head3 MESSAGES
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1696: 
 1697: None.
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1698: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1699: =cut
 1700: 
 1701: sub updated {
 1702: 	my $self = shift;
 1703: 	# Delegate to the D::A backend when available -- it tracks mtime internally.
 1704: 	return $self->{_db}->updated() if $self->{_db} && $self->{_db}->can('updated');
 1705: 	# Fallback: stat the file path directly (header-less CSV and XLSX bypass D::A).
 1706: 	return (stat($self->{_file_path}))[9] if defined $self->{_file_path} && -f $self->{_file_path};
 1707: 	return undef;
 1708: }
 1709: 
 1710: # ---------------------------------------------------------------------------
 1711: # Public data-access methods
 1712: # ---------------------------------------------------------------------------
 1713: 
 1714: =head1 METHODS
 1715: 
 1716: =head2 fetch_all
 1717: 
 1718: Returns every record in the table as an arrayref of hashrefs (one hashref
 1719: per row; keys are the column names).
 1720: 
 1721: This is the primary data-retrieval method.  It is equivalent to calling
 1722: C<selectall_arrayref> with no arguments and normalising the result to an
 1723: arrayref.  Prefer C<selectall_arrayref> when passing to C<Database::Join>
 1724: (it is the method that C<Database::Join> calls internally).
 1725: 
 1726: Filtering (C<eq>, C<contains>, C<gt>, C<lt>, etc.) is applied at the
 1727: controller layer by C<Dashboard::_apply_filter_spec> after C<fetch_all>
 1728: returns.  C<DataSource> itself is filter-unaware.
 1729: 
 1730: Three fast-path shortcuts are checked before touching the DBI backend,
 1731: in this order:
 1732: 
 1733: =over 4
 1734: 
 1735: =item 1.
 1736: 
 1737: C<_file_is_empty> is set (0-byte or blank-first-line file) -- returns C<[]>
 1738: immediately, no DBI connection.
 1739: 
 1740: =item 2.
 1741: 
 1742: C<_file_data> is set (pre-parsed header-less CSV, XLSX, or BerkeleyDB data) --
 1743: returns the in-memory arrayref directly.
 1744: 
 1745: =item 3.
 1746: 
 1747: A matching CHI cache entry exists -- returns the cached arrayref without
 1748: calling C<Database::Abstraction>.
 1749: 
 1750: =back
 1751: 
 1752: =head3 API SPECIFICATION
 1753: 
 1754: =head4 INPUT
 1755: 
 1756: None.  Filtering is applied at the controller layer, not inside C<DataSource>.
 1757: 
 1758: =head4 OUTPUT
 1759: 
 1760:     ARRAYREF of HASHREF   # one hashref per row; keys are column names
 1761:     []                    # empty arrayref when the file is empty or has no data rows
 1762: 
 1763: Croaks (via C<croak>) when the backend raises an exception.  Emits a
 1764: warning via C<carp> (non-fatal) when the result set is empty, so the
 1765: caller can distinguish "opened successfully, no data" from a silent
 1766: failure.
 1767: 
 1768: =head3 MESSAGES
 1769: 
 1770:   error_fetch_failed     -- backend threw an exception during retrieval
 1771:   warn_empty_result      -- query succeeded but returned zero records
 1772:   warn_data_normalised   -- backend returned a hashref; converted to arrayref
 1773: 
 1774: =cut
 1775: 
 1776: =head2 selectall_arrayref
 1777: 
 1778: C<Database::Abstraction>-compatible alias that allows a C<DataSource> object
 1779: to be passed directly to C<Database::Join> as a component database.
 1780: 
 1781: When called with no arguments (the normal path for a full-table scan),
 1782: results are served from the CHI cache when available.  When called with
 1783: arguments (e.g. C<limit =E<gt> N, offset =E<gt> M> for server-side
 1784: pagination), the cache is bypassed -- narrowed results must not pollute
 1785: the full-table cache entry.
 1786: 
 1787: Three fast-path shortcuts are checked before touching the DBI backend:
 1788: 
 1789: =over 4
 1790: 
 1791: =item 1.
 1792: 
 1793: C<_file_is_empty> is set -- returns C<[]> immediately.
 1794: 
 1795: =item 2.
 1796: 
 1797: C<_file_data> is set (pre-parsed headerless CSV / XLSX / BerkeleyDB) -- returns
 1798: the in-memory rows directly.
 1799: 
 1800: =item 3.
 1801: 
 1802: A matching CHI cache entry exists for the full-table scan -- returns the
 1803: cached arrayref.
 1804: 
 1805: =back
 1806: 
 1807: =head3 API SPECIFICATION
 1808: 
 1809: =head4 INPUT
 1810: 
 1811: Optional flat key/value list passed through to C<Database::Abstraction>:
 1812: 
 1813:     limit  => N    # return at most N rows (used by pagination)
 1814:     offset => M    # skip the first M rows (used by pagination)
 1815: 
 1816: When no arguments are given, the full table is returned (and cached).
 1817: 
 1818: =head4 OUTPUT
 1819: 
 1820:     ARRAYREF of HASHREF   # one hashref per row; keys are column names
 1821:     []                    # empty arrayref when the file is empty or no rows match
 1822: 
 1823: =head3 MESSAGES
 1824: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1825: None.  Errors from the DBI backend propagate as uncaught exceptions; wrap
 1826: calls in C<eval> if you need to recover.
 1827: 
 1828: =cut
 1829: 
 1830: sub selectall_arrayref {
  Mutants (Total: 1, Killed: 1, Survived: 0)
●1831 → 1839 → 1847 1831: 	my ($self, @args) = @_;
 1832: 	return [] if $self->{_file_is_empty};
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1833: 	return $self->{_file_data} if $self->{_file_data};
 1834: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1835: 	# Cache only plain unfiltered calls -- Database::Join passes no args for the
 1836: 	# full table scan; a non-empty @args means a narrowed query whose result must
 1837: 	# not be mistaken for the full-table cache entry.
 1838: 	my $cache = $self->{_cache};
 1839: 	if ($cache && !@args) {
 1840: 		my $key = $self->_cache_key;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1841: 		if (defined $key) {
 1842: 			my $hit = $cache->get($key);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1843: 			return $hit if defined $hit;
 1844: 		}
 1845: 	}
 1846: 
●1847 → 1849 → 1858 1847: 	my $data = $self->{_db}->selectall_arrayref(@args);
 1848: 
 1849: 	if ($cache && !@args && defined $data) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1850: 		my $key = $self->_cache_key;
 1851: 		if (defined $key) {
 1852: 			defined $self->{_url}
 1853: 				? $cache->set($key, $data, $self->{_cache_ttl_url})
 1854: 				: $cache->set($key, $data);
 1855: 		}
 1856: 	}
 1857: 
 1858: 	return $data;
 1859: }
 1860: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1861: sub fetch_all {
●1862 → 1874 → 1882 1862: 	my $self  = shift;
 1863: 	my $table = $self->{_table};
 1864: 
 1865: 	# 0-byte file: no backend was created; nothing to fetch.
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1866: 	return [] if $self->{_file_is_empty};
 1867: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1868: 	# Headerless CSV/XLSX: data was pre-parsed with synthesized column names.
 1869: 	return $self->{_file_data} if $self->{_file_data};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1870: 
 1871: 	# Cache check: URL tables benefit from avoiding repeated HTTP round-trips;
 1872: 	# file tables benefit from skipping disk I/O and CSV/TSV/PSV parsing.
 1873: 	my $cache = $self->{_cache};
 1874: 	if ($cache) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1875: 		my $key = $self->_cache_key;
 1876: 		if (defined $key) {
 1877: 			my $hit = $cache->get($key);
 1878: 			return $hit if defined $hit;
 1879: 		}
 1880: 	}
 1881: 
●1882 → 1883 → 1887 1882: 	my $data = eval { $self->{_db}->selectall_hashref() };
 1883: 	if ($@) {
 1884: 		croak $self->_msg('error_fetch_failed', $table, $@);
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1885: 	}
 1886: 
●1887 → 1893 → 1898 1887: 	return [] unless defined $data;
 1888: 
 1889: 	# Strategy: Database::Abstraction can return either an arrayref (when the
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1890: 	# underlying driver iterates rows) or a hashref keyed by primary key (when
 1891: 	# it mirrors DBI's selectall_hashref semantics). We normalise to arrayref
 1892: 	# here so every caller above this layer sees a uniform structure.
 1893: 	if (ref $data eq 'HASH') {
 1894: 		carp $self->_msg('warn_data_normalised', $table);
 1895: 		$data = [ values %{$data} ];
 1896: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1897: 
●1898 → 1898 → 1905 1898: 	if (!@{$data}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1899: 		carp $self->_msg('warn_empty_result', $table);
 1900: 	}
 1901: 
 1902: 	# Cache store: URL tables use a TTL so stale pages expire automatically;
 1903: 	# file tables encode mtime in the key so a changed file produces a natural
 1904: 	# miss without any explicit invalidation.
●1905 → 1905 → 1914 1905: 	if ($cache) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1906: 		my $key = $self->_cache_key;
 1907: 		if (defined $key) {
 1908: 			defined $self->{_url}
 1909: 				? $cache->set($key, $data, $self->{_cache_ttl_url})
 1910: 				: $cache->set($key, $data);
 1911: 		}
 1912: 	}
 1913: 
 1914: 	return $data;
 1915: }
 1916: 
 1917: =head2 count
 1918: 
 1919: Returns the total number of rows in the table.
 1920: 
 1921: For pre-parsed sources (header-less CSV, XLSX, BerkeleyDB) the count comes
 1922: from the already-loaded in-memory slice and is instant (no I/O).  For
 1923: empty-file sentinels it returns C<0> immediately.  For all DBI-backed
 1924: sources (SQLite, large CSV via DBD::CSV) it delegates to
 1925: C<Database::Abstraction::count()>, which issues a
 1926: C<SELECT COUNT(*) FROM E<lt>tableE<gt>> query against the file.
 1927: 
 1928: B<Warning: do not call C<count()> on a very large SQLite file> if you
 1929: only need to know whether a next page exists.  The pagination controller
 1930: uses the N+1 trick (fetch C<per_page + 1> rows via C<limit/offset>)
 1931: specifically to avoid a C<COUNT(*)> on multi-gigabyte databases, which
 1932: can block the server for minutes.
 1933: 
 1934: =head3 API SPECIFICATION
 1935: 
 1936: =head4 INPUT
 1937: 
 1938: None.
 1939: 
 1940: =head4 OUTPUT
 1941: 
 1942:     SCALAR non-negative integer   # total row count, 0 for empty files
 1943: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1944: =head3 MESSAGES
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1945: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1946: None.
 1947: 
 1948: =cut
 1949: 
 1950: sub count {
 1951: 	my ($self) = @_;
 1952: 	return 0 if $self->{_file_is_empty};
 1953: 	return scalar @{ $self->{_file_data} } if $self->{_file_data};
 1954: 	return $self->{_db}->count();
 1955: }
 1956: 
 1957: 1;
 1958: 
 1959: __END__
 1960: 
 1961: =head1 COMMON PITFALLS
 1962: 
 1963: These are the most common mistakes when using C<DataSource>.
 1964: 
 1965: =over 4
 1966: 
 1967: =item B<SQLite databases may use .sql, .sqlite, or .sqlite3 as their file extension>
 1968: 
 1969: C<DataSource> recognises C<.sql>, C<.sqlite>, and C<.sqlite3> as SQLite
 1970: database files.  It does B<not> recognise C<.db3>.  If you have a file called
 1971: C<inventory.db3>, rename it to C<inventory.sql> before passing it to
 1972: C<DataSource>.
 1973: 
 1974: =item B<The table name is always lowercased>
 1975: 
 1976: The constructor lowercases the C<table> argument before using it.  Passing
 1977: C<table =E<gt> 'Sales'> and C<table =E<gt> 'sales'> both look for
 1978: C<sales.csv> (or C<sales.sql>, etc.).  The matching is case-insensitive on the
 1979: table name but B<case-sensitive on the directory path>.
 1980: 
 1981: =item B<CSV files with the wrong separator appear as one giant field per row>
 1982: 
 1983: C<Database::Abstraction> defaults to C<!> (exclamation mark) as its field
 1984: separator.  A standard comma-separated CSV file will look like one big field
 1985: per row (for example, C<1,Widget A,North,100>) because the library never sees
 1986: the commas as separators.  C<DataSource> fixes this automatically by reading
 1987: the first line of the file and detecting the actual separator.  If you bypass
 1988: C<DataSource> and call C<Database::Abstraction> directly, you B<must> pass
 1989: C<sep_char =E<gt> ','> yourself.
 1990: 
 1991: =item B<A table with no "entry" column returns zero rows (without DataSource)>
 1992: 
 1993: C<Database::Abstraction> uses C<entry> as its default primary-key column name.
 1994: When slurping a CSV, it discards any row where C<$row-E<gt>{entry}> is
 1995: undefined.  Because most CSV files do not have an C<entry> column, B<all rows
 1996: are silently discarded>.  C<DataSource> prevents this by reading the actual
 1997: first column name from the CSV header and passing it as C<id>, and also by
 1998: setting C<no_entry =E<gt> 1> so all rows are kept as an ordered array.
 1999: 
 2000: =item B<columns() returns undef for SQLite and XML files>
 2001: 
 2002: C<columns()> only returns an arrayref for file formats where the header order
 2003: is visible before data is read (CSV, TSV and PSV).  For SQLite and XML files it
 2004: returns C<undef>.  Always check: C<if ($source-E<gt>columns) { ... }>.  The
 2005: controller falls back to putting C<id_column> first and then sorting the rest
 2006: alphabetically when C<columns()> is C<undef>.
 2007: 
 2008: =item B<XML elements named "name", "id", or "key" cause parse failures>
 2009: 
 2010: C<XML::Simple> (used by C<Database::Abstraction> for XML files) automatically
 2011: turns a child element called C<name>, C<id>, or C<key> into a hash key instead
 2012: of keeping it as an array element.  This breaks the expected data structure.
 2013: Use different element names in your XML: for example, C<E<lt>skuE<gt>>,
 2014: C<E<lt>labelE<gt>>, or C<E<lt>codeE<gt>> instead of C<E<lt>idE<gt>> and
 2015: C<E<lt>nameE<gt>>.
 2016: 
 2017:   <!-- WRONG: these element names trigger XMLin key-folding -->
 2018:   <items>
 2019:     <item><id>1</id><name>Widget</name></item>
 2020:   </items>
 2021: 
 2022:   <!-- CORRECT: use neutral element names -->
 2023:   <items>
 2024:     <item><sku>1</sku><label>Widget</label></item>
 2025:   </items>
 2026: 
 2027: =item B<fetch_all returns an empty arrayref, not undef, for an empty table>
 2028: 
 2029: When a table exists but contains no data rows, C<fetch_all> returns C<[]> (an
 2030: empty arrayref), not C<undef>.  Check with C<scalar @{$records}>, not with
 2031: C<defined $records> or C<$records>.
 2032: 
 2033: =item B<0-byte CSV/TSV/PSV files bypass Database::Abstraction entirely>
 2034: 
 2035: When C<_detect_file_info> opens a CSV, TSV or PSV file and the first C<readline>
 2036: returns C<undef> (the file is 0 bytes), it returns a C<{ _file_is_empty =E<gt>
 2037: 1 }> sentinel instead of the normal C<{ id, sep_char, columns, file_size }>
 2038: hashref.  C<_init_backend> detects this sentinel and skips
 2039: C<Database::Abstraction> construction; C<fetch_all> returns C<[]> immediately.
 2040: B<No DBI connection is created for 0-byte files.>  If you mock or spy on DBI
 2041: handles and open a 0-byte CSV, the mock will never fire - this is expected
 2042: behaviour, not a mock misconfiguration.
 2043: 
 2044: =item B<Remote files require Net::SFTP::Foreign; one connection per open>
 2045: 
 2046: When C<host> is set, C<DataSource> makes one SFTP connection per C<new()>
 2047: call.  It tries the extension list in order (the C<file_ext> hint first,
 2048: if provided, then the full standard-extension list) and downloads the first
 2049: file it finds.  If no file is found under any tried extension, C<new()>
 2050: croaks C<error_backend_init>.  B<Connections are not pooled or reused>
 2051: between C<DataSource> instances.
 2052: 
 2053: If the remote file has a non-standard extension (e.g. C<.log>, C<.dat>),
 2054: the content is sniffed: SQLite magic bytes map to C<.db>, an XML preamble
 2055: to C<.xml>, a tab-delimited first line to C<.tsv>, a pipe-delimited line to
 2056: C<.psv>, and everything else to C<.csv>.  The temp file is then renamed to
 2057: the detected extension before further processing.
 2058: 
 2059: =item B<Multi-table SQLite: opening without internal_table silently picks the first table>
 2060: 
 2061: When a SQLite file contains more than one user-defined table and you call
 2062: C<new()> without C<internal_table>, C<DataSource> auto-selects the first
 2063: table whose name matches the filename stem; if there is no match, it picks
 2064: whatever C<sqlite_master> lists first.  This is B<silent> -- you get data
 2065: from a table you may not have intended to open.
 2066: 
 2067: Always check C<sqlite_tables()> after construction if you are dealing
 2068: with a SQLite file that might have multiple tables:
 2069: 
 2070:     my $tbl_list = $source->sqlite_tables;
 2071:     if ($tbl_list && @{$tbl_list} > 1) {
 2072:         # warn the user or redirect to the schema browser
 2073:     }
 2074: 
 2075: =item B<The symlink used for .db-extension SQLite files is named .sql, not .db>
 2076: 
 2077: C<Database::Abstraction> does not use its DBI/SQLite backend for files
 2078: with a C<.db> extension -- it falls through to the CSV reader, which tries
 2079: to read a SQLite binary file as text and fails with a parse error.
 2080: 
 2081: When C<DataSource> detects a multi-table SQLite C<.db> file, it creates a
 2082: temporary symlink named C<E<lt>tableE<gt>.sql> (not C<.db>) pointing to the
 2083: original C<.db> file.  SQLite follows symlinks transparently, so the data is
 2084: read correctly.  If you ever audit temporary directories and see C<*.sql>
 2085: symlinks pointing at C<*.db> files, this is expected and intentional.
 2086: 
 2087: =item B<DBD::CSV silently lowercases column names for files larger than 16 KB>
 2088: 
 2089: C<Database::Abstraction> uses C<Text::xSV::Slurp> for files up to 16 KB and
 2090: DBD::CSV for larger ones.  The DBD::CSV path lowercases column names and
 2091: replaces spaces with underscores (C<Account Number> becomes
 2092: C<account_number>), which causes a C<"disallowed key"> error at render time
 2093: when the template iterates the original column names.  C<DataSource> avoids
 2094: this by always passing C<max_slurp_size =E<gt> -s $path> to
 2095: C<Database::Abstraction>, forcing the slurp path regardless of file size.
 2096: If you call C<Database::Abstraction> directly, you B<must> pass this option
 2097: yourself for any file whose column names contain spaces or mixed case.
 2098: 
 2099: =back
 2100: 
 2101: =head1 LIMITATIONS
 2102: 
 2103: =over 4
 2104: 
 2105: =item *
 2106: 
 2107: Only read operations are supported.  Write-back is not in scope.
 2108: 
 2109: =item *
 2110: 
 2111: One C<DataSource> instance corresponds to exactly one table.  Multi-table
 2112: joins are now delegated to C<Database::Join> (see L<Database::Join>), which
 2113: accepts C<DataSource> objects directly as component databases via the
 2114: C<selectall_arrayref> and C<columns> methods this class exposes.
 2115: 
 2116: =item *
 2117: 
 2118: The ephemeral backend class is generated into a package namespace
 2119: (C<Database::BI::_DB::*>) that persists for the lifetime of the process.
 2120: Instantiating two C<DataSource> objects for the same table name reuses
 2121: the same ephemeral class.
 2122: 
 2123: =item *
 2124: 
 2125: The C<i18n> object, if supplied, must implement C<maketext($key, @args)>
 2126: compatible with L<Locale::Maketext>.
 2127: 
 2128: =back
 2129: 
 2130: =head1 CONFIGURATION AND ENVIRONMENT
 2131: 
 2132: No environment variables are read.  All configuration is passed through
 2133: the constructor.
 2134: 
 2135: =head1 DEPENDENCIES
 2136: 
 2137: L<Carp>, L<Readonly>, L<Scalar::Util>, L<Params::Validate::Strict>, L<Params::Get>,
 2138: L<Database::Abstraction>.
 2139: 
 2140: Optional (loaded lazily):
 2141: 
 2142: L<Net::SFTP::Foreign> -- required for remote file access (C<host =E<gt> ...>).
 2143: L<Spreadsheet::ParseXLSX> -- required for opening C<.xlsx> files.
 2144: 
 2145: =head1 INCOMPATIBILITIES
 2146: 
 2147: None known.
 2148: 
 2149: =head1 BUGS AND LIMITATIONS
 2150: 
 2151: Please report bugs via L<https://github.com/nigelhorne/Database-BI/issues>.
 2152: 
 2153: =head1 AUTHOR
 2154: 
 2155: Nigel Horne C<< <njh@nigelhorne.com> >>
 2156: 
 2157: =head1 FORMAL SPECIFICATION
 2158: 
 2159: The following specifications use a Z-calculus notation.
 2160: C<undef> represents the undefined Perl value.
 2161: C<seq T> means an ordered sequence of values of type T.
 2162: C<\A...\z> denotes a Perl regular expression match.
 2163: C<|S|> means the cardinality (size) of set or sequence S.
 2164: 
 2165: =head2 new
 2166: 
 2167:   new == [directory : PATH; table : NAME;
 2168:           host? : HOST_STRING; file_ext? : EXT_STRING;
 2169:           internal_table? : STRING;
 2170:           cache? : CHI_OBJECT; cache_ttl_url? : TTL_STRING;
 2171:           i18n? : I18N_OBJECT]
 2172:          pre  (host = undef => is_dir directory)
 2173:               /\ (host /= undef => host =~ /\A(?:[a-zA-Z0-9][a-zA-Z0-9._-]*\@)?[a-zA-Z0-9][a-zA-Z0-9._-]*\z/)
 2174:               /\ table /= ""
 2175:               /\ table =~ /[^\/\\\x00]/
 2176:          post result.class = DataSource
 2177:               /\ (host = undef => result._db.class = Database::Abstraction | result._file_data /= undef | result._file_is_empty)
 2178:               /\ (host /= undef => result._remote_tmpdir /= undef)
 2179:               /\ (internal_table /= undef => internal_table in result._sqlite_tables)
 2180: 
 2181: =head2 table_name
 2182: 
 2183:   table_name == lambda self . self._table
 2184: 
 2185:   pre  self._table /= undef
 2186:   post result : STRING /\ result =~ /\A[A-Za-z_][A-Za-z0-9_]*\z/
 2187: 
 2188: =head2 sqlite_tables
 2189: 
 2190:   sqlite_tables == lambda self . self._sqlite_tables
 2191: 
 2192:   pre  true
 2193:   post (result = undef /\ self._url /= undef)
 2194:        \/ (result = undef /\ source is not SQLite)
 2195:        \/ (result : seq STRING /\ forall t in result . t =~ /\A[A-Za-z_][A-Za-z0-9_]*\z/)
 2196: 
 2197: =head2 columns
 2198: 
 2199:   columns == lambda self .
 2200:     if defined self._columns then self._columns
 2201:     else if defined self._url then undef
 2202:     else if defined self._db  then self._db.columns()
 2203:     else undef
 2204: 
 2205:   pre  true
 2206:   post (result : seq STRING /\ |result| >= 1)
 2207:        \/ (result = undef)
 2208: 
 2209: =head2 id_column
 2210: 
 2211:   id_column == lambda self . self._id_col
 2212: 
 2213:   pre  true
 2214:   post (result : STRING /\ result =~ /\A[a-zA-Z_][a-zA-Z0-9_]*\z/)
 2215:        \/ (result = undef)
 2216: 
 2217: =head2 source_url
 2218: 
 2219:   source_url == lambda self . self._url
 2220: 
 2221:   pre  true
 2222:   post (result : STRING /\ result =~ /\Ahttps?:\/\//)
 2223:        \/ (result = undef)
 2224: 
 2225: =head2 updated
 2226: 
 2227:   updated == lambda self .
 2228:     if defined self._db /\ can(self._db, 'updated')  then self._db.updated()
 2229:     else if defined self._file_path /\ -f self._file_path then (stat self._file_path)[9]
 2230:     else undef
 2231: 
 2232:   pre  true
 2233:   post (result : N /\ result > 0) \/ (result = undef)
 2234: 
 2235: =head2 fetch_all
 2236: 
 2237:   fetch_all == lambda self .
 2238:     if self._file_is_empty                     then []
 2239:     else if defined self._file_data            then self._file_data
 2240:     else if cache_hit(self)                    then cache_get(self)
 2241:     else
 2242:       let rows = self._db.selectall_hashref() in
 2243:       normalise(rows)
 2244: 
 2245:   pre  self._file_is_empty \/ defined self._file_data \/ defined self._db
 2246:   post result : seq HASHREF
 2247:        /\ |result| >= 0
 2248: 
 2249: =head2 selectall_arrayref
 2250: 
 2251:   selectall_arrayref == lambda self args .
 2252:     if self._file_is_empty                         then []
 2253:     else if defined self._file_data /\ args = ()   then self._file_data
 2254:     else if cache_hit(self) /\ args = ()           then cache_get(self)
 2255:     else self._db.selectall_arrayref(args)
 2256: 
 2257:   pre  self._file_is_empty \/ defined self._file_data \/ defined self._db
 2258:   post result : seq HASHREF /\ |result| >= 0
 2259: 
 2260: =head2 count
 2261: 
 2262:   count == lambda self .
 2263:     if self._file_is_empty     then 0
 2264:     else if defined self._file_data then |self._file_data|
 2265:     else self._db.count()
 2266: 
 2267:   pre  self._file_is_empty \/ defined self._file_data \/ defined self._db
 2268:   post result : N /\ result >= 0
 2269: 
 2270: =head1 STATE DIAGRAM
 2271: 
 2272: The lifecycle of a single C<DataSource> object from creation to destruction.
 2273: Each state is stable until the trigger event listed to its right fires.
 2274: 
 2275:     +------------------+
 2276:     |     [START]      |  -- new() called
 2277:     +------------------+
 2278:              |
 2279:              v
 2280:     +------------------+  _detect_file_info + _init_backend run
 2281:     |   INITIALISING   |  (SFTP download, BerkeleyDB probe, SQLite
 2282:     |                  |   sqlite_master probe, CSV header parse,
 2283:     |                  |   XLSX parse, or URL fetch)
 2284:     +------------------+
 2285:           /     \
 2286:          /       \
 2287:         v         v
 2288:   +----------+  +-----------+
 2289:   |  ERROR   |  |   READY   |
 2290:   | (croaks) |  |           |
 2291:   +----------+  +-----------+
 2292:                  |         |
 2293:                  |         |
 2294:     fetch_all()  |         |  selectall_arrayref()
 2295:     called       |         |  called
 2296:                  v         v
 2297:          +---------------+
 2298:          |   FETCHING    |  DBI query or pre-loaded data returned;
 2299:          |               |  result stored in CHI cache (if configured)
 2300:          +---------------+
 2301:                  |
 2302:                  v
 2303:          +---------------+
 2304:          | DATA RETURNED |  arrayref of hashrefs delivered to caller
 2305:          +---------------+
 2306:                  |
 2307:                  | (next call to fetch_all or selectall_arrayref)
 2308:                  v
 2309:          +---------------+
 2310:          | CACHE CHECK   |  CHI cache hit? -> DATA RETURNED immediately
 2311:          |               |  CHI cache miss? -> FETCHING
 2312:          +---------------+
 2313: 
 2314:     Special cases branching from INITIALISING:
 2315: 
 2316:     1. File is 0 bytes or blank first line
 2317:        -> _file_is_empty flag set -> READY (fetch_all returns [] instantly)
 2318: 
 2319:     2. Header-less CSV / XLSX / BerkeleyDB
 2320:        -> _file_data pre-loaded -> READY (fetch_all returns pre-loaded rows)
 2321: 
 2322:     3. Multi-table SQLite without internal_table
 2323:        -> _sqlite_tables set -> READY
 2324:        -> caller inspects sqlite_tables() and may redirect to /tables
 2325:           before calling fetch_all (which would open the auto-selected table)
 2326: 
 2327:     4. Multi-table SQLite WITH internal_table
 2328:        -> symlink created for named table -> READY -> fetch_all opens that table
 2329: 
 2330:     5. SFTP remote file
 2331:        -> Net::SFTP::Foreign::get() -> local tmpdir -> normal init -> READY
 2332:        -> tmpdir kept alive via $self->{_remote_tmpdir} until DESTROY
 2333: 
 2334:     Object lifetime ends when $self goes out of scope:
 2335: 
 2336:     +---------------+
 2337:     |   DESTROY     |  File::Temp tmpdirs auto-cleaned (symlinks removed,
 2338:     |               |  SFTP tmpdir removed)
 2339:     +---------------+
 2340: 
 2341:     Valid state transitions summary:
 2342: 
 2343:     [START]          -> INITIALISING     (new() invoked)
 2344:     INITIALISING     -> ERROR            (croak on bad args, SFTP failure,
 2345:                                           no safe id, no SQLite tables, etc.)
 2346:     INITIALISING     -> READY            (all checks passed)
 2347:     READY            -> FETCHING         (fetch_all / selectall_arrayref, cache miss)
 2348:     READY            -> DATA RETURNED    (fetch_all, _file_is_empty or _file_data fast-path)
 2349:     READY            -> CACHE CHECK      (fetch_all / selectall_arrayref, cache configured)
 2350:     CACHE CHECK      -> DATA RETURNED    (cache hit)
 2351:     CACHE CHECK      -> FETCHING         (cache miss)
 2352:     FETCHING         -> DATA RETURNED    (DBI query completed)
 2353:     DATA RETURNED    -> CACHE CHECK      (next call, cache configured)
 2354:     DATA RETURNED    -> FETCHING         (next call, no cache)
 2355:     READY / DATA RETURNED -> DESTROY     ($self goes out of scope)
 2356: 
 2357: =head1 LICENCE AND COPYRIGHT
 2358: 
 2359: Copyright 2026 Nigel Horne.
 2360: 
 2361: Usage is subject to the GPL2 licence terms.
 2362: If you use it,
 2363: please let me know.
 2364: 
 2365: =cut