File Coverage

blib/lib/Alzabo/RDBMSRules.pm

Criterion	Covered	Total	%
statement	15	217	6.9
branch	0	64	0.0
condition	0	30	0.0
subroutine	5	56	8.9
pod	42	50	84.0
total	62	417	14.8

package Alzabo::RDBMSRules;

use strict;
use vars qw($VERSION);

use Alzabo::Exceptions ( abbr => [ 'recreate_table_exception' ] );

use Class::Factory::Util;
use Params::Validate qw( validate validate_pos );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );

$VERSION = 2.0;

1;

sub new
{
    shift;
    my %p = @_;

    eval "use Alzabo::RDBMSRules::$p{rdbms};";
    Alzabo::Exception::Eval->throw( error => $@ ) if $@;
    return "Alzabo::RDBMSRules::$p{rdbms}"->new(@_);
}

sub available { __PACKAGE__->subclasses }

# validation

sub validate_schema_name
{
    shift()->_virtual;
}

sub validate_table_name
{
    shift()->_virtual;
}

sub validate_column_name
{
    shift()->_virtual;
}

sub validate_column_type
{
    shift()->_virtual;
}

sub validate_column_length
{
    shift()->_virtual;
}

sub validate_table_attribute
{
    shift()->_virtual;
}

sub validate_column_attribute
{
    shift()->_virtual;
}

sub validate_primary_key
{
    shift()->_virtual;
}

sub validate_sequenced_attribute
{
    shift()->_virtual;
}

sub validate_index
{
    shift()->_virtual;
}

sub type_is_numeric
{
    my $self = shift;
    my $col  = shift;

    return $self->type_is_integer($col) || $self->type_is_floating_point($col);
}

sub type_is_integer
{
    shift()->_virtual;
}

sub type_is_floating_point
{
    shift()->_virtual;
}

sub type_is_character
{
    shift()->_virtual;
}

sub type_is_date
{
    shift()->_virtual;
}

sub type_is_datetime
{
    shift()->_virtual;
}

sub type_is_time
{
    shift()->_virtual;
}

sub type_is_time_interval
{
    shift()->_virtual;
}

sub type_is_blob
{
    shift()->_virtual;
}

sub blob_type
{
    shift()->virtual;
}

# feature probing

sub column_types
{
    shift()->_virtual;
}

sub feature
{
    return 0;
}

sub quote_identifiers { 0 }

sub quote_identifiers_character { '' }

sub schema_attributes
{
    shift()->_virtual;
}

sub table_attributes
{
    shift()->_virtual;
}

sub column_attributes
{
    shift()->_virtual;
}

sub schema_sql
{
    my $self = shift;

    validate_pos( @_, { isa => 'Alzabo::Schema' } );

    my $schema = shift;

    my @sql;

    local $self->{state};

    foreach my $t ( $schema->tables )
    {
        push @sql, $self->table_sql($t);
    }

    return @sql, @{ $self->{state}{deferred_sql} || [] };
}

sub table_sql
{
    shift()->_virtual;
}

sub column_sql
{
    shift()->_virtual;
}

sub index_sql
{
    my $self = shift;
    my $index = shift;

    my $index_name = $index->id;
    $index_name = $self->quote_identifiers_character . $index_name . $self->quote_identifiers_character;

    my $sql = 'CREATE';
    $sql .= ' UNIQUE' if $index->unique;
    $sql .= " INDEX $index_name ON ";
    $sql .= $self->quote_identifiers_character;
    $sql .= $index->table->name;
    $sql .= $self->quote_identifiers_character;
    $sql .= ' ( ';

    if ( defined $index->function )
    {
        $sql .= $index->function;
    }
    else
    {
        $sql .=
            ( join ', ',
              map { $self->quote_identifiers_character . $_->name . $self->quote_identifiers_character }
              $index->columns
            );
    }

    $sql .= ' )';

    return $sql;
}

sub foreign_key_sql
{
    shift()->_virtual;
}

sub drop_table_sql
{
    my $self = shift;

    my $name = shift->name;
    $name = $self->quote_identifiers_character . $name . $self->quote_identifiers_character;

    return "DROP TABLE $name";
}

sub drop_column_sql
{
    shift()->_virtual;
}

sub drop_index_sql
{
    shift()->_virtual;
}

sub drop_foreign_key_sql
{
    shift()->_virtual;
}

sub column_sql_add
{
    shift()->_virtual;
}

sub column_sql_diff
{
    shift()->_virtual;
}

sub index_sql_diff
{
    my $self = shift;

    validate( @_, { new => { isa => 'Alzabo::Index' },
                    old => { isa => 'Alzabo::Index' } } );

    my %p = @_;

    my $new_sql = $self->index_sql($p{new});

    my @sql;
    if ( $new_sql ne $self->index_sql($p{old}) )
    {
        push @sql, $self->drop_index_sql( $p{old}, $p{new}->table->name );
        push @sql, $new_sql;
    }

    return @sql;
}

sub alter_primary_key_sql
{
    shift()->_virtual;
}

sub can_alter_table_name
{
    1;
}

sub can_alter_column_name
{
    1;
}

sub alter_table_name_sql
{
    shift()->_virtual;
}

sub alter_column_name_sql
{
    shift()->_virtual;
}

sub recreate_table_sql
{
    shift()->_virtual;
}

=pod

sub reverse_engineer
{
    my $self = shift;
    my $schema = shift;

    my $dbh = $schema->driver->handle;

    foreach my $table ( $dbh->tables )
    {
        my $t = $schema->make_table( name => $table );

        $self->reverse_engineer_table($t);
    }
}

sub reverse_engineer_table
{
    my $self = shift;
    my $table = shift;

    my $dbh = $table->schema->driver->handle;

    my $sth = $dbh->column_info( undef, $table->schema->name, $table->name, undef );

    while ( my $col_info = $sth->fetchrow_hashref )
    {
        use Data::Dumper; warn Dumper $col_info;
        my %attr = ( name     => $col_info->{COLUMN_NAME},
                     type     => $col_info->{TYPE_NAME},
                     nullable => $col_info->{NULLABLE} ? 1 : 0,
                   );

        $attr{size} =
            $col_info->{COLUMN_SIZE} if $col_info->{COLUMN_SIZE};

        $attr{precision} =
            $col_info->{DECIMAL_DIGITS} if $col_info->{DECIMAL_DIGITS};

        $attr{default} =
            $col_info->{COLUMN_DEF} if defined $col_info->{COLUMN_DEF};

        $attr{comment} =
            $col_info->{REMARKS} if defined $col_info->{REMARKS};

        $table->make_column(%attr);
    }

    $self->reverse_engineer_table_primary_key($table);
}

sub reverse_engineer_table_primary_key
{
    my $self = shift;
    my $table = shift;

    my $dbh = $table->schema->driver->handle;

    my $sth = $dbh->column_info( undef, $table->schema->name, $table->name );

    while ( my $pk_info = $sth->fetchrow_hashref )
    {
        $table->add_primary_key( $table->column( $pk_info->{COLUMN_NAME} ) );
    }
}

=cut

sub rules_id
{
    shift()->_virtual;
}

sub schema_sql_diff
{
    my $self = shift;

    validate( @_, { new => { isa => 'Alzabo::Schema' },
                    old => { isa => 'Alzabo::Schema' } } );

    my %p = @_;

    local $self->{state};

    my @sql;
    my %changed_name;
    foreach my $new_t ( $p{new}->tables )
    {
        # When syncing against an existing schema, the table may be
        # present with its new name.
        my $old_t;
        if ( defined $new_t->former_name )
        {
            $old_t = eval { $p{old}->table( $new_t->former_name ) };
        }

        $old_t ||= eval { $p{old}->table( $new_t->name ) };

        if ($old_t)
        {
            if ( $old_t->name ne $new_t->name )
            {
                $changed_name{ $old_t->name } = 1;

                if ( $self->can_alter_table_name )
                {
                    push @sql, $self->alter_table_name_sql($new_t);
                }
                else
                {
                    push @sql, $self->recreate_table_sql( new => $new_t,
                                                          old => $old_t,
                                                        );
                    push @sql, $self->rename_sequences( new => $new_t,
                                                        old => $old_t,
                                                      );

                    # no need to do more because table will be
                    # recreated from scratch
                    next;
                }
            }

            push @sql,
                eval { $self->table_sql_diff( new => $new_t,
                                              old => $old_t ) };

            if ( my $e = Exception::Class->caught('Alzabo::Exception::RDBMSRules::RecreateTable' ) )
            {
                push @sql, $self->recreate_table_sql( new => $new_t,
                                                      old => $old_t,
                                                    );
            }
            elsif ( $e = $@ )
            {
                die $e;
            }
        }
        else
        {
            push @sql, $self->table_sql($new_t);
            foreach my $fk ( $new_t->all_foreign_keys )
            {
                push @{ $self->{state}{deferred_sql} }, $self->foreign_key_sql($fk);
            }
        }
    }

    foreach my $old_t ( $p{old}->tables )
    {
        unless ( $changed_name{ $old_t->name } ||
                 eval { $p{new}->table( $old_t->name ) } )
        {
            push @sql, $self->drop_table_sql($old_t);
        }
    }

    return @sql, @{ $self->{state}{deferred_sql} || [] };
}

sub table_sql_diff
{
    my $self = shift;

    validate( @_, { new => { isa => 'Alzabo::Table' },
                    old => { isa => 'Alzabo::Table' } } );

    my %p = @_;
    my @sql;
    foreach my $old_i ( $p{old}->indexes )
    {
        unless ( eval { $p{new}->index( $old_i->id ) } )
        {
            push @sql, $self->drop_index_sql($old_i, $p{new}->name)
                if eval { $p{new}->columns( map { $_->name } $old_i->columns ) } && ! $@;
        }
    }

    my %changed_name;
    foreach my $new_c ( $p{new}->columns )
    {
        $changed_name{ $new_c->former_name } = 1
            if defined $new_c->former_name && $new_c->former_name ne $new_c->name;
    }

    foreach my $old_c ( $p{old}->columns )
    {
        unless ( $changed_name{ $old_c->name } ||
                 ( my $new_c = eval { $p{new}->column( $old_c->name ) } )
               )
        {
            push @sql, $self->drop_column_sql( new_table => $p{new},
                                               old => $old_c );
        }
    }

    foreach my $new_c ( $p{new}->columns )
    {
        # When syncing against an existing schema, the column may be
        # present with its new name.
        my $old_c;
        if ( defined $new_c->former_name )
        {
            $old_c = eval { $p{old}->column( $new_c->former_name ) };
        }

        $old_c ||= eval { $p{old}->column( $new_c->name ) };

        if ($old_c)
        {
            if ( $old_c->name ne $new_c->name )
            {
                if ( $self->can_alter_column_name )
                {
                    push @sql, $self->alter_column_name_sql($new_c);
                }
                else
                {
                    # no need to do more because table will be
                    # recreated from scratch
                    recreate_table_exception();
                }
            }

            push @sql, $self->column_sql_diff( new => $new_c,
                                               old => $old_c,
                                             );
        }
        else
        {
            push @sql, $self->column_sql_add($new_c);
        }
    }

    foreach my $new_i ( $p{new}->indexes )
    {
        if ( my $old_i = eval { $p{old}->index( $new_i->id ) } )
        {
            push @sql, $self->index_sql_diff( new => $new_i,
                                              old => $old_i );
        }
        else
        {
            push @sql, $self->index_sql($new_i)
        }
    }

    foreach my $new_fk ( $p{new}->all_foreign_keys )
    {
        unless ( grep { $new_fk->id eq $_->id } $p{old}->all_foreign_keys )
        {
            push @{ $self->{state}{deferred_sql} }, $self->foreign_key_sql($new_fk)
        }
    }

    foreach my $old_fk ( $p{old}->all_foreign_keys )
    {
        unless ( grep { $old_fk->id eq $_->id } $p{new}->all_foreign_keys )
        {
            push @sql, $self->drop_foreign_key_sql($old_fk);
        }
    }

    my $pk_changed;
    foreach my $old_pk ( $p{old}->primary_key )
    {
        next if $changed_name{ $old_pk->name };

        my $new_col = eval { $p{new}->column( $old_pk->name ) };
        unless ( $new_col && $new_col->is_primary_key )
        {
            push @sql, $self->alter_primary_key_sql( new => $p{new},
                                                     old => $p{old} );

            $pk_changed = 1;
            last;
        }
    }

    unless ($pk_changed)
    {
        foreach my $new_pk ( $p{new}->primary_key )
        {
            my $old_col = eval { $p{old}->column( $new_pk->name ) };

            next if $new_pk->former_name && $changed_name{ $new_pk->former_name };

            unless ( $old_col && $old_col->is_primary_key )
            {
                push @sql, $self->alter_primary_key_sql( new => $p{new},
                                                         old => $p{old} );

                last;
            }
        }
    }

    my $alter_attributes;
    foreach my $new_att ( $p{new}->attributes )
    {
        unless ( $p{old}->has_attribute( attribute => $new_att, case_sensitive => 1 ) )
        {
            $alter_attributes = 1;

            push @sql, $self->alter_table_attributes_sql( new => $p{new},
                                                          old => $p{old},
                                                        );

            last;
        }
    }

    unless ($alter_attributes)
    {
        foreach my $old_att ( $p{old}->attributes )
        {
            unless ( $p{new}->has_attribute( attribute => $old_att, case_sensitive => 1 ) )
            {
                $alter_attributes = 1;

                push @sql, $self->alter_table_attributes_sql( new => $p{new},
                                                              old => $p{old},
                                                            );

                last;
            }
        }
    }

    return @sql;
}


sub _virtual
{
    my $self = shift;

    my $sub = (caller(1))[3];
    Alzabo::Exception::VirtualMethod->throw( error =>
                                             "$sub is a virtual method and must be subclassed in " . ref $self );
}

__END__