view release on metacpan or  search on metacpan

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

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

    my $table_name = class_to_table_name($class);

    # 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;

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

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',
    };

    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,
    };

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

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

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

    $params ||= {};
    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,
    };

    $new_relation->{via_table} = $params->{via} if $params->{via};

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

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->_append_relation($rel_name => $new_relation);
    #$class->_mk_relations_accessors;
}

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);
    $class->_mk_relations_accessors;
}

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

    croak "Error: array-ref no longer supported for 'columns' method, sorry"
        if scalar @columns_list == 1 && ref $columns_list[0] eq 'ARRAY';

    $class->_mk_attribute_getter('_get_columns', \@columns_list);
    $class->_mk_rw_accessors(\@columns_list) unless $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
}

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

    $flag //= 1; # default value

    $class->_mk_attribute_getter('_make_columns_accessors', $flag);
}

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

    $class->_mk_attribute_getter('_get_mixins', \%mixins);
    $class->_mk_ro_accessors([keys %mixins]);
}

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

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

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

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

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

        }
    }
    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);
}

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

    return unless $fields;
    return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;

    $class->_mk_accessors($fields, 'rw');
}


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

    return unless $fields;
    return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;

    $class->_mk_accessors($fields, 'ro');
}

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

    $type ||= 'rw';
    my $code_string = q//;
    METHOD_NAME:
    for my $method_name (@$fields) {
        next METHOD_NAME if $class->can($method_name);
        $code_string .= "sub $method_name {\n";
        if ($type eq 'rw') {
            $code_string .= "if (\@_ > 1) { \$_[0]->{$method_name} = \$_[1]; return \$_[0] }\n";
        }
        elsif ($type eq 'ro') {
            $code_string .= "die 'Object is read-only, sorry' if \@_ > 1;\n";
        }
        $code_string .= "return \$_[0]->{$method_name};\n }\n";
    }

    eval "package $class;\n $code_string" if $code_string;

    say $@ if $@;

}

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

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

    #eval { load $class }; ### TODO: check class has been loaded 
    #load $class unless is_loaded $class;
    #mark_as_loaded $class;
    load_module $class;


    my $table_name = _what_is_the_table_name($class);
    
    $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 _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 $rel_hashref;
}

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

    return if $class->can($method_name);

    eval "package $class; \n sub $method_name { \$return }";
}

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

    my $relations = $class->_get_relations;

    no strict 'refs';
    RELATION_NAME:
    for my $relation_name ( keys %{ $relations }) {
        my $pkg_method_name = $class . '::' . $relation_name;
        next RELATION_NAME if $class->can($pkg_method_name); ### FIXME: orrrr $relation_name???

        my $relation           = $relations->{$relation_name};
        my $full_relation_type = _get_relation_type($class, $relation);
        my $related_class      = _get_related_class($relation);