File Coverage

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

Criterion	Covered	Total	%
statement	6	70	8.5
branch	0	12	0.0
condition	0	5	0.0
subroutine	2	16	12.5
pod	0	13	0.0
total	8	116	6.9

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;