package DBIx::DBO::Table;
use strict;
use warnings;
use Carp 'croak';
use overload '**' => \&column, fallback => 1;
sub _row_class { $_[0]{DBO}->_row_class }
=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<Table> objects are mostly used for column references in a L<Query|DBIx::DBO::Query>.
They can also be used for INSERTs, DELETEs and simple lookups (fetch_*).
=head1 METHODS
=head3 C<new>
DBIx::DBO::Table->new($dbo, $table);
DBIx::DBO::Table->new($dbo, [$schema, $table]);
DBIx::DBO::Table->new($dbo, $table_object);
Create and return a new C<Table> object.
Tables can be specified by their name or an arrayref of schema and table name or another C<Table> object.
=cut
sub new {
my $proto = shift;
UNIVERSAL::isa($_[0], '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<tables>
Return a list of C<Table> objects, which will always be this C<Table> object.
=cut
sub tables {
wantarray ? $_[0] : 1;
}
sub _table_alias {
undef;
}
=head3 C<name>
$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 _quoted_name {
my $me = shift;
defined $me->{_quoted_name} ? $me->{_quoted_name} : ($me->{_quoted_name} = $me->{DBO}{dbd_class}->_qi($me, @$me{qw(Schema Name)}));
}
=head3 C<columns>
Return a list of column names.
=cut
sub columns {
@{$_[0]->{Columns}};
}
=head3 C<column>
$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<column> 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->_quoted_name
unless exists $me->{Column_Idx}{$col};
$me->{Column}{$col} ||= bless [$me, $col], 'DBIx::DBO::Column';
}
=head3 C<row>
Returns a new empty L<Row|DBIx::DBO::Row> object for this table.
=cut
sub row {
my $me = shift;
$me->_row_class->new($me->{DBO}, $me);
}
=head3 C<fetch_row>
$table->fetch_row(%where);
Fetch the first matching row from the table returning it as a L<Row|DBIx::DBO::Row> object.
The C<%where> is a hash of field/value pairs.
The value can be a simple SCALAR or C<undef> for C<NULL>
It can also be a SCALAR reference, which will be used without quoting, or an ARRAY reference for multiple C<IN> 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<fetch_value>
$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->_quoted_name;
$sql .= ' WHERE '.$_ if $_ = $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<fetch_hash>
$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->_quoted_name;
my @bind;
$sql .= ' WHERE '.$_ if $_ = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
$me->{DBO}{dbd_class}->_selectrow_hashref($me, $sql, undef, @bind);
}
=head3 C<fetch_column>
$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->_quoted_name;
$sql .= ' WHERE '.$_ if $_ = $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<insert>
$table->insert(name => 'Richard', age => 103);
Insert a row into the table. Returns true on success or C<undef> on failure.
On supporting databases you may also use C<$table-E<gt>last_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->_quoted_name 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->_quoted_name.' ('.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<last_insert_id>
$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<bulk_insert>
$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<undef> on failure.
The C<columns> need not be passed in, and will default to all the columns in the table.
On supporting databases you may also use C<$table-E<gt>last_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->_quoted_name;
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<delete>
$table->delete(name => 'Richard', age => 103);
Delete all rows from the table matching the criteria. Returns the number of rows deleted or C<undef> on failure.
=cut
sub delete {
my $me = shift;
my $sql = 'DELETE FROM '.$me->_quoted_name;
my @bind;
$sql .= ' WHERE '.$_ if $_ = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
$me->{DBO}{dbd_class}->_do($me, $sql, undef, @bind);
}
=head3 C<truncate>
$table->truncate;
Truncate the table. Returns true on success or C<undef> on failure.
=cut
sub truncate {
my $me = shift;
$me->{DBO}{dbd_class}->_do($me, 'TRUNCATE TABLE '.$me->_quoted_name);
}
=head2 Common Methods
These methods are accessible from all DBIx::DBO* objects.
=head3 C<dbo>
The C<DBO> object.
=head3 C<dbh>
The I<read-write> C<DBI> handle.
=head3 C<rdbh>
The I<read-only> C<DBI> handle, or if there is no I<read-only> connection, the I<read-write> C<DBI> handle.
=cut
sub dbo { $_[0]{DBO} }
sub dbh { $_[0]{DBO}->dbh }
sub rdbh { $_[0]{DBO}->rdbh }
=head3 C<config>
$table_setting = $table->config($option);
$table->config($option => $table_setting);
Get or set the C<Table> config settings. When setting an option, the previous value is returned. When getting an option's value, if the value is undefined, the L<DBIx::DBO|DBIx::DBO>'s value is returned.
See L<DBIx::DBO/Available_config_options>.
=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<DBIx::DBO>
=cut