File Coverage

blib/lib/ActiveRecord/Simple.pm

Criterion	Covered	Total	%
statement	366	462	79.2
branch	129	218	59.1
condition	48	104	46.1
subroutine	52	70	74.2
pod	34	34	100.0
total	629	888	70.8

package ActiveRecord::Simple;

use 5.010;
use strict;
use warnings;

our $VERSION = '0.94';

use utf8;
use Encode;
use Carp;
use Storable qw/freeze/;
use Module::Load;
use vars qw/$AUTOLOAD/;
use Scalar::Util qw/blessed/;

use ActiveRecord::Simple::Find;
use ActiveRecord::Simple::Utils;
use ActiveRecord::Simple::Connect;

our $connector;


sub new {
    my $class = shift;
    my $param = (scalar @_ > 1) ? {@_} : $_[0];

    my $accessors_fields = $class->can('_get_columns') ? $class->_get_columns : [];

    if ($class->can('_get_mixins')) {
        my @keys = keys %{ $class->_get_mixins };
        $class->_mk_ro_accessors(\@keys);
    }
    $class->_mk_accessors($accessors_fields);

    if ($class->can('_get_relations')) {
        my $relations = $class->_get_relations();

        no strict 'refs';

        RELNAME:
        for my $relname ( keys %{ $relations } ) {
            my $pkg_method_name = $class . '::' . $relname;

            next RELNAME if $class->can($pkg_method_name);

            *{$pkg_method_name} = sub {
                my ($self, @objects) = @_;


                my $rel = $class->_get_relations->{$relname};
                my $fkey = $rel->{foreign_key} || $rel->{key};
                my $relation = $relations->{$relname};
                if (@objects) {
                    if ($relation->{type} eq 'many') {
                        if ($objects[0] && blessed $objects[0]) {
                            for my $object (@objects) {
                                my $fk = $relation->{params}{fk};
                                my $pk = $self->_get_primary_key;
                                $object->$fk($self->$pk);

                                $object->save;
                            }
                        }
                        else {
                            my $rel_class = (%{ $rel->{class} })[1];
                            return $rel_class->_find_many_to_many({
                                root_class      => $class,
                                m_class         => (%{ $rel->{class} })[0],
                                self            => $self,
                                where_statement => \@objects,
                            });
                        }
                    }
                    elsif ($relation->{type} eq 'one') {
                        OBJECT:
                        for my $object (@objects) {
                            next OBJECT unless ref $object && grep { $relation->{type} eq $_ } qw/one many/;

                            $self->{"relation_instance_$relname"} = $object;
                            my $pk = $relation->{params}{pk} or next OBJECT;
                            my $fk = $relation->{params}{fk} or next OBJECT;

                            $self->$fk($object->$pk);
                        }
                    }

                    return $self;
                }
                ### else
                if (!$self->{"relation_instance_$relname"}) {
                    my $rel  = $class->_get_relations->{$relname};
                    my $fkey = $rel->{foreign_key} || $rel->{key};

                    my $type = $rel->{type} . '_to_';
                    my $rel_class = ( ref $rel->{class} eq 'HASH' ) ?
                        ( %{ $rel->{class} } )[1]
                        : $rel->{class};

                    #load $rel_class;

                    ### TODO: check for relation existing
                    while (my ($rel_key, $rel_opts) = each %{ $rel_class->_get_relations }) {
                        my $rel_opts_class = (ref $rel_opts->{class} eq 'HASH') ?
                            (%{ $rel_opts->{class} })[1]
                            : $rel_opts->{class};
                        $type .= $rel_opts->{type} if $rel_opts_class eq $class;
                    }

                    if ($type eq 'one_to_many' or $type eq 'one_to_one' or $type eq 'one_to_only') {
                        my $fkey = $rel->{params}{fk};
                        my $pkey = $rel->{params}{pk};

                        $self->{"relation_instance_$relname"} =
                            $rel_class->find("$pkey = ?", $self->$fkey)->fetch // $rel_class;
                    }
                    elsif ($type eq 'only_to_one') {
                        my $fkey = $rel->{params}{fk};
                        my $pkey = $rel->{params}{pk};

                        $self->{"relation_instance_$relname"} =
                            $rel_class->find("$fkey = ?", $self->$pkey)->fetch;
                    }
                    elsif ($type eq 'many_to_one') {
                        return $rel_class->new() if not $self->can('_get_primary_key');
                        my $fkey = $rel->{params}{fk};
                        my $pkey = $rel->{params}{pk};

                        $self->{"relation_instance_$relname"}
                            = $rel_class->find("$fkey = ?", $self->$pkey);
                    }
                    elsif ( $type eq 'many_to_many' ) {
                        $self->{"relation_instance_$relname"} =
                            $rel_class->_find_many_to_many({
                                root_class => $class,
                                m_class    => (%{ $rel->{class} })[0],
                                self       => $self,
                            });
                    }
                    elsif ($type eq 'generic_to_generic') {
                        my %find_attrs;
                        while (my ($k, $v) = each %{ $rel->{key} }) {
                            $find_attrs{$v} = $self->$k;
                        }
                        $self->{"relation_instance_$relname"} =
                            $rel_class->find(\%find_attrs);
                    }
                }

                $self->{"relation_instance_$relname"};
            }
        }
        use strict 'refs';
    }

    $class->auto_save(0);

    return bless $param || {}, $class;
}


sub auto_load {
    my ($class) = @_;

    my @class_name_parts = split q/::/, $class;
    my $class_name = $class_name_parts[-1];

    my $table_name = join '-', map {
        join('_', map {lc} grep {length} split /([A-Z]{1}[^A-Z]*)/)
    } $class_name;
    $table_name .= 's';

    # 0. check the name
    my $table_info_sth = $class->dbh->table_info('', '%', $table_name, 'TABLE');
    $table_info_sth->fetchrow_hashref or croak "Can't find table '$table_name' in the database";

    # 1. columns list
    my $column_info_sth = $class->dbh->column_info(undef, undef, $table_name, undef);
    my $cols = $column_info_sth->fetchall_arrayref({});
    my @columns = ();
    push @columns, $_->{COLUMN_NAME} for @$cols;

    # 2. Primary key
    my $primary_key_sth = $class->dbh->primary_key_info(undef, undef, $table_name);
    my $primary_key_data = $primary_key_sth->fetchrow_hashref;
    my $primary_key = ($primary_key_data) ? $primary_key_data->{COLUMN_NAME} : undef;

    # 3. Foreign keys
    # TODO

    $class->table_name($table_name) if $table_name;
    $class->primary_key($primary_key) if $primary_key;
    $class->columns(\@columns) if @columns;
}

sub load_info {
    carp '[DEPRECATED] This method is deprecated and will be remowed in the feature. Use method "auto_load" instead.';
    $_[0]->auto_load;
}

sub _mk_accessors {
    my ($class, $fields) = @_;

    my $super = caller;
    return unless $fields;

    no strict 'refs';
    FIELD:
    for my $f (@$fields) {
        my $pkg_accessor_name = $class . '::' . $f;
        next FIELD if $class->can($pkg_accessor_name);
        *{$pkg_accessor_name} = sub {
            if ( scalar @_ > 1 ) {
                $_[0]->{$f} = $_[1];

                return $_[0];
            }

            return $_[0]->{$f};
        }
    }
    use strict 'refs';

    return 1;
}

sub _mk_ro_accessors {
    my ($class, $fields) = @_;

    return unless $fields;
    my $super = caller;

    no strict 'refs';
    FIELD:
    for my $f (@$fields) {
        my $pkg_accessor_name = $class . '::' . $f;
        next FIELD if $class->can($pkg_accessor_name);
        *{$pkg_accessor_name} = sub {
            croak "You can't change '$f': object is read-only"
                if scalar @_ > 1;

            return $_[0]->{$f}
        };
    }
}

sub connect {
    my ($class, $dsn, $username, $password, $options) = @_;

    eval { require DBIx::Connector };

    $options->{HandleError} = sub {
        my ($error_message, $DBI_st) = @_;

        $error_message or return;
        croak $error_message;

    } if ! exists $options->{HandleError};

    if ($@) {
        $connector = ActiveRecord::Simple::Connect->new($dsn, $username, $password, $options);
        $connector->db_connect;
    }
    else {
        $connector = DBIx::Connector->new($dsn, $username, $password, $options);
    }

    return 1;
}

sub belongs_to {
    my ($class, $rel_name, $rel_class, $params) = @_;

    my $new_relation = {
        class => $rel_class,
        type => 'one',
        #params => $params
    };

    my $primary_key = $params->{pk} ||
        $params->{primary_key} ||
        _guess(primary_key => $class);

    my $foreign_key = $params->{fk} ||
        $params->{foreign_key} ||
        _guess(foreign_key => $rel_class);

    $new_relation->{params} = {
        pk => $primary_key,
        fk => $foreign_key,
    };

    if ($class->can('_get_table_schema') && $class->can('_get_primary_key')) {
       ### load $rel_class;
        $class->_get_table_schema->add_constraint(
            type => 'foreign_key',
            fields => $params, ### TODO: !!!this is wrong!!!
            reference_fields => $class->_get_primary_key,
            reference_table => $rel_class->_table_name,
            on_delete => 'cascade'
        );
    }

    return $class->_append_relation($rel_name => $new_relation);
}

sub has_many {
    my ($class, $rel_name, $rel_class, $params) = @_;

    my $new_relation = {
        class => $rel_class,
        type => 'many',
    };

    $params ||= {};
    #my ($primary_key, $foreign_key);
    my $primary_key = $params->{pk} ||
        $params->{primary_key} ||
        _guess(primary_key => $class);

    my $foreign_key = $params->{fk} ||
        $params->{foreign_key} ||
        _guess(foreign_key => $class);

    $new_relation->{params} = {
        pk => $primary_key,
        fk => $foreign_key,
    };

    return $class->_append_relation($rel_name => $new_relation);
}

sub _guess {
    my ($what_key, $class) = @_;

    return 'id' if $what_key eq 'primary_key';

    eval { load $class };

    my $table_name = $class->_table_name;
    $table_name =~ s/s$// if $what_key eq 'foreign_key';

    return ($what_key eq 'foreign_key') ? "$table_name\_id" : undef;
}

sub _delete_keys {
    my ($self, $rx) = @_;

    map { delete $self->{$_} if $_ =~ $rx } keys %$self;
}

sub has_one {
    my ($class, $rel_name, $rel_class, $params) = @_;

    my $new_relation = {
        class => $rel_class,
        type => 'only',
    };

    $params ||= {};
    #my ($primary_key, $foreign_key);
    my $primary_key = $params->{pk} ||
        $params->{primary_key} ||
        _guess(primary_key => $class);

    my $foreign_key = $params->{fk} ||
        $params->{foreign_key} ||
        _guess(foreign_key => $class);

    $new_relation->{params} = {
        pk => $primary_key,
        fk => $foreign_key,
    };

    #$class->_mk_attribute_getter('_get_secondary_key', $key);
    ### TODO: add schema constraints
    $class->_append_relation($rel_name => $new_relation);
}

sub as_sql {
    my ($class, $producer_name, %args) = @_;

    eval { require SQL::Translator }
      || croak('Please install SQL::Translator to use this feature.');

    $class->can('_get_table_schema')
        or return;

    my $t = SQL::Translator->new;
    my $schema = $t->schema;
    $schema->add_table($class->_get_table_schema);

    $t->producer($producer_name || 'PostgreSQL', %args);

    return $t->translate;
}

sub generic {
    my ($class, $rel_name, $rel_class, $key) = @_;

    my $new_relation = {
        class => $rel_class,
        type => 'generic',
        key => $key
    };

    return $class->_append_relation($rel_name => $new_relation);
}

sub _append_relation {
    my ($class, $rel_name, $rel_hashref) = @_;

    if ($class->can('_get_relations')) {
        my $relations = $class->_get_relations();
        $relations->{$rel_name} = $rel_hashref;
        $class->relations($relations);
    }
    else {
        $class->relations({ $rel_name => $rel_hashref });
    }

    return;
}

sub columns {
    my ($class, @args) = @_;

    #return if $class->can('_get_columns');

    my $columns = [];
    if (scalar @args == 1) {
        my $arg = shift @args;
        if (ref $arg && ref $arg eq 'ARRAY') {
            $columns = $arg;
        }
        elsif (ref $arg && ref $arg eq 'HASH') {
            $columns = [keys %$arg];
            $class->fields(%$arg);
        }
        else {
            # just one column?
            push @$columns, $arg;
        }
    }
    elsif (scalar @args > 1) {
        push @$columns, @args;
    }

    $class->_mk_attribute_getter('_get_columns', $columns);
}

sub mixins {
    my ($class, %mixins) = @_;

    $class->_mk_attribute_getter('_get_mixins', \%mixins);
}

sub fields {
    my ($class, %fields) = @_;

    eval { require SQL::Translator }
      || croak('Please install SQL::Translator to use this feature. ');

    my $sql_translator = SQL::Translator->new(no_comments => 1);
    my $schema = $sql_translator->schema;
    my $table = $schema->add_table(name => $class->_table_name);

    FIELD:
    for my $field (keys %fields) {
        $table->add_field(name => $field, %{ $fields{$field} });
    }

    $class->_mk_attribute_getter('_get_table_schema', $table);
    $class->columns([keys %fields]);
}

sub index {
    my ($class, $index_name, $fields) = @_;

    if ($class->can('_get_table_schema')) {
        $class->_get_table_schema->add_index(
            name => $index_name,
            fields => $fields
        );
    }
}

sub primary_key {
    my ($class, $primary_key) = @_;

    $class->_mk_attribute_getter('_get_primary_key', $primary_key);
    $class->_get_table_schema->primary_key($primary_key)
        if $class->can('_get_table_schema')
}

sub secondary_key {
    my ($class, $key) = @_;

    $class->_mk_attribute_getter('_get_secondary_key', $key);
}

sub table_name {
    my ($class, $table_name) = @_;

    $class->_mk_attribute_getter('_get_table_name', $table_name);
}

sub _table_name {
    my $class = ref $_[0] ? ref $_[0] : $_[0];

    croak 'Invalid data class' if $class =~ /^ActiveRecord::Simple/;

    my $table_name =
        $class->can('_get_table_name') ?
            $class->_get_table_name
            : ActiveRecord::Simple::Utils::class_to_table_name($class);

    return $table_name;
}

sub auto_save {
    my ($class, $is_on) = @_;

    $is_on = 1 if not defined $is_on;

    $class->_mk_attribute_getter('_smart_saving_used', $is_on);
}

sub use_smart_saving {
    carp '[DEPRECATED] Method "use_smart_saving" is deprecated and will be removed in the future. Please, use "auto_save" method insted.';
    $_[0]->auto_save;
}

sub relations {
    my ($class, $relations) = @_;

    $class->_mk_attribute_getter('_get_relations', $relations);
}

sub _mk_attribute_getter {
    my ($class, $method_name, $return) = @_;

    my $pkg_method_name = $class . '::' . $method_name;
    if ( !$class->can($pkg_method_name) ) {
        no strict 'refs';
        *{$pkg_method_name} = sub { $return };
    }
}

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

    if ($dbh) {
        if ($connector) {
            $connector->dbh($dbh);
        }
        else {
            $connector = ActiveRecord::Simple::Connect->new();
            $connector->dbh($dbh);
        }
    }

    return $connector->dbh;
}

sub save {
    my ($self) = @_;

    #return unless $self->dbh;
    croak "Undefined database handler" unless $self->dbh;

    return 1 if $self->_smart_saving_used
        and defined $self->{snapshoot}
        and $self->{snapshoot} eq freeze $self->to_hash;

    croak 'Object is read-only'
        if exists $self->{read_only} && $self->{read_only} == 1;

    my $save_param = {};
    my $fields = $self->_get_columns;

    my $pkey = ($self->can('_get_primary_key')) ? $self->_get_primary_key : undef;

    FIELD:
    for my $field (@$fields) {
        next FIELD if defined $pkey && $field eq $pkey && !$self->{$pkey};
        next FIELD if ref $field && ref $field eq 'HASH';
        $save_param->{$field} = $self->{$field};
    }

    ### Get additional fields from related objects:
    for my $field (keys %$self) {
        next unless ref $self->{$field};
        next unless $self->can('_get_relations');
        next unless grep { $_ eq $field } keys %{ $self->_get_relations };

        my $relation = $self->_get_relations->{$field} or next;
        next unless $relation->{type} && $relation->{type} eq 'one';

        my $fk = $relation->{params}{fk};
        my $pk = $relation->{params}{pk};

        $save_param->{$fk} = $self->{$field}->$pk;
    }

    my $result;
    if ($self->{isin_database}) {
        $result = $self->_update($save_param);
    }
    else {
        $result = $self->_insert($save_param);
    }
    $self->{need_to_save} = 0 if $result;
    delete $self->{SQL} if $result;

    return (defined $result) ? $self : undef;
}

sub update {
    my ($self, $params) = @_;

    my $fields = $self->_get_columns();
    FIELD:
    for my $field (@$fields) {
        next FIELD if ! exists $params->{$field};
        next FIELD if ! $params->{$field};

        $self->$field($params->{$field});
    }

    return $self;
}

sub _insert {
    my ($self, $param) = @_;

    return unless $self->dbh && $param;

    my $table_name  = $self->_table_name;
    my @field_names  = grep { defined $param->{$_} } sort keys %$param;
    my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
                      ($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;

    my $field_names_str = join q/, /, map { q/"/ . $_ . q/"/ } @field_names;

    my (@bind, @values_list);
    for (@field_names) {
        if (ref $param->{$_} eq 'SCALAR') {
            push @values_list, ${ $param->{$_} };
        }
        else {
            push @values_list, '?';
            push @bind, $param->{$_};
        }
    }
    my $values = join q/, /, @values_list;
    my $pkey_val;
    my $sql_stm = qq{
        INSERT INTO "$table_name" ($field_names_str)
        VALUES ($values)
    };

    if ( $self->dbh->{Driver}{Name} eq 'Pg' ) {
        if ($primary_key) {
            $sql_stm .= ' RETURINIG ' . $primary_key if $primary_key;
            $sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name});
            $pkey_val = $self->dbh->selectrow_array($sql_stm, undef, @bind);
        }
        else {
            my $sth = $self->dbh->prepare(
                ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
            );

            $sth->execute(@bind);
        }
    }
    else {
        my $sth = $self->dbh->prepare(
            ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
        );
        $sth->execute(@bind);

        if ( $primary_key && defined $self->{$primary_key} ) {
            $pkey_val = $self->{$primary_key};
        }
        else {
            $pkey_val = $self->dbh->last_insert_id(undef, undef, $table_name, undef);
        }
    }

    if (defined $primary_key && $self->can($primary_key) && $pkey_val) {
        $self->$primary_key($pkey_val);
    }
    $self->{isin_database} = 1;

    return $pkey_val;
}

sub _update {
    my ($self, $param) = @_;

    return unless $self->dbh && $param;

    my $table_name      = $self->_table_name;
    my @field_names     = sort keys %$param;
    my $primary_key     = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
                          ($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;

    my (@set_list, @bind);
    for (@field_names) {
        if (ref $param->{$_} eq 'SCALAR') {
            push @set_list, $_ . ' = ' . ${ $param->{$_} };
        }
        else {
            push @set_list, "$_ = ?";
            push @bind, $param->{$_};
        }
    }
    my $setstring = join q/, /, @set_list;
    push @bind, $self->{$primary_key};

    my $sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt(
        qq{
            UPDATE "$table_name" SET $setstring
            WHERE
                $primary_key = ?
        },
        $self->dbh->{Driver}{Name}
    );

    return $self->dbh->do($sql_stm, undef, @bind);
}

# param:
#     cascade => 1
sub delete {
    my ($self, $param) = @_;

    return unless $self->dbh;

    my $table_name = $self->_table_name;
    my $pkey = $self->_get_primary_key;

    return unless $self->{$pkey};

    my $sql = qq{
        DELETE FROM "$table_name" WHERE $pkey = ?
    };
    $sql .= ' CASCADE ' if $param && $param->{cascade};

    my $res = undef;
    $sql = ActiveRecord::Simple::Utils::quote_sql_stmt($sql, $self->dbh->{Driver}{Name});

    if ( $self->dbh->do($sql, undef, $self->{$pkey}) ) {
        $self->{isin_database} = undef;
        delete $self->{$pkey};

        $res = 1;
    }

    return $res;
}

sub is_defined {
    my ($self) = @_;

    return grep { defined $self->{$_} } @{ $self->_get_columns };
}

# param:
#     only_defined_fields => 1
###  TODO: refactor this
sub to_hash {
    my ($self, $param) = @_;

    my $field_names = $self->_get_columns;
    push @$field_names, keys %{ $self->_get_mixins } if $self->can('_get_mixins');
    my $attrs = {};

    for my $field (@$field_names) {
        next if ref $field;
        if ( $param && $param->{only_defined_fields} ) {
            $attrs->{$field} = $self->{$field} if defined $self->$field;
        }
        else {
            $attrs->{$field} = $self->{$field};
        }
    }

    return $attrs;
}

sub increment {
    my ($self, @fields) = @_;

    FIELD:
    for my $field (@fields) {
        next FIELD if not exists $self->{$field};
        $self->{$field} += 1;
    }

    return $self;
}

sub decrement {
    my ($self, @fields) = @_;

    FIELD:
    for my $field (@fields) {
        next FIELD if not exists $self->{$field};
        $self->{$field} -= 1;
    }

    return $self;
}

#### Find ####

sub find   { ActiveRecord::Simple::Find->new(shift, @_) }
sub get    { shift->find(@_)->fetch } ### TODO: move to Finder
sub count  { ActiveRecord::Simple::Find->count(shift, @_) }

sub exists {
    my $first_arg = shift;

    my ($class, @search_criteria);
    if (ref $first_arg) {
        # FOXME: Ugly solution, need some beautifulness =)
        # object method
        $class = ref $first_arg;

        if ($class eq 'ActiveRecord::Simple::Find') {
            return $first_arg->exists;
        }
        else {
            return ActiveRecord::Simple::Find->new($class, $first_arg->to_hash({ only_defined_fields => 1 }))->exists;
        }
    }
    else {
        carp '[DEPRECATED] This way of using method "exists" is deprecated. Please, see documentation to know how does it work now.';
        $class = $first_arg;
        @search_criteria = @_;
        return (defined $class->find(@search_criteria)->fetch) ? 1 : 0;
    }


}

sub first  { croak '[DEPRECATED] Using method "first" as a class-method is deprecated. Sorry about that. Please, use "first" in this way: "Model->find->first".'; }
sub last   { croak '[DEPRECATED] Using method "last" as a class-method is deprecated. Sorry about that. Please, use "last" in this way: "Model->find->last".'; }
sub select { ActiveRecord::Simple::Find->select(shift, @_) }

sub _find_many_to_many { ActiveRecord::Simple::Find->_find_many_to_many(shift, @_) }

sub DESTROY {}

### FIXME: this implementation is actually too slow, need much faster solution
sub AUTOLOAD {
    my ($self, $param) = @_;

    my $sub = $AUTOLOAD; $sub =~ s/.*:://g;
    my $error = "Unknown method: $sub";

    croak "Error while executing '$sub' method, '$self' is not a valid (blessed) object." unless blessed $self;
    croak "Undefined object for method $sub: must be not undef" unless $param;

    croak $error unless $self->can('_get_relations');
    my @many2manies;
    my $relations = $self->_get_relations;

    my $subclass = undef;
    my %class_options;
    for my $relation (values %$relations) {
        next unless $relation->{type} eq 'many' && ref $relation->{class} eq 'HASH';
        ($subclass) = keys %{ $relation->{class} };
        next if !$subclass->can('_get_relations');
        my $relations2 = $subclass->_get_relations;

        for my $rel_name (keys %$relations2) {
            next unless exists $relations2->{$rel_name};

            my $pk = $relations2->{$rel_name}{params}{pk};
            my $fk = $relations2->{$rel_name}{params}{fk};

            next unless $pk && $fk;

            $class_options{$fk} = ($rel_name eq $sub) ? $param->$pk : $self->$pk;
        }
    }

    return $subclass->new(\%class_options);
}

### Private

1;

__END__;