view Lib/IMPL/Class/PropertyInfo.pm @ 21:fafe56cfcd69

temp commit
author Sergey
date Wed, 30 Sep 2009 10:25:41 +0400
parents e59f44f75f20
children b544a772b654
line wrap: on
line source

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

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

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

my %LoadedModules;

sub CTOR {
    my $this = shift;
    
    $this->Mutators(0) unless defined $this->Mutators;
}

sub Implementor {
    my $this = shift;
    
    my $implementor;
    
    if (@_) {
        $this->SUPER::Implementor(@_);
    } else {
        my $implementor = $this->SUPER::Implementor;
        return $implementor if $implementor;
        
        $implementor = $this->SelectImplementor();
        
        if (my $class = ref $implementor ? undef : $implementor) {
            if (not $LoadedModules{$class}) {
                (my $package = $class.'.pm') =~ s/::/\//g;
                require $package;
                $LoadedModules{$class} = 1;
            }
        }
        
        $this->Implementor($implementor);
        return $implementor;
    }
    
}

sub SelectImplementor {
    my ($this) = @_;
    
    if ($this->Class->can('_PropertyImplementor')) {
        return $this->Class->_PropertyImplementor;
    }
    die new IMPL::Exception('Can\'t find a property implementor for the specified class',$this->Class);
}

1;