|
112
|
1 package IMPL::DOM::Transform::PostToDOM;
|
|
49
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
112
|
5 use IMPL::DOM::Navigator::Builder;
|
|
49
|
6 use IMPL::Class::Property;
|
|
|
7
|
|
|
8 use base qw(IMPL::Transform);
|
|
|
9
|
|
|
10 BEGIN {
|
|
106
|
11 public property documentClass => prop_get | owner_set;
|
|
|
12 public property documentSchema => prop_get | owner_set;
|
|
113
|
13 public property prefix => prop_get | owner_set;
|
|
106
|
14 private property _navi => prop_all;
|
|
113
|
15 public property Errors => prop_all | prop_list;
|
|
|
16 private property _schema => prop_all;
|
|
49
|
17 }
|
|
|
18
|
|
|
19 our %CTOR = (
|
|
|
20 'IMPL::Transform' => sub {
|
|
113
|
21 -plain => \&TransformPlain,
|
|
|
22 HASH => \&TransformContainer,
|
|
|
23 CGI => \&TransformCGI
|
|
49
|
24 }
|
|
|
25 );
|
|
|
26
|
|
106
|
27 sub CTOR {
|
|
113
|
28 my ($this,$docClass,$docSchema,$prefix) = @_;
|
|
112
|
29 $docClass ||= 'IMPL::DOM::Document';
|
|
|
30
|
|
|
31 $this->_navi(
|
|
|
32 IMPL::DOM::Navigator::Builder->new(
|
|
|
33 $docClass,
|
|
|
34 $docSchema
|
|
|
35 )
|
|
|
36 );
|
|
113
|
37 $this->_schema($docSchema);
|
|
|
38 $this->prefix($prefix) if $prefix;
|
|
106
|
39 }
|
|
|
40
|
|
113
|
41 sub TransformContainer {
|
|
49
|
42 my ($this,$data) = @_;
|
|
|
43
|
|
112
|
44 my $navi = $this->_navi;
|
|
113
|
45
|
|
49
|
46 while (my ($key,$value) = each %$data) {
|
|
113
|
47
|
|
|
48 $navi->NavigateCreate($key);
|
|
|
49
|
|
|
50 $this->Transform($value);
|
|
|
51
|
|
|
52 $navi->Back();
|
|
49
|
53 }
|
|
|
54
|
|
113
|
55 return $navi->Current;
|
|
|
56 }
|
|
|
57
|
|
|
58 sub TransformPlain {
|
|
|
59 my ($this,$data) = @_;
|
|
|
60
|
|
|
61 $this->_navi->Current->nodeValue( $this->_navi->inflateValue($data) );
|
|
49
|
62 }
|
|
|
63
|
|
113
|
64 sub TransformCGI {
|
|
|
65 my ($this,$query) = @_;
|
|
126
|
66
|
|
113
|
67 my $data={};
|
|
|
68
|
|
|
69 my $prefix = $this->prefix;
|
|
|
70 $prefix = qr/$prefix/;
|
|
|
71
|
|
|
72 foreach my $param (grep $_=~/$prefix/, $query->param()) {
|
|
|
73 my $value = $query->param($param);
|
|
|
74
|
|
|
75 my @parts = split /\//,$param;
|
|
|
76
|
|
|
77 my $node = $data;
|
|
|
78 while ( my $part = shift @parts ) {
|
|
|
79 if (@parts) {
|
|
|
80 $node = ($node->{$part} ||= {});
|
|
|
81 } else {
|
|
|
82 $node->{$part} = $value;
|
|
|
83 }
|
|
|
84 }
|
|
|
85 }
|
|
|
86
|
|
|
87 my $doc = $this->Transform($data);
|
|
|
88 $this->Errors->Append( $this->_navi->BuildErrors);
|
|
|
89 $this->Errors->Append( $this->_schema->Validate($doc));
|
|
|
90 return $doc;
|
|
106
|
91 }
|
|
49
|
92
|
|
|
93 1;
|
