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__
=pod
=head1 NAME
SQL::Admin::Driver::Base::Evaluate
=head1 DESCRIPTION
Evaluate statements