view release on metacpan or  search on metacpan

lib/DBIx/ObjectMapper/Session.pm  view on Meta::CPAN

package DBIx::ObjectMapper::Session;
use strict;
use warnings;
use Carp::Clan qw/^DBIx::ObjectMapper/;
use Try::Tiny;
use Params::Validate qw(validate OBJECT BOOLEAN SCALAR);
use DBIx::ObjectMapper::Utils;
use DBIx::ObjectMapper::Session::Cache;
use DBIx::ObjectMapper::Session::Search;
use DBIx::ObjectMapper::Session::UnitOfWork;
use DBIx::ObjectMapper::Session::ObjectChangeChecker;
my $DEFAULT_SEARCH_CLASS = 'DBIx::ObjectMapper::Session::Search';

sub new {
    my $class = shift;

    my %attr = validate(
        @_,
        {   engine => { type => OBJECT, isa => 'DBIx::ObjectMapper::Engine' },
            autocommit   => { type => BOOLEAN, default => 1 },
            autoflush    => { type => BOOLEAN, default => 0 },
            share_object => { type => BOOLEAN, default => 0 },
            no_cache     => { type => BOOLEAN, default => 0 },
            cache        => {
                type      => OBJECT,
                callbacks => {
                    'ducktype' => sub {
                        ( grep { $_[0]->can($_) } qw(get set remove) ) == 3;
                    }
                },
                default => DBIx::ObjectMapper::Session::Cache->new()
            },
            search_class =>
                { type => SCALAR, default => $DEFAULT_SEARCH_CLASS },
            change_checker => {
                type => OBJECT,
                default =>
                    DBIx::ObjectMapper::Session::ObjectChangeChecker->new(),
                },
        }
    );

    $attr{unit_of_work}
        = DBIx::ObjectMapper::Session::UnitOfWork->new(
        ( $attr{no_cache} ? undef : $attr{cache} ),
        $attr{search_class},
        $attr{change_checker},
        {   share_object => $attr{share_object},
            autoflush    => $attr{autoflush},
        },
    );

    return bless \%attr, $class;
}

sub autocommit  { $_[0]->{autocommit} }
sub uow         { $_[0]->{unit_of_work} }
sub engine      { $_[0]->{engine} }
sub autoflush   { $_[0]->{autoflush} }

sub search {
    my $self = shift;
    $self->flush;
    return $self->uow->search(@_);
}


sub get {
    my $self = shift;
    $self->flush;
    $self->uow->get(@_);
}

sub add {
    my $self = shift;
    my $obj  = shift || return;
    $self->uow->add($obj);
    $self->start_transaction;
    $self->flush() if $self->autoflush;
    return $obj;
}

sub add_all {
    my $self = shift;
    $self->add($_) for @_;
    return @_;