File Coverage

lib/DBIx/EAV/Schema.pm

Criterion	Covered	Total	%
statement	116	117	99.1
branch	42	50	84.0
condition	3	8	37.5
subroutine	20	20	100.0
pod	6	12	50.0
total	187	207	90.3

package DBIx::EAV::Schema;

use Moo;
use Carp 'croak';
use Scalar::Util 'blessed';
use DBIx::EAV::Table;
use SQL::Translator;
use constant {
    SQL_DEBUG => $ENV{DBIX_EAV_TRACE}
};

our $SCHEMA_VERSION = 1;


my %driver_to_producer = (
    mysql => 'MySQL'
);


has 'dbh', is => 'ro', required => 1;

has 'database_cascade_delete', is => 'ro', default => 1;
has 'table_prefix', is => 'ro', default => 'eav_';
has 'tenant_id', is => 'ro';
has 'data_types', is => 'ro', default => sub { [qw/ int decimal varchar text datetime bool /] };
has 'static_attributes', is => 'ro', default => sub { [] };
has 'id_type', is => 'ro', default => 'int';

has 'translator', is => 'ro', init_arg => undef, lazy => 1, builder => 1;
has '_tables', is => 'ro', init_arg => undef, default => sub { {} };


sub BUILD {
    my $self = shift;

    # enable sqlite fk for cascade delete to work
    $self->dbh_do("PRAGMA foreign_keys = ON;")
        if $self->db_driver_name eq 'SQLite';
}


sub _build_translator {
    my $self = shift;

    my $sqlt = SQL::Translator->new;
    $self->_build_sqlt_schema($sqlt->schema);

    $sqlt;
}

sub _build_sqlt_schema {
    my ($self, $schema) = @_;

    my @schema = (

        entity_types => {
            columns => ['id', $self->tenant_id ? 'tenant_id' : (), 'name:varchar:255'],
            index   => [$self->tenant_id ? 'tenant_id' : ()],
            unique  => {
                name => [$self->tenant_id ? 'tenant_id' : (),'name']
            }
        },

        entities => {
            columns => [qw/ id entity_type_id  /, @{ $self->static_attributes } ],
            fk      => { entity_type_id => 'entity_types' }
        },

        attributes => {
            columns => [qw/ id entity_type_id name:varchar:255 data_type:varchar:64 /],
            fk      => { entity_type_id => 'entity_types' }
        },

        relationships => {
            columns => [qw/ id left_entity_type_id right_entity_type_id name:varchar:255 incoming_name:varchar:255 is_has_one:bool::0 is_has_many:bool::0 is_many_to_many:bool::0 /],
            fk      => { left_entity_type_id => 'entity_types', right_entity_type_id => 'entity_types' },
            unique  => {
                name => ['left_entity_type_id','name']
            }
        },

        entity_relationships => {
            columns => [qw/ relationship_id left_entity_id right_entity_id /],
            pk => [qw/ relationship_id left_entity_id right_entity_id /],
            fk => {
                relationship_id => 'relationships',
                left_entity_id  => { table => 'entities', cascade_delete => $self->database_cascade_delete },
                right_entity_id => { table => 'entities', cascade_delete => $self->database_cascade_delete },
            }
        },

        type_hierarchy => {
            columns => [qw/ parent_type_id child_type_id /],
            pk => [qw/ parent_type_id child_type_id /],
            fk => {
                parent_type_id => { table => 'entity_types', cascade_delete => $self->database_cascade_delete },
                child_type_id  => { table => 'entity_types', cascade_delete => $self->database_cascade_delete },
            }
        },

        map {
            ("value_$_" => {
                columns => [qw/ entity_id attribute_id /, 'value:'.$_],
                fk => {
                    entity_id    => { table => 'entities', cascade_delete => $self->database_cascade_delete },
                    attribute_id => 'attributes'
                }
            })
        } @{ $self->data_types }
    );

    for (my $i = 0; $i < @schema; $i += 2) {

        # add table
        my $table_name = $schema[$i];
        my $table_schema = $schema[$i+1];
        my $table = $schema->add_table( name => $self->table_prefix . $table_name )
            or die $schema->error;

        # add columns
        foreach my $col ( @{ $table_schema->{columns} }) {

            my $field_params = ref $col ? $col : do {

                my ($name, $type, $size, $default) = split ':', $col;
                +{
                    name => $name,
                    data_type => $type,
                    size => $size,
                    default_value => $default
                }
            };

            $field_params->{data_type} = $self->id_type
                if $field_params->{name} =~ /(?:^id$|_id$)/;

            $field_params->{is_auto_increment} = 1
                if $field_params->{name} eq 'id';

            $field_params->{is_nullable} //= 0;

            $table->add_field(%$field_params)
                or die $table->error;
        }

        # # primary key
        my $pk = $table->get_field('id') ? 'id' : $table_schema->{pk};
        $table->primary_key($pk) if $pk;

        # # foreign keys
        foreach my $fk_column (keys %{ $table_schema->{fk} || {} }) {

            my $params = $table_schema->{fk}->{$fk_column};
            $params = { table => $params } unless ref $params;

            $table->add_constraint(
                name => join('_', 'fk', $table_name, $fk_column, $params->{table}),
                type => 'foreign_key',
                fields => $fk_column,
                reference_fields => 'id',
                reference_table => $self->table_prefix . $params->{table},
                on_delete => $params->{cascade_delete} ? 'CASCADE' : 'NO ACTION'
            );
        }

        # # unique constraints
        foreach my $name (keys %{ $table_schema->{unique} || {} }) {

            $table->add_index(
                name => join('_', 'unique', $table_name, $name),
                type => 'unique',
                fields => $table_schema->{unique}{$name},
            );
        }

        # # index
        foreach my $colname (@{ $table_schema->{index} || [] }) {

            $table->add_index(
                name => join('_', 'idx', $table_name, $colname),
                type => 'normal',
                fields => $colname,
            );
        }
    }

    return 1;
}


sub version { $SCHEMA_VERSION }

sub get_ddl {
    my ($self, $producer) = @_;

    unless ($producer) {

        my $driver = $self->dbh->{Driver}{Name};
        $producer = $driver_to_producer{$driver} || $driver;
    }

    $self->translator->producer($producer);
    $self->translator->translate;
}

sub version_table {
    my $self = shift;

    DBIx::EAV::Table->new(
        dbh       => $self->dbh,
        name      => $self->table_prefix . 'schema_versions',
        columns   => [qw/ id version ddl /]
    );
}

sub version_table_is_installed {
    my $self = shift;

    my $success = 0;

    eval {
        $self->dbh_do(sprintf 'SELECT COUNT(*) FROM %s', $self->table_prefix . 'schema_versions');
        $success = 1;
    };

    $success;
}

sub install_version_table {
    my $self = shift;

    my $sqlt = SQL::Translator->new;
    my $table = $sqlt->schema->add_table( name => $self->version_table->name );

    $table->add_field(
        name => 'id',
        data_type => 'INTEGER',
        is_auto_increment => 1
    );

    $table->add_field(
        name => 'version',
        data_type => 'INTEGER'
    );

    $table->add_field(
        name => 'ddl',
        data_type => 'TEXT'
    );

    $table->primary_key('id');

    # execute ddl
    my $driver = $self->dbh->{Driver}{Name};
    $sqlt->producer($driver_to_producer{$driver} || $driver);

    $self->dbh_do($_)
        for grep { /\w/ } split ';', $sqlt->translate;

}

sub installed_version {
    my $self = shift;
    my $table = $self->version_table;
    my $row;
    eval {
        my ($rv, $sth) = $self->dbh_do(sprintf 'SELECT * FROM %s ORDER BY id DESC', $table->name);
        $row = $sth->fetchrow_hashref;
    };
    return unless $row;
    $row->{version};
}

sub deploy {
    my $self = shift;
    my %options = ( @_, no_comments => 1 );

    $self->translator->$_($options{$_})
        for keys %options;

    # deploy version table
    $self->install_version_table
        unless $self->version_table_is_installed;

    # check we already installed this version
    my $version_table = $self->version_table;
    return if $version_table->select_one({ version => $self->version });

    # deploy ddl
    my $ddl = $self->get_ddl;
    $self->dbh_do($_)
        for grep { /\w/ } split ';', $ddl;

    # create version record
    $version_table->insert({
        version => $self->version,
        ddl => 'DDL'
    });
}


sub dbh_do {
    my ($self, $stmt, $bind) = @_;

    if (SQL_DEBUG) {
        my $i = 0;
        print STDERR "$stmt";
        print STDERR $bind ? sprintf(": %s\n", join('  ', map { $i++.'='.$_ } @{ $bind || [] }))
                           : ";\n";
    }

    my $sth = $self->dbh->prepare($stmt);
    my $rv = $sth->execute(ref $bind eq 'ARRAY' ? @$bind : ());
    die $sth->errstr unless defined $rv;

    return ($rv, $sth);
}

sub table {
    my ($self, $name) = @_;

    return $self->_tables->{$name}
        if exists $self->_tables->{$name};

    my $table_schema = $self->translator->schema->get_table($self->table_prefix . $name);

    croak "Table '$name' does not exist."
        unless $table_schema;

    $self->_tables->{$name} = DBIx::EAV::Table->new(
        dbh       => $self->dbh,
        tenant_id => $self->tenant_id,
        name      => $table_schema->name,
        columns   => [ $table_schema->field_names ]
    );
}

sub has_data_type {
    my ($self, $name) = @_;
    foreach (@{$self->data_types}) {
        return 1 if $_ eq $name;
    }
    0;
}

sub db_driver_name {
    shift->dbh->{Driver}{Name};
}


1;


__END__