File Coverage

lib/DBIx/ActiveRecord.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package DBIx::ActiveRecord;

use 5.008008;
use strict;
use warnings;

use DBI;

our $VERSION = '0.03';

our $DBH;
our $SINGLETON;
our %GLOBAL;

sub connect {
    my ($self, $data_source, $user_name, $auth, $attr) = @_;
    $DBH = DBI->connect($data_source, $user_name, $auth, $attr);
    $SINGLETON = bless {dbh => $DBH}, $self;
    $self->init;
}

sub init {
    my $self = shift;
    foreach my $package (keys %GLOBAL) {
        $self->_load_model($package);
        $self->_make_field_accessors($package);
    }
    $self->_define_associates;
}

sub _load_model {
    my ($self, $package) = @_;
    my $file = $package;
    $file =~ s/::/\//;
    $file .= ".pm";
    eval {require $file};
}

sub _make_field_accessors {
    my $self = shift;
    my $pkg = shift;
    no strict 'refs';
    foreach my $col (@{$pkg->_global->{columns}}) {
        *{$pkg."::$col"} = sub {
            my $self = shift;
            @_ ? $self->set_column($col, @_) : $self->get_column($col);
        };
    }
}

sub _define_associates {
    my $self = shift;
    foreach my $package (keys %GLOBAL) {
        $self->_define_belong_to($package, @$_) for @{$package->_global->{belongs_to}||[]};
        $self->_define_has_relation($package, @$_) for @{$package->_global->{has_relation}||[]};
    }
}

sub _define_belong_to {
    my ($self, $pkg, $name, $package, $opt) = @_;

    $opt->{primary_key} = 'id' if !$opt->{primary_key};
    if (!$opt->{foreign_key}) {
        $package =~ /([^:]+)$/;
        $opt->{foreign_key} = lc($1)."_id";
    }

    $pkg->_global->{joins}->{$name} = {%$opt, model => $package, belongs_to => 1, one => 1};

    no strict 'refs';
    *{$pkg."::$name"} = sub {
        my $self = shift;

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

        my $m = $opt->{foreign_key};
        $package->unscoped->eq($opt->{primary_key} => $self->$m)->first;
    };
}

sub _define_has_relation {
    my ($self, $pkg, $name, $package, $opt, $has_one) = @_;

    $opt->{primary_key} = 'id' if !$opt->{primary_key};
    if (!$opt->{foreign_key}) {
        $pkg =~ /([^:]+)$/;
        $opt->{foreign_key} = lc($1)."_id";
    }

    $pkg->_global->{joins}->{$name} = {%$opt, model => $package, one => $has_one};

    no strict 'refs';
    *{$pkg."::$name"} = sub {
        my $self = shift;

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

        my $m = $opt->{primary_key};
        my $s = $package->eq($opt->{foreign_key}, $self->$m);
        $has_one ? $s->limit(1)->first : $s;
    };
}

sub dbh {$DBH}

sub transaction {
    my ($self, $coderef) = @_;
    $self->dbh->begin_work;
    eval {$coderef->()};
    if ($@) {
      $self->dbh->rollback;
    } else {
      $self->dbh->commit;
    }
}

sub DESTROY {
    my ($self) = @_;
    $SINGLETON = undef;
    $self->dbh->disconnect if $self->dbh;
}

1;
__END__