package DBIx::DBO::Table;
use strict;
use warnings;
use Carp 'croak';
use overload '**' => \&column, fallback => 1;
sub _row_class { $_[0]{DBO}->_row_class }
*_isa = \&DBIx::DBO::DBD::_isa;
=head1 NAME
DBIx::DBO::Table - An OO interface to SQL queries and results. Encapsulates a table in an object.
=head1 SYNOPSIS
# Create a Table object
my $table = $dbo->table('my_table');
# Get a column reference
my $column = $table ** 'employee_id';
# Quickly display my employee id
print $table->fetch_value('employee_id', name => 'Vernon');
# Find the IDs of fired employees
my @fired = @{ $table->fetch_column('id', status => 'fired');
# Insert a new row into the table
$table->insert(employee_id => 007, name => 'James Bond');
# Remove rows from the table where the name IS NULL
$table->delete(name => undef);
=head1 DESCRIPTION
C
objects are mostly used for column references in a L.
They can also be used for INSERTs, DELETEs and simple lookups (fetch_*).
=head1 METHODS
=head3 C
DBIx::DBO::Table->new($dbo, $table);
# or
$dbo->table($table);
Create and return a new C object.
The C<$table> argument that specifies the table can be a string containing the table name, C<'customers'> or C<'history.log'>, it can be an arrayref of schema and table name C<['history', 'log']> or as another Table object to clone.
=cut
sub new {
my $proto = shift;
eval { $_[0]->isa('DBIx::DBO') } or croak 'Invalid DBO Object';
my $class = ref($proto) || $proto;
$class->_init(@_);
}
sub _init {
my($class, $dbo, $table) = @_;
(my $schema, $table, my $info) = $dbo->table_info($table);
bless { %$info, Schema => $schema, Name => $table, DBO => $dbo, LastInsertID => undef }, $class;
}
=head3 C
Return a list of C objects, which will always be this C object.
=cut
sub tables {
wantarray ? $_[0] : 1;
}
sub _table_alias {
undef;
}
=head3 C
$table_name = $table->name;
($schema_name, $table_name) = $table->name;
In scalar context it returns the name of the table in list context the schema and table names are returned.
=cut
sub name {
wantarray ? @{$_[0]}{qw(Schema Name)} : $_[0]->{Name};
}
sub _from {
my $me = shift;
defined $me->{_from} ? $me->{_from} : ($me->{_from} = $me->{DBO}{dbd_class}->_qi($me, @$me{qw(Schema Name)}));
}
=head3 C
Return a list of column names.
=cut
sub columns {
@{$_[0]->{Columns}};
}
=head3 C
$table->column($column_name);
$table ** $column_name;
Returns a reference to a column for use with other methods.
The C<**> method is a shortcut for the C method.
=cut
sub column {
my($me, $col) = @_;
croak 'Missing argument for column' unless defined $col;
croak 'Invalid column '.$me->{DBO}{dbd_class}->_qi($me, $col).' in table '.$me->_from
unless exists $me->{Column_Idx}{$col};
$me->{Column}{$col} ||= bless [$me, $col], 'DBIx::DBO::Column';
}
*_inner_col = \&column;
=head3 C
Returns a new empty L object for this table.
=cut
sub row {
my $me = shift;
$me->_row_class->new($me->{DBO}, $me);
}
=head3 C
$table->fetch_row(%where);
Fetch the first matching row from the table returning it as a L object.
The C<%where> is a hash of field/value pairs.
The value can be a simple SCALAR or C for C
It can also be a SCALAR reference, which will be used without quoting, or an ARRAY reference for multiple C values.
$someone = $table->fetch_row(age => 21, join_date => \'CURDATE()', end_date => undef);
$a_child = $table->fetch_row(name => \'NOT NULL', age => [5 .. 15]);
=cut
sub fetch_row {
my $me = shift;
$me->row->load(@_);
}
=head3 C
$table->fetch_value($column, %where);
Fetch the first matching row from the table returning the value in one column.
=cut
sub fetch_value {
my($me, $col) = splice @_, 0, 2;
my @bind;
$col = $me->{DBO}{dbd_class}->_build_val($me, \@bind, $me->{DBO}{dbd_class}->_parse_col_val($me, $col));
my $sql = "SELECT $col FROM ".$me->_from;
my $clause;
$sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
my $ref = $me->{DBO}{dbd_class}->_selectrow_arrayref($me, $sql, undef, @bind);
return $ref && $ref->[0];
}
=head3 C
$table->fetch_hash(%where);
Fetch the first matching row from the table returning it as a hashref.
=cut
sub fetch_hash {
my $me = shift;
my $sql = 'SELECT * FROM '.$me->_from;
my @bind;
my $clause;
$sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
$me->{DBO}{dbd_class}->_selectrow_hashref($me, $sql, undef, @bind);
}
=head3 C
$table->fetch_column($column, %where);
Fetch all matching rows from the table returning an arrayref of the values in one column.
=cut
sub fetch_column {
my($me, $col) = splice @_, 0, 2;
my @bind;
$col = $me->{DBO}{dbd_class}->_build_val($me, \@bind, $me->{DBO}{dbd_class}->_parse_col_val($me, $col));
my $sql = "SELECT $col FROM ".$me->_from;
my $clause;
$sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
$me->{DBO}{dbd_class}->_sql($me, $sql, @bind);
return $me->rdbh->selectcol_arrayref($sql, undef, @bind);
}
=head3 C
$table->insert(name => 'Richard', age => 103);
Insert a row into the table. Returns true on success or C on failure.
On supporting databases you may also use C<$table-Elast_insert_id> to retreive
the autogenerated ID (if there was one) from the last inserted row.
=cut
sub insert {
my $me = shift;
croak 'Called insert() without args on table '.$me->_from unless @_;
croak 'Wrong number of arguments' if @_ & 1;
my @cols;
my @vals;
my @bind;
my %remove_duplicates;
while (@_) {
my @val = $me->{DBO}{dbd_class}->_parse_val($me, pop);
my $col = $me->{DBO}{dbd_class}->_build_col($me, $me->{DBO}{dbd_class}->_parse_col($me, pop));
next if $remove_duplicates{$col}++;
push @cols, $col;
push @vals, $me->{DBO}{dbd_class}->_build_val($me, \@bind, @val);
}
my $sql = 'INSERT INTO '.$me->_from.' ('.join(', ', @cols).') VALUES ('.join(', ', @vals).')';
$me->{DBO}{dbd_class}->_sql($me, $sql, @bind);
my $sth = $me->dbh->prepare($sql) or return undef;
my $rv = $sth->execute(@bind) or return undef;
$me->{LastInsertID} = $me->{DBO}{dbd_class}->_save_last_insert_id($me, $sth);
return $rv;
}
=head3 C
$table->insert(name => 'Quentin');
my $row_id = $table->last_insert_id;
Retreive the autogenerated ID (if there was one) from the last inserted row.
Returns the ID or undef if it's unavailable.
=cut
sub last_insert_id {
my $me = shift;
$me->{LastInsertID};
}
=head3 C
$table->bulk_insert(
columns => [qw(id name age)], # Optional
rows => [{name => 'Richard', age => 103}, ...]
);
$table->bulk_insert(
columns => [qw(id name age)], # Optional
rows => [[ undef, 'Richard', 103 ], ...]
);
Insert multiple rows into the table.
Returns the number of rows inserted or C on failure.
The C need not be passed in, and will default to all the columns in the table.
On supporting databases you may also use C<$table-Elast_insert_id> to retreive
the autogenerated ID (if there was one) from the last inserted row.
=cut
sub bulk_insert {
my($me, %opt) = @_;
croak 'The "rows" argument must be an arrayref' if ref $opt{rows} ne 'ARRAY';
my $sql = 'INSERT INTO '.$me->_from;
my @cols;
if (defined $opt{columns}) {
@cols = map $me->column($_), @{$opt{columns}};
$sql .= ' ('.join(', ', map $me->{DBO}{dbd_class}->_build_col($me, $_), @cols).')';
@cols = map $_->[1], @cols;
} else {
@cols = @{$me->{Columns}};
}
$sql .= ' VALUES ';
$me->{DBO}{dbd_class}->_bulk_insert($me, $sql, \@cols, %opt);
}
=head3 C
$table->delete(name => 'Richard', age => 103);
Delete all rows from the table matching the criteria. Returns the number of rows deleted or C on failure.
=cut
sub delete {
my $me = shift;
my $sql = 'DELETE FROM '.$me->_from;
my @bind;
my $clause;
$sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
$me->{DBO}{dbd_class}->_do($me, $sql, undef, @bind);
}
=head3 C
$table->truncate;
Truncate the table. Returns true on success or C on failure.
=cut
sub truncate {
my $me = shift;
$me->{DBO}{dbd_class}->_do($me, 'TRUNCATE TABLE '.$me->_from);
}
=head2 Common Methods
These methods are accessible from all DBIx::DBO* objects.
=head3 C
The C object.
=head3 C
The I C handle.
=head3 C
The I C handle, or if there is no I connection, the I C handle.
=cut
sub dbo { $_[0]{DBO} }
sub dbh { $_[0]{DBO}->dbh }
sub rdbh { $_[0]{DBO}->rdbh }
=head3 C
$table_setting = $table->config($option);
$table->config($option => $table_setting);
Get or set the C config settings. When setting an option, the previous value is returned. When getting an option's value, if the value is undefined, the L's value is returned.
See L.
=cut
sub config {
my $me = shift;
my $opt = shift;
return $me->{DBO}{dbd_class}->_set_config($me->{Config} ||= {}, $opt, shift) if @_;
$me->{DBO}{dbd_class}->_get_config($opt, $me->{Config} ||= {}, $me->{DBO}{Config}, \%DBIx::DBO::Config);
}
sub DESTROY {
undef %{$_[0]};
}
1;
__END__
=head1 SEE ALSO
L
=cut