annotate lib/IMPL/Config/Resolve.pm @ 408:5c80e33f1218 ref20150831

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