|
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,
|
|
|
11 delimier => PROP_RO
|
|
|
12 ]
|
|
|
13 };
|
|
|
14
|
|
|
15 sub CTOR {
|
|
|
16 my ($this) = @_;
|
|
|
17
|
|
|
18 $this->templates->{'CGI'} = \&TransformCGI;
|
|
|
19 $this->templates->{'CGIWrapper'} = \&TransformCGI;
|
|
|
20
|
|
|
21 $this->delimier('.');
|
|
|
22 }
|
|
|
23
|
|
|
24 sub TransformCGI {
|
|
|
25 my ($this,$query) = @_;
|
|
|
26
|
|
|
27 my $data={};
|
|
|
28
|
|
|
29 my $prefix = $this->prefix;
|
|
|
30 my $delim = $this->delimiter;
|
|
|
31
|
|
|
32 foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) {
|
|
|
33 length (my $value = $query->param($param)) or next;
|
|
|
34
|
|
|
35 my @parts = split /\//,$param;
|
|
|
36
|
|
|
37 my $node = $data;
|
|
|
38 while ( my $part = shift @parts ) {
|
|
|
39 if (@parts) {
|
|
|
40 $node = ($node->{$part} ||= {});
|
|
|
41 } else {
|
|
|
42 $node->{$part} = $value;
|
|
|
43 }
|
|
|
44 }
|
|
|
45 }
|
|
|
46
|
|
|
47 if (keys %$data > 1) {
|
|
|
48 $data = { document => $data };
|
|
|
49 }
|
|
|
50
|
|
|
51 return $this->Transform($data);
|
|
|
52 } |
