Alzabo
29 results

 view release on metacpan or  search on metacpan

lib/Alzabo/Create/Schema.pm  view on Meta::CPAN 

package Alzabo::Create::Schema;

use strict;
use vars qw($VERSION);

use Alzabo::ChangeTracker;
use Alzabo::Config;
use Alzabo::Create;
use Alzabo::Driver;
use Alzabo::Exceptions
    ( abbr => [ qw( params_exception system_exception ) ] );
use Alzabo::RDBMSRules;
use Alzabo::Runtime;
use Alzabo::SQLMaker;
use Alzabo::Utils;

use File::Spec;

use Params::Validate qw( :all );
Params::Validate::validation_options
    ( on_fail => sub { params_exception join '', @_ } );

use Storable ();
use Tie::IxHash;

use base qw( Alzabo::Schema );

$VERSION = 2.0;

1;

sub new
{
    my $proto = shift;
    my $class = ref $proto || $proto;

    validate( @_, { rdbms    => { type => SCALAR },
                    name     => { type => SCALAR },
                    no_cache => { type => SCALAR, default => 0 },
                  } );
    my %p = @_;

    my $self = bless {}, $class;

    params_exception "Alzabo does not support the '$p{rdbms}' RDBMS"
        unless ( ( grep { $p{rdbms} eq $_ } Alzabo::Driver->available ) &&
                 ( grep { $p{rdbms} eq $_ } Alzabo::RDBMSRules->available ) );

    $self->{driver} = Alzabo::Driver->new( rdbms => $p{rdbms},
                                           schema => $self );
    $self->{rules} = Alzabo::RDBMSRules->new( rdbms => $p{rdbms} );

    $self->{sql} = Alzabo::SQLMaker->load( rdbms => $p{rdbms} );

    params_exception "Alzabo::Create::Schema->new requires a name parameter\n"
        unless exists $p{name};

    $self->set_name($p{name});

    $self->{tables} = Tie::IxHash->new;

    $self->_save_to_cache unless $p{no_cache};

    return $self;
}

sub load_from_file
{
    return shift->_load_from_file(@_);
}

sub reverse_engineer
{
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %p = @_;

    my $self = $class->new( name     => $p{name},
                            rdbms    => $p{rdbms},
                            no_cache => 1,
                          );

    delete $p{rdbms};
    $self->{driver}->connect(%p);

    $self->{rules}->reverse_engineer($self);

    $self->set_instantiated(1);
    my $driver = delete $self->{driver};
    $self->{original} = Storable::dclone($self);
    $self->{driver} = $driver;
    delete $self->{original}{original};
    return $self;
}

sub set_name
{
    my $self = shift;

    validate_pos( @_, { type => SCALAR } );
    my $name = shift;

    return if defined $self->{name} && $name eq $self->{name};

    my $old_name = $self->{name};
    $self->{name} = $name;

    eval { $self->rules->validate_schema_name($self); };
    if ($@)
    {
        $self->{name} = $old_name;

        rethrow_exception($@);
    }

    # Gotta clean up old files or we have a mess!
    $self->delete( name => $old_name ) if $old_name;
    $self->set_instantiated(0);
    undef $self->{original};
}

sub set_instantiated
{
    my $self = shift;

    validate_pos( @_, 1 );
    $self->{instantiated} = shift;
}

sub make_table
{
    my $self = shift;
    my %p = @_;

    my %p2;
    foreach ( qw( before after ) )
    {
        $p2{$_} = delete $p{$_} if exists $p{$_};
    }
    $self->add_table( table => Alzabo::Create::Table->new( schema => $self,
                                                           %p ),
                      %p2 );

    return $self->table( $p{name} );
}

sub add_table
{
    my $self = shift;

    validate( @_, { table  => { isa => 'Alzabo::Create::Table' },
                    before => { optional => 1 },
                    after  => { optional => 1 } } );
    my %p = @_;

    my $table = $p{table};

    params_exception "Table " . $table->name . " already exists in schema"
        if $self->{tables}->EXISTS( $table->name );

    $self->{tables}->STORE( $table->name, $table );

    foreach ( qw( before after ) )
    {
        if ( exists $p{$_} )
        {
            $self->move_table( $_ => $p{$_},
                               table => $table );
            last;
        }
    }
}

sub delete_table
{
    my $self = shift;

    validate_pos( @_, { isa => 'Alzabo::Create::Table' } );
    my $table = shift;

    params_exception "Table " . $table->name ." doesn't exist in schema"
        unless $self->{tables}->EXISTS( $table->name );

    foreach my $fk ($table->all_foreign_keys)
    {
        foreach my $other_fk ( $fk->table_to->foreign_keys_by_table($table) )
        {
            $fk->table_to->delete_foreign_key($other_fk);
        }
    }

    $self->{tables}->DELETE( $table->name );
}

sub move_table
{
    my $self = shift;

    validate( @_, { table  => { isa => 'Alzabo::Create::Table' },
                    before => { isa => 'Alzabo::Create::Table',
                                optional => 1 },
                    after  => { isa => 'Alzabo::Create::Table',
                                optional => 1 } } );
    my %p = @_;

    if ( exists $p{before} && exists $p{after} )
    {
        params_exception
            "move_table method cannot be called with both 'before' and 'after' parameters";
    }

    if ( $p{before} )
    {
        params_exception "Table " . $p{before}->name . " doesn't exist in schema"
            unless $self->{tables}->EXISTS( $p{before}->name );
    }
    else
    {
        params_exception "Table " . $p{after}->name . " doesn't exist in schema"
            unless $self->{tables}->EXISTS( $p{after}->name );
    }

    params_exception "Table " . $p{table}->name . " doesn't exist in schema"
        unless $self->{tables}->EXISTS( $p{table}->name );

    $self->{tables}->DELETE( $p{table}->name );

    my $index;
    if ( $p{before} )
    {
        $index = $self->{tables}->Indices( $p{before}->name );
    }
    else
    {
        $index = $self->{tables}->Indices( $p{after}->name ) + 1;
    }

    $self->{tables}->Splice( $index, 0, $p{table}->name => $p{table} );
}

sub register_table_name_change
{
    my $self = shift;

    validate( @_, { table => { isa => 'Alzabo::Create::Table' },
                    old_name => { type => SCALAR } } );
    my %p = @_;

    params_exception "Table $p{old_name} doesn't exist in schema"
        unless $self->{tables}->EXISTS( $p{old_name} );

    my $index = $self->{tables}->Indices( $p{old_name} );
    $self->{tables}->Replace( $index, $p{table}, $p{table}->name );
}

sub add_relationship
{
    my $self = shift;

    my %p = @_;

    my $tracker = Alzabo::ChangeTracker->new;

    $self->_check_add_relationship_args(%p);

    # This requires an entirely new table.
    unless ( grep { $_ ne 'n' } @{ $p{cardinality} } )
    {
        $self->_create_linking_table(%p);
        return;
    }

    params_exception "Must provide 'table_from' or 'columns_from' parameter"
        unless $p{table_from} || $p{columns_from};

    params_exception "Must provide 'table_to' or 'columns_to' parameter"
        unless $p{table_to} || $p{columns_to};

    $p{columns_from} =
        ( defined $p{columns_from} ?
          ( Alzabo::Utils::is_arrayref( $p{columns_from} ) ?
            $p{columns_from} :
            [ $p{columns_from} ] ) :
          undef );

    $p{columns_to} =
        ( defined $p{columns_to} ?
          ( Alzabo::Utils::is_arrayref( $p{columns_to} ) ?
            $p{columns_to} :
            [ $p{columns_to} ] ) :
          undef );

    my $f_table = $p{table_from} || $p{columns_from}->[0]->table;
    my $t_table = $p{table_to} || $p{columns_to}->[0]->table;

    if ( $p{columns_from} && $p{columns_to} )
    {
        params_exception
            "Cannot create a relationship with differing numbers of columns " .
            "on either side of the relation"
                unless @{ $p{columns_from} } == @{ $p{columns_to} };
    }

    foreach ( [ columns_from => $f_table ], [ columns_to => $t_table ] )
    {

lib/Alzabo/Create/Schema.pm  view on Meta::CPAN 

        # Is there a way to handle this properly?
        params_exception $f_table->name . " has no primary key."
            unless @c;

        $col_from = \@c;
    }

    my $col_to;
    if ($p{columns_to})
    {
        $col_to = $p{columns_to};
    }
    else
    {
        # If the columns this links to in the 'to' table ares not specified
        # explicitly we assume that the user wants to have this coumn
        # created/adjusted in the 'to' table.
        my @new_col;
        foreach my $c ( @$col_from )
        {
            push @new_col, $self->_add_foreign_key_column( table  => $t_table,
                                                           column => $c );
        }

        $col_to = \@new_col;
    }

    return ($col_from, $col_to);
}

sub _create_n_to_1_relationship
{
    my $self = shift;
    my %p = @_;

    # reverse everything ...
    ($p{table_from}, $p{table_to}) = ($p{table_to}, $p{table_from});
    ($p{columns_from}, $p{columns_to}) = ($p{columns_to}, $p{columns_from});
    ($p{from_is_dependent}, $p{to_is_dependent}) =
        ($p{to_is_dependent}, $p{from_is_dependent});

    # pass it into the inverse method and then swap the return values.
    # Tada!
    return ( $self->_create_1_to_n_relationship(%p) )[1,0];
}

# Given two tables and a column, it will add the column to the table
# if it doesn't exist.  Otherwise, it adjusts the column in the table
# to match the given column.  In either case, the two columns (the one
# passed to the method and the one altered/created) will share a
# ColumnDefinition object.

# This is called when a relationship is created and the columns aren't
# specified.  This means that changes to the column in one table are
# automatically reflected in the other table, which is generally a
# good thing.
sub _add_foreign_key_column
{
    my $self = shift;

    validate( @_, { table => { isa => 'Alzabo::Create::Table' },
                    column => { isa => 'Alzabo::Create::Column' } } );
    my %p = @_;

    my $tracker = Alzabo::ChangeTracker->new;

    # Note: This code _does_ explicitly want to compare the string
    # representation of the $p{column}->definition reference.
    my $new_col;
    if ( eval { $p{table}->column( $p{column}->name ) } &&
         ( $p{column}->definition ne $p{table}->column( $p{column}->name )->definition ) )
    {
        # This will make the two column share a single definition
        # object.
        my $old_def = $p{table}->column( $p{column}->name )->definition;
        $p{table}->column( $p{column}->name )->set_definition($p{column}->definition);

        $tracker->add
            ( sub { $p{table}->column
                        ( $p{column}->name )->set_definition($old_def) } );
    }
    else
    {
        # Just add the new column, but use the existing definition
        # object.
        $p{table}->make_column( name => $p{column}->name,
                                definition => $p{column}->definition );

        my $del_col = $p{table}->column( $p{column}->name );
        $tracker->add( sub { $p{table}->delete_column($del_col) } );
    }

    # Return the new column we just made.
    return $p{table}->column( $p{column}->name );
}

sub _create_linking_table
{
    my $self = shift;
    my %p = @_;

    my $tracker = Alzabo::ChangeTracker->new;

    my $t1 = $p{table_from} || $p{columns_from}->[0]->table;
    my $t2 = $p{table_to} || $p{columns_to}->[0]->table;

    my $t1_col;
    if ($p{columns_from})
    {
        $t1_col = $p{columns_from};
    }
    else
    {
        my @c = $t1->primary_key;

        params_exception $t1->name . " has no primary key."
            unless @c;

        $t1_col = \@c;
    }

lib/Alzabo/Create/Schema.pm  view on Meta::CPAN 

    my $self = shift;

    my $schema_dir = File::Spec->catdir( Alzabo::Config::schema_dir(), $self->{name} );
    unless (-e $schema_dir)
    {
        mkdir $schema_dir, 0775
            or system_exception "Unable to make directory $schema_dir: $!";
    }

    my $create_save_name = $self->_base_filename( $self->{name} ) . '.create.alz';

    my $fh = do { local *FH; };
    open $fh, ">$create_save_name"
        or system_exception "Unable to write to $create_save_name: $!\n";

    my $driver = delete $self->{driver};
    Storable::nstore_fd( $self, $fh )
        or system_exception "Can't store to filehandle";

    $self->{driver} = $driver;
    close $fh
        or system_exception "Unable to close $create_save_name: $!";

    my $rdbms_save_name = $self->_base_filename( $self->{name} ) . '.rdbms';

    open $fh, ">$rdbms_save_name"
        or system_exception "Unable to write to $rdbms_save_name: $!\n";

    print $fh $self->{driver}->driver_id
        or system_exception "Can't write to $rdbms_save_name: $!";
    close $fh
        or system_exception "Unable to close $rdbms_save_name: $!";

    my $version_save_name = $self->_base_filename( $self->{name} ) . '.version';

    open $fh, ">$version_save_name"
        or system_exception "Unable to write to $version_save_name: $!\n";
    print $fh $Alzabo::VERSION
        or system_exception "Can't write to $version_save_name: $!";
    close $fh
        or system_exception "Unable to close $version_save_name: $!";

    my $rt = $self->runtime_clone;

    my $runtime_save_name = $self->_base_filename( $self->{name} ) . '.runtime.alz';

    open $fh, ">$runtime_save_name"
        or system_exception "Unable to write to $runtime_save_name: $!\n";
    Storable::nstore_fd( $rt, $fh )
        or system_exception "Can't store to filehandle";
    close $fh
        or system_exception "Unable to close $runtime_save_name: $!";

    $self->_save_to_cache;
}

sub clone
{
    my $self = shift;

    validate( @_, { name  => { type => SCALAR } } );
    my %p = @_;

    my $driver = delete $self->{driver};
    my $clone = Storable::dclone($self);
    $self->{driver} = $driver;

    $clone->{name} = $p{name};
    $clone->{driver} = Alzabo::Driver->new( rdbms => $self->{driver}->driver_id,
                                            schema => $clone );

    $clone->rules->validate_schema_name($clone);
    $clone->{original}{name} = $p{name} if $p{name};

    $clone->set_instantiated(0);

    return $clone;
}

sub runtime_clone
{
    my $self = shift;

    my %s;
    my $driver = delete $self->{driver};
    my $clone = Storable::dclone($self);
    $self->{driver} = $driver;

    foreach my $f ( qw( original instantiated rules driver ) )
    {
        delete $clone->{$f};
    }

    foreach my $t ($clone->tables)
    {
        foreach my $c ($t->columns)
        {
            my $def = $c->definition;
            bless $def, 'Alzabo::Runtime::ColumnDefinition';
            bless $c, 'Alzabo::Runtime::Column';

            delete $c->{last_instantiation_name};
        }

        foreach my $fk ($t->all_foreign_keys)
        {
            bless $fk, 'Alzabo::Runtime::ForeignKey';
        }

        foreach my $i ($t->indexes)
        {
            bless $i, 'Alzabo::Runtime::Index';
        }

        delete $t->{last_instantiation_name};

        bless $t, 'Alzabo::Runtime::Table';
    }
    bless $clone, 'Alzabo::Runtime::Schema';

    return $clone;
}

sub save_current_name
{
    my $self = shift;

    $self->{last_instantiated_name} = $self->name;

    foreach my $table ( $self->tables )
    {
        $table->save_current_name;



( run in 1.868 second using v1.01-cache-2.11-cpan-437f7b0c052 )