Mercurial > pub > Impl
changeset 93:0667064553ef
fixed _is_class in activator
rewritten IMPL::Config::Resolve
new features in the Abstract class
author | wizard |
---|---|
date | Wed, 28 Apr 2010 17:50:55 +0400 |
parents | 5f676b61fb8b |
children | 79bf75223afe |
files | Lib/IMPL/Config/Activator.pm Lib/IMPL/Config/Resolve.pm Lib/IMPL/Object/Abstract.pm _test/temp.pl |
diffstat | 4 files changed, 59 insertions(+), 25 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Config/Activator.pm Tue Apr 27 20:10:07 2010 +0400 +++ b/Lib/IMPL/Config/Activator.pm Wed Apr 28 17:50:55 2010 +0400 @@ -21,7 +21,7 @@ sub _is_class { no strict 'refs'; - scalar keys %{"$_[0]::"} ? 1 : 0; + UNIVERSAL::can($_[0],'new') ? 1 : 0; } sub activate { @@ -44,7 +44,7 @@ push @args, map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @_ if @_; my $factory = $this->factory; - eval "require $factory; 1;" unless ref $factory or _is_class($factory); + eval "require $factory; 1;" unless (ref $factory or _is_class($factory)); return $this->object($factory->new(@args)); } else {
--- a/Lib/IMPL/Config/Resolve.pm Tue Apr 27 20:10:07 2010 +0400 +++ b/Lib/IMPL/Config/Resolve.pm Wed Apr 28 17:50:55 2010 +0400 @@ -1,47 +1,61 @@ package IMPL::Config::Resolve; -use base qw(IMPL::Object IMPL::Object::Autofill IMPL::Object::Serializable); +use strict; +use base qw(IMPL::Object IMPL::Object::Serializable); use IMPL::Class::Property; use IMPL::Exception; BEGIN { - public property target => prop_all; - public property path => prop_all; - public property default => prop_all + public property path => prop_all|prop_list; } __PACKAGE__->PassThroughArgs; sub CTOR { - my ($this) = @_; + my $this = shift; + + my $list = $this->path; - die new IMPL::InvalidArgumentException("The argument is mandatory","target") unless $this->target; - die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path; + while(my $name = shift ) { + my $args = shift; + $list->Append({ method => $name, (defined $args ? (args => $args) : ()) }); + } + + die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path->Count; } sub Invoke { - my ($this) = @_; - - my $path = $this->path; + my ($this,$target,$default) = @_; - if (ref $path eq 'ARRAY') { - my $result = $this->target; - $result = $this->_InvokeMember($result,$_) || return $this->default foreach @$path; - return $result; - } elsif (not ref $path) { - my $result = $this->target; - $result = $this->_InvokeMember($result,$_) || return $this->default foreach map { name => $_},split /\./,$this->path; - return $result; - } else { - die new IMPL::InvalidOperationException("Unsopported path type",ref $path); - } + my $result = $target; + $result = $this->_InvokeMember($result,$_) || return $default foreach $this->path; + + return $result; } sub _InvokeMember { my ($self,$object,$member) = @_; + my $method = $member->{method}; + local $@; - return eval { $object->($member->{method})(exists $member->{parameters} ? _as_list($member->{parameters}) : ()) }; + return eval { + ref $object eq 'HASH' ? + $object->{$method} + : + $object->$method( + exists $member->{args} ? + _as_list($member->{args}) + : + () + ) + }; +} + +sub save { + my ($this,$ctx) = @_; + + $ctx->AddVar($_->{method},$_->{args}) foreach $this->path; } sub _as_list {
--- a/Lib/IMPL/Object/Abstract.pm Tue Apr 27 20:10:07 2010 +0400 +++ b/Lib/IMPL/Object/Abstract.pm Wed Apr 28 17:50:55 2010 +0400 @@ -73,6 +73,10 @@ return (ref $self || $self); } +sub type { + ref $_[0] || $_[0]; +} + sub isDisposed { 0; }
--- a/_test/temp.pl Tue Apr 27 20:10:07 2010 +0400 +++ b/_test/temp.pl Wed Apr 28 17:50:55 2010 +0400 @@ -1,3 +1,19 @@ #!/usr/bin/perl +use strict; + +package Boz; -warn join "\n", keys %{__PACKAGE__.'::'}; \ No newline at end of file +sub run { + my ($self,$code) = @_; + + $code->('Boz'); +} + +sub speak { + my ($self,$str) = @_; + print "Boz: $str"; +} + +sub type { $_[0]; } + +print type Boz; \ No newline at end of file