annotate Lib/IMPL/DOM/Transform/ObjectToDOM.pm @ 254:fb52014f6931

updated web-session creation
author sergey
date Thu, 06 Dec 2012 19:58:42 +0400
parents 129e48bb5afb
children 299af584c05f
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
1 package IMPL::DOM::Transform::ObjectToDOM;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
2 use strict;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
3
2904da230022 DOM refactoring
sergey
parents:
diff changeset
4 use IMPL::Const qw(:prop :access);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
5 use IMPL::declare {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
6 require => {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
7 PropertyInfo => 'IMPL::Class::PropertyInfo',
2904da230022 DOM refactoring
sergey
parents:
diff changeset
8 Builder => 'IMPL::DOM::Navigator::Builder',
2904da230022 DOM refactoring
sergey
parents:
diff changeset
9 Exception => 'IMPL::Exception',
2904da230022 DOM refactoring
sergey
parents:
diff changeset
10 ArgumentException => '-IMPL::InvalidArgumentException',
2904da230022 DOM refactoring
sergey
parents:
diff changeset
11 OperationException => '-IMPL::InvalidOperationException'
2904da230022 DOM refactoring
sergey
parents:
diff changeset
12 },
2904da230022 DOM refactoring
sergey
parents:
diff changeset
13 base => [
2904da230022 DOM refactoring
sergey
parents:
diff changeset
14 'IMPL::Transform' => sub {
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
15 -plain => 'TransformPlain',
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
16 HASH => 'TransformHash',
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
17 -default => 'TransformDefault'
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
18 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
19 ],
2904da230022 DOM refactoring
sergey
parents:
diff changeset
20 props => [
2904da230022 DOM refactoring
sergey
parents:
diff changeset
21 documentSchema => PROP_RO,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
22 _schema => PROP_RW,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
23 _navi => PROP_RW
2904da230022 DOM refactoring
sergey
parents:
diff changeset
24 ]
2904da230022 DOM refactoring
sergey
parents:
diff changeset
25 };
2904da230022 DOM refactoring
sergey
parents:
diff changeset
26
246
2746a8e5a6c4 Fixed regressions in DOM due previous refactorings
sergey
parents: 237
diff changeset
27 use constant {
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
28 SchemaNode => 'IMPL::DOM::Schema::Node',
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
29 ComplexNode => 'IMPL::DOM::Schema::ComplexNode'
246
2746a8e5a6c4 Fixed regressions in DOM due previous refactorings
sergey
parents: 237
diff changeset
30 };
2746a8e5a6c4 Fixed regressions in DOM due previous refactorings
sergey
parents: 237
diff changeset
31
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
32 sub CTOR {
237
61db68166c37 refactoring QueryToDOM
sergey
parents: 236
diff changeset
33 my ($this,$docName,$docSchema,$transforms) = @_;
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
34
246
2746a8e5a6c4 Fixed regressions in DOM due previous refactorings
sergey
parents: 237
diff changeset
35 my $docNodeSchema = $docSchema->selectSingleNode(sub { $_->isa(SchemaNode) and $_->name eq $docName } )
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
36 or die OperationException->new("Can't find a node schema for the document '$docName'");
2904da230022 DOM refactoring
sergey
parents:
diff changeset
37
2904da230022 DOM refactoring
sergey
parents:
diff changeset
38 my $docClass = ($docNodeSchema->can('nativeType') ? $docNodeSchema->nativeType : undef) || 'IMPL::DOM::Document';
2904da230022 DOM refactoring
sergey
parents:
diff changeset
39
2904da230022 DOM refactoring
sergey
parents:
diff changeset
40 $this->documentSchema($docNodeSchema);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
41
2904da230022 DOM refactoring
sergey
parents:
diff changeset
42 $this->_navi(
2904da230022 DOM refactoring
sergey
parents:
diff changeset
43 Builder->new(
2904da230022 DOM refactoring
sergey
parents:
diff changeset
44 $docClass,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
45 $docSchema,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
46 ignoreUndefined => 1
2904da230022 DOM refactoring
sergey
parents:
diff changeset
47 )
2904da230022 DOM refactoring
sergey
parents:
diff changeset
48 );
2904da230022 DOM refactoring
sergey
parents:
diff changeset
49 $this->_schema($docSchema);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
50
2904da230022 DOM refactoring
sergey
parents:
diff changeset
51 $this->_navi->NavigateCreate($docName);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
52 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
53
2904da230022 DOM refactoring
sergey
parents:
diff changeset
54 sub TransformPlain {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
55 my ($this,$data) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
56
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
57 $this->_navi->Current->nodeValue( $data );
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
58 return $this->_navi->Current;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
59 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
60
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
61 sub currentNode {
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
62 shift->_navi->Current;
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
63 }
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
64
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
65 sub inflateNodeValue {
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
66 shift->_navi->inflateValue(shift);
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
67 }
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
68
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
69 sub TransformHash {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
70 my ($this,$data) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
71
2904da230022 DOM refactoring
sergey
parents:
diff changeset
72 die ArgumentException->new(data => 'A HASH reference is required')
2904da230022 DOM refactoring
sergey
parents:
diff changeset
73 unless ref $data eq 'HASH';
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
74
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
75 return $this->StoreObject($this->currentNode,$data)
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
76 if !$this->currentNode->schema->isa(ComplexNode);
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
77
2904da230022 DOM refactoring
sergey
parents:
diff changeset
78 KEYLOOP: foreach my $key (keys %$data) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
79 my $value = $data->{$key};
2904da230022 DOM refactoring
sergey
parents:
diff changeset
80
2904da230022 DOM refactoring
sergey
parents:
diff changeset
81 if (ref $value eq 'ARRAY') {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
82 foreach my $subval (@$value) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
83
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
84 $this->_navi->saveState();
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
85
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
86 my $node = $this->_navi->NavigateCreate($key);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
87
2904da230022 DOM refactoring
sergey
parents:
diff changeset
88 unless(defined $node) {
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
89 #$this->_navi->Back();
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
90 $this->_navi->restoreState();
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
91 next KEYLOOP;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
92 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
93
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
94 $this->_navi->applyState();
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
95
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
96 $this->Transform($subval);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
97
2904da230022 DOM refactoring
sergey
parents:
diff changeset
98 $this->_navi->Back();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
99 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
100 } else {
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
101 $this->_navi->saveState();
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
102 my $node = $this->_navi->NavigateCreate($key);
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
103
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
104 unless(defined $node) {
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
105 #$this->_navi->Back();
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
106 $this->_navi->restoreState();
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
107 next KEYLOOP;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
108 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
109
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
110 $this->_navi->applyState();
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
111
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
112 warn "$key = $value";
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
113
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
114 $this->Transform($value);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
115
2904da230022 DOM refactoring
sergey
parents:
diff changeset
116 $this->_navi->Back();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
117 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
118 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
119 return $this->_navi->Current;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
120 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
121
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
122 # this method handles situatuions when a complex object must be stored in a
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
123 # simple node.
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
124 sub StoreObject {
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
125 my ($this,$node,$data) = @_;
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
126
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
127 $node->nodeValue($data);
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
128
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
129 warn "Stored value for", $node->nodeName;
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
130
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
131 return $node;
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
132 }
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
133
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
134 sub TransformDefault {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
135 my ($this,$data) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
136
250
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
137 return $this->StoreObject($this->currentNode,$data)
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
138 if !$this->currentNode->schema->isa(ComplexNode);
129e48bb5afb DOM refactoring
sergey
parents: 246
diff changeset
139
236
2904da230022 DOM refactoring
sergey
parents:
diff changeset
140 if ( ref $data and eval { $data->can('GetMeta') } ) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
141 my %props = map {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
142 $_->name, 1
2904da230022 DOM refactoring
sergey
parents:
diff changeset
143 } $data->GetMeta(PropertyInfo, sub { $_->access == ACCESS_PUBLIC }, 1 );
2904da230022 DOM refactoring
sergey
parents:
diff changeset
144
2904da230022 DOM refactoring
sergey
parents:
diff changeset
145 my %values = map {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
146 $_,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
147 $data->$_();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
148 } keys %props;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
149
2904da230022 DOM refactoring
sergey
parents:
diff changeset
150 return $this->Transform(\%values);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
151 } else {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
152 die OperationException->new("Don't know how to transform $data");
2904da230022 DOM refactoring
sergey
parents:
diff changeset
153 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
154
2904da230022 DOM refactoring
sergey
parents:
diff changeset
155 return $this->_navi->Current;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
156 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
157
2904da230022 DOM refactoring
sergey
parents:
diff changeset
158 sub buildErrors {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
159 my ($this) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
160
2904da230022 DOM refactoring
sergey
parents:
diff changeset
161 return $this->_navi->buildErrors;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
162 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
163
2904da230022 DOM refactoring
sergey
parents:
diff changeset
164 1;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
165
2904da230022 DOM refactoring
sergey
parents:
diff changeset
166 __END__
2904da230022 DOM refactoring
sergey
parents:
diff changeset
167
2904da230022 DOM refactoring
sergey
parents:
diff changeset
168 =pod
2904da230022 DOM refactoring
sergey
parents:
diff changeset
169
2904da230022 DOM refactoring
sergey
parents:
diff changeset
170 =head1 NAME
2904da230022 DOM refactoring
sergey
parents:
diff changeset
171
2904da230022 DOM refactoring
sergey
parents:
diff changeset
172 C<IMPL::DOM::Transform::ObjectToDOM> -преобразование объекта
2904da230022 DOM refactoring
sergey
parents:
diff changeset
173
2904da230022 DOM refactoring
sergey
parents:
diff changeset
174 =head1 SYNOPSIS
2904da230022 DOM refactoring
sergey
parents:
diff changeset
175
2904da230022 DOM refactoring
sergey
parents:
diff changeset
176 =cut