237
|
1 package IMPL::DOM::Transform::QueryToDOM;
|
|
2 use strict;
|
|
3
|
|
4 use IMPL::Const qw(:prop);
|
|
5 use IMPL::declare {
|
|
6 base => [
|
|
7 'IMPL::DOM::Transform::ObjectToDOM' => '@_'
|
|
8 ],
|
|
9 props => [
|
|
10 prefix => PROP_RO,
|
238
|
11 delimiter => PROP_RO
|
237
|
12 ]
|
|
13 };
|
|
14
|
|
15 sub CTOR {
|
|
16 my ($this) = @_;
|
|
17
|
|
18 $this->templates->{'CGI'} = \&TransformCGI;
|
244
|
19
|
238
|
20 $this->delimiter('[.]');
|
|
21 $this->prefix('');
|
237
|
22 }
|
|
23
|
250
|
24 # inflate simple properties
|
|
25 sub TransformPlain {
|
|
26 my ($this,$data) = @_;
|
|
27
|
|
28 $this->currentNode->nodeProperty( rawValue => $data );
|
|
29 $this->currentNode->nodeValue( $this->inflateNodeValue($data) );
|
|
30 return $this->currentNode;
|
|
31 }
|
|
32
|
|
33 # do not store complex data as node values
|
|
34 sub StoreObject {
|
|
35 my ($this,$node,$data) = @_;
|
|
36
|
|
37 return $node;
|
|
38 }
|
|
39
|
237
|
40 sub TransformCGI {
|
|
41 my ($this,$query) = @_;
|
|
42
|
|
43 my $data={};
|
|
44
|
|
45 my $prefix = $this->prefix;
|
|
46 my $delim = $this->delimiter;
|
|
47
|
|
48 foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) {
|
244
|
49
|
|
50 my @value = grep length($_), $query->param($param) or next;
|
237
|
51
|
238
|
52 my @parts = split /$delim/,$param;
|
237
|
53
|
|
54 my $node = $data;
|
|
55 while ( my $part = shift @parts ) {
|
238
|
56 if (my ($name,$index) = ($part =~ m/^(\w+)(?:\[(\d+)\])?$/) ) {
|
|
57 if (@parts) {
|
|
58 if(defined $index) {
|
|
59 $node = ($node->{$name}[$index] ||= {});
|
|
60 } else {
|
|
61 $node = ($node->{$name} ||= {});
|
|
62 }
|
|
63 } else {
|
|
64 if(defined $index) {
|
244
|
65 $node->{$name}[$index] = (@value == 1 ? $value[0] : \@value);
|
238
|
66 } else {
|
244
|
67 $node->{$name} = (@value == 1 ? $value[0] : \@value);
|
238
|
68 }
|
|
69 }
|
237
|
70 }
|
|
71 }
|
|
72 }
|
|
73
|
|
74 return $this->Transform($data);
|
238
|
75 }
|
|
76
|
|
77 1; |