Data-ObjectDriver

 view release on metacpan or  search on metacpan

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

# $Id$

package Data::ObjectDriver::BaseObject;
use strict;
use warnings;

our $HasWeaken;
eval q{ use Scalar::Util qw(weaken) }; ## no critic
$HasWeaken = !$@;

use Carp ();

use Class::Trigger qw( pre_save post_save post_load pre_search
                       pre_insert post_insert pre_update post_update
                       pre_remove post_remove post_inflate );

use Data::ObjectDriver::ResultSet;

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

                my $id = (ref($column) eq 'ARRAY')
                    ? [ map { $obj->{column_values}->{$_} } @{$column}]
                    : $obj->{column_values}->{$column}
                    ;
                ## Hold in a variable here too, so we don't lose it immediately
                ## by having only the weak reference.
                my $ret = $parentclass->lookup($id);
                if ($HasWeaken) {
                    $obj->{$cachekey} = $ret;
                    weaken($obj->{$cachekey});
                }
                return $ret;
            };
        } else {
            if (ref($column)) {
                no strict 'refs'; ## no critic
                *{"${class}::$method"} = sub {
                    my $obj = shift;
                    return $parentclass->lookup([ map{ $obj->{column_values}->{$_} } @{$column}]);
                };

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

use Data::ObjectDriver::SQL;
use Data::ObjectDriver::Driver::DBD;
use Data::ObjectDriver::Iterator;

my $ForkSafe = _is_fork_safe();
my %Handles;

sub _is_fork_safe {
    return if exists $ENV{DOD_FORK_SAFE} and !$ENV{DOD_FORK_SAFE};
    eval { require POSIX::AtFork; 1 } or return;
    eval { require Scalar::Util; Scalar::Util->import('weaken'); 1 } or return;
    return 1;
}

__PACKAGE__->mk_accessors(qw( dsn username password connect_options get_dbh dbd prefix reuse_dbh force_no_prepared_cache));


sub init {
    my $driver = shift;
    my %param = @_;
    for my $key (keys %param) {

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

        } elsif (my $getter = $driver->get_dbh) {
## Ugly. Shouldn't have to connect just to get the driver name.
            my $dbh = $getter->();
            $type = $dbh->{Driver}{Name};
        }
        $driver->dbd(Data::ObjectDriver::Driver::DBD->new($type));
    }

    if ($ForkSafe) {
        # Purge cached handles
        weaken(my $driver_weaken = $driver);
        POSIX::AtFork->add_to_child(sub {
            return unless $driver_weaken;
            $driver_weaken->{dbh} = undef;
            %Handles = ();
        });
    }

    $driver;
}

sub generate_pk {
    my $driver = shift;
    if (my $generator = $driver->pk_generator) {

t/07-has-a-cached.t  view on Meta::CPAN

use Test::More;
use Test::Exception;
use Scalar::Util;
use DodTestUtil;
BEGIN {
    DodTestUtil->check_driver;

    unless (eval { require Cache::Memory }) {
        plan skip_all => 'Tests require Cache::Memory';
    }
    unless (eval 'use Scalar::Util qw(weaken); 1') {
        plan skip_all => 'Tests require weakref';
    }
}

plan tests => 3;

use Recipe;
use Ingredient;

setup_dbs({