view release on metacpan or  search on metacpan

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

package DBIx::ObjectMapper::Mapper;
use strict;
use warnings;
use Carp::Clan qw/^DBIx::ObjectMapper/;
use List::MoreUtils;
use Scalar::Util qw(blessed weaken);
use Digest::MD5 qw(md5_hex);
use Params::Validate qw(:all);
use Class::MOP;
use Class::MOP::Class;
use Log::Any qw($log);

use DBIx::ObjectMapper::Utils;
use DBIx::ObjectMapper::Mapper::Instance;
use DBIx::ObjectMapper::Mapper::Constructor;
use DBIx::ObjectMapper::Mapper::Accessor;
use DBIx::ObjectMapper::Mapper::Attribute;
use DBIx::ObjectMapper::Metadata::Query;

{
    my %INITIALIZED_CLASSES;

    sub _set_initialized_class {
        my $self = shift;
        $INITIALIZED_CLASSES{$self->mapped_class} = 1;
    }

    sub is_initialized {
        my $self = shift;
        my $class = shift;
        return $INITIALIZED_CLASSES{$class};
    }

    sub DESTROY {
        my $self = shift;
        warn "DESTROY $self" if $ENV{MAPPER_DEBUG};
        delete $INITIALIZED_CLASSES{ $self->mapped_class }
            if $self->mapped_class;
    }

    my %POLYMORPHIC_TREE;

    sub get_polymorphic_tree {
        my $self = shift;
        my $tree = $POLYMORPHIC_TREE{$self->mapped_class} || +{};
        my @tree = map{ [ $_ => $tree->{$_} ] } keys %$tree;
        for my $child_class ( keys %$tree ) {
            my @child_tree
                = $child_class->__class_mapper__->get_polymorphic_tree;
            unshift @tree, @child_tree;
        }
        return @tree;
    }

    sub set_polymorphic_tree {
        my $self = shift;
        return
            unless $self->inherits
                and $self->polymorphic_on
                and $self->polymorphic_identity;
        my $tree = $POLYMORPHIC_TREE{$self->inherits} ||= +{};
        return $tree->{$self->mapped_class} = [
            $self->table->c($self->polymorphic_on),
            $self->polymorphic_identity,
        ];
    }