File Coverage

blib/lib/ObjectDB/Meta.pm

Criterion	Covered	Total	%
statement	189	256	73.8
branch	46	86	53.4
condition	17	31	54.8
subroutine	42	57	73.6
pod	5	39	12.8
total	299	469	63.7

package ObjectDB::Meta;

use strict;
use warnings;
use mro;

our $VERSION = '3.26';

require Storable;
require Carp;
use List::Util qw(first);

use ObjectDB::Meta::RelationshipFactory;

my %OBJECTS;

sub find_or_register_meta {
    my $class = shift;
    my ($meta_class, @args) = @_;

    return $OBJECTS{$meta_class} ||= ObjectDB::Meta->new(class => $meta_class, @args);
}

sub find_by_table {
    my $class = shift;
    my ($table) = @_;

    foreach my $meta_class (keys %OBJECTS) {
        my $meta = $OBJECTS{$meta_class};

        if ($meta->table eq $table) {
            return $meta;
        }
    }

    return;
}

sub new {
    my $class = shift;
    my (%params) = @_;

    Carp::croak('Class is required when building meta') unless $params{class};

    if (my $parent = $class->_is_inheriting($params{class})) {
        return $parent;
    }

    Carp::croak('Table is required when building meta') unless $params{table};

    my $self = {
        class => $params{class},
        table => $params{table}
    };
    bless $self, $class;

    if ($params{discover_schema}) {
        $self->discover_schema;
    }

    $self->set_columns($params{columns})         if $params{columns};
    $self->set_primary_key($params{primary_key}) if $params{primary_key};
    $self->set_unique_keys($params{unique_keys}) if $params{unique_keys};
    $self->set_auto_increment($params{auto_increment})
      if $params{auto_increment};

    $self->_build_relationships($params{relationships});

    if ($params{generate_columns_methods}) {
        $self->generate_columns_methods;
    }

    if ($params{generate_related_methods}) {
        $self->generate_related_methods;
    }

    return $self;
}

sub class          { $_[0]->{class} }
sub table          { $_[0]->{table} }
sub relationships  { $_[0]->{relationships} }
sub column         { shift->get_column(@_); }
sub columns        { $_[0]->get_columns; }
sub primary_key    { $_[0]->get_primary_key; }
sub auto_increment { $_[0]->get_auto_increment; }

sub is_primary_key {
    my $self = shift;
    my ($name) = @_;

    return !!first { $name eq $_ } $self->get_primary_key;
}

sub is_unique_key {
    my $self = shift;
    my ($name) = @_;

    foreach my $key (@{ $self->{unique_keys} }) {
        return 1 if first { $name eq $_ } @$key;
    }

    return 0;
}

sub is_nullable {
    my $self = shift;
    my ($name) = @_;

    my $column = $self->get_column($name);

    return $column->{is_null};
}

sub get_class {
    my $self = shift;

    return $self->{class};
}

sub get_table {
    my $self = shift;

    return $self->{table};
}

sub set_table {
    my $self = shift;
    my ($value) = @_;

    $self->{table} = $value;

    return $self;
}

sub is_column {
    my $self = shift;
    my ($name) = @_;

    Carp::croak('Name is required') unless $name;

    return !!first { $name eq $_->{name} } @{ $self->{columns} };
}

sub get_column {
    my $self = shift;
    my ($name) = @_;

    Carp::croak("Unknown column '$name'") unless $self->is_column($name);

    return first { $_->{name} eq $name } @{ $self->{columns} };
}

sub get_columns {
    my $self = shift;

    return map { $_->{name} } @{ $self->{columns} };
}

sub get_regular_columns {
    my $self = shift;

    my @columns;

    foreach my $column ($self->get_columns) {
        next if first { $column eq $_ } $self->get_primary_key;

        push @columns, $column;
    }

    return @columns;
}

sub set_columns {
    my $self = shift;

    $self->{columns} = [];

    $self->add_columns(@_);

    return $self;
}

sub add_columns {
    my $self = shift;
    my (@columns) = @_ == 1 && ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;

    my $count = 0;
    while (my ($name, $options) = @columns[ $count, $count + 1 ]) {
        last unless $name;

        if (ref $options eq 'HASH') {
            $self->add_column($name, $options);
        }
        else {
            $self->add_column($name);

            $count++;
            next;
        }

        $count += 2;
    }

    return $self;
}

sub add_column {
    my $self = shift;
    my ($name, $attributes) = @_;

    Carp::croak('Name is required') unless $name;
    Carp::croak("Column '$name' already exists") if $self->is_column($name);

    $attributes ||= {};

    push @{ $self->{columns} }, { name => $name, %$attributes };

    return $self;
}

sub remove_column {
    my $self = shift;
    my ($name) = @_;

    return unless $name && $self->is_column($name);

    $self->{columns} = [ grep { $_->{name} ne $name } @{ $self->{columns} } ];

    return $self;
}

sub get_primary_key {
    my $self = shift;

    return @{ $self->{primary_key} || [] };
}

sub set_primary_key {
    my $self = shift;
    my (@columns) = @_ == 1 && ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;

    foreach my $column (@columns) {
        Carp::croak("Unknown column '$column' set as primary key")
          unless $self->is_column($column);
    }

    $self->{primary_key} = [@columns];

    return $self;
}

sub get_unique_keys {
    my $self = shift;

    return @{ $self->{unique_keys} };
}

sub set_unique_keys {
    my $self = shift;
    my (@columns) = @_ == 1 && ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;

    $self->{unique_keys} = [];

    $self->add_unique_keys(@columns);

    return $self;
}

sub add_unique_keys {
    my $self = shift;
    my (@columns) = @_ == 1 && ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;

    foreach my $column (@columns) {
        $self->add_unique_key($column);
    }

    return $self;
}

sub add_unique_key {
    my $self = shift;
    my (@columns) = @_ == 1 && ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;

    foreach my $column (@columns) {
        Carp::croak("Unknown column '$column' set as unique key")
          unless $self->is_column($column);
    }

    push @{ $self->{unique_keys} }, [@columns];

    return $self;
}

sub get_auto_increment {
    my $self = shift;

    return $self->{auto_increment};
}

sub set_auto_increment {
    my $self = shift;
    my ($column) = @_;

    Carp::croak("Unknown column '$column' set as auto increment")
      unless $self->is_column($column);

    $self->{auto_increment} = $column;

    return $self;
}

sub is_relationship {
    my $self = shift;
    my ($name) = @_;

    return exists $self->{relationships}->{$name};
}

sub get_relationship {
    my $self = shift;
    my ($name) = @_;

    Carp::croak("Unknown relationship '$name'")
      unless exists $self->{relationships}->{$name};

    return $self->{relationships}->{$name};
}

sub add_relationship {
    my $self = shift;
    my ($name, $options) = @_;

    Carp::croak('Name and options are required') unless $name && $options;

    $self->{relationships}->{$name} = ObjectDB::Meta::RelationshipFactory->new->build(
        $options->{type}, %{$options},
        orig_class => $self->get_class,
        name       => $name
    );
}

sub add_relationships {
    my $self = shift;

    my $count = 0;
    while (my ($name, $options) = @_[ $count, $count + 1 ]) {
        last unless $name && $options;

        $self->add_relationship($name, $options);

        $count += 2;
    }
}

sub discover_schema {
    my $self = shift;

    eval { require DBIx::Inspector; 1 } or do {
        Carp::croak('DBIx::Inspector is required for auto discover');
    };

    my $dbh = $self->class->init_db;

    my $inspector = DBIx::Inspector->new(dbh => $dbh);

    my $table = $inspector->table($self->table);
    Carp::croak('auto discovery failed') unless $table;

    $self->{columns} = [];
    foreach my $column ($table->columns) {
        my $default_value = undef;

        if (defined $column->column_def) {
            $default_value = $column->column_def =~ /^'(.*?)'/ ? $1 : $column->column_def;

            if ($column->type_name =~ m/^bool/i) {
                if ($column->column_def =~ m/^\d/) {
                    $default_value = $column->column_def;
                }
                else {
                    $default_value = $column->column_def =~ m/^t/ ? 1 == 1 : 1 == 0;
                }
            }
        }

        my $type = 'string';
        if ( $column->type_name =~ m/^bool/i ) {
            $type = 'bool';
        }
        elsif ( $column->type_name =~ m/^(?:int|num|float|real|decimal)/i ) {
            $type = 'number';
        }

        my $is_null = $column->is_nullable eq 'YES' ? 1 : 0;

        $self->add_column($column->name, { default => $default_value, is_null => $is_null, type => $type });
    }

    $self->set_primary_key(map { $_->name } $table->primary_key);

    return $self;
}

sub generate_columns_methods {
    my $self = shift;

    no strict 'refs';
    no warnings 'redefine';
    foreach my $column ($self->get_columns) {
        *{ $self->class . '::' . $column } =
          sub { shift->column($column, @_) };
    }

    return $self;
}

sub generate_related_methods {
    my $self = shift;

    no strict 'refs';
    no warnings 'redefine';
    foreach my $rel_name (keys %{ $self->relationships }) {
        *{ $self->class . '::' . $rel_name } =
          sub { shift->related($rel_name, @_) };
    }

    return $self;
}

sub _build_relationships {
    my $self = shift;
    my ($relationships) = @_;

    $self->{relationships} ||= {};

    foreach my $rel (keys %{$relationships}) {
        $self->{relationships}->{$rel} = ObjectDB::Meta::RelationshipFactory->new->build(
            $relationships->{$rel}->{type}, %{ $relationships->{$rel} },
            orig_class => $self->{class},
            name       => $rel
        );
    }
}

sub _is_inheriting {
    my $class = shift;
    my ($for_class) = @_;

    my $parents = mro::get_linear_isa($for_class);
    foreach my $parent (@$parents) {
        if (my $parent_meta = $OBJECTS{$parent}) {
            my $meta = Storable::dclone($parent_meta);

            $meta->{class} = $for_class;

            return $meta;
        }
    }

    return;
}

1;
__END__