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