package SQL::Admin::Driver::Base::Decompose;
use strict;
use warnings;
our $VERSION = v0.5.0;
######################################################################
######################################################################
sub new { # ;
my ($class, %param) = @_;
bless \ %param, ref $class || $class;
}
######################################################################
######################################################################
sub decompose { # ;
my ($self, $catalog) = @_;
my (@retval, %map);
local $self->{log} = {};
my $sorter = sub { $a->fullname cmp $b->fullname };
##################################################################
for my $entity (qw( schema sequence table index column primary_key unique foreign_key )) {
my $log = $self->{log}{$entity} ||= {};
my $method = 'create_' . $entity;
for my $obj (sort $sorter values %{ $catalog->list ($entity) }) {
next if exists $log->{$obj->fullname};
push @retval, $self->$method ($catalog, $obj);
}
}
##################################################################
for my $obj (sort $sorter values %{ $catalog->list ('table') }) {
push @retval, $self->table_row ($obj);
}
##################################################################
\ @retval;
}
######################################################################
######################################################################
sub create_schema { # ;
my ($self, $catalog, $schema) = @_;
$self->{log}{schema}{ $schema->fullname } = 1;
+{ create_schema => {
schema_identifier => $schema->name,
}};
}
######################################################################
######################################################################
sub create_table { # ;
my ($self, $catalog, $table) = @_;
$self->{log}{table}{ $table->fullname } = 1;
+{ create_table => {
table_name => { name => $table->name, schema => $table->schema },
table_content => [
( map $self->create_table_column ($catalog, $table->column ($_)), $table->columns ),
],
}};
}
######################################################################
######################################################################
sub create_table_column { # ;
my ($self, $catalog, $column) = @_;
my $type = { %{ $column->type } };
$type->{data_type} = delete $type->{type};
my @param = (
table => $column->table,
column_list => [ $column->name ],
);
my $primary_key = $catalog->exists (primary_key => @param);
my $unique = $catalog->exists (unique => @param);
$self->{log}{column}{ $column->fullname } = 1;
$self->{log}{primary_key}{ $primary_key } = 1;
$self->{log}{unique}{ $unique } = 1;
##################################################################
+{ column_definition => {
column_name => $column->name,
%$type,
($primary_key ? (column_primary_key => 1) : ()),
($unique ? (column_unique => 1) : ()),
(map +(column_not_null => 1), grep $_, $column->not_null),
(map +(default_clause => $_), grep $_, $column->default),
($column->autoincrement ? (autoincrement => $column->autoincrement_hint) : ()),
}};
}
######################################################################
######################################################################
sub create_index { # ;
my ($self, $catalog, $index) = @_;
+{ create_index => {
index_name => { name => $index->name, schema => $index->schema },
table_name => { name => $index->table->name, schema => $index->table->schema },
($index->unique ? (index_unique => 1) : ()),
index_column_list => [
map +{
column_name => $_->[0],
($_->[1] ? (column_order => $_->[1]) : ()),
}, @{ $index->column_list }
]
}};
}
######################################################################
######################################################################
sub create_primary_key { # ;
my ($self, $catalog, $obj) = @_;
+{ alter_table => {
table_name => { name => $obj->table->name, schema => $obj->table->schema },
alter_table_actions => [ {
add_constraint => { primary_key_constraint => {
column_list => $obj->column_list,
}}
}]
}};
}
######################################################################
######################################################################
sub create_unique { # ;
my ($self, $catalog, $obj) = @_;
+{ alter_table => {
table_name => { name => $obj->table->name, schema => $obj->table->schema },
alter_table_actions => [ {
add_constraint => { unique_constraint => {
(map {(constraint_name => $_)} grep $_, $obj->name),
column_list => $obj->column_list,
}}
}]
}};
}
######################################################################
######################################################################
sub create_foreign_key { # ;
my ($self, $catalog, $obj) = @_;
+{ alter_table => {
table_name => { name => $obj->table->name, schema => $obj->table->schema },
alter_table_actions => [ {
add_constraint => { foreign_key_constraint => {
(map +(constraint_name => $_), grep $_, $obj->name),
referencing_column_list => $obj->referencing_column_list,
referenced_column_list => $obj->referenced_column_list,
referenced_table => {
name => $obj->referenced_table->name,
schema => $obj->referenced_table->schema,
},
(map +(update_rule => $_), grep $_, $obj->update_rule),
(map +(delete_rule => $_), grep $_, $obj->delete_rule),
}}
}]
}};
}
######################################################################
######################################################################
sub drop_schema { # ;
my ($self, $catalog, $schema) = @_;
+{ drop_schema => {
schema_identifier => $schema->name,
}};
}
######################################################################
######################################################################
sub add_column { # ;
my ($self, $catalog, $column) = @_;
my $data_type = { %{ $column->type } };
$data_type->{data_type} = delete $data_type->{type};
# print Data::Dumper::Dumper ($column->default);
+{ alter_table => {
table_name => { name => $column->table->name, schema => $column->table->schema },
alter_table_actions => [ { add_column => [ { column_definition => {
column_name => $column->name,
%$data_type,
not_null => $column->not_null,
default_clause => $column->default,
} } ] } ],
}};
}
######################################################################
######################################################################
sub alter_column { # ;
my ($self, $catalog, $column, $action, $value) = @_;
my $data_type = { %{ $column->type } };
$data_type->{data_type} = delete $data_type->{type};
# print Data::Dumper::Dumper ($column->default);
+{ alter_table => {
table_name => { name => $column->table->name, schema => $column->table->schema },
alter_table_actions => [ { add_column => [ { column_definition => {
column_name => $column->name,
%$data_type,
not_null => $column->not_null,
default_clause => $column->default,
} } ] } ],
}};
}
######################################################################
######################################################################
sub table_row { # ;
my ($self, $table) = @_;
my @retval;
my $table_name = { name => $table->name, schema => $table->schema };
for my $row (@{ $table->table_row }) {
push @retval, +{ statement_insert => {
table_name => $table_name,
(map +(column_list => $_), grep $_, $row->{columns}),
insert_value_list => $row->{values},
}};
}
@retval;
}
######################################################################
######################################################################
package SQL::Admin::Driver::Base::Decompose;
1;