view release on metacpan or  search on metacpan

lib/DBIx/DBO/Query.pm  view on Meta::CPAN

package DBIx::DBO::Query;

use 5.014;
use warnings;
use DBIx::DBO;

use Carp 'croak';
use Devel::Peek 'SvREFCNT';
use Hash::Util 'hv_store';
use Scalar::Util 'weaken';

use overload '**' => \&column, fallback => 1;

sub table_class { $_[0]{DBO}->table_class }
sub row_class { $_[0]{DBO}->row_class }

*_isa = \&DBIx::DBO::DBD::_isa;

=head1 NAME

DBIx::DBO::Query - An OO interface to SQL queries and results.  Encapsulates an entire query in an object.

=head1 SYNOPSIS

  # Create a Query object by JOINing 2 tables
  my $query = $dbo->query('my_table', 'my_other_table');
  
  # Get the Table objects from the query
  my($table1, $table2) = $query->tables;
  
  # Add a JOIN ON clause
  $query->join_on($table1 ** 'login', '=', $table2 ** 'username');
  
  # Find our ancestors, and order by age (oldest first)
  $query->where('name', '=', 'Adam');
  $query->where('name', '=', 'Eve');
  $query->order_by({ COL => 'age', ORDER => 'DESC' });
  
  # New Query using a LEFT JOIN
  ($query, $table1) = $dbo->query('my_table');
  $table2 = $query->join_table('another_table', 'LEFT');
  $query->join_on($table1 ** 'parent_id', '=', $table2 ** 'child_id');
  
  # Find those not aged between 20 and 30.
  $query->where($table1 ** 'age', '<', 20, FORCE => 'OR'); # Force OR so that we get: (age < 20 OR age > 30)
  $query->where($table1 ** 'age', '>', 30, FORCE => 'OR'); # instead of the default: (age < 20 AND age > 30)

=head1 DESCRIPTION

A C<Query> object represents rows from a database (from one or more tables). This module makes it easy, not only to fetch and use the data in the returned rows, but also to modify the query to return a different result set.

=head1 METHODS

=head3 C<new>

  DBIx::DBO::Query->new($dbo, $table1, ...);
  # or
  $dbo->query($table1, ...);

Create a new C<Query> object from the tables specified.
In scalar context, just the C<Query> object will be returned.
In list context, the C<Query> object and L<Table|DBIx::DBO::Table> objects will be returned for each table specified.
Tables can be specified with the same arguments as L<DBIx::DBO::Table/new> or another Query can be used as a subquery.

  my($query, $table1, $table2) = DBIx::DBO::Query->new($dbo, 'customers', ['history', 'transactions']);

You can also pass in a Query instead of a Table to use that query as a subquery.

  my $subquery = DBIx::DBO::Query->new($dbo, 'history.transactions');
  my $query = DBIx::DBO::Query->new($dbo, 'customers', $subquery);

lib/DBIx/DBO/Query.pm  view on Meta::CPAN

Returns undefined if there is an error or is unable to determine the number of found rows.

=cut

sub found_rows {
    my $me = shift;
    return $me->{Found_Rows} // $me->{DBO}{dbd_class}->_calc_found_rows($me);
}

=head3 C<update>

  $query->update(department => 'Tech');
  $query->update(salary => { FUNC => '? * 1.10', COL => 'salary' }); # 10% raise

Updates every row in the query with the new values specified.
Returns the number of rows updated or C<'0E0'> for no rows to ensure the value is true,
and returns false if there was an error.

=cut

sub update {
    my $me = shift;
    my @update = $me->{DBO}{dbd_class}->_parse_set($me, @_);
    my $sql = $me->{DBO}{dbd_class}->_build_sql_update($me, @update);
    $me->{DBO}{dbd_class}->_do($me, $sql, undef, $me->{DBO}{dbd_class}->_bind_params_update($me));
}

=head3 C<sql>

  my $sql = $query->sql;

Returns the SQL statement string.

=cut

sub _recursion_check {
    my($me, @upquery) = @_;

    state @_recursion_check;
    push @_recursion_check, $me;

    for my $upquery (@upquery) {
        if (grep $upquery eq $_, @_recursion_check) {
            undef @_recursion_check;
            croak 'Recursive subquery found';
        }
        exists $upquery->{up_queries}
            and $upquery->_recursion_check(grep defined($_), @{ $upquery->{up_queries} });
    }

    pop @_recursion_check;
}

sub _add_up_query {
    my($me, $upquery) = @_;

    $me->_recursion_check($upquery);

    my $uq = $me->{up_queries} //= [];
    push @$uq, $upquery;
    weaken $uq->[-1];
}

sub sql {
    my $me = shift;
    return $me->{DBO}{dbd_class}->_build_sql_select($me);
}

sub _inactivate {
    my $me = shift;
    $me->_empty_row;
    # Also inactivate super queries
    if (exists $me->{up_queries}) {
        defined $_ and $_->_inactivate for @{ $me->{up_queries} };
    }
    # Reset the query
    delete $me->{cache};
    undef $me->{sth};
    undef $me->{sql};
    undef $me->{bind};
    undef $me->{hash};
    undef $me->{Active};
    undef $me->{Row_Count};
    undef $me->{Found_Rows};
    undef @{$me->{Columns}};
}

=head3 C<finish>

  $query->finish;

Calls L<DBI-E<gt>finish|DBI/"finish"> on the statement handle, if it's active.
Restarts cached queries from the first row (if created using the C<CacheQuery> config).
This ensures that the next call to L</fetch> will return the first row from the query.

=cut

sub finish {
    my $me = shift;
    $me->_empty_row;
    # Restart the query
    if (exists $me->{cache}) {
        $me->{cache}{idx} = 0;
    } else {
        $me->{sth}->finish if $me->{sth} and $me->{sth}{Active};
        $me->{Active} = 0;
    }
}

sub _empty_row {
    my $me = shift;
    # Detach or empty the Row
    if (defined $me->{Row}) {
        if (SvREFCNT(${$me->{Row}}) > 1) {
            $me->{Row}->_detach;
        } else {
            undef ${$me->{Row}}->{array};
            ${$me->{Row}}->{hash} = {};
        }
    }
}