annotate Lib/IMPL/Config/Resolve.pm @ 123:1d7e370a91fa

Additional DOM::Node tests
author wizard
date Wed, 09 Jun 2010 17:53:12 +0400
parents 0667064553ef
children 76515373dac0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
1 package IMPL::Config::Resolve;
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
2 use strict;
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
3 use base qw(IMPL::Object IMPL::Object::Serializable);
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
4
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
5 use IMPL::Class::Property;
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
6 use IMPL::Exception;
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
7
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
8 BEGIN {
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
9 public property path => prop_all|prop_list;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
10 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
11
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
12 __PACKAGE__->PassThroughArgs;
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
13
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
14 sub CTOR {
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
15 my $this = shift;
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
16
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
17 my $list = $this->path;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
18
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
19 while(my $name = shift ) {
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
20 my $args = shift;
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
21 $list->Append({ method => $name, (defined $args ? (args => $args) : ()) });
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
22 }
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
23
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
24 die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path->Count;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
25 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
26
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
27 sub Invoke {
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
28 my ($this,$target,$default) = @_;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
29
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
30 my $result = $target;
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
31 $result = $this->_InvokeMember($result,$_) || return $default foreach $this->path;
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
32
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
33 return $result;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
34 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
35
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
36 sub _InvokeMember {
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
37 my ($self,$object,$member) = @_;
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
38
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
39 my $method = $member->{method};
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
40
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
41 local $@;
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
42 return eval {
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
43 ref $object eq 'HASH' ?
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
44 $object->{$method}
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
45 :
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
46 $object->$method(
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
47 exists $member->{args} ?
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
48 _as_list($member->{args})
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
49 :
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
50 ()
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
51 )
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
52 };
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
53 }
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
54
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
55 sub save {
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
56 my ($this,$ctx) = @_;
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
57
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
58 $ctx->AddVar($_->{method},$_->{args}) foreach $this->path;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
59 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
60
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
61 sub _as_list {
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
62 ref $_[0] ?
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
63 (ref $_[0] eq 'HASH' ?
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
64 %{$_[0]}
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
65 :
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
66 (ref $_[0] eq 'ARRAY'?
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
67 @{$_[0]}
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
68 :
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
69 $_[0]
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
70 )
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
71 )
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
72 :
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
73 ($_[0]);
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
74 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
75
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
76 1;