annotate Lib/IMPL/DOM/Transform/QueryToDOM.pm @ 263:0f59b2de72af

*fixed IMPL::DOM::Schema circular module references *modified IMPL::Object::Singleton, added auto-activation *code cleanups, docs
author sergey
date Wed, 09 Jan 2013 05:17:44 +0400
parents 129e48bb5afb
children c9c2ec29793f
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
237
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
1 package IMPL::DOM::Transform::QueryToDOM;
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
2 use strict;
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
3
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
4 use IMPL::Const qw(:prop);
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
5 use IMPL::declare {
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
6 base => [
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
7 'IMPL::DOM::Transform::ObjectToDOM' => '@_'
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
8 ],
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
9 props => [
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
10 prefix => PROP_RO,
238
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
11 delimiter => PROP_RO
237
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
12 ]
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
13 };
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
14
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
15 sub CTOR {
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
16 my ($this) = @_;
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
17
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
18 $this->templates->{'CGI'} = \&TransformCGI;
244
a02b110da931 refactoring
sergey
parents: 238
diff changeset
19
238
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
20 $this->delimiter('[.]');
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
21 $this->prefix('');
237
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
22 }
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
23
250
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
24 # inflate simple properties
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
25 sub TransformPlain {
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
26 my ($this,$data) = @_;
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
27
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
28 $this->currentNode->nodeProperty( rawValue => $data );
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
29 $this->currentNode->nodeValue( $this->inflateNodeValue($data) );
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
30 return $this->currentNode;
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
31 }
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
32
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
33 # do not store complex data as node values
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
34 sub StoreObject {
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
35 my ($this,$node,$data) = @_;
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
36
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
37 return $node;
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
38 }
129e48bb5afb DOM refactoring
sergey
parents: 244
diff changeset
39
237
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
40 sub TransformCGI {
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
41 my ($this,$query) = @_;
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
42
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
43 my $data={};
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
44
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
45 my $prefix = $this->prefix;
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
46 my $delim = $this->delimiter;
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
47
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
48 foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) {
244
a02b110da931 refactoring
sergey
parents: 238
diff changeset
49
a02b110da931 refactoring
sergey
parents: 238
diff changeset
50 my @value = grep length($_), $query->param($param) or next;
237
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
51
238
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
52 my @parts = split /$delim/,$param;
237
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
53
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
54 my $node = $data;
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
55 while ( my $part = shift @parts ) {
238
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
56 if (my ($name,$index) = ($part =~ m/^(\w+)(?:\[(\d+)\])?$/) ) {
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
57 if (@parts) {
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
58 if(defined $index) {
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
59 $node = ($node->{$name}[$index] ||= {});
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
60 } else {
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
61 $node = ($node->{$name} ||= {});
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
62 }
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
63 } else {
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
64 if(defined $index) {
244
a02b110da931 refactoring
sergey
parents: 238
diff changeset
65 $node->{$name}[$index] = (@value == 1 ? $value[0] : \@value);
238
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
66 } else {
244
a02b110da931 refactoring
sergey
parents: 238
diff changeset
67 $node->{$name} = (@value == 1 ? $value[0] : \@value);
238
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
68 }
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
69 }
237
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
70 }
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
71 }
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
72 }
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
73
61db68166c37 refactoring QueryToDOM
sergey
parents:
diff changeset
74 return $this->Transform($data);
238
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
75 }
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
76
b8c724f6de36 DOM model refactoring
sergey
parents: 237
diff changeset
77 1;