| File: | blib/lib/Database/Abstraction/Query.pm |
| Coverage: | 68.4% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Database::Abstraction::Query; | |||||
| 2 | ||||||
| 3 | # Chained query builder for Database::Abstraction objects. | |||||
| 4 | # Returned by $db->query() and used as: | |||||
| 5 | # $db->query->where(col => val)->order_by('col')->limit(10)->all() | |||||
| 6 | ||||||
| 7 | 6 6 6 | 1657 6 103 | use strict; | |||
| 8 | 6 6 6 | 11 5 186 | use warnings; | |||
| 9 | ||||||
| 10 | 6 6 6 | 12 4 182 | use Carp; | |||
| 11 | 6 6 6 | 12 7 4294 | use Scalar::Util qw(blessed); | |||
| 12 | ||||||
| 13 - 21 | =head1 NAME Database::Abstraction::Query - Fluent, chainable query builder for Database::Abstraction =head1 VERSION Version 0.36 =cut | |||||
| 22 | ||||||
| 23 | our $VERSION = '0.36'; | |||||
| 24 | ||||||
| 25 - 111 | =head1 SYNOPSIS
my $db = Database::Foo->new(directory => '/path/to/data');
# --- Basic usage -----------------------------------------------
# All rows
my $all = $db->query->all();
# Filter, sort, page
my $rows = $db->query
->where(status => 'active')
->where(score => { '>=' => 80 })
->order_by('score DESC')
->limit(10)
->offset(20)
->all();
# Single row
my $row = $db->query->where(name => 'Alice')->first();
# Count
my $n = $db->query->where(status => 'active')->count();
# --- Specific columns ------------------------------------------
my $names = $db->query->select('name, score')->where(status => 'active')->all();
# --- Joins -----------------------------------------------------
my $joined = $db->query
->join({ table => 'dept', on => 'e.dept_id = dept.id', type => 'LEFT' })
->where(dept_name => 'Engineering')
->all();
# --- OR criteria -----------------------------------------------
my $either = $db->query
->where(-or => [
{ status => 'active' },
{ score => { '>=' => 95 } },
])
->all();
=head1 DESCRIPTION
C<Database::Abstraction::Query> is a fluent query builder returned by
C<< $db->query() >>. You assemble a query by chaining builder methods,
then execute it with a terminal method.
=over 4
=item *
B<Builder methods> (C<select>, C<where>, C<join>, C<order_by>, C<limit>,
C<offset>) all return C<$self>, so calls can be chained in any order.
=item *
B<Terminal methods> (C<all>, C<first>, C<count>) assemble the SQL, execute
it, and return the result. Each terminal method can be called on the same
builder object independently - calling C<first()> does not modify the stored
state (it temporarily sets LIMIT 1 internally).
=item *
C<where()> calls are B<merged with AND semantics>: each call adds more
required conditions. To express OR conditions pass C<< -or => [...] >> as a
key inside a single C<where()> call.
=item *
The C<join> parameter accepts the same spec as the C<join> parameter in
L<Database::Abstraction/QUERY CRITERIA>.
=item *
BerkeleyDB backends support C<all()>, C<first()>, and C<count()> with
C<where()> criteria and C<order_by()>/C<limit()>/C<offset()> applied in Perl.
The C<join()> builder method and the C<select()> column projection are not
supported on BerkeleyDB and will raise an error.
=back
=head1 METHODS
=cut | |||||
| 112 | ||||||
| 113 - 120 | =head2 new my $q = Database::Abstraction::Query->new(_db => $db_object); Construct a new, empty query builder bound to C<$db_object>. In practice you almost always call this via C<< $db->query() >> instead. =cut | |||||
| 121 | ||||||
| 122 | sub new | |||||
| 123 | { | |||||
| 124 | 61 | 1288 | my ($class, %args) = @_; | |||
| 125 | ||||||
| 126 | 61 | 112 | my $db = $args{'_db'} | |||
| 127 | or croak('Database::Abstraction::Query: _db is required'); | |||||
| 128 | ||||||
| 129 | 59 | 239 | croak('Database::Abstraction::Query: _db must be a Database::Abstraction object') | |||
| 130 | unless blessed($db) && $db->isa('Database::Abstraction'); | |||||
| 131 | ||||||
| 132 | 57 | 220 | return bless { | |||
| 133 | _db => $db, | |||||
| 134 | _select => '*', | |||||
| 135 | _where => {}, | |||||
| 136 | _joins => [], | |||||
| 137 | _order_by => undef, | |||||
| 138 | _limit => undef, | |||||
| 139 | _offset => undef, | |||||
| 140 | }, $class; | |||||
| 141 | } | |||||
| 142 | ||||||
| 143 - 151 | =head2 select
$q->select('name, score');
$q->select('COUNT(*) AS n, status');
Set the column expression for the C<SELECT> clause. Default is C<*> (all
columns). Returns C<$self>.
=cut | |||||
| 152 | ||||||
| 153 | sub select | |||||
| 154 | { | |||||
| 155 | 5 | 3671 | my ($self, $cols) = @_; | |||
| 156 | 5 | 12 | $self->{'_select'} = defined($cols) ? $cols : '*'; | |||
| 157 | 5 | 10 | return $self; | |||
| 158 | } | |||||
| 159 | ||||||
| 160 - 177 | =head2 where
$q->where(status => 'active');
$q->where(score => { '>' => 8 });
$q->where(name => { -in => [...] });
$q->where(-or => [ {...}, {...} ]);
Add one or more criteria to the query. Multiple calls are merged with
AND semantics. Accepts a flat list of key/value pairs or a single hashref.
Supports the full criteria syntax of L<Database::Abstraction/QUERY CRITERIA>:
plain scalars, wildcard strings, C<undef> (IS NULL), comparison operator
hashrefs (C<< { '>' => n } >>), C<-in>, C<-not_in>, C<-between>,
C<-like>, C<-not_like>, C<-or>, and C<-and>.
Returns C<$self>.
=cut | |||||
| 178 | ||||||
| 179 | sub where | |||||
| 180 | { | |||||
| 181 | 30 | 25 | my $self = shift; | |||
| 182 | 30 0 | 51 0 | my %criteria = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_; | |||
| 183 | 30 | 38 | for my $k (keys %criteria) { | |||
| 184 | 30 | 35 | $self->{'_where'}{$k} = $criteria{$k}; | |||
| 185 | } | |||||
| 186 | 30 | 57 | return $self; | |||
| 187 | } | |||||
| 188 | ||||||
| 189 - 213 | =head2 join
$q->join({ table => 'dept', on => 'e.dept_id = dept.id', type => 'LEFT' });
# Multiple joins at once
$q->join([
{ table => 'dept', on => 'e.dept_id = dept.id' },
{ table => 'country', on => 'e.country_id = country.id' },
]);
Append one or more JOIN specs. Each spec is a hashref with:
=over 4
=item * C<table> - the table to join (required)
=item * C<on> - the join condition, verbatim SQL (required)
=item * C<type> - join type: C<INNER> (default), C<LEFT>, C<RIGHT>, C<FULL>, C<CROSS>
=back
Multiple calls accumulate joins. Returns C<$self>.
=cut | |||||
| 214 | ||||||
| 215 | sub join ## no critic(ProhibitBuiltinHomonyms) | |||||
| 216 | { | |||||
| 217 | 6 | 11 | my ($self, $spec) = @_; | |||
| 218 | 6 0 | 13 0 | my @specs = ref($spec) eq 'ARRAY' ? @{$spec} : ($spec); | |||
| 219 | 6 6 | 6 10 | push @{$self->{'_joins'}}, @specs; | |||
| 220 | 6 | 31 | return $self; | |||
| 221 | } | |||||
| 222 | ||||||
| 223 - 231 | =head2 order_by
$q->order_by('name DESC');
$q->order_by('score DESC, name ASC');
Set the C<ORDER BY> expression. Replaces any previously set ordering.
Returns C<$self>.
=cut | |||||
| 232 | ||||||
| 233 | sub order_by | |||||
| 234 | { | |||||
| 235 | 15 | 17 | my ($self, $col) = @_; | |||
| 236 | 15 | 15 | $self->{'_order_by'} = $col; | |||
| 237 | 15 | 22 | return $self; | |||
| 238 | } | |||||
| 239 | ||||||
| 240 - 246 | =head2 limit $q->limit(20); Set the maximum number of rows to return. Returns C<$self>. =cut | |||||
| 247 | ||||||
| 248 | sub limit | |||||
| 249 | { | |||||
| 250 | 13 | 14 | my ($self, $n) = @_; | |||
| 251 | 13 | 12 | $self->{'_limit'} = $n; | |||
| 252 | 13 | 16 | return $self; | |||
| 253 | } | |||||
| 254 | ||||||
| 255 - 261 | =head2 offset $q->offset(40); Skip the first N rows (for pagination with L</limit>). Returns C<$self>. =cut | |||||
| 262 | ||||||
| 263 | sub offset | |||||
| 264 | { | |||||
| 265 | 8 | 12 | my ($self, $n) = @_; | |||
| 266 | 8 | 9 | $self->{'_offset'} = $n; | |||
| 267 | 8 | 48 | return $self; | |||
| 268 | } | |||||
| 269 | ||||||
| 270 | # Apply Perl-side sort, offset, and limit to an arrayref of rows in place. | |||||
| 271 | # Used by the BerkeleyDB execution paths in all() and first(). | |||||
| 272 | # order_by must be a single "column [ASC|DESC]" string (multi-column not supported). | |||||
| 273 | sub _apply_perl_sort_limit | |||||
| 274 | { | |||||
| 275 | 0 | 0 | my ($rows, $order_by, $offset, $limit) = @_; | |||
| 276 | ||||||
| 277 | 0 | 0 | if(defined $order_by) { | |||
| 278 | 0 | 0 | my ($col, $dir) = ($order_by =~ /^(\S+)(?:\s+(ASC|DESC))?$/i); | |||
| 279 | 0 | 0 | $dir //= 'ASC'; | |||
| 280 | 0 | 0 | @{$rows} = sort { | |||
| 281 | $dir =~ /DESC/i | |||||
| 282 | ? (($b->{$col} // '') cmp ($a->{$col} // '')) | |||||
| 283 | 0 | 0 | : (($a->{$col} // '') cmp ($b->{$col} // '')) | |||
| 284 | 0 0 | 0 0 | } @{$rows}; | |||
| 285 | } | |||||
| 286 | 0 0 | 0 0 | splice(@{$rows}, 0, $offset) if $offset; | |||
| 287 | 0 0 | 0 0 | splice(@{$rows}, $limit) if defined $limit; | |||
| 288 | } | |||||
| 289 | ||||||
| 290 | # Internal: assemble SQL + bind args. $count_only replaces SELECT cols with COUNT(*). | |||||
| 291 | sub _build_sql | |||||
| 292 | { | |||||
| 293 | 52 | 82 | my ($self, $count_only) = @_; | |||
| 294 | ||||||
| 295 | 52 | 43 | my $db = $self->{'_db'}; | |||
| 296 | 52 | 84 | my $table = $db->{'table'} || ref($db); | |||
| 297 | 52 | 77 | $table =~ s/.*:://; | |||
| 298 | ||||||
| 299 | # Ensure the underlying table connection is open | |||||
| 300 | 52 | 67 | $db->_open_table({}); | |||
| 301 | ||||||
| 302 | 52 | 59 | my $select = $count_only ? 'COUNT(*)' : $self->{'_select'}; | |||
| 303 | 52 | 44 | my $query = "SELECT $select FROM $table"; | |||
| 304 | ||||||
| 305 | 52 52 | 32 55 | if(@{$self->{'_joins'}}) { | |||
| 306 | 3 | 13 | $query .= ' ' . $db->_build_joins($self->{'_joins'}); | |||
| 307 | } | |||||
| 308 | ||||||
| 309 | 52 | 111 | my ($where, $wargs) = $db->_build_where($self->{'_where'}); | |||
| 310 | 52 52 | 36 47 | my @args = @{$wargs}; | |||
| 311 | ||||||
| 312 | 52 52 | 39 83 | if(@{$self->{'_joins'}}) { | |||
| 313 | 3 | 5 | $query .= " WHERE $where" if $where; | |||
| 314 | } elsif(($db->{'type'} eq 'CSV') && !$db->{'no_entry'}) { | |||||
| 315 | 2 | 2 | my $id = $db->{'id'}; | |||
| 316 | 2 | 3 | $query .= " WHERE $id IS NOT NULL AND $id NOT LIKE '#%'"; | |||
| 317 | 2 | 3 | $query .= " AND ($where)" if $where; | |||
| 318 | } else { | |||||
| 319 | 47 | 47 | $query .= " WHERE $where" if $where; | |||
| 320 | } | |||||
| 321 | ||||||
| 322 | 52 | 59 | unless($count_only) { | |||
| 323 | 44 | 46 | $query .= " ORDER BY $self->{'_order_by'}" if defined $self->{'_order_by'}; | |||
| 324 | 44 | 51 | $query .= " LIMIT $self->{'_limit'}" if defined $self->{'_limit'}; | |||
| 325 | 44 | 47 | $query .= " OFFSET $self->{'_offset'}" if defined $self->{'_offset'}; | |||
| 326 | } | |||||
| 327 | ||||||
| 328 | 52 | 86 | return ($query, \@args, $table); | |||
| 329 | } | |||||
| 330 | ||||||
| 331 - 339 | =head2 all my $rows = $q->all(); B<Terminal method.> Executes the assembled query and returns an array reference of hash references, one per matching row. Returns an empty array reference when there are no matches (never C<undef>). =cut | |||||
| 340 | ||||||
| 341 | sub all | |||||
| 342 | { | |||||
| 343 | 36 | 371 | my $self = shift; | |||
| 344 | 36 | 44 | my $db = $self->{'_db'}; | |||
| 345 | ||||||
| 346 | # Ensure _open() fires before checking the backend type. | |||||
| 347 | 36 | 68 | $db->_open_table({}); | |||
| 348 | ||||||
| 349 | 36 | 48 | if($db->{'berkeley'}) { | |||
| 350 | croak(ref($db), ': query->all() with JOINs is not supported on BerkeleyDB') | |||||
| 351 | 0 0 | 0 0 | if @{$self->{'_joins'}}; | |||
| 352 | 0 0 | 0 0 | my $rows = $db->selectall_arrayref({%{$self->{'_where'}}}); | |||
| 353 | 0 | 0 | _apply_perl_sort_limit($rows, $self->{'_order_by'}, $self->{'_offset'}, $self->{'_limit'}); | |||
| 354 | 0 | 0 | return $rows; | |||
| 355 | } | |||||
| 356 | ||||||
| 357 | 36 | 45 | my ($query, $args, $table) = $self->_build_sql(0); | |||
| 358 | 36 | 69 | $db->_debug("Query->all: $query"); | |||
| 359 | ||||||
| 360 | 36 | 766 | my $sth = $db->{$table}->prepare_cached($query); | |||
| 361 | 36 0 36 | 7973 0 682 | $sth->execute(@{$args}) or croak("$query: @{$args}"); | |||
| 362 | ||||||
| 363 | 36 | 2847 | my @rows; | |||
| 364 | 36 | 307 | while(my $row = $sth->fetchrow_hashref()) { | |||
| 365 | 110 | 793 | push @rows, $row; | |||
| 366 | } | |||||
| 367 | 36 | 105 | return \@rows; | |||
| 368 | } | |||||
| 369 | ||||||
| 370 - 379 | =head2 first my $row = $q->first(); # \%hashref or undef B<Terminal method.> Executes the query with C<LIMIT 1> and returns the first matching row as a hash reference, or C<undef> when there is no match. Any C<limit()> or C<offset()> you have set is temporarily overridden for efficiency (only the LIMIT is overridden; offset is still applied). =cut | |||||
| 380 | ||||||
| 381 | sub first | |||||
| 382 | { | |||||
| 383 | 8 | 7 | my $self = shift; | |||
| 384 | 8 | 8 | my $db = $self->{'_db'}; | |||
| 385 | ||||||
| 386 | 8 | 14 | $db->_open_table({}); | |||
| 387 | ||||||
| 388 | 8 | 11 | if($db->{'berkeley'}) { | |||
| 389 | croak(ref($db), ': query->first() with JOINs is not supported on BerkeleyDB') | |||||
| 390 | 0 0 | 0 0 | if @{$self->{'_joins'}}; | |||
| 391 | 0 0 | 0 0 | my $rows = $db->selectall_arrayref({%{$self->{'_where'}}}); | |||
| 392 | 0 | 0 | _apply_perl_sort_limit($rows, $self->{'_order_by'}, $self->{'_offset'}, undef); | |||
| 393 | 0 | 0 | return $rows->[0]; | |||
| 394 | } | |||||
| 395 | ||||||
| 396 | 8 | 8 | my $saved = $self->{'_limit'}; | |||
| 397 | 8 | 9 | $self->{'_limit'} = 1; | |||
| 398 | 8 | 11 | my ($query, $args, $table) = $self->_build_sql(0); | |||
| 399 | 8 | 9 | $self->{'_limit'} = $saved; | |||
| 400 | ||||||
| 401 | 8 | 15 | $db->_debug("Query->first: $query"); | |||
| 402 | ||||||
| 403 | 8 | 186 | my $sth = $db->{$table}->prepare_cached($query); | |||
| 404 | 8 0 8 | 286 0 165 | $sth->execute(@{$args}) or croak("$query: @{$args}"); | |||
| 405 | ||||||
| 406 | 8 | 65 | my $row = $sth->fetchrow_hashref(); | |||
| 407 | 8 | 19 | $sth->finish(); | |||
| 408 | 8 | 15 | return $row; | |||
| 409 | } | |||||
| 410 | ||||||
| 411 - 419 | =head2 count my $n = $q->count(); B<Terminal method.> Executes C<SELECT COUNT(*)> with the current C<WHERE> and C<JOIN> clauses and returns the integer count. C<ORDER BY>, C<LIMIT>, and C<OFFSET> are ignored for the count query. =cut | |||||
| 420 | ||||||
| 421 | sub count | |||||
| 422 | { | |||||
| 423 | 8 | 42 | my $self = shift; | |||
| 424 | 8 | 9 | my $db = $self->{'_db'}; | |||
| 425 | ||||||
| 426 | 8 | 11 | $db->_open_table({}); | |||
| 427 | ||||||
| 428 | 8 | 12 | if($db->{'berkeley'}) { | |||
| 429 | croak(ref($db), ': query->count() with JOINs is not supported on BerkeleyDB') | |||||
| 430 | 0 0 | 0 0 | if @{$self->{'_joins'}}; | |||
| 431 | 0 0 | 0 0 | return $db->count({%{$self->{'_where'}}}); | |||
| 432 | } | |||||
| 433 | ||||||
| 434 | 8 | 10 | my ($query, $args, $table) = $self->_build_sql(1); | |||
| 435 | 8 | 16 | $db->_debug("Query->count: $query"); | |||
| 436 | ||||||
| 437 | 8 | 160 | my $sth = $db->{$table}->prepare_cached($query); | |||
| 438 | 8 0 8 | 199 0 118 | $sth->execute(@{$args}) or croak("$query: @{$args}"); | |||
| 439 | ||||||
| 440 | 8 | 39 | my $row = $sth->fetchrow_arrayref(); | |||
| 441 | 8 | 13 | $sth->finish(); | |||
| 442 | 8 | 20 | return $row ? $row->[0] : 0; | |||
| 443 | } | |||||
| 444 | ||||||
| 445 - 464 | =head1 SEE ALSO L<Database::Abstraction> - the parent module and its L<Database::Abstraction/QUERY CRITERIA> section. =head1 AUTHOR Nigel Horne, C<< <njh at nigelhorne.com> >> =head1 SUPPORT Please report bugs at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Database-Abstraction>. =head1 LICENSE AND COPYRIGHT Copyright 2026 Nigel Horne. Usage is subject to the GPL2 licence terms. =cut | |||||
| 465 | ||||||
| 466 | 1; | |||||