File Coverage

blib/lib/SQL/Entity.pm

Criterion	Covered	Total	%
statement	167	171	97.6
branch	43	60	71.6
condition	16	28	57.1
subroutine	32	33	96.9
pod	20	20	100.0
total	278	312	89.1

package SQL::Entity;

use warnings;
use strict;
use vars qw(@EXPORT_OK %EXPORT_TAGS $VERSION);
use Storable qw(dclone);

$VERSION = 0.05;

use Abstract::Meta::Class ':all';
use Carp 'confess';
use SQL::Entity::Column ':all';
use SQL::Entity::Column::LOB ':all';
use SQL::Entity::Condition ':all';
use SQL::Entity::Index ':all';
use SQL::Entity::Relationship ':all';

use base qw(Exporter SQL::Entity::Table);

use constant THE_ROWID  => 'the_rowid';

@EXPORT_OK = qw(
  sql_relationship
  sql_column
  sql_lob
  sql_index
  sql_cond
  sql_and
  sql_or
);

%EXPORT_TAGS = (all => \@EXPORT_OK);


=head1 NAME

SQL::Entity - Entity sql abstraction layer.

=head1 CLASS HIERARCHY

 SQL::Entity::Table
    |
    +----SQL::Entity

=head1 SYNOPSIS

    use SQL::Entity;

    my $entity = SQL::Entity->new(
        id                    => 'emp',
        name                  => 'emp',
        unique_expression     => 'rowid',
        columns               => {
            emp_name => sql_column(name => 'ename'),
            emp_no   => sql_column(name => 'empno'),
        },
    );

    my($sql_text, $bind_variables) = $entity->query(
      sql_cond('emp_no', '>', '20')
      ->and(sql_cond('emp_name', 'NOT LIKE', 'HO%'))
    )

    # select from database
    .... do some stuff

    my ($sql_text, $bind_variables) = $entity->insert(
        emp_no   => '0',
        emp_name => 'Smith',
    );

    # insert row/s
    ... do some stuff

    my ($sql_text, $bind_variables) = $entity->update(
        { ename => 'Smith'},
        { empno => '20'} #pk values
    );

    # update row
    ... do some stuff

    my ($sql_text, $bind_variables) = $entity->delete(
        empno => '20'
    );
    # delete row/s
    ... do some stuff


    my $dept = SQL::Entity->new(
        name    => 'dept',
        columns => [
            sql_column(name => 'deptno'),
            sql_column(name => 'dname')
        ],
    );

    my $emp = SQL::Entity->new(
        name                  => 'emp',
        primary_key           => ['empno'],
        unique_expression     => 'rowid',
        columns               => [
            sql_column(name => 'ename'),
            sql_column(name => 'empno'),
            sql_column(name => 'deptno')
        ],
    );


    $emp->add_to_one_relationships(sql_relationship(
        target_entity => $dept,
        condition     => sql_cond($dept->column('deptno'), '=', $entity->column('deptno'))
        # or join_columns => ['deptno'],
    ));

    $emp->add_subquery_columns($dept->column('dname'));


=head1 DESCRIPTION

This class uses entity meta definition to generate different kinds of sql statmements.

=head2 EXPORT

  sql_column
  sql_lob
  sql_index
  sql_cond
  sql_and
  sql_or by 'all' tag

=head2 ATTRIBUTES

=over

=item id

=cut

has '$.id';


=item query_from

SQL fragment.

=cut

has '$.query_from';


=item query_from_helper

Code referebce that may transform query_from

=cut

has '&.query_from_helper';


=item columns

=cut

has '%.subquery_columns' => (
    item_accessor    => 'subquery_column',
    associated_class => 'SQL::Entity::Column',
    index_by         => 'id',
    the_other_end    => 'entity',
);


=item unique_expression

Expression that's value will be used to identifying the unique row in Entity.
It may be any column or pseudo column like ROWID for Oracle,
or expression like PK_COLUMN1||PK_COLUMN2

=cut


has '$.unique_expression';


=item unique_row_column

Association to the column object that based on unique_expression.

=cut

has '$.unique_row_column';


=item to_one_relations

Association many_to_one, or one_to_one tables.

=cut

has '%.to_one_relationships' => (associated_class => 'SQL::Entity::Relationship', item_accessor => 'to_one_relationship', index_by => 'name');


=item to_many_relations

Association many_to_many, or one_to_many tables.
To many relation implicitly creates to one relation on the reflective entity.

=cut


has '%.to_many_relationships' => (
    associated_class => 'SQL::Entity::Relationship',
    item_accessor    => 'to_many_relationship',
    index_by         => 'name',
    on_change        => sub {
        my ($self, $attribute, $scope, $value, $key) = @_;
        if($scope eq 'mutator') {
            foreach my $relation (values %$$value) {
                $relation->associate_the_other_end($self);
            }

        } else {
            $$value->associate_the_other_end($self);
        }
        $self;
    }
);


=item sql_template_parameters

Allows use mini language variable,

    SELECT t.* FROM
    (SELECT t.* FROM tab t WHERE t.col1 = [% var1 %]) t

=cut

has '%.sql_template_parameters' => (item_accessor => 'sql_template_parameter');


=item dml_generator

Represents class that will be used to generate DML statements.
SQL::DMLGenerator by default.

=cut

{
    my %loaded;
    has '$.dml_generator' => (
        default => 'SQL::DMLGenerator',
        on_read => sub {
            my ($self, $attribute, $scope, $value) = @_;
            my $result = $attribute->get_value($self);
            unless ($loaded{$result}) {
                my $module = $result;
                $module =~ s/::/\//g;
                $module  .= ".pm";
                eval {
                    require $module;
                    $loaded{$result} = 1;
                }
            }
            $result;
        }
    );
}


=back

=head2 METHODS

=over

=item initialise

=cut

sub initialise {
    my ($self) = @_;
    $self->SUPER::initialise();
    unless  ($self->id) {
        my $schema = $self->schema;
        $self->set_id(($schema ? $schema ."." :"") .  $self->name);
    }
    $self->initialise_unique_row_column;
}


=item initialise_unique_row_column

=cut

sub initialise_unique_row_column {
    my ($self) = @_;
    unless ($self->unique_expression) {
        my @pk = $self->primary_key;
        confess "unique_expression or primary_key is required"
        unless(@pk);
        my $alias = @pk > 1 ? $self->alias : "";
        $self->unique_expression( join "||", @pk);
    }

    if ($self->unique_expression) {
        my $unique_expression = $self->unique_expression;
        $self->set_unique_row_column(
            sql_column(
                ($unique_expression =~ m/[^\w]/ ? 'expression' :  'name') => $self->unique_expression,
                id         => THE_ROWID() ,
                table      => $self,
                updatable  => 0,
                insertable => 0,
            )
        );
    }
}



=item set_relationship_join_method

Sets join methods

=cut

sub set_relationship_join_method {
    my ($self, $column, $method, $join_methods) = @_;
    my $table = $column->table;
    if ($table && $table ne $self) {
        return if $join_methods->{$table->id};
        $join_methods->{$table->id} = $method;
    }
}


=item query

Returns sql statement and bind variables,
Takes optionally array ref of the requeted columns (undef returns all entity columns), condition object, bind_variables reference

    my ($sql, $bind_variables) = $entity->query(undef,
      sql_cond('empno', '>', '20')->and(sql_cond('dname', 'NOT LIKE', 'HO%'))
    );

=cut


sub query {
    my ($self, @args) = @_;
    my ($sql, $bind_variables) = $self->SUPER::query(@args);
    $sql = $self->parse_template_parameters($sql);
    ($sql, $bind_variables);
}


=item lock

Returns sql that locks all rows that meets passed in condition
It uses SELECT ... FOR UPDATE pattern.
Takes optionally array ref of the requeted columns, condition object, bind_variables reference

    my ($sql, $bind_variables) = $entity->lock(undef,
      sql_cond('empno', '>', '20')->and(sql_cond('dname', 'NOT LIKE', 'HO%'))
    );

=cut

sub lock {
    my ($self, @args) = @_;
    my ($sql, $bind_variables) = $self->SUPER::query(@args);
    $sql .= " FOR UPDATE";
    ($sql, $bind_variables);
}


=item insert

Returns insert sql statement and bind variables

    my ($sql, $bind_variables) = $entity->insert(
        dname  => 'hr',
        deptno => '10',
        ename  => 'adi',
        empno => '1',
    );

=cut

sub insert {
    my ($self, %args) = @_;
    my @columns = $self->insertable_columns;
    my %field_values;
    foreach my $column (@columns) {
        my $name = $column->name;
        $field_values{$name} = $args{$name};
    }
    my $dml_generator = $self->dml_generator;
    $dml_generator->insert($self, \%field_values);
}


=item update

Returns update sql statement and bind variables

    my ($sql, $bind_variables) = $entity->update(
        {dname  => 'hr',
        deptno => '10',
        ename  => 'adi',
        empno => '1',},
        {the_rowid => 'AAAMgzAAEAAAAAgAAB'},
    );

=cut

sub update {
    my ($self, $fields_values, $conditions) = @_;
    my @columns = $self->updatable_columns;
    my %field_values;

    foreach my $column (@columns) {
        my $name = $column->name;
        next unless exists($fields_values->{$name});
        $field_values{$name} = $fields_values->{$name};
    }

    my $dml_generator = $self->dml_generator;
    $dml_generator->update($self, \%field_values, $conditions);

}


=item delete

Returns deletes sql statement and bind variables

    my ($sql, $bind_variables) = $entity->delete(empno => '1');

=cut

sub delete {
    my ($self, @args) = @_;
    my $dml_generator = $self->dml_generator;
    $dml_generator->delete($self, @args);
}


=item unique_condition_values

Returns condition that uniquely identify the entity.
Takes the entity fields values, and validation flag.
If validation flag is true, then exception will be raise if there are not condition values.

=cut

sub unique_condition_values {
    my ($self, $fields_values, $validate) = @_;
    my $column = $self->unique_row_column;
    my %result;
    if ($fields_values && $column && (defined $fields_values->{$column->id} || ($column->name && $fields_values->{$column->name}))) {
        my $column_name = $column->name || $column->expression;
        my $value = ($fields_values->{$column->id} || $fields_values->{$column_name});
        $result{$column_name} = $value if $value;

    } else {
        my @pk = $self->primary_key;
        for my $column (@pk) {
            next unless exists $fields_values->{$column};
            my $value = $fields_values->{$column};
            $result{$column} = $value if defined $value;
        }
    }
    unless (%result) {
        my @columns = values %{$self->columns};
        for my $column (@columns) {
            if($column->unique) {
                my $column_name= $column->name;
                my $value = $fields_values->{$column_name};
                if (defined $value) {
                    $result{$column_name} = $value;
                    last;
                }
            }
        }
        confess "cant find unique value: on dataset: \n\t" . join ",\n\t", map { $_ . " => " . ($fields_values->{$_} || '')} keys %$fields_values
            if !(%result) && $validate;
    }

    wantarray ? (%result) : \%result;
}


=item selectable_columns

Retuns list of columns that can be selected.
Takes requested columns as parameter.

=cut

sub selectable_columns {
    my ($self, $requested_columns) = @_;
    my $subquery_columns = $self->subquery_columns;
    my @result = ($self->unique_row_column, (values %$subquery_columns), $self->SUPER::selectable_columns($requested_columns));
    if (@$requested_columns) {
        my %column_hash = map {$_->id, $_} @result;
        return map {$column_hash{$_} ? ($column_hash{$_}) : ()} @$requested_columns;
    }
    @result;
}



=item from_sql_clause

Returns FROM .. sql fragment without join.

=cut

sub from_sql_clause {
    my ($self, $join_methods) = @_;
    my $query_from = $self->query_from;
    my $query_from_helper = $self->query_from_helper;
    $query_from = $query_from_helper->($self)
        if $query_from_helper;
    my $alias = $self->alias;
    my $name = $self->name;
    ($query_from
      ? "( $query_from )" . $self->from_clause_alias
      : $self->SUPER::from_clause_params($join_methods))
}


=item from_clause_params

Returns FROM sql frgments with join clause.

=cut

sub from_clause_params {
    my ($self, $join_methods) = @_;
    $self->from_sql_clause($join_methods) . $self->join_clause($join_methods);
}


=item join_clause

Returns "JOIN ... " sql fragment for all to one relationship

=cut

sub join_clause {
    my ($self, $join_methods) = @_;
    my $result = '';
    foreach my $k (keys %$join_methods) {
        my $relation = ($self->to_one_relationship($k) || $self->to_many_relationship($k)) or return '';
        my $target_entity = $relation->target_entity;
        my $join_method = $join_methods->{$k};
        next if $join_method ne 'JOIN';
        my $condition = $relation->condition;
        my %query_columns = $target_entity->query_columns;
        $result .= "\n${join_method} "
        . $target_entity->from_clause_params($join_methods)
        . " ON (" . $relation->join_condition_as_string($self) . ")";

    }
    $result;
}


=item relationship_query

Returns sql query + bind_variables to many relationship

=cut

sub relationship_query {
    my ($self, $relation_name, @args) = @_;
    my $relationship = $self->relationship($relation_name)
        or confess "cant find relationship ${relation_name}";
    my $entity = $relationship->target_entity;
    my ($sql, $bind_variables) = $entity->query();
    my $condition = $self->condition_converter(@args);
    $sql .= "\nWHERE EXISTS (SELECT 1 FROM "
        . $self->from_sql_clause
        . " WHERE " . $relationship->join_condition_as_string($self, $bind_variables, $condition) .")"
        . $relationship->order_by_clause;
    ($sql, $bind_variables);
}


=item normalise_field_names

Replaces all keys that are passed in as alias to column name
for instance we have the folllowing SQL: SELECT ename as name, id, loc FROM emp
name will be replaced to ename.

=cut

sub normalise_field_names {
    my ($self, @args) = @_;
    my %columns = $self->query_columns;
    my @result;
    for(my $i = 0; $i < $#args; $i +=2) {
        my $column = $args[$i];
        push @result, (($columns{$column} ? $columns{$column}->name : $column), $args[$i + 1]);
    }
    @result
}


=item relationship

Return relationship object, takes relationship name.

=cut

sub relationship {
    my ($self, $relation_name) = @_;
    my $result = $self->to_many_relationship($relation_name) || $self->to_one_relationship($relation_name) || '';
    confess "cant find relationship $result" unless $result;
    $result;
}

=item query_columns

All columns that belongs to this object.

=cut


sub query_columns {
    my ($self) = @_;
    (THE_ROWID() =>  $self->unique_row_column, $self->subquery_columns, $self->SUPER::query_columns);
}


=item condition_converter

Converts passed in argumets to condition object

=cut

sub condition_converter {
    my ($self, @args) = @_;
    (@args > 1)
        ? SQL::Entity::Condition->struct_to_condition(@args)
        : $args[0];
}


=item parse_template_parameters

Parses template variables.

=cut

sub parse_template_parameters {
    my ($self, $sql) = @_;
    my $sql_template_parameters = $self->sql_template_parameters or return $sql;
    for my $k (keys %$sql_template_parameters) {
        my $value = $sql_template_parameters->{$k};
        $sql =~ s/\[\%\s+$k\s+\%\]/$value/g;
    }
    $sql;
}


=item clone

Clones this entity

=cut

sub clone {
    my $self = shift;
    dclone $self;
}

1;

__END__