File Coverage

blib/lib/DBIx/Lite.pm

Criterion	Covered	Total	%
statement	61	89	68.5
branch	14	38	36.8
condition	5	8	62.5
subroutine	16	22	72.7
pod	6	8	75.0
total	102	165	61.8

package DBIx::Lite;
$DBIx::Lite::VERSION = '0.36';
# ABSTRACT: Chained and minimal ORM
use strict;
use warnings;

use Carp qw(croak);
use DBIx::Connector;
use DBIx::Lite::ResultSet;
use DBIx::Lite::Row;
use DBIx::Lite::Schema;
use SQL::Abstract::More;

$Carp::Internal{$_}++ for __PACKAGE__, qw(DBIx::Connector);

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

    my $self = {
        schema      => delete $params{schema} || DBIx::Lite::Schema->new,
        abstract    => SQL::Abstract::More->new(
            %{ delete $params{abstract} || {} },
        ),
        connector   => delete $params{connector},
        dbh         => delete $params{dbh},
    };

    if (!$params{connector} && $params{driver_name}) {
        $self->{connector} = DBIx::Connector->new('DBI:' . delete $params{driver_name});
    }

    !%params
        or croak "Unknown options: " . join(', ', keys %params);

    ref $self->{schema} eq 'DBIx::Lite::Schema'
        or croak "schema must be a DBIx::Lite::Schema object";

    bless $self, $class;
    $self;
}

sub connect {
    my $class = shift;
    my $self = ref $class ? $class : $class->new;

    $self->{connector} = DBIx::Connector->new(@_);
    $self->{dbh} = undef;
    $self->dbh(1) or return undef;
    $self->dbh->{HandleError} = sub { croak $_[0] };

    $self;
}

sub schema {
    my $self = shift;
    if (ref $_[0] eq 'DBIx::Lite::Schema') {
        $self->{schema} = $_[0];
        return $self;
    }
    $self->{schema};
}

sub table {
    my $self = shift;
    my $table_name = shift or croak "Table name missing";

    my $table = $self->schema->table($table_name);
    my $package = $table->resultset_class || 'DBIx::Lite::ResultSet';
    $package->_new(
        dbix_lite   => $self,
        table       => $table,
    );
}

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

    my $dbh = $self->{dbh} ? $self->{dbh}
        : $self->{connector} ? $self->{connector}->dbh
        : undef;
    return $dbh ? $dbh
        : $dont_die ? undef
        : croak "No database handle or DBIx::Connector object provided";
}

sub dbh_do {
    my $self = shift;
    my $code = shift;

    if ($self->{connector}) {
        return $self->{connector}->run($code);
    } else {
        $_ = $self->dbh;
        return $code->();
    }
}

sub txn {
    my $self = shift;
    my $code = shift;

    if ($self->{connector}) {
        return $self->{connector}->txn($code);
    } else {
        $self->dbh->begin_work;
        eval { $code->() };
        if (my $err = $@) {
            eval { $self->dbh->rollback };
            croak $err;
        }
        $self->dbh->commit;
    }
}

sub driver_name {
    my $self = shift;

    return $self->{connector} ? $self->{connector}->driver_name : $self->dbh->{Driver}->{Name};
}

sub _autopk {
    my $self = shift;
    my $table_name = shift;

    my $driver_name = $self->driver_name;

    if ($driver_name eq 'mysql') {
        return $self->dbh_do(sub { +($_->selectrow_array('SELECT LAST_INSERT_ID()'))[0] });
    } elsif ($driver_name eq 'SQLite') {
        return $self->dbh_do(sub { +($_->selectrow_array('SELECT LAST_INSERT_ROWID()'))[0] });
    } elsif ($driver_name eq 'Pg') {
        return $self->dbh_do(sub { $_->last_insert_id( undef, undef, $table_name, undef ) });
    } else {
        croak "Autoincrementing ID is not supported on $driver_name";
    }
}

sub _quote {
    my $self = shift;

    return $self->{abstract}->_quote(@_);
}

1;

__END__