view release on metacpan or  search on metacpan

lib/Data/ObjectDriver/BaseObject.pm  view on Meta::CPAN

sub lookup_multi {
    my $class = shift;
    my $driver = $class->driver;
    my $objs = $driver->lookup_multi($class, @_) or return;
    for my $obj (@$objs) {
        $driver->cache_object($obj) if $obj;
    }
    $objs;
}

sub result {
    my $class = shift;
    my ($terms, $args) = @_;

    return Data::ObjectDriver::ResultSet->new({
                          class     => (ref $class || $class),
                          page_size => delete $args->{page_size},
                          paging    => delete $args->{no_paging},
                          terms     => $terms,
                          args      => $args,
                          });
}

sub search {
    my $class = shift;
    my($terms, $args) = @_;
    my $driver = $class->driver;
    if (wantarray) {
        my @objs = $driver->search($class, $terms, $args);

        ## Don't attempt to cache objects where the caller specified fetchonly,
        ## because they won't be complete.
        ## Also skip this step if we don't get any objects back from the search
        if (!$args->{fetchonly} || !@objs) {
            for my $obj (@objs) {
                $driver->cache_object($obj) if $obj;
            }
        }
        return @objs;
    } else {
        my $iter = $driver->search($class, $terms, $args);
        return $iter if $args->{fetchonly};

        my $caching_iter = sub {
            my $d = $driver;

            my $o = $iter->();
            unless ($o) {
                $iter->end;
                return;
            }
            $driver->cache_object($o);
            return $o;
        };
        return Data::ObjectDriver::Iterator->new($caching_iter, sub { $iter->end });
    }
}

sub remove         { shift->_proxy( 'remove',         @_ ) }
sub update         { shift->_proxy( 'update',         @_ ) }
sub insert         { shift->_proxy( 'insert',         @_ ) }
sub replace        { shift->_proxy( 'replace',        @_ ) }
sub fetch_data     { shift->_proxy( 'fetch_data',     @_ ) }
sub uncache_object { shift->_proxy( 'uncache_object', @_ ) }

sub refresh {
    my $obj = shift;
    return unless $obj->has_primary_key;
    my $fields = $obj->fetch_data;
    $obj->set_values_internal($fields);
    $obj->call_trigger('post_load');
    $obj->driver->cache_object($obj);
    return 1;
}

## NOTE: I wonder if it could be useful to BaseObject superclass
## to override the global transaction flag. If so, I'd add methods
## to manipulate this flag and the working drivers. -- Yann
sub _proxy {
    my $obj = shift;
    my($meth, @args) = @_;
    my $driver = $obj->driver;
    ## faster than $obj->txn_active && ! $driver->txn_active but see note.
    if ($TransactionLevel && ! $driver->txn_active) {
        $driver->begin_work;
        push @WorkingDrivers, $driver;
    }
    $driver->$meth($obj, @args);
}

sub txn_active { $TransactionLevel }

sub begin_work {
    my $class = shift;
    if ( $TransactionLevel > 0 ) {
        Carp::carp(
            $TransactionLevel > 1
            ? "$TransactionLevel transactions already active"
            : "Transaction already active"
        );
    }
    $TransactionLevel++;
}

sub commit {
    my $class = shift;
    $class->_end_txn('commit');
}

sub rollback {
    my $class = shift;
    $class->_end_txn('rollback');
}

sub _end_txn {
    my $class = shift;
    my $meth  =  shift;
    
    ## Ignore nested transactions
    if ($TransactionLevel > 1) {