KiokuDB::TypeMap::Resolver - Caching resolver for L<KiokuDB::TypeMap>

KiokuDB documentation Contained in the KiokuDB distribution.

Index

Code Index:

NAME

Top

KiokuDB::TypeMap::Resolver - Caching resolver for KiokuDB::TypeMap

SYNOPSIS

Top

This object is used by KiokuDB::Linker and KiokuDB::Collapser to map class names to collapsing/expanding method bodies.

Since KiokuDB::TypeMaps are fairly complex, and KiokuDB::TypeMap::Entry objects can benefit from specializing to a class by precomputing some things, resolution is performed once per class, and the results are cached in the resolver.

KiokuDB documentation Contained in the KiokuDB distribution. 
#!/usr/bin/perl

package KiokuDB::TypeMap::Resolver;
use Moose;

use Carp qw(croak);

use KiokuDB::TypeMap;
use KiokuDB::TypeMap::Entry::MOP;

use namespace::clean -except => 'meta';

has typemap => (
    does => "KiokuDB::Role::TypeMap",
    is   => "ro",
);

has _compiled => (
    isa => "HashRef",
    is  => "ro",
    default => sub { return {} },
);

has fallback_entry => (
    does => "KiokuDB::TypeMap::Entry",
    is   => "ro",
    default => sub { KiokuDB::TypeMap::Entry::MOP->new },
);

sub clear_compiled {
    my $self = shift;

    %{ $self->_compiled } = ();
}

sub resolved {
    my ( $self, $class ) = @_;

    exists $self->_compiled->{$class};
}

sub collapse_method {
    my ( $self, $class ) = @_;

    return $self->find_or_resolve($class)->collapse_method;
}

sub expand_method {
    my ( $self, $class ) = @_;

    return $self->find_or_resolve($class)->expand_method;
}

sub refresh_method {
    my ( $self, $class ) = @_;

    return $self->find_or_resolve($class)->refresh_method;
}

sub id_method {
    my ( $self, $class ) = @_;

    return $self->find_or_resolve($class)->id_method;
}

sub compile_entry {
    my ( $self, $class, $entry ) = @_;

    return $self->register_compiled( $class, $entry->compile($class, $self) );
}

sub register_compiled {
    my ( $self, $class, $compiled ) = @_;

    return ( $self->_compiled->{$class} = $compiled );
}

sub find_or_resolve {
    my ( $self, $class ) = @_;

    return ( $self->_compiled->{$class} || $self->resolve($class) );
}

sub resolve {
    my ( $self, $class ) = @_;

    if ( my $entry = $self->typemap->resolve($class) ) {
        return $self->compile_entry( $class, $entry );
    } else {
        return $self->resolve_fallback($class);
    }
}

sub resolve_fallback {
    my ( $self, $class ) = @_;

    if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
        return $self->resolve_fallback_with_meta($class, $meta);
    } else {
        return $self->resolve_fallback_without_meta($class);
    }
}

sub resolve_fallback_with_meta {
    my ( $self, $class, $meta ) = @_;

    # FIXME only allow with Storage?
    return $self->compile_entry( $class => $self->fallback_entry );
}

sub resolve_fallback_without_meta {
    my ( $self, $class ) = @_;

    croak "$class has no metaclass, please provide a typemap entry or add to the allowed classes";
}

__PACKAGE__->meta->make_immutable;

__PACKAGE__

__END__