Mercurial > pub > Impl
view Lib/IMPL/Class/PropertyInfo.pm @ 103:c289ed9662ca
Schema beta 2
More strict validation, support for inflating a simple nodes and properties
author | wizard |
---|---|
date | Fri, 07 May 2010 18:17:40 +0400 |
parents | b0c068da93ac |
children | 44977efed303 |
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 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; 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;