Mercurial > pub > Impl
annotate Lib/IMPL/Config/Resolve.pm @ 370:cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
| author | sergey |
|---|---|
| date | Tue, 10 Dec 2013 03:02:01 +0400 |
| parents | f534a60d5b01 |
| children |
| rev | line source |
|---|---|
| 92 | 1 package IMPL::Config::Resolve; |
| 93 | 2 use strict; |
| 165 | 3 use parent qw(IMPL::Object IMPL::Object::Serializable); |
| 92 | 4 |
| 5 use IMPL::Class::Property; | |
| 6 use IMPL::Exception; | |
| 206 | 7 use Carp qw(carp); |
| 92 | 8 |
| 9 BEGIN { | |
| 194 | 10 public property path => prop_all|prop_list; |
| 92 | 11 } |
| 12 | |
| 13 __PACKAGE__->PassThroughArgs; | |
| 14 | |
| 15 sub CTOR { | |
| 194 | 16 my $this = shift; |
| 17 | |
| 18 my $list = $this->path; | |
| 19 | |
| 20 while(my $name = shift ) { | |
| 21 my $args = shift; | |
| 22 $list->Append({ method => $name, (defined $args ? (args => $args) : ()) }); | |
| 23 } | |
| 24 | |
|
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
194
diff
changeset
|
25 #die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path->Count; |
| 92 | 26 } |
| 27 | |
| 28 sub Invoke { | |
| 194 | 29 my ($this,$target,$default) = @_; |
| 30 | |
| 31 my $result = $target; | |
| 32 $result = $this->_InvokeMember($result,$_) || return $default foreach $this->path; | |
| 33 | |
| 34 return $result; | |
| 92 | 35 } |
| 36 | |
| 37 sub _InvokeMember { | |
| 194 | 38 my ($self,$object,$member) = @_; |
| 39 | |
| 40 my $method = $member->{method}; | |
| 41 | |
| 42 local $@; | |
| 43 return eval { | |
| 44 ref $object eq 'HASH' ? | |
| 45 $object->{$method} | |
| 46 : | |
| 47 $object->$method( | |
| 48 exists $member->{args} ? | |
| 49 _as_list($member->{args}) | |
| 50 : | |
| 51 () | |
| 52 ) | |
| 53 }; | |
| 93 | 54 } |
| 55 | |
| 56 sub save { | |
| 194 | 57 my ($this,$ctx) = @_; |
| 58 | |
| 59 $ctx->AddVar($_->{method},$_->{args}) foreach $this->path; | |
| 92 | 60 } |
| 61 | |
| 62 sub _as_list { | |
| 194 | 63 ref $_[0] ? |
| 64 (ref $_[0] eq 'HASH' ? | |
| 65 %{$_[0]} | |
| 66 : | |
| 67 (ref $_[0] eq 'ARRAY'? | |
| 68 @{$_[0]} | |
| 69 : | |
| 70 $_[0] | |
| 71 ) | |
| 72 ) | |
| 73 : | |
| 74 ($_[0]); | |
| 92 | 75 } |
| 76 | |
| 77 1; |