package SQL::Entity::Table;
use warnings;
use strict;
use vars qw($VERSION);
$VERSION = 0.02;
use Abstract::Meta::Class ':all';
use Carp 'confess';
use SQL::Entity::Column;
=head1 NAME
SQL::Entity::Table - Database table abstraction
=head1 SYNOPSIS
use SQL::Entity::Table;
use'SQL::Entity::Column ':all';
my $table = SQL::Entity::Table->new(
name => 'emp'
columns => [sql_column(name => 'empno')]
);
my ($sql) = $table->query;
my $dept = SQL::Entity->new(
name => 'dept',
alias => 'd',
columns => [
sql_column(name => 'deptno'),
sql_column(name => 'dname')
],
);
my $emp = SQL::Entity->new(
name => 'emp',
primary_key => ['empno'],
columns => [
sql_column(name => 'ename'),
sql_column(name => 'empno'),
sql_column(name => 'deptno')
],
);
$emp->add_to_one_relationships(sql_relationship(
table => $dept,
condition => sql_cond($dept->column('deptno'), '=', $entity->column('deptno'))
));
=head1 DESCRIPTION
Represents database table definition.
=head2 EXPORT
None.
all - exports sql_column method
=head2 ATTRIBUTES
=over
=item name
=cut
has '$.name';
=item schema
Table schema name
=cut
has '$.schema';
=item primary_key
=cut
has '@.primary_key';
=item alias
=cut
has '$.alias';
=item columns
=cut
has '%.columns' => (
item_accessor => 'column',
associated_class => 'SQL::Entity::Column',
index_by => 'id',
the_other_end => 'table',
);
=item lobs
=cut
has '%.lobs' => (
item_accessor => 'lob',
associated_class => 'SQL::Entity::Column::LOB',
index_by => 'id',
the_other_end => 'table',
);
=item indexes
=cut
has '%.indexes' => (
item_accessor => '_index',
associated_class => 'SQL::Entity::Index',
index_by => 'name',
);
=item order_index
Index name that will be used to enforce order of the result.
=cut
has '$.order_index';
=back
=head2 METHODS
=over
=item initialise
=cut
sub initialise {
my ($self) = @_;
$self->set_alias($self->name) unless $self->alias;
}
=item unique_columns
Returns list of unique columns
=cut
sub unique_columns {
my ($self) = @_;
(grep { $_->unique } values %{$self->columns});
}
=item query
Returns sql statement and bind variables,
Takes optionally array ref of the requeted columns, condition object, bind_variables reference
=cut
sub query {
my ($self, $requested_columns, $condition, $bind_variables, $join_methods) = @_;
$requested_columns ||=[];
$bind_variables ||= [];
$join_methods ||= {};
my $where_clause = $self->where_clause($condition, $bind_variables, $join_methods);
my $stmt = $self->select_clause($requested_columns, $join_methods)
. $self->from_clause($join_methods)
. $where_clause
. $self->order_by_clause;
wantarray ? ($stmt, $bind_variables) : $stmt;
}
=item count
Retiurn sql and bind variables that returns number of rows for passed in condition,
=cut
sub count {
my ($self, $condition, $bind_variables, $join_methods) = @_;
$bind_variables ||= [];
$join_methods ||= {};
my $where_clause = $self->where_clause($condition, $bind_variables, $join_methods);
my $stmt = "SELECT COUNT(*) AS count"
. $self->from_clause($join_methods)
. $where_clause;
wantarray ? ($stmt, $bind_variables) : $stmt;
}
=item from_clause
Returns "FROM .... " SQL fragment
=cut
sub from_clause {
my ($self, $join_methods) = @_;
"\nFROM "
. $self->from_clause_params($join_methods)
}
=item from_clause_params
Returns FROM operand " table1 " SQL fragment
=cut
sub from_clause_params {
my ($self) = @_;
my $schema = $self->schema;
($schema ? $schema . "." : "")
. $self->name
. $self->from_clause_alias;
}
=item from_clause_alias
Returns table alias
=cut
sub from_clause_alias {
my ($self) = @_;
my $alias = $self->alias;
($alias && $self->name ne $alias ? " $alias" : '')
}
=item select_clause
Returns " SELECT ..." SQL fragment
=cut
sub select_clause {
my ($self, $requested_columns, $join_methods) = @_;
"SELECT "
. $self->select_hint_clause
. join ",\n ", map { $_->as_string($self, $join_methods) } $self->selectable_columns($requested_columns);
}
=item selectable_columns
Returns list of column that can be used in select clause
=cut
sub selectable_columns {
my ($self, $requested_columns) = @_;
confess unless $requested_columns;
my $columns = $self->columns;
if(@$requested_columns) {
return map { $columns->{$_} ? ($columns->{$_}) : () } @$requested_columns;
}
$self->columns ? (values %$columns) : ();
}
=item insertable_columns
Returns list of column that can be used in insert clause
=cut
sub insertable_columns {
my ($self) = @_;
my $query_columns = $self->query_columns;
map {
my $column = $query_columns->{$_};
($column->insertable ? $column : ()) } keys %$query_columns;
}
=item updatable_columns
Returns list of column that can be used in update clause
=cut
sub updatable_columns {
my ($self) = @_;
my $query_columns = $self->query_columns;
map {
my $column = $query_columns->{$_};
($column->updatable ? $column : ()) } keys %$query_columns;
}
=item query_columns
Returns hash_ref with all columns that belongs to this object.
=cut
sub query_columns {
my ($self) = @_;
$self->columns;
}
=item where_clause
Returns " WHERE ..." SQL fragment
=cut
sub where_clause {
my ($self, $condition, $bind_variables, $join_methods) = @_;
return "" unless $condition;
confess "should have condition object"
if ($condition && ref($condition) ne 'SQL::Entity::Condition');
my %query_columns = $self->query_columns;
"\nWHERE " . $condition->as_string(\%query_columns, $bind_variables, $self, $join_methods);
}
=item index
Returns order_index object, if order_index is not set then the first index will be seleted.
=cut
sub index {
my $self = shift;
my $order_index = $self->order_index;
unless ($order_index) {
my $indexes = $self->indexes or return;
($order_index) = (keys %$indexes) or return;
}
$self->_index($order_index);
}
=item select_hint_clause
Return hinst cluase that will be placed as SELECT operand
=cut
sub select_hint_clause {
my ($self) = @_;
""
}
=item order_by_clause
Returns " ORDER BY ..." SQL fragment
=cut
sub order_by_clause {
my ($self) = @_;
my $index = $self->index or return "";
" ORDER BY " . $index->order_by_operand($self);
}
__END__
=back
=head1 SEE ALSO
L<SQL::Query>
L<SQL::Entity>
L<SQL::Entity::Column>
=head1 COPYRIGHT AND LICENSE
The SQL::Entity::Table module is free software. You may distribute under the terms of
either the GNU General Public License or the Artistic License, as specified in
the Perl README file.
=head1 AUTHOR
Adrian Witas, adrian@webapp.strefa.pl
=cut