view release on metacpan or  search on metacpan

lib/Elive/DAO.pm  view on Meta::CPAN

package Elive::DAO;
use warnings; use strict;

use Mouse;
use Mouse::Util::TypeConstraints;

our $VERSION = '1.37';

use parent 'Elive::DAO::_Base';

use YAML::Syck;
use Scalar::Util qw{weaken};
use Carp;
use Try::Tiny;
use URI;

use Elive::Util qw{1.37};

__PACKAGE__->mk_classdata('_entities' => {});
__PACKAGE__->mk_classdata('_aliases');
__PACKAGE__->mk_classdata('_derivable' => {});
__PACKAGE__->mk_classdata('_entity_name');
__PACKAGE__->mk_classdata('_primary_key' => []);
__PACKAGE__->mk_classdata('_params' => {});
__PACKAGE__->mk_classdata('collection_name');
__PACKAGE__->mk_classdata('_isa');

foreach my $accessor (qw{_db_data _deleted _is_copy}) {
    __PACKAGE__->has_metadata($accessor);
}

=head1 NAME

Elive::DAO - Abstract class for Elive Data Access Objects

=head1 DESCRIPTION

This is an abstract class for retrieving and managing objects mapped to a
datastore.

=cut

our %Stored_Objects;

sub BUILDARGS {
    my ($class, $raw, @args) = @_;

    warn "$class - ignoring arguments to new: @args\n"
	if @args;

    if (Elive::Util::_reftype($raw) eq 'HASH') {

	my $types = $class->property_types;

	my %cooked;

	my $aliases = $class->_get_aliases;

	foreach (keys %$raw) {

	    #
	    # apply any aliases
	    #

	    my $prop = (exists $aliases->{$_}
			? ($aliases->{$_}{to} or die "$class has malformed alias: $_")
			: $_);

	    my $value = $raw->{$_};
	    if (my $type = $types->{$prop}) {
		if (ref($value)) {
		    #

lib/Elive/DAO.pm  view on Meta::CPAN

    my $type = Elive::Util::_reftype( $struct );

    if ($type) {

	if (Scalar::Util::blessed $struct
	    && $struct->can('_is_copy')) {

	    $opt{copy} ||=  $struct->_is_copy;

	    $struct->_is_copy(1)
		if $opt{copy};
	}  

	# recurse
	if ($type eq 'ARRAY') {
	    foreach (0 .. scalar(@$struct)) {
		$struct->[$_] = __set_db_data($struct->[$_], $data_copy->[$_], %opt)
		    if ref $struct->[$_];
	    }
	}
	elsif ($type eq 'HASH') {
	    foreach (sort keys %$struct) {
		$struct->{$_} = __set_db_data($struct->{$_}, $data_copy->{$_}, %opt)
		    if ref $struct->{$_};
	    }
	}
	else {
	    warn "don't know how to set db data for sub-type $type";
	}

	if (Scalar::Util::blessed $struct) {
	    if ($connection && $struct->can('connection')) {

		if (!$opt{copy}
		    && $struct->can('url')
		    && (my $obj_url = $struct->url($connection))
		    ) {

		    my $cache_access;

		    if (my $cached = $Stored_Objects{ $obj_url }) {
			$cache_access = 'reuse';
			#
			# Overwrite the cached object, then reuse it.
			#
			die "attempted overwrite of object with unsaved changes ($obj_url)"
			    if !$opt{overwrite} && $cached->is_changed;

			die "cache type conflict. $obj_url contains an ".ref($cached)." object, but requested ".ref($struct)
			    unless $cached->isa(ref($struct));


			%{$cached} = %{$struct};
			$struct = $cached;
		    }
		    else {
			$cache_access = 'init';
		    }

		    # rewrite, for benefit of 5.13.3
		    weaken ($Stored_Objects{$obj_url} = $struct);

		    if ($struct->debug >= 5) {
			warn YAML::Syck::Dump({opt => \%opt, struct => $struct, class => ref($struct), url => $obj_url, cache => $cache_access, ref1 => "$struct", ref2 => "$Stored_Objects{$obj_url}"});
		    }
		}

		$struct->connection( $connection );
	    }

	    if ($struct->can('_db_data')) {
		#
		# save before image from database
		#
		$data_copy->_db_data(undef)
		    if Scalar::Util::blessed($data_copy)
		    && $data_copy->can('_db_data');

		$struct->_db_data($data_copy);
	    }
	}
    }

    return $struct;
}

#
# _freeze - construct name/value pairs for database inserts or updates
#

sub _freeze {
    my $class = shift;
    my $db_data = shift;
    my %opt = @_;

    $db_data ||= $class if ref($class);
    $db_data ||= {};
    $db_data = Elive::Util::_clone( $db_data );

    my $property_types = $class->property_types || {};
    my %param_types = $class->params;

    $class->_canonicalize_properties( $db_data );

    foreach (keys %$db_data) {

	my $property = $property_types->{$_} || $param_types{$_};

	unless ($property) {
	    my @properties = $class->properties;
	    my @param_names = sort keys %param_types;
	    Carp::croak "$class: unknown property/parameter: $_: expected: ",join(',', @properties, @param_names);
	}

	my $type_info = Elive::Util::inspect_type($property);
	my $type = $type_info->elemental_type;
	my $is_array = $type_info->is_array;

	for ($db_data->{$_}) {

	    $_ = Elive::Util::_freeze($_, $is_array ? $property : $type);