The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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