File Coverage

lib/SQL/Admin/Driver/Base/Evaluate.pm

Criterion	Covered	Total	%
statement	131	172	76.1
branch	10	18	55.5
condition	3	6	50.0
subroutine	45	61	73.7
pod	0	53	0.0
total	189	310	60.9

package SQL::Admin::Driver::Base::Evaluate;

use strict;
use warnings;

our $VERSION = v0.5.0;

######################################################################

use SQL::Admin::Utils qw( refarray refhash );

######################################################################

our $AUTOLOAD;
our $WARN_ON_AUTOLOAD = 1;

######################################################################
######################################################################
sub new {                                # ;
    my ($class, %param) = @_;

    bless \ %param, ref $class || $class;
}


######################################################################
######################################################################
sub evaluate {                           # ;
    my $self = shift;
    my $owner = shift;

    $self->__process ($owner, $_) for @_;

    $owner;
}


######################################################################
######################################################################
sub __process {                          # ;
    my ($self, $owner, $def) = @_;

    return $def
      unless ref $def;

    return [ map $self->__apply ($owner, %$_), @$def ]
      if refarray $def;

    return map $self->__call ($owner, $_, $def), keys %$def
      if refhash $def;
}


######################################################################
######################################################################
sub __apply {                            # ;
    my ($self, $owner, $method, $def) = @_;

    # print "# >> [APPLY] $method";
    $self->$method ($owner, $def);
}


######################################################################
######################################################################
sub __call {                             # ;
    my ($self, $owner, $method, $def) = @_;

    # print "# >> [CALL ] $method";

    return unless refhash $def;
    return unless exists $def->{$method};

    $self->$method ($owner, $def->{$method}, $def);
}


######################################################################
######################################################################

sub create_schema {                      # ;
    my ($self, $owner, $def) = @_;

    my $obj = $owner->add (schema => (name => $def->{schema_identifier}));

    #my $previous = $owner->default_schema;
    #$owner->default_schema ($obj);
    #$self->__process ($owner, $def->{schema_statements});
    #$owner->default_schema ($previous);

    ##################################################################

    $obj;
}


######################################################################
######################################################################

sub schema_qualified_name {              # ;
    my ($self, $owner, $def) = @_;

    %$def,
}


######################################################################
######################################################################
sub data_type {                          # ;
    my ($self, $owner, $type, $parent) = @_;
    $type = { type => $type };

    if (refhash $parent and defined $parent->{size}) {
        $type->{size}  = $parent->{size};
        $type->{scale} = $parent->{scale} if defined $parent->{scale};
    }

    $type;
}


######################################################################
######################################################################
sub column_name {                        # ;
    my ($self, $owner, $def) = @_;

    $def;
}


######################################################################
######################################################################
sub column_order {                       # ;
    my ($self, $owner, $def) = @_;

    map uc, grep defined $_, $def;
}


######################################################################
######################################################################
sub ordered_column_name {                # ;
    my ($self, $owner, $def) = @_;

    [ grep $_, (
        $self->__call ($owner, column_name  => $def),
        $self->__call ($owner, column_order => $def),
    )];
}


######################################################################
######################################################################
sub ordered_column_names {               # ;
    my ($self, $owner, $def) = @_;

    [ map $self->ordered_column_name ($owner, $_), @$def ];
}


######################################################################
######################################################################
sub column_list {                        # ;
    my ($self, $owner, $def) = @_;

    [ map $self->column_name ($owner, $_), @$def ];
}

######################################################################
######################################################################

sub connect_to {                         # ;
}


######################################################################
######################################################################
sub commit_work {                        # ;
}


######################################################################
######################################################################

sub create_sequence {                    # ;
    my ($self, $owner, $def) = @_;

    my $obj = $owner->add (sequence => %{ $def->{sequence_name} });
    $self->__call ($obj, sequence_type    => $def);
    $self->__call ($obj, sequence_options => $def);

    $obj;
}


######################################################################
######################################################################
sub sequence_type {                      # ;
    my ($self, $owner, $def) = @_;

    $owner->type ($def);
}


######################################################################
######################################################################
sub sequence_options {                   # ;
    my ($self, $owner, $def) = @_;

    $self->__process ($owner, $def);
}


######################################################################
######################################################################
sub sequence_start_with {                # ;
    my ($self, $owner, $def) = @_;
    $owner->start_with ($def);
}


######################################################################
######################################################################
sub sequence_increment_by {              # ;
    my ($self, $owner, $def) = @_;
    $owner->increment_by ($def);
}


######################################################################
######################################################################
sub sequence_minvalue {                  # ;
    my ($self, $owner, $def) = @_;
    $owner->minvalue ($def);
}


######################################################################
######################################################################
sub sequence_maxvalue {                  # ;
    my ($self, $owner, $def) = @_;
    $owner->maxvalue ($def);
}


######################################################################
######################################################################
sub sequence_cache {                     # ;
    my ($self, $owner, $def) = @_;
    $owner->cache ($def);
}


######################################################################
######################################################################
sub sequence_owner {                     # ;
    my ($self, $owner, $def) = @_;
    $owner->owner ($def);
}


######################################################################
######################################################################

sub create_index {                       # ;
    my ($self, $owner, $def) = @_;

    my $obj = $owner->add (index => %{ $def->{index_name} });
    $obj->table ($owner->get (table => %{ $def->{table_name} }));

    $self->__call ($obj, index_unique      => $def);
    $self->__call ($obj, index_column_list => $def);
    $self->__call ($obj, index_options     => $def);
    $self->__call ($obj, index_hints       => $def);

    $obj;
}


######################################################################
######################################################################
sub index_unique {                       # ;
    my ($self, $owner, $def) = @_;
    $owner->unique ($def);
}


######################################################################
######################################################################
sub index_column_list {                  # ;
    my ($self, $owner, $def) = @_;

    $owner->column_list (
        $self->__apply (0, ordered_column_names => $def)
    );
}


######################################################################
######################################################################
sub index_options {                      # ;
    shift->index_hints (@_);
}


######################################################################
######################################################################
sub index_hints {                        # ;
    my ($self, $owner, $def) = @_;
    while (my @v = each %$def) {
        $owner->hint (@v);
    }
}


######################################################################
######################################################################

sub create_table {                       # ;
    my ($self, $owner, $def) = @_;

    my $obj = $owner->add (table => %{ $def->{table_name}});

    $self->__call ($obj, table_content => $def);
    $self->__call ($obj, table_options => $def);
    $self->__call ($obj, table_hints   => $def);

    $obj;
}


######################################################################
######################################################################
sub table_options {                      # ;
    shift->table_hints (@_);
}


######################################################################
######################################################################
sub table_hints {                        # ;
    my ($self, $owner, $def) = @_;
    while (my @v = each %$def) { $owner->hint (@v); }
}


######################################################################
######################################################################
sub table_content {                      # ;
    my ($self, $owner, $def) = @_;

    $self->__process ($owner, $def);
}


######################################################################
######################################################################
sub column_definition {                  # ;
    my ($self, $owner, $def) = @_;

    my $obj = $owner->add (column => name => $def->{column_name});

    $obj->type ($self->__call (0, data_type => $def));
    $self->__call ($obj, not_null       => $def);
    $self->__call ($obj, column_not_null       => $def);
    $self->__call ($obj, default_clause => $def);
    $self->__call ($obj, autoincrement  => $def);

    $obj;
}


######################################################################
######################################################################
sub column_not_null {                    # ;
    my ($self, $owner, $def) = @_;

    $owner->not_null (1);
}


######################################################################
######################################################################
sub default_clause {                     # ;
    my ($self, $owner, $def) = @_;

    $owner->default ($def);
}


######################################################################
######################################################################
sub autoincrement {                      # ;
    my ($self, $owner, $def) = @_;

    $owner->autoincrement (1);
    while (my @v = each %$def) { $owner->autoincrement_hint (@v); }
}


######################################################################
######################################################################

sub alter_table {                        # ;
    my ($self, $owner, $def) = @_;

    my $obj = $owner->add (table => %{ $def->{table_name}});

    $self->__apply ($obj, %$_) for @{ $def->{alter_table_actions} };

    $obj;
}


######################################################################
######################################################################
sub set_table_hint {                     # ;
    my ($self, $owner, $def) = @_;
    $owner->hint (%$def);
}


######################################################################
######################################################################


# Value templates
sub add_constraint {                     # ;
    my ($self, $owner, $def) = @_;

    $self->__apply ($owner, %$def);
}


######################################################################
######################################################################
sub primary_key_constraint {             # ;
    my ($self, $owner, $def) = @_;

    $owner->add (primary_key => (
        column_list => $self->__call (0, column_list => $def),
        (map {(name => $_)} grep $_, $def->{constraint_name}),
    ));
}


######################################################################
######################################################################
sub unique_constraint {                  # ;
    my ($self, $owner, $def) = @_;

    $owner->add (unique => (
        column_list => $self->__call (0, column_list => $def),
        (map {(name => $_)} grep $_, $def->{constraint_name}),
    ));
}


######################################################################
######################################################################
sub foreign_key_constraint {             # ;
    my ($self, $owner, $def) = @_;

    $owner->add (foreign_key => (
        referenced_table        => $self->__call ($owner, referenced_table => $def),
        referencing_column_list => $self->__call (0, referencing_column_list => $def),
        referenced_column_list  => $self->__call (0, referenced_column_list => $def),
        (map +(update_rule => $_), grep $_, $self->__call (0, update_rule => $def)),
        (map +(delete_rule => $_), grep $_, $self->__call (0, delete_rule => $def)),
        (map +(name => $_),        grep $_, $def->{constraint_name}),
    ));
}


######################################################################
######################################################################
sub referencing_column_list {            # ;
    shift->column_list (@_);
}


######################################################################
######################################################################
sub referenced_column_list {             # ;
    shift->column_list (@_);
}


######################################################################
######################################################################
sub referenced_table {                   # ;
    my ($self, $owner, $def) = @_;

    $owner->catalog->get (table => %$def);
}


######################################################################
######################################################################
sub update_rule {                        # ;
    my ($self, $owner, $def) = @_;

    $def;
}


######################################################################
######################################################################
sub delete_rule {                        # ;
    my ($self, $owner, $def) = @_;

    $def;
}


######################################################################
######################################################################
sub add_column {                         # ;
    my ($self, $owner, $def) = @_;
    $self->__process ($owner, $def);
}


######################################################################
######################################################################
sub alter_column {                       # ;
    my ($self, $owner, $def) = @_;
    my $obj = $owner->add (column => name => $def->{column_name});

    $self->__call ($obj, 'alter_column_set_default',   $def);
    $self->__call ($obj, 'alter_column_set_not_null',  $def);
    $self->__call ($obj, 'alter_column_drop_default',  $def);
    $self->__call ($obj, 'alter_column_drop_not_null', $def);

    $obj;
}


######################################################################
######################################################################
sub alter_column_set_default {           # ;
    my ($self, $owner, $def) = @_;
    $self->__call ($owner, default_clause => $def);
}


######################################################################
######################################################################
sub alter_column_drop_default {          # ;
    my ($self, $owner, $def) = @_;
    $owner->default (undef);
}


######################################################################
######################################################################
sub alter_column_set_not_null {          # ;
    my ($self, $owner, $def) = @_;
    $owner->not_null (1);
}


######################################################################
######################################################################
sub alter_column_drop_not_null {         # ;
    my ($self, $owner, $def) = @_;
    $owner->not_null (undef);
}


######################################################################
######################################################################

sub statement_insert {                   # ;
    my ($self, $owner, $def) = @_;
    my $obj = $owner->add (table => %{ $def->{table_name}});

    my $columns = $self->__call ($owner, column_list => $def);
    my $values  = $self->__call ($owner, insert_value_list => $def);

    my @columns = $columns ? (columns => $columns) : ();

    #for my $row (@$values) {
        $obj->table_row ({ @columns, values => $values });
    #}
}


######################################################################
######################################################################
sub insert_value_list {                  # ;
    my ($self, $owner, $def) = @_;

    $def;
}


######################################################################
######################################################################

sub DESTROY {                            # ;
}


######################################################################
######################################################################
sub AUTOLOAD {                           # ;
    warn 'Unhandler method: ' . $AUTOLOAD if $WARN_ON_AUTOLOAD;
    ();
}


######################################################################
######################################################################

package SQL::Admin::Driver::Base::Evaluate;

1;

__END__