Mercurial > pub > Impl
annotate Lib/IMPL/Web/View/Metadata/ObjectMeta.pm @ 373:3ca44e23fd1f
implemented new web resource
author | cin |
---|---|
date | Wed, 25 Dec 2013 17:29:38 +0400 |
parents | d5c8b955bf8d |
children |
rev | line source |
---|---|
370
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
1 package IMPL::Web::View::Metadata::ObjectMeta; |
369 | 2 use strict; |
3 | |
370
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
4 use IMPL::lang; |
371 | 5 use IMPL::Const qw(:prop :access); |
369 | 6 use IMPL::declare { |
7 require => { | |
8 Exception => 'IMPL::Exception', | |
9 ArgException => '-IMPL::InvalidArgumentException', | |
10 OpException => '-IMPL::InvalidOperationException', | |
11 PropertyInfo => 'IMPL::Class::PropertyInfo', | |
12 AbstractObject => '-IMPL::Object::Abstract' | |
13 }, | |
14 base => [ | |
370
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
15 'IMPL::Web::View::Metadata::BaseMeta' => sub { |
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
16 my ($model,$type,$args) = @_; |
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
17 $type ||= typeof($model); |
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
18 return ($model,$type,$args); |
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
19 } |
369 | 20 ], |
21 props => [ | |
22 isMultiple => PROP_RO, | |
23 holdingType => PROP_RO | |
24 ] | |
25 }; | |
26 | |
27 use constant { | |
28 Meta => __PACKAGE__ | |
29 }; | |
30 | |
31 sub CTOR { | |
32 my ($this,$model,$type,$args) = @_; | |
33 | |
370
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
34 $type = $this->modelType; |
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
35 |
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
36 $args->{isMultiple} ||= $type && $type eq 'ARRAY'; |
369 | 37 |
38 if ($args) { | |
39 $this->$_($args->{$_}) foreach grep $args->{$_}, qw(isMultiple holdingType); | |
40 } | |
41 } | |
42 | |
43 sub PopulateProperties { | |
44 my ($this) = @_; | |
45 | |
46 my %seen; | |
47 my @props; | |
48 | |
49 my $modelType = $this->modelType; | |
50 | |
51 if ( isclass($modelType,AbstractObject) ) { | |
371 | 52 foreach my $pi ( |
53 $this->modelType->GetMeta( | |
54 PropertyInfo, | |
55 sub { not($seen{$_}++) and $_->access == ACCESS_PUBLIC }, | |
56 1 | |
57 ) | |
58 ) { | |
59 my $pv = $this->model && $pi->getter->($this->model); | |
369 | 60 my $pt; |
61 | |
62 my %args = (name => $pi->name); | |
63 if ($pi->isList) { | |
64 $pt = 'ARRAY'; | |
65 $args{isMultiple} = 1; | |
66 $args{holdingType} = $pi->type; | |
67 } else { | |
68 $pt = $pi->type; | |
69 } | |
70 | |
71 push @props, Meta->new($pv, $pt, \%args); | |
72 } | |
370
cbf4febf0930
ObjectMeta, Tests, migrating to the new metadata model.
sergey
parents:
369
diff
changeset
|
73 } elsif ( $modelType && $modelType eq 'HASH' ) { |
369 | 74 while ( my ($k,$v) = each %{$this->model || {}} ) { |
75 push @props, Meta->new($v,undef,{name => $k}); | |
76 } | |
77 } | |
78 | |
79 return \@props; | |
80 } | |
81 | |
82 sub GetItems { | |
83 my ($this) = @_; | |
84 | |
85 die OpException->new("The operation must be performed on the container") | |
86 unless $this->isMultiple; | |
87 | |
88 my $i = 0; | |
89 | |
90 return [ | |
91 map $this->_GetItemMeta($_,$i++), @{$this->model || []} | |
92 ]; | |
93 } | |
94 | |
95 sub GetItem { | |
96 my ($this,$index) = @_; | |
97 | |
98 die OpException->new("The operation must be performed on the container") | |
99 unless $this->isMultiple; | |
100 | |
101 my $item = @{$this->model || []}[$index]; | |
102 | |
103 return $this->_GetItemMeta($item,$index); | |
104 } | |
105 | |
106 sub _GetItemMeta { | |
107 my ($this,$item,$index) = @_; | |
108 | |
109 return Meta->new( | |
110 $item, | |
111 $this->holdingType, | |
112 { | |
113 name => $index, | |
114 container => $this | |
115 } | |
116 ); | |
117 } | |
118 | |
371 | 119 sub GetMetadataForModel { |
120 my ($self,$model,$args) = @_; | |
121 | |
122 $args ||= {}; | |
123 | |
124 return $self->new( | |
125 $model, | |
126 delete $args->{modelType}, | |
127 $args | |
128 ) | |
129 } | |
130 | |
369 | 131 1; |
132 | |
133 __END__ |