annotate Lib/IMPL/Config/Resolve.pm @ 393:69a1f1508696

minor security refactoring
author cin
date Fri, 14 Feb 2014 16:41:12 +0400
parents f534a60d5b01
children
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;
165
76515373dac0 Added Class::Template,
wizard
parents: 93
diff changeset
3 use parent 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;
206
c8fe3f84feba +IMPL::Web::Handlers::ViewSelector
sergey
parents: 199
diff changeset
7 use Carp qw(carp);
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
8
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
9 BEGIN {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
10 public property path => prop_all|prop_list;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
11 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
12
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
13 __PACKAGE__->PassThroughArgs;
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
14
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
15 sub CTOR {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
16 my $this = shift;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
17
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
18 my $list = $this->path;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
19
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
20 while(my $name = shift ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
21 my $args = shift;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
22 $list->Append({ method => $name, (defined $args ? (args => $args) : ()) });
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
23 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
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
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
26 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
27
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
28 sub Invoke {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
29 my ($this,$target,$default) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
30
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
31 my $result = $target;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
32 $result = $this->_InvokeMember($result,$_) || return $default foreach $this->path;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
33
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
34 return $result;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
35 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
36
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
37 sub _InvokeMember {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
38 my ($self,$object,$member) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
39
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
40 my $method = $member->{method};
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
41
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
42 local $@;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
43 return eval {
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
44 ref $object eq 'HASH' ?
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
45 $object->{$method}
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
46 :
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
47 $object->$method(
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
48 exists $member->{args} ?
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
49 _as_list($member->{args})
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
50 :
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
51 ()
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
52 )
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
53 };
93
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
54 }
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
55
0667064553ef fixed _is_class in activator
wizard
parents: 92
diff changeset
56 sub save {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
57 my ($this,$ctx) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
58
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
59 $ctx->AddVar($_->{method},$_->{args}) foreach $this->path;
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
60 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
61
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
62 sub _as_list {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
63 ref $_[0] ?
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
64 (ref $_[0] eq 'HASH' ?
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
65 %{$_[0]}
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
66 :
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
67 (ref $_[0] eq 'ARRAY'?
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
68 @{$_[0]}
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
69 :
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
70 $_[0]
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
71 )
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
72 )
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
73 :
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
74 ($_[0]);
92
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
75 }
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
76
5f676b61fb8b IMPL::Config::Resolve alpha version
wizard
parents:
diff changeset
77 1;