|
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;
|
|
|
19 $this->templates->{'CGIWrapper'} = \&TransformCGI;
|
|
|
20
|
|
238
|
21 $this->delimiter('[.]');
|
|
|
22 $this->prefix('');
|
|
237
|
23 }
|
|
|
24
|
|
|
25 sub TransformCGI {
|
|
|
26 my ($this,$query) = @_;
|
|
|
27
|
|
|
28 my $data={};
|
|
|
29
|
|
|
30 my $prefix = $this->prefix;
|
|
|
31 my $delim = $this->delimiter;
|
|
|
32
|
|
|
33 foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) {
|
|
|
34 length (my $value = $query->param($param)) or next;
|
|
|
35
|
|
238
|
36 my @parts = split /$delim/,$param;
|
|
237
|
37
|
|
|
38 my $node = $data;
|
|
|
39 while ( my $part = shift @parts ) {
|
|
238
|
40 if (my ($name,$index) = ($part =~ m/^(\w+)(?:\[(\d+)\])?$/) ) {
|
|
|
41 if (@parts) {
|
|
|
42 if(defined $index) {
|
|
|
43 $node = ($node->{$name}[$index] ||= {});
|
|
|
44 } else {
|
|
|
45 $node = ($node->{$name} ||= {});
|
|
|
46 }
|
|
|
47 } else {
|
|
|
48 if(defined $index) {
|
|
|
49 $node->{$name}[$index] = $value;
|
|
|
50 } else {
|
|
|
51 $node->{$name} = $value;
|
|
|
52 }
|
|
|
53 }
|
|
237
|
54 }
|
|
|
55 }
|
|
|
56 }
|
|
|
57
|
|
|
58 return $this->Transform($data);
|
|
238
|
59 }
|
|
|
60
|
|
|
61 1; |
