| File: | blib/lib/Database/Join.pm |
| Coverage: | 96.3% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Database::Join; | |||||
| 2 | ||||||
| 3 | # ABSTRACT: Combined view across two or more Database::Abstraction objects | |||||
| 4 | ||||||
| 5 | 18 18 18 | 3248894 16 270 | use strict; | |||
| 6 | 18 18 18 | 27 13 383 | use warnings; | |||
| 7 | 18 18 18 | 803 22723 44 | use autodie qw(:all); | |||
| 8 | ||||||
| 9 | 18 18 18 | 57353 20 462 | use Carp qw(croak carp); | |||
| 10 | 18 18 18 | 32 13 389 | use List::Util qw(max); | |||
| 11 | 18 18 18 | 263 1588 282 | use Readonly; | |||
| 12 | 18 18 18 | 30 12 259 | use Scalar::Util qw(blessed); | |||
| 13 | 18 18 18 | 1205 268063 204 | use Object::Configure; | |||
| 14 | 18 18 18 | 33 15 272 | use Params::Get qw(get_params); | |||
| 15 | 18 18 18 | 30 9 243 | use Params::Validate::Strict qw(validate_strict); | |||
| 16 | 18 18 18 | 974 14416 68 | use Sub::Protected; | |||
| 17 | ||||||
| 18 | # Named-pair keys accepted by add_database; kept here so the guard and the | |||||
| 19 | # validate_strict schema cannot silently diverge. | |||||
| 20 | Readonly::Array my @_ADD_DB_KEYS => qw(database join_column filter remove_columns); | |||||
| 21 | ||||||
| 22 | our $VERSION = '0.001.0'; | |||||
| 23 | ||||||
| 24 | # --------------------------------------------------------------------------- | |||||
| 25 | # All user-facing strings route through this dictionary. Supply an i18n | |||||
| 26 | # object with a translate($key, @sprintf_args) method to localise them. | |||||
| 27 | # --------------------------------------------------------------------------- | |||||
| 28 | Readonly::Hash my %MESSAGES => ( | |||||
| 29 | error_no_databases => 'At least one Database::Abstraction object is required', | |||||
| 30 | error_invalid_db => 'databases[%d] is not a Database::Abstraction object', | |||||
| 31 | error_join_col_missing => 'join_column "%s" is absent from databases[%d] (%s)', | |||||
| 32 | error_col_conflict => 'Column "%s" exists in multiple databases; use the owning database directly or rename the column', | |||||
| 33 | error_remove_join_col => 'Cannot remove join_column "%s"; it is required for the join', | |||||
| 34 | warn_unknown_column => 'Column "%s" is not present in any configured database; criterion ignored', | |||||
| 35 | error_query_unsupported => 'query() chained builder is not supported on Database::Join; call selectall_arrayref / fetchrow_hashref directly', | |||||
| 36 | error_execute_unsupported => 'execute() raw SQL is not supported on Database::Join', | |||||
| 37 | error_unknown_message => 'Unknown message key "%s"', | |||||
| 38 | ); | |||||
| 39 | ||||||
| 40 - 431 | =head1 NAME
Database::Join - Read-only combined view across two or more Database::Abstraction objects
=head1 VERSION
Version 0.001.0
=head1 SYNOPSIS
B<Basic two-database join>
use Database::Join;
# Step 1: create each component database the normal way
my $customers = Database::Customers->new(directory => '/data');
my $loyalty = Database::Loyalty->new(directory => '/data');
# Step 2: combine them on the shared key column 'entry'
my $join = Database::Join->new(
databases => [ $customers, $loyalty ],
join_column => 'entry',
);
# Step 3: query exactly as you would a single Database::Abstraction object
my $all_rows = $join->selectall_arrayref();
my $vip_rows = $join->selectall_arrayref(tier => 'gold');
my $one_row = $join->fetchrow_hashref(entry => 'C001');
my $total = $join->count();
my $col_names = $join->columns();
B<Hiding internal columns>
my $join = Database::Join->new(
databases => [ $customers, $loyalty ],
join_column => 'entry',
remove_columns => [ 'internal_id', 'audit_ts' ],
);
# 'internal_id' and 'audit_ts' never appear in results or columns()
B<join_map: when the key column has different names in each database>
# $cities (index 0) has a column called 'statecode' -- matches join_column
# $stnames (index 1) has a column called 'entry' -- different name
my $join = Database::Join->new(
databases => [ $cities, $stnames ],
# index 0 index 1
join_column => 'statecode',
join_map => { 1 => 'entry' }, # index 1 calls its join key 'entry'
);
# All returned rows use 'statecode'; 'entry' is never exposed
my $rows = $join->selectall_arrayref();
B<filters: permanently restrict a database's visible rows>
# Only show orders placed more than 60 days ago, without repeating
# the criterion on every query call.
my $join = Database::Join->new(
databases => [ $customers, $orders ],
join_column => 'entry',
filters => { 1 => { age_days => { '>' => 60 } } },
);
my $rows = $join->selectall_arrayref(); # all old orders
my $vip = $join->selectall_arrayref(tier => 'gold'); # old + gold tier
B<Inner and outer join types>
my $inner = Database::Join->new(
databases => [ $customers, $loyalty ],
join_column => 'entry',
join_type => 'inner', # only keys present in BOTH databases
);
my $outer = Database::Join->new(
databases => [ $customers, $loyalty ],
join_column => 'entry',
join_type => 'outer', # all keys from EITHER database
);
B<Building the view incrementally with add_database>
my $join = Database::Join->new(
databases => [ $customers ],
join_column => 'entry',
);
$join->add_database($loyalty)
->add_database($scores, remove_columns => ['raw_score']);
B<AUTOLOAD column shortcut>
# Returns the 'name' value for entry 'C001' (scalar context)
my $name = $join->name(entry => 'C001');
# Returns all 'tier' values (list context)
my @tiers = $join->tier();
=head1 DESCRIPTION
C<Database::Join> merges two or more L<Database::Abstraction> objects into a
single logical, read-only view. Each component database is queried
independently through its own C<Database::Abstraction> interface. The results
are combined in Perl memory using a shared key column (C<join_column>).
The module exposes the same read-only API as C<Database::Abstraction>:
C<selectall_arrayref>, C<selectall_array>, C<fetchrow_hashref>, C<count>,
C<columns>, C<schema>, C<updated>, C<set_logger>, and the AUTOLOAD column
shortcut. Callers do not need to know how many underlying databases are
involved.
Think of it as a virtual database table that is assembled on demand from
several real tables, one per component database.
=head2 Join semantics
The C<join_type> parameter controls what happens when a particular key value
exists in some component databases but not all:
=over 4
=item C<left> (the default)
All rows from the I<primary> (first) database are returned. Columns from
subsequent databases are included where a matching row is found, and simply
absent from the hashref where there is no match. If you are familiar with
SQL, this is a LEFT OUTER JOIN on the first table.
=item C<inner>
Only rows whose join-column value is present in I<every> component database
are returned. This is equivalent to a SQL INNER JOIN.
=item C<outer>
Every join-column value found in I<any> component database is returned.
Columns from databases that do not have that key value are absent from the
merged row. This is a FULL OUTER JOIN.
=back
B<Important override rule:> whenever you pass a query criterion for a column
that belongs to a secondary database, that database automatically acts as an
inner-join partner for that query only -- regardless of C<join_type>. This
gives WHERE-clause semantics. For example, if you have a LEFT join but query
C<< tier => 'gold' >> on a secondary database, only rows whose secondary entry
has tier = 'gold' are returned (rows with no secondary entry are excluded, just
as a WHERE clause would exclude them).
=head2 Column ownership and routing
At construction time, C<Database::Join> calls C<columns()> on each component
database and builds an internal index that maps every column name to the
database that owns it.
When you pass criteria to a query method, each key-value pair is automatically
routed to the right database. You never need to say which database a column
belongs to.
The C<join_column> is special: criteria on it are broadcast to I<all>
databases so that each database fetches only the relevant rows before the
in-memory merge.
When the same non-join column name exists in more than one database, the
I<last> database in the C<databases> array wins: its value overwrites earlier
ones in merged rows.
=head1 LIMITATIONS
=over 4
=item In-memory join only
All matching rows from every component database are fetched into memory before
the merge. This is not suitable for very large result sets.
=item No chained builder or raw SQL
C<query()> and C<execute()> are not implemented. Use C<selectall_arrayref>
or C<fetchrow_hashref> instead.
=item Single-column equi-join only
Joining on more than one column simultaneously, or on expressions, is not
supported. When the join key has different names in different databases,
use C<join_map> to declare each database's local column name.
=item Sort order
Results are sorted by the C<join_column> value only. Caller-specified
C<ORDER BY> is not propagated to the component databases.
=item count() fetches all rows
C<count()> executes the full join and counts the resulting rows in Perl. It
does not push a C<COUNT(*)> query down to the databases.
=back
=head1 COMMON PITFALLS
=over 4
=item The join_column must exist in every component database
If even one database is missing the join key column, C<new()> (or
C<add_database()>) will C<croak> immediately. Use C<join_map> when the
column has a different local name in some databases.
=item Criteria on a removed column are silently dropped
If you call C<remove_column('tier')> and later query
C<< selectall_arrayref(tier => 'gold') >>, the criterion is ignored (with a
C<carp> warning) and all rows are returned. Always pass criteria before
removing columns, or restructure your code to avoid this.
=item You cannot remove the join column
C<< $join->remove_column($join->join_column) >> will C<croak>. The join key
is required for the merge to work.
=item Left join does not guarantee all columns are populated
Under a LEFT join, rows from the primary database that have no matching row
in a secondary database will be returned with I<no keys> from that secondary
database. Accessing C<< $row->{score} >> on such a row returns C<undef> --
not zero, not an empty string. Always test C<defined $row->{score}> rather
than just C<$row->{score}> when the secondary match is optional.
=item Filters act as inner-join partners
Any database that has a C<filters> entry is promoted to an inner-join partner,
regardless of C<join_type>. A row whose join-key value does not appear in
the filtered database's result is removed from the merged output entirely, not
merely missing its secondary columns. This is intentional but can be
surprising if you expected LEFT join semantics.
=item Criteria-merging replaces scalar filters
When both a base filter and a query criterion target the same column, and both
are operator hashrefs (e.g. C<< { '>' => 60 } >>), the operators are combined
(AND semantics). But if the query criterion is a plain scalar (e.g.
C<< score => 75 >>), it I<replaces> the base filter for that column entirely --
the base filter is ignored for that query.
=item AUTOLOAD sees the full merged join when filters or join_map are active
When either C<filters> or C<join_map> is in effect, the AUTOLOAD shortcut
(C<< $join->columnname(...) >>) runs the full join query rather than
delegating directly to the owning database. This is necessary for correctness
but means the result respects all active filters and join-key translations,
which may differ from what the owning database would return on its own.
=item Duplicate column names: last database wins
When two component databases each have a column called C<notes>, the second
database's value silently overwrites the first in every merged row. Use
C<remove_columns> (or C<remove_column>) to drop the unwanted duplicate.
=back
=head1 METHODS
=head2 new
=head3 SYNOPSIS
my $join = Database::Join->new(
databases => [ $db1, $db2 ],
join_column => 'entry',
join_type => 'left',
join_map => { 1 => 'local_col' },
filters => { 1 => { score => { '>' => 60 } } },
remove_columns => [ 'email', 'internal_id' ],
logger => $log,
i18n => $locale,
);
=head3 DESCRIPTION
Constructs and returns a new C<Database::Join> object.
Each element of C<databases> must be an already-instantiated subclass of
C<Database::Abstraction>. The constructor calls C<columns()> on every
database to build an internal column-routing table and verifies that
C<join_column> (or its local alias from C<join_map>) is present in each one.
Columns listed in C<remove_columns> are hidden immediately: they do not appear
in C<columns()>, C<schema()>, or any returned row hashref. This is equivalent
to calling C<remove_column> once per name after construction.
=head3 API SPECIFICATION
=head4 Input
databases => { type => 'arrayref', required => 1 }
# One or more Database::Abstraction subclass objects.
#
# DOMAIN -- EP valid: non-empty arrayref of blessed DA subclasses.
# DOMAIN -- EP invalid: scalar, hashref, or absent => croak.
# DOMAIN -- BVA size: minimum 1 element; no documented upper bound.
# DOMAIN -- BVA elem: each element must pass isa('Database::Abstraction').
join_column => { type => 'string', optional => 1, default => 'entry' }
# The column name shared by all databases (the join key).
#
# DOMAIN -- EP valid: any non-empty string present in every component DA.
# DOMAIN -- EP invalid: column absent from any DA => croak join_col_missing.
# DOMAIN -- BVA: empty string '' is treated as a column name and
# will croak if (as expected) it is absent from every DA.
# DOMAIN -- NOTE: matching is case-sensitive and exact.
join_type => { type => 'string', optional => 1, default => 'left',
enum => ['inner', 'left', 'outer'] }
# Controls which keys appear in the result when not all
# databases share the same key values.
#
# DOMAIN -- EP valid: exactly 'inner', 'left', or 'outer'.
# DOMAIN -- EP invalid: any other string including 'INNER', 'LEFT',
# 'OUTER' (enum check is case-sensitive), 'cross',
# or '' => croak from validate_strict.
join_map => { type => 'hashref', optional => 1 }
# Zero-based database index => local column name.
# See the join_map section for full details.
#
# DOMAIN -- EP valid: hashref values must be plain strings.
# DOMAIN -- EP invalid: reference value (hashref, arrayref, coderef, etc.)
# => croak; the guard prevents heap-address leakage.
# DOMAIN -- BVA: out-of-range keys (beyond the databases array) are
# silently ignored.
filters => { type => 'hashref', optional => 1 }
# Zero-based database index => criteria hashref.
# Permanent row restrictions on individual databases.
# See the filters section for full details.
remove_columns => { type => 'arrayref', optional => 1 }
# Column names to hide from the merged view.
#
# DOMAIN -- EP valid: arrayref of any strings; non-existent columns
# are silently ignored (idempotent).
# DOMAIN -- EP invalid: join_column itself => croak remove_join_col.
# DOMAIN -- BVA: [] empty arrayref is a safe no-op.
logger => { type => 'object', optional => 1 }
# Logger object propagated to all component databases.
i18n => { type => 'object', optional => 1 }
# Localisation object with a translate($key, @args) method.
=head4 Output
A blessed Database::Join object.
=head3 EXAMPLE
# Customers database: entry | name | email
# Loyalty database: entry | tier | points
my $join = Database::Join->new(
databases => [ $customers, $loyalty ],
join_column => 'entry',
join_type => 'inner', # only customers who also have loyalty records
remove_columns => [ 'email' ], # hide PII from query results
filters => { 1 => { points => { '>' => 0 } } }, # ignore zero-point records
);
my $rows = $join->selectall_arrayref();
# Each row: { entry => ..., name => ..., tier => ..., points => ... }
# 'email' is absent. Zero-point loyalty records are excluded.
=head3 PSEUDOCODE
validate all parameters with validate_strict
croak if databases is empty
croak if any element of databases is not a Database::Abstraction subclass
bless the object with all fields initialised
call _build_col_index to map every column to its owning database
and verify join_column presence in each database
for each column in remove_columns: call remove_column
return the new object
=head3 MESSAGES
error_no_databases -- databases arrayref was empty
error_invalid_db -- an element of databases is not a D::A subclass
error_join_col_missing -- join_column (or its join_map alias) not found in a database
=cut | |||||
| 432 | ||||||
| 433 | sub new { | |||||
| 434 | 533 | 1639657 | my ($class, @args) = @_; | |||
| 435 | ||||||
| 436 | 533 | 2877 | my $p = validate_strict( | |||
| 437 | schema => { | |||||
| 438 | databases => { type => 'arrayref' }, | |||||
| 439 | join_column => { type => 'string', optional => 1, default => 'entry' }, | |||||
| 440 | join_type => { type => 'string', optional => 1, default => 'left', | |||||
| 441 | enum => ['inner', 'left', 'outer'] }, | |||||
| 442 | join_map => { type => 'hashref', optional => 1 }, | |||||
| 443 | filters => { type => 'hashref', optional => 1 }, | |||||
| 444 | remove_columns => { type => 'arrayref', optional => 1 }, | |||||
| 445 | logger => { type => 'object', optional => 1 }, | |||||
| 446 | i18n => { type => 'object', optional => 1 }, | |||||
| 447 | }, | |||||
| 448 | input => get_params(undef, \@args) // {}, | |||||
| 449 | ); | |||||
| 450 | ||||||
| 451 | croak _msg($p->{i18n}, 'error_no_databases') | |||||
| 452 | 520 520 | 94967 789 | unless @{ $p->{databases} }; | |||
| 453 | ||||||
| 454 | # Capture caller-supplied logger and i18n object BEFORE Object::Configure::configure | |||||
| 455 | # overwrites them with class-level defaults. configure() reads default values | |||||
| 456 | # from Database::Abstraction's class config and silently replaces any caller- | |||||
| 457 | # supplied value if a class default exists for that key. | |||||
| 458 | 507 | 401 | my $caller_logger = $p->{logger}; | |||
| 459 | 507 | 352 | my $caller_i18n = $p->{i18n}; | |||
| 460 | ||||||
| 461 | 507 | 619 | $p = Object::Configure::configure($class, $p); | |||
| 462 | ||||||
| 463 | 507 507 | 997767 875 | for my $i (0 .. $#{ $p->{databases} }) { | |||
| 464 | croak _msg($p->{i18n}, 'error_invalid_db', $i) | |||||
| 465 | unless blessed($p->{databases}[$i]) | |||||
| 466 | 937 | 3113 | && $p->{databases}[$i]->isa('Database::Abstraction'); | |||
| 467 | } | |||||
| 468 | ||||||
| 469 | # Cache the primary database's internal primary-key column name once at | |||||
| 470 | # construction. AUTOLOAD uses this to map a bare positional argument to the | |||||
| 471 | # correct column when join_map is active and the primary DB's primary key | |||||
| 472 | # differs from join_column (e.g. join_col='statecode' but primary key='entry'). | |||||
| 473 | # Accessing {id} here â at construction time, before the object is shared â | |||||
| 474 | # is the single permitted point of coupling to DA's internal field; caching | |||||
| 475 | # avoids repeating the hash intrusion on every AUTOLOAD call. | |||||
| 476 | 494 | 822 | my $primary_pk = $p->{databases}[0]{id} // $p->{join_column}; | |||
| 477 | ||||||
| 478 | my $self = bless { | |||||
| 479 | _dbs => $p->{databases}, | |||||
| 480 | _join_col => $p->{join_column}, | |||||
| 481 | _join_type => $p->{join_type}, | |||||
| 482 | _join_map => $p->{join_map} // {}, # db_index => local join col name | |||||
| 483 | # TODO: Data Flow Anomaly (filter reference aliasing) - _filters stores | |||||
| 484 | # the caller's hashref directly. External mutation of the caller's hash | |||||
| 485 | # after construction will silently change query behaviour. A deep copy | |||||
| 486 | # (e.g. Storable::dclone) would bound the lifetime but adds a dependency. | |||||
| 487 | _filters => $p->{filters} // {}, # db_index => criteria hashref | |||||
| 488 | 494 | 2298 | _logger => $caller_logger, | |||
| 489 | _i18n => $caller_i18n, | |||||
| 490 | _col_db => {}, # column_name => db_index | |||||
| 491 | _db_cols => [], # per-db column-presence hashref | |||||
| 492 | _removed_cols => {}, # column_name => 1 (hidden from the view) | |||||
| 493 | _col_cache => undef, # memoised columns() result | |||||
| 494 | _schema_cache => undef, # memoised schema() result | |||||
| 495 | _autoload_pk => $primary_pk, # primary DB's key col; positional arg for AUTOLOAD | |||||
| 496 | }, $class; | |||||
| 497 | ||||||
| 498 | 494 | 793 | $self->_build_col_index(); | |||
| 499 | ||||||
| 500 | # Propagate the logger to every component database if one was supplied. | |||||
| 501 | # set_logger() is used here (rather than a direct hash write) to honour each | |||||
| 502 | # DA's own logging setup hook and remain decoupled from DA internals. | |||||
| 503 | 476 | 478 | if (my $log = $self->{_logger}) { | |||
| 504 | 3 3 | 3 7 | $_->set_logger($log) for @{ $self->{_dbs} }; | |||
| 505 | } | |||||
| 506 | ||||||
| 507 | # Apply column removals requested in the constructor | |||||
| 508 | 476 | 447 | if (my $rc = $p->{remove_columns}) { | |||
| 509 | 11 11 | 22 22 | $self->remove_column($_) for @{$rc}; | |||
| 510 | } | |||||
| 511 | ||||||
| 512 | 474 | 778 | return $self; | |||
| 513 | } | |||||
| 514 | ||||||
| 515 | # --------------------------------------------------------------------------- | |||||
| 516 | # Public API (mirrors Database::Abstraction) | |||||
| 517 | # --------------------------------------------------------------------------- | |||||
| 518 | ||||||
| 519 - 707 | =head2 join_map - joining on differently-named columns
By default every component database must have a column whose name matches
C<join_column>. If a database uses a different local name for the join key,
declare the mapping with C<join_map>.
C<join_map> is a hashref. Each B<key> is the B<zero-based position> of a
database in the C<databases> array (0 = first, 1 = second, and so on). Each
B<value> is the name that B<that particular database> uses for the join key.
Databases not listed in C<join_map> are assumed to already have a column
named C<join_column> and need no entry.
Throughout the merged view the join key is I<always> referred to by the name
given in C<join_column>. The local alias is never exposed in returned rows,
in C<columns()>, or in C<schema()>.
B<When do you need join_map?>
You need C<join_map> when you have two tables like:
cities table : entry (the city name) | statecode
stnames table : entry (the state code) | state
Here you want to join cities.statecode to stnames.entry. You choose
C<< join_column => 'statecode' >> as the canonical name, but stnames calls
that same concept C<entry>, so you declare:
join_map => { 1 => 'entry' } # stnames (index 1) calls it 'entry'
B<Example>
# index 0 index 1
my @databases = ( $cities, $stnames );
# join key column: 'statecode' 'entry'
# join_column: 'statecode' (chosen canonical name)
# stnames differs, so declare the alias:
my $join = Database::Join->new(
databases => \@databases,
join_column => 'statecode',
join_map => { 1 => 'entry' },
);
my $rows = $join->selectall_arrayref();
# Each $row has keys: entry (city), statecode, state
# 'entry' from stnames is never exposed directly.
my $row = $join->fetchrow_hashref(statecode => 'CA');
B<Using add_database instead>
If you build the join incrementally with C<add_database>, pass
C<join_column> directly to that call instead of using C<join_map>:
my $join = Database::Join->new(
databases => [ $cities ],
join_column => 'statecode',
);
$join->add_database($stnames, join_column => 'entry');
This is exactly equivalent to the C<join_map> form above.
=head2 filters - permanent per-database row filters
C<filters> lets you restrict a component database to a subset of its rows
permanently, without repeating the criterion on every query call.
Think of it as telling the join: "whenever you query this database, always
add these extra conditions". Callers never need to specify the restriction
themselves and can never accidentally omit it.
C<filters> is a hashref. Each B<key> is the B<zero-based position> of a
database in the C<databases> array (same numbering as C<join_map>). Each
B<value> is a criteria hashref in the same format as C<selectall_arrayref>
accepts.
B<Key-set semantics>
A filtered database always acts as an inner-join partner, regardless of the
C<join_type> setting. Any join-key value that does not pass the filter is
excluded from the merged output entirely -- not just missing its secondary
columns. This ensures the filter genuinely restricts the view rather than
simply hiding a few fields.
B<Criteria merging>
When a query call also passes a criterion for a column that already has a base
filter, the two constraints are combined:
=over 4
=item *
When both the base filter value and the query criterion are operator hashrefs
(e.g. C<< { '>' => 60 } >> and C<< { '<' => 365 } >>), their operators are
merged: I<both> constraints apply simultaneously (AND semantics).
=item *
When either value is a plain scalar, or the operators conflict, the
query-time criterion wins and the base filter for that column is ignored for
that one call.
=back
B<Example -- only show orders placed more than 60 days ago>
my $join = Database::Join->new(
databases => [ $customers, $orders ],
join_column => 'entry',
filters => { 1 => { age_days => { '>' => 60 } } },
);
# Every query automatically sees only old orders
my $rows = $join->selectall_arrayref();
# Additional criteria layer on top -- gold tier AND old order
my $vip = $join->selectall_arrayref(tier => 'gold');
# Range intersection: age_days > 60 AND age_days < 365
my $mid = $join->selectall_arrayref(age_days => { '<' => 365 });
When using C<add_database>, pass C<filter> (singular) to set the base
criteria for the new database:
$join->add_database($orders, filter => { age_days => { '>' => 60 } });
=head2 selectall_arrayref
=head3 SYNOPSIS
my $rows = $join->selectall_arrayref();
my $rows = $join->selectall_arrayref(tier => 'gold');
my $rows = $join->selectall_arrayref(score => { '>' => 80 });
my $rows = $join->selectall_arrayref('C001'); # positional: entry => 'C001'
=head3 DESCRIPTION
Returns an arrayref of hashrefs representing the merged view of all component
databases, optionally filtered by the given criteria.
Criteria for columns that live in different databases are routed
automatically: each database is queried with only the criteria that apply to
its own columns. The results are combined in memory using C<join_column>.
Accepts the same criteria syntax as C<Database::Abstraction::selectall_arrayref>.
A single plain scalar argument is interpreted as the C<join_column> value
(equivalent to C<< entry => 'C001' >> when C<join_column> is C<'entry'>).
=head3 API SPECIFICATION
=head4 Input
Calling conventions (in order of precedence):
1. No arguments -- returns all rows
2. One plain scalar -- shorthand for join_column => $scalar
3. Key-value pairs or
a criteria hashref -- routed per-database
Values may be:
Plain scalar -- exact match
Hashref of operators -- e.g. { '>' => 80 }
=head4 Output
Arrayref of hashrefs; one hashref per qualifying merged row,
sorted ascending by join_column value.
Returns a reference to an empty array when no rows match.
=head3 EXAMPLE
# All rows from both databases
my $all = $join->selectall_arrayref();
# Only rows where the 'tier' column (from the loyalty database)
# equals 'gold' -- the criterion is routed to the right database
my $vip = $join->selectall_arrayref(tier => 'gold');
# Operator hashref: score > 80
my $high = $join->selectall_arrayref(score => { '>' => 80 });
# Access each merged row
for my $row (@{$vip}) {
printf "%-10s tier=%-8s score=%d\n",
$row->{entry}, $row->{tier}, $row->{score} // 0;
}
=cut | |||||
| 708 | ||||||
| 709 | sub selectall_arrayref { | |||||
| 710 | 222 | 18516 | my ($self, @args) = @_; | |||
| 711 | 222 | 296 | return $self->_joined_query($self->_parse_query_args(undef, @args)); | |||
| 712 | } | |||||
| 713 | ||||||
| 714 - 752 | =head2 selectall_array
=head3 SYNOPSIS
my @rows = $join->selectall_array(tier => 'gold');
# Scalar context: only the first matching row
my $first = $join->selectall_array(entry => 'C001');
=head3 DESCRIPTION
In list context returns a list of merged hashrefs -- the same rows that
C<selectall_arrayref> would return, just as a flat list rather than an
arrayref.
In scalar context returns only the first matching hashref (or C<undef> if
nothing matches).
=head3 API SPECIFICATION
=head4 Input
Same as selectall_arrayref.
=head4 Output
List context: list of hashrefs (may be empty).
Scalar context: single hashref or undef.
=head3 EXAMPLE
my @all = $join->selectall_array();
print scalar @all, " rows\n";
# First gold-tier customer only
my $first_vip = $join->selectall_array(tier => 'gold');
print $first_vip->{name}, "\n" if defined $first_vip;
=cut | |||||
| 753 | ||||||
| 754 | sub selectall_array { | |||||
| 755 | 8 | 794 | my ($self, @args) = @_; | |||
| 756 | 8 | 14 | my $rows = $self->_joined_query($self->_parse_query_args(undef, @args)); | |||
| 757 | 8 4 | 17 9 | return wantarray ? @{$rows} : $rows->[0]; | |||
| 758 | } | |||||
| 759 | ||||||
| 760 - 797 | =head2 fetchrow_hashref
=head3 SYNOPSIS
my $row = $join->fetchrow_hashref(entry => 'C001');
my $row = $join->fetchrow_hashref('C001'); # positional shorthand
=head3 DESCRIPTION
Returns a single merged hashref for the first row matching the given
criteria, or C<undef> when nothing matches.
Equivalent to calling C<selectall_arrayref> and taking only the first element.
All the same criteria conventions apply.
=head3 API SPECIFICATION
=head4 Input
Same as selectall_arrayref.
=head4 Output
Hashref, or undef when no row matches.
=head3 EXAMPLE
my $row = $join->fetchrow_hashref(entry => 'C001');
if (defined $row) {
print "Name: $row->{name}, Tier: $row->{tier}\n";
} else {
print "No record for C001\n";
}
# Positional: works when join_column is 'entry'
my $row2 = $join->fetchrow_hashref('C001');
=cut | |||||
| 798 | ||||||
| 799 | sub fetchrow_hashref { | |||||
| 800 | 27 | 3647 | my ($self, @args) = @_; | |||
| 801 | 27 | 41 | my $rows = $self->_joined_query($self->_parse_query_args(undef, @args)); | |||
| 802 | 27 | 56 | return $rows->[0]; | |||
| 803 | } | |||||
| 804 | ||||||
| 805 - 838 | =head2 count
=head3 SYNOPSIS
my $total = $join->count();
my $active = $join->count(tier => 'gold');
=head3 DESCRIPTION
Returns the number of merged rows that satisfy the given criteria.
The full join is performed and the resulting rows are counted in Perl; no
C<COUNT(*)> is pushed down to the component databases.
=head3 API SPECIFICATION
=head4 Input
Same criteria syntax as selectall_arrayref.
=head4 Output
Non-negative integer.
=head3 EXAMPLE
my $total = $join->count();
my $gold = $join->count(tier => 'gold');
my $high = $join->count(score => { '>' => 90 });
printf "%d total, %d gold-tier, %d high-scorers\n",
$total, $gold, $high;
=cut | |||||
| 839 | ||||||
| 840 | sub count { | |||||
| 841 | 46 | 9855 | my ($self, @args) = @_; | |||
| 842 | 46 | 72 | my $rows = $self->_joined_query($self->_parse_query_args(undef, @args)); | |||
| 843 | 46 46 | 38 122 | return scalar @{$rows}; | |||
| 844 | } | |||||
| 845 | ||||||
| 846 - 879 | =head2 columns
=head3 SYNOPSIS
my $cols = $join->columns();
=head3 DESCRIPTION
Returns an arrayref of all column names visible in the merged view,
deduplicated and sorted alphabetically.
The C<join_column> appears exactly once, even if it exists under different
local names in some databases (see C<join_map>). Columns that have been
hidden with C<remove_column> or C<remove_columns> do not appear.
The result is memoised: repeated calls are cheap.
=head3 API SPECIFICATION
=head4 Input
None.
=head4 Output
Arrayref of column name strings, sorted alphabetically.
=head3 EXAMPLE
my $cols = $join->columns();
print join(', ', @{$cols}), "\n";
# e.g. "entry, name, score, tier"
=cut | |||||
| 880 | ||||||
| 881 | sub columns { | |||||
| 882 | 107 | 9460 | my ($self) = @_; | |||
| 883 | ||||||
| 884 | 107 | 122 | return $self->{_col_cache} if $self->{_col_cache}; | |||
| 885 | ||||||
| 886 | 95 | 74 | my %seen; | |||
| 887 | my @cols; | |||||
| 888 | 95 | 79 | my $join_col = $self->{_join_col}; | |||
| 889 | ||||||
| 890 | 95 95 | 59 123 | for my $i (0 .. $#{ $self->{_dbs} }) { | |||
| 891 | 200 | 150 | my $local_jc = $self->{_join_map}{$i}; | |||
| 892 | 200 200 | 132 185 | for my $col (@{ $self->{_dbs}[$i]->columns() }) { | |||
| 893 | 481 | 653 | next if $seen{$col}++; | |||
| 894 | 382 | 324 | next if $self->{_removed_cols}{$col}; | |||
| 895 | # The local join-key alias is not a data column; the canonical name | |||||
| 896 | # is already contributed by the database that owns it under that name. | |||||
| 897 | 348 | 353 | next if $local_jc && $col eq $local_jc && $col ne $join_col; | |||
| 898 | 341 | 287 | push @cols, $col; | |||
| 899 | } | |||||
| 900 | } | |||||
| 901 | ||||||
| 902 | 95 | 199 | $self->{_col_cache} = [ sort @cols ]; | |||
| 903 | 95 | 210 | return $self->{_col_cache}; | |||
| 904 | } | |||||
| 905 | ||||||
| 906 - 944 | =head2 schema
=head3 SYNOPSIS
my $schema = $join->schema();
=head3 DESCRIPTION
Returns a merged schema hashref for all visible columns across all component
databases. Each key is a column name; each value is the schema metadata
hashref returned by C<Database::Abstraction::schema()> for that column
(typically C<{ type, nullable, default, pk }>).
When the same column name appears in more than one database the I<last>
database's metadata is used. Columns hidden with C<remove_column> are not
included.
The result is memoised.
=head3 API SPECIFICATION
=head4 Input
None.
=head4 Output
Hashref: column_name => { type => ..., nullable => ..., default => ..., pk => ... }.
=head3 EXAMPLE
my $schema = $join->schema();
for my $col (sort keys %{$schema}) {
my $info = $schema->{$col};
printf "%-15s type=%-10s nullable=%s\n",
$col, $info->{type}, $info->{nullable} ? 'yes' : 'no';
}
=cut | |||||
| 945 | ||||||
| 946 | sub schema { | |||||
| 947 | 39 | 3982 | my ($self) = @_; | |||
| 948 | ||||||
| 949 | 39 | 47 | return $self->{_schema_cache} if $self->{_schema_cache}; | |||
| 950 | ||||||
| 951 | # Hash slice assignment (@merged{keys} = values) is O(M) per database; | |||||
| 952 | # the previous (%merged = (%merged, %s)) pattern was O(NÃM) per iteration, | |||||
| 953 | # totalling O(N²ÃM) over all databases for the same result. | |||||
| 954 | 32 | 27 | my %merged; | |||
| 955 | 32 32 | 25 42 | for my $i (0 .. $#{ $self->{_dbs} }) { | |||
| 956 | 66 | 82 | my $s = $self->{_dbs}[$i]->schema() // {}; | |||
| 957 | 66 | 497 | my $local_jc = $self->{_join_map}{$i}; | |||
| 958 | 66 | 95 | if ($local_jc && $local_jc ne $self->{_join_col}) { | |||
| 959 | 4 4 | 5 4 | for my $col (keys %{$s}) { | |||
| 960 | 8 | 11 | $merged{$col} = $s->{$col} unless $col eq $local_jc; | |||
| 961 | } | |||||
| 962 | } else { | |||||
| 963 | 62 62 62 | 34 82 59 | @merged{keys %{$s}} = values %{$s}; | |||
| 964 | } | |||||
| 965 | } | |||||
| 966 | ||||||
| 967 | 8 | 14 | delete @merged{keys %{ $self->{_removed_cols} }} | |||
| 968 | 32 32 | 25 47 | if %{ $self->{_removed_cols} }; | |||
| 969 | ||||||
| 970 | 32 | 32 | $self->{_schema_cache} = \%merged; | |||
| 971 | 32 | 64 | return $self->{_schema_cache}; | |||
| 972 | } | |||||
| 973 | ||||||
| 974 - 1007 | =head2 updated
=head3 SYNOPSIS
my $ts = $join->updated();
=head3 DESCRIPTION
Returns the Unix timestamp of the most recent modification across all
component databases. This is the maximum of all individual C<updated()>
return values.
Use this to implement simple cache-invalidation logic: if C<updated()>
has advanced since your last snapshot, re-query.
=head3 API SPECIFICATION
=head4 Input
None.
=head4 Output
Unix timestamp (positive integer).
=head3 EXAMPLE
my $last_modified = $join->updated();
if ($last_modified > $my_cache_timestamp) {
$my_cache = $join->selectall_arrayref();
$my_cache_timestamp = $last_modified;
}
=cut | |||||
| 1008 | ||||||
| 1009 | sub updated { | |||||
| 1010 | 11 | 1593 | my ($self) = @_; | |||
| 1011 | 11 21 11 | 10 42 11 | return max(map { $_->updated() } @{ $self->{_dbs} }); | |||
| 1012 | } | |||||
| 1013 | ||||||
| 1014 - 1047 | =head2 set_logger =head3 SYNOPSIS $join->set_logger($log); =head3 DESCRIPTION Attaches a new logger object to the join and propagates it to every component database. The logger is used for diagnostic output by all component databases. =head3 API SPECIFICATION =head4 Input $log Positional: a logger object (required). Must support whatever interface Database::Abstraction expects. =head4 Output Returns C<$self> for method chaining. =head3 EXAMPLE # Log::Any is used here as an example; any object that implements # debug() and info() (or whichever methods your component databases # call internally) works equally well. use Log::Any qw($log); my $join = Database::Join->new(databases => [$db1, $db2], join_column => 'entry'); $join->set_logger($log); # $log is now used by $join and by $db1 and $db2 =cut | |||||
| 1048 | ||||||
| 1049 | sub set_logger { | |||||
| 1050 | 17 | 191 | my ($self, $logger) = @_; | |||
| 1051 | ||||||
| 1052 | 17 | 73 | croak 'Usage: set_logger($logger)' unless defined $logger; | |||
| 1053 | ||||||
| 1054 | 14 | 10 | $self->{_logger} = $logger; | |||
| 1055 | 14 14 | 16 55 | $_->set_logger($logger) for @{ $self->{_dbs} }; | |||
| 1056 | ||||||
| 1057 | 14 | 161 | return $self; | |||
| 1058 | } | |||||
| 1059 | ||||||
| 1060 - 1178 | =head2 add_database
=head3 SYNOPSIS
# Positional: database object as first argument
$join->add_database($db);
# Named: equivalent to the above
$join->add_database(database => $db);
# With options (mixed positional + named)
$join->add_database($db, remove_columns => ['internal_id']);
$join->add_database($db, join_column => 'local_key_name');
$join->add_database($db, filter => { score => { '>' => 60 } });
# Chainable
$join->add_database($db1)->add_database($db2, remove_columns => ['notes']);
=head3 DESCRIPTION
Adds one more C<Database::Abstraction> subclass object to the logical view
and immediately updates the column-ownership index.
After the call, all query methods return rows that include columns from the
newly added database, and criteria on those new columns are routed to it
automatically.
When a column name in the new database already exists in an earlier database,
the new database becomes the authoritative source for that column
(last-database-wins, the same rule that applies at construction time).
The join-column must be present in the new database (or declared via
C<join_column>). The logger is propagated to the new database if one is set.
C<add_database> is the runtime equivalent of listing the database in the
C<databases> array to C<new>. The optional C<join_column> parameter is
equivalent to a C<join_map> entry; the optional C<filter> parameter is
equivalent to a C<filters> entry.
=head3 API SPECIFICATION
=head4 Input
database => { type => 'object', required => 1 }
# A Database::Abstraction subclass instance.
#
# DOMAIN -- EP valid: blessed object that passes
# isa('Database::Abstraction').
# DOMAIN -- EP invalid: non-reference, unblessed ref, wrong class,
# or non-reference non-key scalar (the guard at
# the top of add_database rejects it with
# error_invalid_db before validate_strict runs).
join_column => { type => 'string', optional => 1 }
# The name of the join key in THIS new database,
# when it differs from the canonical join_column.
#
# DOMAIN -- EP valid: any string that exists as a column in the
# new database.
# DOMAIN -- EP invalid: string absent from the new database's columns()
# => croak error_join_col_missing.
filter => { type => 'hashref', optional => 1 }
# Permanent criteria for this database only.
# Same format as selectall_arrayref.
remove_columns => { type => 'arrayref', optional => 1 }
# Column names from this database to hide.
=head4 Output
Returns C<$self> to support method chaining.
=head3 EXAMPLE
my $join = Database::Join->new(
databases => [ $customers ],
join_column => 'entry',
);
# Add loyalty data; hide internal columns from it
$join->add_database($loyalty, remove_columns => ['audit_ts']);
# Add score data; only include rows with score > 60
$join->add_database($scores, filter => { score => { '>' => 60 } });
# Add a database whose join key has a different local name
$join->add_database($stnames, join_column => 'state_code');
# All three options combined, and chained
$join->add_database($db4,
join_column => 'ref_id',
filter => { active => 1 },
remove_columns => ['legacy_col'],
);
=head3 PSEUDOCODE
determine the new database's index (length of current _dbs array)
extract the database object from positional or named argument
croak if it is not a Database::Abstraction subclass
register join_column alias in _join_map if different from canonical
register filter in _filters if provided
fetch column list from the new database
croak if the join key is missing from the new database
append the new database to _dbs and _db_cols
update _col_db: for each new column, point it at the new index
(last-database-wins; skip removed columns and the local join alias)
invalidate _col_cache and _schema_cache
propagate logger if set
apply remove_columns if provided
return $self
=head3 MESSAGES
error_invalid_db -- argument is not a Database::Abstraction subclass
error_join_col_missing -- join_column not found in the new database
=cut | |||||
| 1179 | ||||||
| 1180 | sub add_database { | |||||
| 1181 | 70 | 3735 | my ($self, @args) = @_; | |||
| 1182 | ||||||
| 1183 | 70 70 | 49 70 | my $idx = scalar @{ $self->{_dbs} }; | |||
| 1184 | 70 | 44 | my $db; | |||
| 1185 | ||||||
| 1186 | # Fail-fast guard: a non-reference first arg must be a recognised named-pair key. | |||||
| 1187 | # Modus Ponens: !ref(x) â§ x â @_ADD_DB_KEYS â cannot be a database object â croak. | |||||
| 1188 | # De Morgan reduction: the elsif below is logically equivalent to (@args && ref(args[0])) | |||||
| 1189 | # because the !ref branch was already handled; exhaustion makes the ref() check redundant. | |||||
| 1190 | 70 | 173 | if (@args && !ref($args[0])) { | |||
| 1191 | croak $self->_err('error_invalid_db', $idx) | |||||
| 1192 | 11 44 | 36 160 | unless grep { $args[0] eq $_ } @_ADD_DB_KEYS; | |||
| 1193 | } elsif (@args) { | |||||
| 1194 | # Positional form: first arg is a reference â extract it before get_params | |||||
| 1195 | # to avoid the mixed positional+named-pairs confusion. | |||||
| 1196 | 59 | 47 | $db = shift @args; | |||
| 1197 | } | |||||
| 1198 | ||||||
| 1199 | 64 | 262 | my $p = validate_strict( | |||
| 1200 | schema => { | |||||
| 1201 | database => { type => 'object', optional => 1 }, | |||||
| 1202 | join_column => { type => 'string', optional => 1 }, | |||||
| 1203 | filter => { type => 'hashref', optional => 1 }, | |||||
| 1204 | remove_columns => { type => 'arrayref', optional => 1 }, | |||||
| 1205 | }, | |||||
| 1206 | input => (@args ? get_params(undef, @args) : {}) // {}, | |||||
| 1207 | ); | |||||
| 1208 | ||||||
| 1209 | 64 | 5598 | $db //= $p->{database}; | |||
| 1210 | ||||||
| 1211 | 64 | 201 | croak $self->_err('error_invalid_db', $idx) | |||
| 1212 | unless blessed($db) && $db->isa('Database::Abstraction'); | |||||
| 1213 | ||||||
| 1214 | # Determine and register the local join column name for this database | |||||
| 1215 | 61 | 110 | my $local_jc = $p->{join_column} // $self->{_join_col}; | |||
| 1216 | 61 | 73 | $self->{_join_map}{$idx} = $local_jc if $p->{join_column}; | |||
| 1217 | 61 | 65 | $self->{_filters}{$idx} = $p->{filter} if $p->{filter}; | |||
| 1218 | ||||||
| 1219 | 61 | 70 | my $cols = $db->columns(); | |||
| 1220 | 61 135 61 | 1293 138 63 | my %col_presence = map { $_ => 1 } @{$cols}; | |||
| 1221 | ||||||
| 1222 | croak $self->_err('error_join_col_missing', $local_jc, $idx, ref($db)) | |||||
| 1223 | 61 | 83 | unless $col_presence{$local_jc}; | |||
| 1224 | ||||||
| 1225 | # Register the new database | |||||
| 1226 | 58 58 | 33 64 | push @{ $self->{_dbs} }, $db; | |||
| 1227 | 58 58 | 42 51 | push @{ $self->{_db_cols} }, \%col_presence; | |||
| 1228 | ||||||
| 1229 | # Update column routing: last-database-wins for duplicate column names; | |||||
| 1230 | # skip the local join-key alias (it is not a data column). | |||||
| 1231 | 58 58 | 37 52 | for my $col (@{$cols}) { | |||
| 1232 | 131 | 109 | next if $self->{_removed_cols}{$col}; | |||
| 1233 | 131 | 123 | next if $local_jc ne $self->{_join_col} && $col eq $local_jc; | |||
| 1234 | 123 | 668 | $self->{_col_db}{$col} = $idx; | |||
| 1235 | } | |||||
| 1236 | ||||||
| 1237 | # Invalidate memoisation caches | |||||
| 1238 | 58 | 49 | $self->{_col_cache} = undef; | |||
| 1239 | 58 | 42 | $self->{_schema_cache} = undef; | |||
| 1240 | ||||||
| 1241 | # Propagate logger if one is configured | |||||
| 1242 | 58 | 65 | if (my $log = $self->{_logger}) { | |||
| 1243 | 4 | 9 | $db->set_logger($log); | |||
| 1244 | } | |||||
| 1245 | ||||||
| 1246 | # Apply any column removals requested for this database | |||||
| 1247 | 58 | 74 | if (my $rc = $p->{remove_columns}) { | |||
| 1248 | 4 4 | 4 9 | $self->remove_column($_) for @{$rc}; | |||
| 1249 | } | |||||
| 1250 | ||||||
| 1251 | 58 | 100 | return $self; | |||
| 1252 | } | |||||
| 1253 | ||||||
| 1254 - 1323 | =head2 remove_column
=head3 SYNOPSIS
$join->remove_column('email');
# Chainable
$join->remove_column('internal_id')->remove_column('audit_ts');
=head3 DESCRIPTION
Permanently hides a column from the merged view. After this call:
=over 4
=item *
The column does not appear in C<columns()> or C<schema()>.
=item *
Returned row hashrefs do not contain the column key.
=item *
Any query criterion that references the removed column is silently dropped
(with a C<carp> warning).
=back
The C<join_column> cannot be removed; attempting to do so will C<croak>.
Removing a column that does not exist in any database is silently ignored
(the call is idempotent and safe). The C<columns()> and C<schema()>
memoisation caches are cleared automatically.
=head3 API SPECIFICATION
=head4 Input
$col Positional string: the column name to remove.
DOMAIN -- EP valid: any string; non-existent columns are silently
ignored (idempotent call, returns $self).
DOMAIN -- EP invalid: join_column value => croak error_remove_join_col.
DOMAIN -- BVA: undef and '' are explicit no-ops (returns $self).
These are below the minimum meaningful string
length and are handled without any warning.
=head4 Output
Returns C<$self> to support method chaining.
=head3 EXAMPLE
# Hide private fields immediately after construction
my $join = Database::Join->new(
databases => [ $customers, $loyalty ],
join_column => 'entry',
)->remove_column('email')
->remove_column('internal_notes');
# Verify they are gone
my $cols = $join->columns();
# 'email' and 'internal_notes' are absent
=head3 MESSAGES
error_remove_join_col -- attempt to remove the join_column itself
=cut | |||||
| 1324 | ||||||
| 1325 | sub remove_column { | |||||
| 1326 | 89 | 4660 | my ($self, $col) = @_; | |||
| 1327 | ||||||
| 1328 | croak $self->_err('error_remove_join_col', $col) | |||||
| 1329 | 89 | 184 | if defined $col && $col eq $self->{_join_col}; | |||
| 1330 | ||||||
| 1331 | 80 | 134 | if (defined $col && length $col) { | |||
| 1332 | 72 | 77 | $self->{_removed_cols}{$col} = 1; | |||
| 1333 | 72 | 77 | delete $self->{_col_db}{$col}; | |||
| 1334 | 72 | 61 | $self->{_col_cache} = undef; | |||
| 1335 | 72 | 65 | $self->{_schema_cache} = undef; | |||
| 1336 | } | |||||
| 1337 | ||||||
| 1338 | 80 | 107 | return $self; | |||
| 1339 | } | |||||
| 1340 | ||||||
| 1341 - 1349 | =head2 query Not supported. C<Database::Join> does not implement the chained query builder. Calling this method will always C<croak> with an explanatory message. Use C<selectall_arrayref>, C<selectall_array>, C<fetchrow_hashref>, or C<count> instead. =cut | |||||
| 1350 | ||||||
| 1351 | sub query { | |||||
| 1352 | 5 | 417 | my ($self) = @_; | |||
| 1353 | 5 | 15 | croak $self->_err('error_query_unsupported'); | |||
| 1354 | } | |||||
| 1355 | ||||||
| 1356 - 1363 | =head2 execute Not supported. Raw SQL cannot span heterogeneous backends that may use different database engines. Calling this method will always C<croak>. Use C<selectall_arrayref> or C<fetchrow_hashref> to query the joined view. =cut | |||||
| 1364 | ||||||
| 1365 | sub execute { | |||||
| 1366 | 5 | 349 | my ($self) = @_; | |||
| 1367 | 5 | 7 | croak $self->_err('error_execute_unsupported'); | |||
| 1368 | } | |||||
| 1369 | ||||||
| 1370 - 1445 | =head2 AUTOLOAD - column shortcut
Calling an unknown method whose name matches a visible column name performs
a column lookup across the merged view.
=head3 SYNOPSIS
# Scalar context: value from the first matching row
my $name = $join->name(entry => 'C001');
# List context: values from every matching row
my @tiers = $join->tier();
# With a positional join-key argument (when join_column is 'entry')
my $score = $join->score('C001');
=head3 DESCRIPTION
AUTOLOAD routes the call to the appropriate component database by looking up
the column name in the internal column-ownership index.
When either C<join_map> or C<filters> is active, AUTOLOAD performs a full
join query instead of delegating directly to the owning database. This is
necessary because:
=over 4
=item *
With C<join_map>, the owning database's primary key may differ from the
canonical join key used in the call arguments.
=item *
With C<filters>, bypassing the join would return rows that the filter is
meant to exclude.
=back
In list context, every matching merged row contributes one value to the
returned list. In scalar context, only the first row's value is returned.
Calling a method whose name begins with C<_> (a private method) via AUTOLOAD
will C<croak> with a clear error message rather than being silently ignored.
=head3 EXAMPLE
# Lookup a single customer's name (scalar context)
my $name = $join->name('C001'); # 'C001' maps to entry => 'C001'
print "Name: $name\n";
# Get every tier value in the view (list context)
my @all_tiers = $join->tier();
my %freq;
$freq{$_}++ for @all_tiers;
# join_map active: AUTOLOAD runs a full join so the criteria are
# translated correctly between the canonical and local key names.
my @leesburg_states = sort $join->state('Leesburg');
# ['Florida', 'Virginia'] if Leesburg appears in two states
=head3 PSEUDOCODE
extract column name from $AUTOLOAD
return if DESTROY
croak if column name starts with '_' (private method guard)
croak if column name is not in _col_db (unknown column)
if join_map or filters are active:
parse calling arguments using _parse_query_args
call _joined_query to get all merged rows
return map { $_->{col} } @rows in list context
return $rows[0]{col} in scalar context
else:
delegate directly to the owning database
=cut | |||||
| 1446 | ||||||
| 1447 | our $AUTOLOAD; | |||||
| 1448 | ||||||
| 1449 | sub AUTOLOAD { | |||||
| 1450 | 47 | 2461 | my $self = shift; | |||
| 1451 | ||||||
| 1452 | 47 | 140 | my ($col) = $AUTOLOAD =~ /::(\w+)$/; | |||
| 1453 | # TODO: Unreachable code detected during path analysis. Investigate for removal. | |||||
| 1454 | # `sub DESTROY {}` is defined explicitly in this package; Perl's method-resolution | |||||
| 1455 | # order finds it before AUTOLOAD is ever invoked, so $col can never equal 'DESTROY'. | |||||
| 1456 | 47 | 55 | return if $col eq 'DESTROY'; | |||
| 1457 | ||||||
| 1458 | # Private methods must not be reached via AUTOLOAD â croak immediately so | |||||
| 1459 | # typos like $join->_join_col are not silently swallowed. | |||||
| 1460 | 47 | 190 | croak ref($self), ": cannot call private method '$col' via AUTOLOAD" | |||
| 1461 | if $col =~ /^_/; | |||||
| 1462 | ||||||
| 1463 | 38 | 58 | my $db_idx = $self->{_col_db}{$col}; | |||
| 1464 | 38 | 144 | croak ref($self), ": unknown column '$col'" unless defined $db_idx; | |||
| 1465 | ||||||
| 1466 | # Use a full join query when join_map OR filters are active. Direct | |||||
| 1467 | # delegation to the owning database would bypass the join key translation | |||||
| 1468 | # (join_map) and skip any permanent per-database row filters (filters). | |||||
| 1469 | 30 30 20 | 19 51 40 | if (%{ $self->{_join_map} } || %{ $self->{_filters} }) { | |||
| 1470 | # _autoload_pk was captured once at construction from the primary DA's | |||||
| 1471 | # {id} field; using the cached value avoids re-introspecting the blessed | |||||
| 1472 | # hash on every call and isolates the coupling to a single known site. | |||||
| 1473 | 23 | 42 | my $params = $self->_parse_query_args($self->{_autoload_pk}, @_); | |||
| 1474 | 23 | 107 | my $rows = $self->_joined_query($params); | |||
| 1475 | 23 10 9 | 32 22 10 | return map { $_->{$col} } @{$rows} if wantarray; | |||
| 1476 | 14 14 | 14 46 | return @{$rows} ? $rows->[0]{$col} : undef; | |||
| 1477 | } | |||||
| 1478 | ||||||
| 1479 | # $db is resolved here (not earlier) to avoid a dead store on the join path above. | |||||
| 1480 | 7 | 12 | my $db = $self->{_dbs}[$db_idx]; | |||
| 1481 | 7 | 20 | return $db->$col(@_); | |||
| 1482 | } | |||||
| 1483 | ||||||
| 1484 | sub DESTROY {} | |||||
| 1485 | ||||||
| 1486 | # --------------------------------------------------------------------------- | |||||
| 1487 | # Private helpers | |||||
| 1488 | # --------------------------------------------------------------------------- | |||||
| 1489 | ||||||
| 1490 | # _parse_query_args( $self, $positional_key, @caller_args ) -> \%params | |||||
| 1491 | # Purpose: Normalise the three calling conventions used by every public query | |||||
| 1492 | # method and AUTOLOAD into a single criteria hashref. | |||||
| 1493 | # Entry: $positional_key -- the column name mapped to a bare scalar argument; | |||||
| 1494 | # pass undef to use the join_column (the default for public methods). | |||||
| 1495 | # Exit: Always returns a hashref; never undef. | |||||
| 1496 | sub _parse_query_args :Protected { | |||||
| 1497 | 85 | 84 | my ($self, $key, @args) = @_; | |||
| 1498 | 85 | 164 | $key //= $self->{_join_col}; | |||
| 1499 | 85 | 152 | return {} unless @args; | |||
| 1500 | 34 | 54 | return { $key => $args[0] } if @args == 1 && !ref($args[0]); | |||
| 1501 | 32 | 46 | return get_params(undef, @args) // {}; | |||
| 1502 | 18 18 18 | 21455 15 301 | } | |||
| 1503 | ||||||
| 1504 | # _err( $self, $msg_key, @sprintf_args ) -> $string | |||||
| 1505 | # Convenience wrapper around _msg for use after construction, so callers do | |||||
| 1506 | # not have to extract $self->{_i18n} at every error site. | |||||
| 1507 | sub _err :Protected { | |||||
| 1508 | 16 | 24 | my ($self, $key, @args) = @_; | |||
| 1509 | 16 | 20 | return _msg($self->{_i18n}, $key, @args); | |||
| 1510 | 18 18 18 | 2636 15 118 | } | |||
| 1511 | ||||||
| 1512 | # _build_col_index() | |||||
| 1513 | # Purpose: Populate _col_db (column_name => db_index) and _db_cols | |||||
| 1514 | # (per-db column-presence hashrefs) by calling columns() on each | |||||
| 1515 | # component database at construction time. | |||||
| 1516 | # Entry: _dbs, _join_col, _join_map must already be set. | |||||
| 1517 | # Exit: _col_db and _db_cols are set; join_column verified in every db. | |||||
| 1518 | # Effects: Croaks if any database is missing its join key column. | |||||
| 1519 | sub _build_col_index :Protected { | |||||
| 1520 | 132 | 94 | my ($self) = @_; | |||
| 1521 | ||||||
| 1522 | 132 | 123 | my $join_col = $self->{_join_col}; | |||
| 1523 | 132 | 76 | my %col_db; | |||
| 1524 | my @db_cols; | |||||
| 1525 | ||||||
| 1526 | 132 132 | 80 140 | for my $i (0 .. $#{ $self->{_dbs} }) { | |||
| 1527 | 248 | 165 | my $db = $self->{_dbs}[$i]; | |||
| 1528 | 248 | 303 | my $local_jc = $self->{_join_map}{$i} // $join_col; | |||
| 1529 | 248 | 235 | my $cols = $db->columns(); | |||
| 1530 | 248 497 248 | 297 452 169 | $db_cols[$i] = { map { $_ => 1 } @{$cols} }; | |||
| 1531 | ||||||
| 1532 | # Guard: a join_map value that is a reference (e.g. a hashref) would | |||||
| 1533 | # stringify to "HASH(0x...)" when interpolated into an error message, | |||||
| 1534 | # leaking a heap address to callers. Reject early with a clear message. | |||||
| 1535 | 248 | 226 | croak $self->_err('error_join_col_missing', "(join_map[$i] must be a string)", $i, ref($db)) | |||
| 1536 | if ref $local_jc; | |||||
| 1537 | ||||||
| 1538 | croak $self->_err('error_join_col_missing', $local_jc, $i, ref($db)) | |||||
| 1539 | 245 | 210 | unless $db_cols[$i]{$local_jc}; | |||
| 1540 | ||||||
| 1541 | 242 242 | 128 170 | for my $col (@{$cols}) { | |||
| 1542 | # Skip the local alias for the join key â it is not a data column | |||||
| 1543 | 485 | 392 | next if $local_jc ne $join_col && $col eq $local_jc; | |||
| 1544 | # Last database wins for duplicate non-join columns | |||||
| 1545 | 477 | 429 | $col_db{$col} = $i; | |||
| 1546 | } | |||||
| 1547 | } | |||||
| 1548 | ||||||
| 1549 | 126 | 107 | $self->{_col_db} = \%col_db; | |||
| 1550 | 126 | 100 | $self->{_db_cols} = \@db_cols; | |||
| 1551 | ||||||
| 1552 | 126 | 105 | return; | |||
| 1553 | 18 18 18 | 4106 23 169 | } | |||
| 1554 | ||||||
| 1555 | # _partition_criteria( \%params ) -> \@per_db | |||||
| 1556 | # Purpose: Split a flat criteria hashref into one slice per component database. | |||||
| 1557 | # Entry: $params is a criteria hashref; all keys must be column names or | |||||
| 1558 | # join_column. | |||||
| 1559 | # Exit: Returns an arrayref of per-database criteria hashrefs. The | |||||
| 1560 | # join_column criterion is broadcast to every database using each | |||||
| 1561 | # database's local join-key name. Unknown columns trigger a carp. | |||||
| 1562 | # Effects: Carps for each unrecognised column name. | |||||
| 1563 | sub _partition_criteria :Protected { | |||||
| 1564 | 85 | 79 | my ($self, $params) = @_; | |||
| 1565 | ||||||
| 1566 | 85 | 75 | my $join_col = $self->{_join_col}; | |||
| 1567 | 85 85 | 53 65 | my $n = scalar @{ $self->{_dbs} }; | |||
| 1568 | 85 170 | 99 158 | my @per_db = map { {} } 1 .. $n; | |||
| 1569 | ||||||
| 1570 | 85 85 | 54 89 | for my $col (keys %{$params}) { | |||
| 1571 | 34 | 49 | if ($col eq $join_col) { | |||
| 1572 | # Broadcast to every database using each one's local key column name. | |||||
| 1573 | # Shallow-copy operator hashrefs so a malicious component DA that | |||||
| 1574 | # mutates its criteria hashref contents cannot corrupt siblings. | |||||
| 1575 | 16 | 15 | my $val = $params->{$col}; | |||
| 1576 | 16 | 17 | for my $i (0 .. $n - 1) { | |||
| 1577 | 32 | 43 | my $local = $self->{_join_map}{$i} // $join_col; | |||
| 1578 | 32 2 | 49 3 | $per_db[$i]{$local} = ref($val) eq 'HASH' ? { %{$val} } : $val; | |||
| 1579 | } | |||||
| 1580 | } elsif (defined(my $idx = $self->{_col_db}{$col})) { | |||||
| 1581 | 14 | 20 | $per_db[$idx]{$col} = $params->{$col}; | |||
| 1582 | } else { | |||||
| 1583 | 4 | 6 | carp $self->_err('warn_unknown_column', $col); | |||
| 1584 | } | |||||
| 1585 | } | |||||
| 1586 | ||||||
| 1587 | 85 | 589 | return \@per_db; | |||
| 1588 | 18 18 18 | 3945 28 121 | } | |||
| 1589 | ||||||
| 1590 | # _fetch_indexed( $db_idx, \%criteria ) -> \%join_val_to_\@rows | |||||
| 1591 | # Purpose: Query one component database and index its rows by join-key value. | |||||
| 1592 | # Entry: $db_idx is the zero-based database index; $criteria is the | |||||
| 1593 | # pre-partitioned criteria hashref for this database. | |||||
| 1594 | # Exit: Returns a hashref: join-key value => arrayref of row hashrefs. | |||||
| 1595 | # Multiple rows sharing the same join-key value are all preserved | |||||
| 1596 | # (important for the primary database when one key maps to many rows). | |||||
| 1597 | # Effects: Calls selectall_arrayref on the component database. | |||||
| 1598 | sub _fetch_indexed :Protected { | |||||
| 1599 | 170 | 128 | my ($self, $db_idx, $criteria) = @_; | |||
| 1600 | ||||||
| 1601 | 170 | 137 | my $db = $self->{_dbs}[$db_idx]; | |||
| 1602 | 170 | 207 | my $local_jc = $self->{_join_map}{$db_idx} // $self->{_join_col}; | |||
| 1603 | ||||||
| 1604 | 170 | 162 | my $rows = $db->selectall_arrayref($criteria); | |||
| 1605 | 168 | 1694 | $rows //= []; | |||
| 1606 | ||||||
| 1607 | 168 | 106 | my %indexed; | |||
| 1608 | 168 168 | 87 123 | for my $row (@{$rows}) { | |||
| 1609 | 263 | 167 | my $key = $row->{$local_jc}; | |||
| 1610 | 263 | 190 | next unless defined $key; | |||
| 1611 | 262 262 | 133 273 | push @{ $indexed{$key} }, $row; | |||
| 1612 | } | |||||
| 1613 | ||||||
| 1614 | 168 | 174 | return \%indexed; | |||
| 1615 | 18 18 18 | 2777 37 109 | } | |||
| 1616 | ||||||
| 1617 | # _joined_query( \%params ) -> \@merged_rows | |||||
| 1618 | # | |||||
| 1619 | # Purpose: Core join algorithm. Partitions criteria, fetches per-database | |||||
| 1620 | # results, resolves the key set, and merges rows. | |||||
| 1621 | # | |||||
| 1622 | # Key-set resolution (applied for each secondary database after the primary): | |||||
| 1623 | # | |||||
| 1624 | # If the database had criteria in this query call (after base filter overlay), | |||||
| 1625 | # it acts as an INNER-JOIN partner: only keys present in its filtered result | |||||
| 1626 | # survive. This gives WHERE-clause semantics even under a LEFT join. | |||||
| 1627 | # | |||||
| 1628 | # If the database had NO effective criteria: | |||||
| 1629 | # inner -> intersect (standard inner join) | |||||
| 1630 | # left -> no change (primary defines the key set) | |||||
| 1631 | # outer -> union (all keys from any database) | |||||
| 1632 | # | |||||
| 1633 | # Row merge: for each qualifying primary row, secondary rows are overlaid in | |||||
| 1634 | # index order. For duplicate columns, later databases win. Local join-key | |||||
| 1635 | # aliases are renamed to the canonical join_column before merging. | |||||
| 1636 | # Removed columns are deleted from every merged row. | |||||
| 1637 | sub _joined_query :Protected { | |||||
| 1638 | 85 | 451 | my ($self, $params) = @_; | |||
| 1639 | ||||||
| 1640 | 85 | 59 | my $join_col = $self->{_join_col}; | |||
| 1641 | 85 | 66 | my $join_type = $self->{_join_type}; | |||
| 1642 | 85 85 | 46 76 | my $n = scalar @{ $self->{_dbs} }; | |||
| 1643 | ||||||
| 1644 | 85 | 101 | my $per_db = $self->_partition_criteria($params); | |||
| 1645 | ||||||
| 1646 | # Overlay any per-database base filters onto the partitioned criteria. | |||||
| 1647 | # A filtered database always has effective criteria, so $had_criteria will | |||||
| 1648 | # be true for it â giving inner-join key-set semantics regardless of join_type. | |||||
| 1649 | 85 | 85 | for my $i (0 .. $n - 1) { | |||
| 1650 | 170 | 216 | my $base = $self->{_filters}{$i} // {}; | |||
| 1651 | 170 170 | 103 192 | next unless %{$base}; | |||
| 1652 | 16 | 25 | $per_db->[$i] = _merge_criteria($base, $per_db->[$i]); | |||
| 1653 | } | |||||
| 1654 | ||||||
| 1655 | # Fetch and index each database with its own criteria slice. | |||||
| 1656 | # !!%hash collapses to 1 (non-empty) or '' (empty) without allocating a count. | |||||
| 1657 | 85 | 57 | my @indexed; | |||
| 1658 | my @had_criteria; | |||||
| 1659 | 85 | 70 | for my $i (0 .. $n - 1) { | |||
| 1660 | 170 | 168 | $indexed[$i] = $self->_fetch_indexed($i, $per_db->[$i]); | |||
| 1661 | # TODO: Data Flow Anomaly (D~) - $had_criteria[0] written here but never read; | |||||
| 1662 | # the key-set resolution loop below starts at i=1. When n==1 this is always | |||||
| 1663 | # a dead store. Harmless but could be removed if n>1 is enforced, or the | |||||
| 1664 | # loop could start at i=0 if primary-criteria semantics are ever needed. | |||||
| 1665 | 168 168 | 87 178 | $had_criteria[$i] = !!%{ $per_db->[$i] }; | |||
| 1666 | } | |||||
| 1667 | ||||||
| 1668 | # Seed the key set from the primary database. | |||||
| 1669 | 83 136 83 | 48 128 88 | my %key_set = map { $_ => 1 } keys %{ $indexed[0] }; | |||
| 1670 | ||||||
| 1671 | # Merge in each secondary database. | |||||
| 1672 | # Premise 1: indexed[$i] is a valid hashref (returned by _fetch_indexed). | |||||
| 1673 | # Premise 2: join_type â {left, inner, outer} (enforced by validate_strict). | |||||
| 1674 | # Conclusion: the three branches below are exhaustive and mutually exclusive. | |||||
| 1675 | 83 | 93 | for my $i (1 .. $n - 1) { | |||
| 1676 | 83 | 143 | if ($had_criteria[$i] || $join_type eq 'inner') { | |||
| 1677 | # Intersect: single-pass delete for keys absent from this secondary. | |||||
| 1678 | # A single loop avoids the intermediate list that grep would allocate | |||||
| 1679 | # before the delete loop could iterate it (saves O(K) allocations). | |||||
| 1680 | 41 | 34 | for my $k (keys %key_set) { | |||
| 1681 | 63 | 74 | delete $key_set{$k} unless exists $indexed[$i]{$k}; | |||
| 1682 | } | |||||
| 1683 | } elsif ($join_type eq 'outer') { | |||||
| 1684 | # Union: hash slice assignment is a single Perl op, not a per-key loop. | |||||
| 1685 | 3 3 | 3 5 | @key_set{ keys %{ $indexed[$i] } } = (); | |||
| 1686 | } | |||||
| 1687 | # left + no criteria: key_set unchanged (primary defines the set). | |||||
| 1688 | } | |||||
| 1689 | ||||||
| 1690 | # Build one merged result row for every primary-database row that qualifies. | |||||
| 1691 | # Secondary databases act as lookup tables: when a key maps to multiple | |||||
| 1692 | # secondary rows, the last one wins (consistent with construction-time | |||||
| 1693 | # last-database-wins column routing). | |||||
| 1694 | 83 | 46 | my @result; | |||
| 1695 | 83 83 | 73 95 | my @removed = keys %{ $self->{_removed_cols} }; | |||
| 1696 | 83 | 105 | for my $key (sort keys %key_set) { | |||
| 1697 | # All qualifying rows from the primary database for this key. | |||||
| 1698 | # Use [{}] so that outer-join keys absent from the primary still | |||||
| 1699 | # produce one merged row filled from secondary databases. | |||||
| 1700 | 118 118 | 69 132 | my @base_rows = @{ $indexed[0]{$key} // [{}] }; | |||
| 1701 | ||||||
| 1702 | 118 | 76 | for my $prow (@base_rows) { | |||
| 1703 | 119 119 | 66 149 | my %merged = %{$prow}; | |||
| 1704 | ||||||
| 1705 | 119 | 91 | for my $i (1 .. $n - 1) { | |||
| 1706 | 118 | 78 | my $sec_arr = $indexed[$i]{$key}; | |||
| 1707 | 118 114 | 98 105 | next unless $sec_arr && @{$sec_arr}; | |||
| 1708 | ||||||
| 1709 | # Write secondary columns directly into %merged without copying | |||||
| 1710 | # the source row into a temporary hash first. | |||||
| 1711 | # Before: %row_copy = %{$src} then %merged = (%merged,%row_copy) | |||||
| 1712 | # â 2 full hash copies per secondary per row: O(C) + O(|merged|+C) | |||||
| 1713 | # After: per-key loop writes straight into %merged | |||||
| 1714 | # â O(C) key assignments only; no intermediate allocation | |||||
| 1715 | 114 | 66 | my $src = $sec_arr->[-1]; | |||
| 1716 | 114 | 89 | my $local_jc = $self->{_join_map}{$i}; | |||
| 1717 | 114 | 95 | my $rename = $local_jc && $local_jc ne $join_col; | |||
| 1718 | 114 114 | 56 96 | for my $k (keys %{$src}) { | |||
| 1719 | 228 | 167 | if ($rename && $k eq $local_jc) { | |||
| 1720 | 6 | 8 | $merged{$join_col} = $src->{$k}; | |||
| 1721 | } else { | |||||
| 1722 | 222 | 208 | $merged{$k} = $src->{$k}; | |||
| 1723 | } | |||||
| 1724 | } | |||||
| 1725 | } | |||||
| 1726 | ||||||
| 1727 | 119 | 92 | delete @merged{@removed} if @removed; | |||
| 1728 | 119 | 123 | push @result, \%merged; | |||
| 1729 | } | |||||
| 1730 | } | |||||
| 1731 | ||||||
| 1732 | 83 | 252 | return \@result; | |||
| 1733 | 18 18 18 | 6219 15 126 | } | |||
| 1734 | ||||||
| 1735 | # _merge_criteria( \%base, \%extra ) -> \%merged | |||||
| 1736 | # Purpose: Merge two criteria hashrefs for the same database column set. | |||||
| 1737 | # Entry: %base is the permanent filter; %extra is the query-time criteria. | |||||
| 1738 | # Exit: Returns a new hashref with both applied. | |||||
| 1739 | # Merging rule: when both values for the same column are operator hashrefs | |||||
| 1740 | # (e.g. { '>' => 60 } and { '<' => 365 }), the operators are combined | |||||
| 1741 | # so both constraints apply simultaneously (AND semantics). | |||||
| 1742 | # Otherwise the extra (query-time) value overwrites the base value. | |||||
| 1743 | sub _merge_criteria :Protected { | |||||
| 1744 | 16 | 17 | my ($base, $extra) = @_; | |||
| 1745 | 16 16 | 11 21 | my %merged = %{$base}; | |||
| 1746 | 16 16 | 12 18 | for my $col (keys %{$extra}) { | |||
| 1747 | 8 | 26 | if (exists $merged{$col} | |||
| 1748 | && ref($merged{$col}) eq 'HASH' | |||||
| 1749 | && ref($extra->{$col}) eq 'HASH') { | |||||
| 1750 | 5 5 5 | 6 6 11 | $merged{$col} = { %{ $merged{$col} }, %{ $extra->{$col} } }; | |||
| 1751 | } else { | |||||
| 1752 | 3 | 3 | $merged{$col} = $extra->{$col}; | |||
| 1753 | } | |||||
| 1754 | } | |||||
| 1755 | 16 | 23 | return \%merged; | |||
| 1756 | 18 18 18 | 2806 14 109 | } | |||
| 1757 | ||||||
| 1758 | # _msg( $i18n, $key, @sprintf_args ) -> $string | |||||
| 1759 | # Purpose: Format a user-facing message, routing through the i18n object when | |||||
| 1760 | # one is provided. Falls back to the built-in %MESSAGES dictionary. | |||||
| 1761 | # Entry: $i18n may be undef. $key must be a key in %MESSAGES. | |||||
| 1762 | # Exit: Returns the formatted string. | |||||
| 1763 | sub _msg :Protected { | |||||
| 1764 | 26 | 37 | my ($i18n, $key, @args) = @_; | |||
| 1765 | ||||||
| 1766 | 26 | 47 | if ($i18n && $i18n->can('translate')) { | |||
| 1767 | 1 | 2 | return $i18n->translate($key, @args); | |||
| 1768 | } | |||||
| 1769 | ||||||
| 1770 | my $fmt = $MESSAGES{$key} | |||||
| 1771 | 25 | 53 | // sprintf($MESSAGES{error_unknown_message}, $key); | |||
| 1772 | ||||||
| 1773 | 25 | 416 | return @args ? sprintf($fmt, @args) : $fmt; | |||
| 1774 | 18 18 18 | 2334 15 90 | } | |||
| 1775 | ||||||
| 1776 | 1; | |||||
| 1777 | ||||||