view Lib/IMPL/Class/PropertyInfo.pm @ 165:76515373dac0

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents 6ce1f052b90a
children d1676be8afcc
line wrap: on
line source

package IMPL::Class::PropertyInfo;
use strict;
use IMPL::_core::version;

use parent qw(IMPL::Class::MemberInfo);

__PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet ownerSet));
__PACKAGE__->PassThroughArgs;

my %LoadedModules;

sub CTOR {
    my $this = shift;
    
    if ( my $type = $this->Attributes ? delete $this->Attributes->{type} : undef ) {
        $this->Type($type);
    }
    
    $this->Mutators(0) unless defined $this->Mutators;
}

sub Implementor {
    my $this = shift;
        
    if (@_) {
        $this->SUPER::Implementor(@_);
    } else {
        my $implementor = $this->SUPER::Implementor;
        return $implementor if $implementor;
        
        $implementor = $this->SelectImplementor();
        
        if (my $class = ref $implementor ? undef : $implementor) {
            eval "require $class; 1;" or die $@ unless $LoadedModules{$class}++;
        }
        
        $this->Implementor($implementor);
    }
    
}

sub SelectImplementor {
    eval {$_[0]->Class->_PropertyImplementor} or die new IMPL::Exception('Can\'t find a property implementor for the specified class',$_[0]->Class);
}

1;