File Coverage

blib/lib/Data/ObjectDriver.pm

Criterion	Covered	Total	%
statement	17	79	21.5
branch	0	18	0.0
condition	0	14	0.0
subroutine	6	22	27.2
pod	4	13	30.7
total	27	146	18.4

# $Id$

package Data::ObjectDriver;
use strict;
use warnings;
use 5.006_001;
use Class::Accessor::Fast;

use base qw( Class::Accessor::Fast );
use Data::ObjectDriver::Iterator;

__PACKAGE__->mk_accessors(qw( pk_generator txn_active ));

our $VERSION = '0.22';
our $DEBUG = $ENV{DOD_DEBUG} || 0;
our $PROFILE = $ENV{DOD_PROFILE} || 0;
our $PROFILER;
our $LOGGER;

sub new {
    my $class = shift;
    my $driver = bless {}, $class;
    $driver->init(@_);
    $driver;
}

sub logger {
    my $class = shift;
    if ( @_ ) {
        return $LOGGER = shift;
    } else {
        return $LOGGER ||= sub {
            print STDERR @_;
        };
    }
}

sub init {
    my $driver = shift;
    my %param = @_;
    $driver->pk_generator($param{pk_generator});
    $driver->txn_active(0);
    $driver;
}

# Alias record_query to start_query
*record_query = \*start_query;

sub start_query {
    my $driver = shift;
    my($sql, $bind) = @_;

    $driver->debug($sql, $bind) if $DEBUG;
    $driver->profiler($sql) if $PROFILE;

    return;
}

sub end_query { }

sub begin_work {
    my $driver = shift;
    $driver->txn_active(1);
    $driver->debug(sprintf("%14s", "BEGIN_WORK") . ": driver=$driver");
}

sub commit {
    my $driver = shift;
    _end_txn($driver, 'commit');
}

sub rollback {
    my $driver = shift;
    _end_txn($driver, 'rollback');
}

sub _end_txn {
    my $driver = shift;
    my $method = shift;
    $driver->txn_active(0);
    $driver->debug(sprintf("%14s", uc($method)) . ": driver=$driver");
}

sub debug {
    my $driver = shift;
    return unless $DEBUG;

    my $class = ref $driver || $driver;
    my @caller;
    my $i = 0;
    while (1) {
        @caller = caller($i++);
        last if $caller[0] !~ /^(Data::ObjectDriver|$class)/;
    }

    my $where = " in file $caller[1] line $caller[2]\n";

    if (@_ == 1 && !ref($_[0])) {
        $driver->logger->( @_, $where );
    } else {
        require Data::Dumper;
        local $Data::Dumper::Indent = 1;
        $driver->logger->( Data::Dumper::Dumper(@_), $where );
    }
}

sub profiler {
    my $driver = shift;
    my ($sql) = @_;
    local $@;
    $PROFILER ||= eval {
        require Data::ObjectDriver::Profiler;
        Data::ObjectDriver::Profiler->new;
    };
    return $PROFILE = 0 if $@ || !$PROFILER;
    return $PROFILER unless @_;
    $PROFILER->record_query($driver, $sql);
}

sub list_or_iterator {
    my $driver = shift;
    my($objs) = @_;

    ## Emulate the standard search behavior of returning an
    ## iterator in scalar context, and the full list in list context.
    if (wantarray) {
        return @{$objs};
    } else {
        my $iter = sub { shift @{$objs} };
        return Data::ObjectDriver::Iterator->new($iter);
    }
}

sub cache_object { }
sub uncache_object { }

1;
__END__