annotate Lib/IMPL/DOM/Transform/ObjectToDOM.pm @ 236:2904da230022

DOM refactoring
author sergey
date Mon, 15 Oct 2012 04:23:01 +0400
parents
children 61db68166c37
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 {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
15 -plain => \&TransformPlain,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
16 HASH => \&TransformHash,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
17 -default => \&TransformDefault
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
2904da230022 DOM refactoring
sergey
parents:
diff changeset
27 sub CTOR {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
28 my ($this,$docName,$docSchema) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
29
2904da230022 DOM refactoring
sergey
parents:
diff changeset
30 my $docNodeSchema = $docSchema->selectSingleNode(sub { $_->name eq $docName })
2904da230022 DOM refactoring
sergey
parents:
diff changeset
31 or die OperationException->new("Can't find a node schema for the document '$docName'");
2904da230022 DOM refactoring
sergey
parents:
diff changeset
32
2904da230022 DOM refactoring
sergey
parents:
diff changeset
33 my $docClass = ($docNodeSchema->can('nativeType') ? $docNodeSchema->nativeType : undef) || 'IMPL::DOM::Document';
2904da230022 DOM refactoring
sergey
parents:
diff changeset
34
2904da230022 DOM refactoring
sergey
parents:
diff changeset
35 $this->documentSchema($docNodeSchema);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
36
2904da230022 DOM refactoring
sergey
parents:
diff changeset
37 $this->_navi(
2904da230022 DOM refactoring
sergey
parents:
diff changeset
38 Builder->new(
2904da230022 DOM refactoring
sergey
parents:
diff changeset
39 $docClass,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
40 $docSchema,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
41 ignoreUndefined => 1
2904da230022 DOM refactoring
sergey
parents:
diff changeset
42 )
2904da230022 DOM refactoring
sergey
parents:
diff changeset
43 );
2904da230022 DOM refactoring
sergey
parents:
diff changeset
44 $this->_schema($docSchema);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
45
2904da230022 DOM refactoring
sergey
parents:
diff changeset
46 $this->_navi->NavigateCreate($docName);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
47 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
48
2904da230022 DOM refactoring
sergey
parents:
diff changeset
49 sub TransformPlain {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
50 my ($this,$data) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
51
2904da230022 DOM refactoring
sergey
parents:
diff changeset
52 $this->_navi->Current->nodeValue( $this->_navi->inflateValue($data) );
2904da230022 DOM refactoring
sergey
parents:
diff changeset
53 return $this->_navi->Current;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
54 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
55
2904da230022 DOM refactoring
sergey
parents:
diff changeset
56 sub TransformHash {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
57 my ($this,$data) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
58
2904da230022 DOM refactoring
sergey
parents:
diff changeset
59 die ArgumentException->new(data => 'A HASH reference is required')
2904da230022 DOM refactoring
sergey
parents:
diff changeset
60 unless ref $data eq 'HASH';
2904da230022 DOM refactoring
sergey
parents:
diff changeset
61
2904da230022 DOM refactoring
sergey
parents:
diff changeset
62 KEYLOOP: foreach my $key (keys %$data) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
63 my $value = $data->{$key};
2904da230022 DOM refactoring
sergey
parents:
diff changeset
64
2904da230022 DOM refactoring
sergey
parents:
diff changeset
65 if (ref $value eq 'ARRAY') {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
66 foreach my $subval (@$value) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
67
2904da230022 DOM refactoring
sergey
parents:
diff changeset
68 my $node = $this->_navi->NavigateCreate($key);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
69
2904da230022 DOM refactoring
sergey
parents:
diff changeset
70 unless(defined $node) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
71 $this->_navi->Back();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
72 next KEYLOOP;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
73 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
74
2904da230022 DOM refactoring
sergey
parents:
diff changeset
75 $this->Transform($subval);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
76
2904da230022 DOM refactoring
sergey
parents:
diff changeset
77 $this->_navi->Back();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
78 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
79 } else {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
80 my $node = $this->_navi->NavigateCreate($key);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
81
2904da230022 DOM refactoring
sergey
parents:
diff changeset
82 unless(defined $node) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
83 $this->_navi->Back();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
84 next KEYLOOP;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
85 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
86
2904da230022 DOM refactoring
sergey
parents:
diff changeset
87 $this->Transform($value);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
88
2904da230022 DOM refactoring
sergey
parents:
diff changeset
89 $this->_navi->Back();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
90 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
91 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
92 return $this->_navi->Current;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
93 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
94
2904da230022 DOM refactoring
sergey
parents:
diff changeset
95 sub TransformDefault {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
96 my ($this,$data) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
97
2904da230022 DOM refactoring
sergey
parents:
diff changeset
98 if ( ref $data and eval { $data->can('GetMeta') } ) {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
99 my %props = map {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
100 $_->name, 1
2904da230022 DOM refactoring
sergey
parents:
diff changeset
101 } $data->GetMeta(PropertyInfo, sub { $_->access == ACCESS_PUBLIC }, 1 );
2904da230022 DOM refactoring
sergey
parents:
diff changeset
102
2904da230022 DOM refactoring
sergey
parents:
diff changeset
103 my %values = map {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
104 $_,
2904da230022 DOM refactoring
sergey
parents:
diff changeset
105 $data->$_();
2904da230022 DOM refactoring
sergey
parents:
diff changeset
106 } keys %props;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
107
2904da230022 DOM refactoring
sergey
parents:
diff changeset
108 return $this->Transform(\%values);
2904da230022 DOM refactoring
sergey
parents:
diff changeset
109 } else {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
110 die OperationException->new("Don't know how to transform $data");
2904da230022 DOM refactoring
sergey
parents:
diff changeset
111 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
112
2904da230022 DOM refactoring
sergey
parents:
diff changeset
113 return $this->_navi->Current;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
114 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
115
2904da230022 DOM refactoring
sergey
parents:
diff changeset
116 sub buildErrors {
2904da230022 DOM refactoring
sergey
parents:
diff changeset
117 my ($this) = @_;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
118
2904da230022 DOM refactoring
sergey
parents:
diff changeset
119 return $this->_navi->buildErrors;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
120 }
2904da230022 DOM refactoring
sergey
parents:
diff changeset
121
2904da230022 DOM refactoring
sergey
parents:
diff changeset
122 1;
2904da230022 DOM refactoring
sergey
parents:
diff changeset
123
2904da230022 DOM refactoring
sergey
parents:
diff changeset
124 __END__
2904da230022 DOM refactoring
sergey
parents:
diff changeset
125
2904da230022 DOM refactoring
sergey
parents:
diff changeset
126 =pod
2904da230022 DOM refactoring
sergey
parents:
diff changeset
127
2904da230022 DOM refactoring
sergey
parents:
diff changeset
128 =head1 NAME
2904da230022 DOM refactoring
sergey
parents:
diff changeset
129
2904da230022 DOM refactoring
sergey
parents:
diff changeset
130 C<IMPL::DOM::Transform::ObjectToDOM> -преобразование объекта
2904da230022 DOM refactoring
sergey
parents:
diff changeset
131
2904da230022 DOM refactoring
sergey
parents:
diff changeset
132 =head1 SYNOPSIS
2904da230022 DOM refactoring
sergey
parents:
diff changeset
133
2904da230022 DOM refactoring
sergey
parents:
diff changeset
134 =cut