view release on metacpan or  search on metacpan

lib/Data/ObjectDriver/Driver/Multiplexer.pm  view on Meta::CPAN

use Storable();

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

__PACKAGE__->mk_accessors(qw( on_search on_lookup drivers ));

use Carp qw( croak );

sub init {
    my $driver = shift;
    $driver->SUPER::init(@_);
    my %param = @_;
    for my $key (qw( on_search on_lookup drivers )) {
        $driver->$key( $param{$key} );
    }
    return $driver;
}

sub lookup {
    my $driver = shift;
    my $subdriver = $driver->on_lookup;
    croak "on_lookup is not defined in $driver"
        unless $subdriver;
    return $subdriver->lookup(@_);
}

sub fetch_data {
    my $driver = shift;
    my $subdriver = $driver->on_lookup;
    croak "on_lookup is not defined in $driver"
        unless $subdriver;
    return $subdriver->fetch_data(@_);
}

sub lookup_multi {
    my $driver = shift;
    my $subdriver = $driver->on_lookup;
    croak "on_lookup is not defined in $driver"
        unless $subdriver;
    return $subdriver->lookup_multi(@_);
}

sub exists {
    my $driver = shift;
    my($class, $terms, $args) = @_;
    ## just assume that the first driver declared is the more efficient one
    my $sub_driver = $driver->drivers->[0];
    return $sub_driver->exists(@_);
}

sub search {
    my $driver = shift;
    my($class, $terms, $args) = @_;
    my $sub_driver = $driver->_find_sub_driver($terms)
        or croak "No matching sub-driver found";
    return $sub_driver->search(@_);
}

sub replace { shift->_exec_multiplexed('replace', @_) }
sub insert  { shift->_exec_multiplexed('insert',  @_) }
sub update  { shift->_exec_multiplexed('update',  @_) }

sub remove {
    my $driver = shift;
    my $removed = 0;
    for my $sub_driver (@{ $driver->drivers }) {
        $removed += $sub_driver->remove(@_);
    }
    if ($removed % 2) {
        warn "remove count looks incorrect, we might miss one object";
    }
    return $removed || 0E0;
}

sub _find_sub_driver {
    my $driver = shift;
    my($terms) = @_;
    for my $key (keys %$terms) {
        if (my $sub_driver = $driver->on_search->{$key}) {
            return $sub_driver;
        }
    }
}

sub _exec_multiplexed {
    my $driver = shift;
    my($meth, $obj, @args) = @_;
    my $orig_obj = Storable::dclone($obj);
    my $ret;

    ## We want to be sure to have the initial and final state of the object
    ## strictly identical as if we made only one call on $obj
    ## (Perhaps it's a bit overkill ? playing with 'changed_cols' may do the trick)
    for my $sub_driver (@{ $driver->drivers }) {
        $obj = Storable::dclone($orig_obj);
        $ret = $sub_driver->$meth($obj, @args);
    }
    return $ret;
}

sub begin_work {
    my $driver = shift;
    $driver->SUPER::begin_work(@_);
    for my $sub_driver (@{ $driver->drivers }) {
        $sub_driver->begin_work;
    }
}

sub commit {
    my $driver = shift;
    $driver->SUPER::commit(@_);
    $driver->_end_txn('commit', @_);
}

sub rollback {
    my $driver = shift;
    $driver->SUPER::rollback(@_);
    $driver->_end_txn('rollback', @_);
}

sub _end_txn {