File Coverage

blib/lib/Data/Model.pm

Criterion	Covered	Total	%
statement	305	318	95.9
branch	133	160	83.1
condition	36	51	70.5
subroutine	37	48	77.0
pod	7	36	19.4
total	518	613	84.5

package Data::Model;

use strict;
use warnings;
our $VERSION = '0.00008';

use Carp ();
$Carp::Internal{(__PACKAGE__)}++;

use Data::Model::Iterator;
use Data::Model::Transaction;

our $RUN_VALIDATION;
if (exists $ENV{DATA_MODE_RUN_VALIDATION}) {
    $RUN_VALIDATION = $ENV{DATA_MODE_RUN_VALIDATION} ? 1 : 0;
} else {
    $RUN_VALIDATION = 1; # default is any time validation
    # $RUN_VALIDATION = $ENV{HARNESS_ACTIVE} ? 1 : 0;
}
use Params::Validate ':all';


## for schema methods
sub driver  {};
sub model   {};
sub schema  {};
sub column  {};
sub columns {};
sub key     {};
sub index   {};
sub unique  {};
sub schema_options {};
sub __properties { +{} }

sub new {
    my $class = shift;
    bless {
        schema_class => $class,
    }, $class;
}

## data model attributes

sub get_schema_class {
    my($self, $model) = @_;
    (ref($self) || $self) . '::' . $model;
}

sub get_schema {
    my($self, $model) = @_;
    my $schema = $self->__properties->{schema}->{$model};
    Carp::croak "not defined schema $model" unless $schema;
    $schema;
}

sub clear_all_drivers {
    my $self = shift;
    for my $model ($self->schema_names) {
        $self->set_driver($model, undef);
    }
}

sub get_base_driver {
    shift->__properties->{base_driver};
}

sub set_base_driver {
    my($self, $driver) = @_;
    $self->__properties->{base_driver} = $driver;
    for my $model ($self->schema_names) {
        $self->set_driver($model, $driver) unless $self->get_driver($model);
    }
}

sub get_driver {
    my($self, $model) = @_;
    $self->get_schema($model)->{driver};
}

sub set_driver {
    my($self, $model, $driver) = @_;
    my $schema = $self->get_schema($model);
    my $old = (exists $schema->{driver} && $schema->{driver});
    if ($old) {
        $old->detach_model($model, $schema);
    }
    $schema->driver($driver);
    if ($driver) {
        $driver->attach_model($model, $schema);
    }
}


sub schema_names {
    my $self = shift;
    keys %{ $self->__properties->{schema} };
}

sub as_sqls {
    my $self   = shift;
    my $target = shift;
    my @sql = ();
    for my $model ($self->schema_names) {
        next if $target && $model ne $target;
        push @sql, $self->get_schema($model)->sql->as_sql;
    }
    @sql;
}

## get / set / delete

sub _get_query_args {
    my $self   = shift;
    my $schema = shift;
    return [] unless exists $_[0];

    # get key array or query
    my $key_array = undef;
    my $query = undef;
    if (ref($_[0]) eq 'HASH') {
        ## ->get( modelname => { search query } );
        $query = shift;
    } elsif (ref($_[0]) eq 'ARRAY') {
        ## ->get( modelname => [ keys ]);
        $key_array = shift;
    } elsif (!ref($_[0])) {
        ## ->get( modelname => 'key');
        $key_array = [ shift ];
    } else {
        return [];
    }

    # get query
    if ($query) {
        ## nop
    } elsif (ref($_[0]) eq 'HASH') {
        ## get query
        $query = shift;
    } else {
        shift;
    }


    # for query param validation
    if ($RUN_VALIDATION && $query) {
        my @p = %{ $query };
        validate(
            @p, {
                index => {
                    type     => HASHREF | UNDEF,
                    optional => 1,
                    callbacks => {
                        has_index_name => sub {
                            return 1 unless $_[0];
                            return 0 unless scalar(@{ [ %{ $_[0] } ] }) == 2;
                            my($name) = %{ $_[0] };
                            $schema->has_index($name);
                        },
                    },
                },
                where => {
                    type     => HASHREF | ARRAYREF | UNDEF,
                    optional => 1,
                },
                order => {
                    type     => HASHREF | ARRAYREF | UNDEF,
                    optional => 1,
                },
                group => {
                    type     => HASHREF | ARRAYREF | UNDEF,
                    optional => 1,
                },
                limit => {
                    type     => SCALAR | UNDEF,
                    optional => 1,
                },
                offset => {
                    type     => SCALAR | UNDEF,
                    optional => 1,
                },
            },
        );
    }


    # if first key is undef then nothing keys
    $key_array = [] if $key_array && ref($key_array) && !defined $key_array->[0];

    # deflate search key
    if ($schema->has_deflate) {
        if ($key_array) {
            my $columns = $schema->get_columns_hash_by_key_array_and_hash(+{}, $key_array);
            $schema->deflate($columns);
            $key_array = $schema->get_key_array_by_hash( $columns );
        }

        # deflate search index
        if ($query && ref($query->{index}) eq 'HASH') {
            my($name, $key_array) = ( %{ $query->{index} } );
            $key_array = [ $key_array ] unless ref($key_array) eq 'ARRAY';
            my $columns = $schema->get_columns_hash_by_key_array_and_hash(+{}, $key_array, $name);
            $schema->deflate($columns);
            $query->{index} = { $name => $schema->get_key_array_by_hash($columns, $name) };
        }
    }

    return [] if ($key_array && !@{ $key_array });
    return [] unless $key_array || $query;
    return [ $key_array, $query, @_ ];
}

sub lookup {
    my($self, $model, $id) = @_;
    Carp::croak "The 'lookup' method can not be performed during a transaction." if $self->{active_transaction};
    my $schema = $self->get_schema($model);
    return unless $schema;

    $id = [ $id ] unless ref($id) eq 'ARRAY';

    # deflating
    my $id_hash = $schema->get_columns_hash_by_key_array_and_hash(+{}, $id);
    $schema->deflate($id_hash);
    $id = $schema->get_key_array_by_hash( $id_hash );

    Carp::confess 'The number of key is wrong'
            unless scalar(@{ $id }) == scalar(@{ $schema->key });

    my $data = $schema->{driver}->lookup( $schema, $id );
    return unless $data;

    my $obj = $data;
    unless ($schema->{options}->{bare_row}) {
        $obj = $schema->new_obj($self, $data);
        $schema->inflate($obj);
        $schema->call_trigger('post_load', $obj);
    }
    return $obj;
}

sub lookup_multi {
    my($self, $model, $ids) = @_;
    Carp::croak "The 'lookup_multi' method can not be performed during a transaction." if $self->{active_transaction};
    my $schema = $self->get_schema($model);
    return unless $schema;

    $ids = [ $ids ] unless ref($ids) eq 'ARRAY';
    my $id_size = scalar(@{ $schema->key });
    my @id_list;
    for my $id (@{ $ids }) {
        $id = [ $id ] unless ref($id) eq 'ARRAY';

        Carp::confess 'The number of key is wrong'
                unless scalar(@{ $id }) == $id_size;

        # deflating
        my $id_hash = $schema->get_columns_hash_by_key_array_and_hash(+{}, $id);
        $schema->deflate($id_hash);
        $id = $schema->get_key_array_by_hash( $id_hash );

        push @id_list, $id;
    }

    my $results = $schema->{driver}->lookup_multi( $schema, \@id_list );
    return (undef) x scalar(@id_list) unless $results && ref($results) eq 'HASH';

    while (my($id, $data) = each %{ $results }) {
        my $obj = $data;
        unless ($schema->{options}->{bare_row} || !$obj) {
            $obj = $schema->new_obj($self, $data);
            $schema->inflate($obj);
            $schema->call_trigger('post_load', $obj);
        }
        $results->{$id} = $obj;
    }

    map { $results->{join("\0", @{ $_ })} } @id_list;
}


#  $model->get( model_name => 'key' );
#  $model->get( model_name => [qw/ key1 key2 /] );
#  $model->get( model_name => 'key' => { query options ... });
#  $model->set( model_name => { search query, ... } );
sub get {
    my $self   = shift;
    Carp::croak "The 'get' method can not be performed during a transaction." if $self->{active_transaction};
    my $model  = shift;
    my $schema = $self->get_schema($model);
    return unless $schema;

    my $query = $self->_get_query_args($schema, @_);
    return if @_ && !@{ $query }; # undef key
    local $schema->{schema_obj} = $self;
    my($iterator, $iterator_options) = $schema->{driver}->get( $schema, @{ $query } );
    unless ($iterator) {
        return if wantarray;
        return Data::Model::Iterator::Empty->new;
    }

    if (wantarray) {
        my @objs = ();
        while (my $data = $iterator->()) {
            my $obj = $data;
            unless ($schema->{options}->{bare_row}) {
                $obj = $schema->new_obj($self, $data);
                $schema->inflate($obj);
                $schema->call_trigger('post_load', $obj);
            }
            push @objs, $obj;
        }
        $iterator_options->{end}->() if exists $iterator_options->{end} && ref($iterator_options->{end}) eq 'CODE';
        return @objs;
    }
    return Data::Model::Iterator->new(
        $iterator,
        %{ $iterator_options },
        wrapper => sub {
            return shift if $schema->{options}->{bare_row};
            my $obj = $schema->new_obj($self, shift);
            $schema->inflate($obj);
            $schema->call_trigger('post_load', $obj);
            $obj;
        },
    );
}

sub get_multi {
    my $self = shift;
    Carp::croak "The 'get_multi' method can not be performed during a transaction." if $self->{active_transaction};
}


#  $model->set( model_name => 'key' );
#  $model->set( model_name => [qw/ key1 key2 /] );
#  $model->set( model_name => 'key' => { column => 'value', ... });
#  $model->set( model_name => [qw/ key1 key2 /] => { column => 'value', ... } );
#  $model->set( model_name => { column => 'value', ... } );
sub set {
    Carp::croak "The 'set' method can not be performed during a transaction." if $_[0]->{active_transaction};
    shift->_insert_or_replace(0, @_);
}

sub replace {
    Carp::croak "The 'replace' method can not be performed during a transaction." if $_[0]->{active_transaction};
    shift->_insert_or_replace(1, @_);
}

sub _insert_or_replace {
    my $self       = shift;
    my $is_replace = shift;
    my $model      = shift;
    return $self->update($model, @_) if ref($model) && $model->isa('Data::Model::Row');
    my $schema = $self->get_schema($model);
    return unless $schema;
    # return unless exists $_[0];

    # get key array
    my $key_array;
    my $columns;
    if (ref($_[0]) eq 'HASH') {
        ## ->set( modelname => { key => value, ... } );
        $columns = shift;
        $key_array = $schema->get_key_array_by_hash($columns);
    } elsif (ref($_[0]) eq 'ARRAY') {
        ## ->set( modelname => [ keys ] => { key => value, ... } );
        $key_array = shift;
    } elsif (!ref($_[0])) {
        ## ->set( modelname => 'key' => { key => value, ... } );
        $key_array = [ shift ];
    } else {
        # return;
    }

    # get columns
    if ($columns) {
        ## nop
    } elsif (ref($_[0]) eq 'HASH') {
        ## get hash columns data
        my $hash = shift;
        $columns = $schema->get_columns_hash_by_key_array_and_hash($hash, $key_array);
    } else {
        $columns = $schema->get_columns_hash_by_key_array_and_hash(+{}, $key_array);
    }

    # deflate
    $schema->deflate($columns);
    $key_array = $schema->get_key_array_by_hash( $columns );

    # triggers
    $schema->call_trigger('pre_save', $columns);
    $schema->set_default($columns); # set default
    $schema->call_trigger('pre_insert', $columns);

    local $schema->{schema_obj} = $self;
    my $method = $is_replace ? 'replace' : 'set';
    my $result = $schema->{driver}->$method( $schema, $key_array => $columns, @_ );
    return unless $result;

    unless ($schema->{options}->{bare_row}) {
        my $obj = $schema->new_obj($self, $result);
        $schema->inflate($obj);
        $schema->call_trigger('post_load', $obj);
        return $obj;
    }
    return $result;
}

sub set_multi {
    my $self = shift;
    Carp::croak "The 'set_multi' method can not be performed during a transaction." if $self->{active_transaction};
}


sub _get_schema_by_row {
    my($self, $row) = @_;

    my $class = ref($row);
    return unless $class;

    my($klass, $model) = $class =~ /^(.+)::([^:]+)$/;
    return unless (ref($self) || $self) eq $klass;
    return $self->get_schema($model);
}

sub update {
    my $self = shift;
    Carp::croak "The 'update' method can not be performed during a transaction." if $self->{active_transaction};
    my $row  = shift;
    return $self->update_direct($row, @_) unless ref($row) && $row->isa('Data::Model::Row');

    my $schema = $self->_get_schema_by_row($row);
    return unless $schema;
    return unless @{ $schema->{key} } > 0; # not has key

    return unless scalar(%{ $row->get_changed_columns });

    my $columns         = $row->get_columns;
    my $changed_columns = $row->get_changed_columns;
    my $old_columns     = +{ %{ $columns }, %{ $changed_columns } };

    if ($schema->has_deflate) {
        # deflate
        $schema->deflate($columns);
        $schema->deflate($old_columns);
    }

    $schema->call_trigger('pre_save', $columns);
    $schema->call_trigger('pre_update', $columns, $old_columns);

    my $key_array     = $schema->get_key_array_by_hash($columns);
    my $old_key_array = $schema->get_key_array_by_hash($old_columns);

    my $result = $schema->{driver}->update(
        $schema, $old_key_array, $key_array, $old_columns, $columns, $changed_columns, @_
    );
    $row->{changed_cols} = +{};
    return unless $result;

    $row;
}


#  $model->update_direct( model_name => 'key', +{ querys }, +{ update columns } );
#  $model->update_direct( model_name => [qw/ key1 key2 /], +{ querys }, +{ update columns } );
#  $model->update_direct( model_name => +{ querys }, +{ update columns } );
# direct_update get しないで直接 updateする where の組み立ては get/delete と同じ
sub update_direct {
    my $self   = shift;
    Carp::croak "The 'update_direct' method can not be performed during a transaction." if $self->{active_transaction};
    my $model  = shift;

    my $schema = $self->get_schema($model);
    return unless $schema;

    my $query = $self->_get_query_args($schema, @_);
    return unless @{ $query };

    $schema->deflate($query->[2]);
    $schema->call_trigger('pre_save', $query->[2]);
    $schema->call_trigger('pre_update', $query->[2]);

    local $schema->{schema_obj} = $self;
    $schema->{driver}->update_direct( $schema, @{ $query } );
}


#  $model->delete( model_name => 'key' );
#  $model->delete( model_name => [qw/ key1 key2 /] );
sub delete {
    my $self = shift;
    Carp::croak "The 'delete' method can not be performed during a transaction." if $self->{active_transaction};
    my $row  = shift;
    return $self->delete_direct($row, @_) unless ref($row) && $row->isa('Data::Model::Row');

    my $schema = $self->_get_schema_by_row($row);
    return unless $schema;
    return unless @{ $schema->{key} } > 0; # not has key

    my $columns       = $row->get_columns;
    my $key_array     = $schema->get_key_array_by_hash($columns);

    local $schema->{schema_obj} = $self;
    $schema->{driver}->delete( $schema, $key_array, @_ );
}

sub delete_direct {
    my $self   = shift;
    Carp::croak "The 'delete_direct' method can not be performed during a transaction." if $self->{active_transaction};
    my $model  = shift;
    my $schema = $self->get_schema($model);
    return unless $schema;

    my $query = $self->_get_query_args($schema, @_);
    return unless @{ $query };

    local $schema->{schema_obj} = $self;
    $schema->{driver}->delete( $schema, @{ $query } );
}

sub delete_multi {
    my $self   = shift;
    Carp::croak "The 'delete_multi' method can not be performed during a transaction." if $self->{active_transaction};
}


# for transactions
sub txn_scope {
    Carp::croak "The 'txn_scope' method can not be performed during a transaction." if $_[0]->{active_transaction};
    Data::Model::Transaction->new( @_ );
}

sub txn_begin {
    my $self = shift;
    Carp::croak "The 'txn_begin' method can not be performed during a transaction." if $self->{active_transaction};
    my $driver = $self->get_base_driver;
    Carp::croak 'You cannot use transaction, Because base_driver is not set by schema.' unless $driver;
    $self->{active_transaction} = 1;

    $driver->txn_begin;
}

sub txn_rollback {
    my $self = shift;
    my $driver = $self->get_base_driver;

    $driver->txn_rollback;
    $self->txn_end;
    1;
}

sub txn_commit {
    my $self = shift;
    my $driver = $self->get_base_driver;

    $driver->txn_commit;
    $self->txn_end;
    1;
}

sub txn_end {
    my $self = shift;
    my $driver = $self->get_base_driver;
    $self->{active_transaction} = 0;
    $driver->txn_end;
}


1;
__END__