Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Transform/QueryToDOM.pm @ 403:7171a8e2e2ba
dirty fix for url encoding
| author | sergey |
|---|---|
| date | Tue, 20 May 2014 01:26:45 +0400 |
| parents | 4cc6cc370fb2 |
| children |
| rev | line source |
|---|---|
| 237 | 1 package IMPL::DOM::Transform::QueryToDOM; |
| 2 use strict; | |
| 3 | |
| 4 use IMPL::Const qw(:prop); | |
| 5 use IMPL::declare { | |
| 325 | 6 require => { |
| 7 OutOfRangeException => '-IMPL::OutOfRangeException' | |
| 8 }, | |
| 237 | 9 base => [ |
| 10 'IMPL::DOM::Transform::ObjectToDOM' => '@_' | |
| 11 ], | |
| 12 props => [ | |
| 13 prefix => PROP_RO, | |
| 238 | 14 delimiter => PROP_RO |
| 237 | 15 ] |
| 16 }; | |
| 17 | |
| 325 | 18 our $MAX_INDEX = 1024; |
| 19 | |
| 237 | 20 sub CTOR { |
| 21 my ($this) = @_; | |
| 22 | |
| 264 | 23 $this->templates->{'CGI'} = 'TransformCGI'; |
|
323
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
24 $this->templates->{'IMPL::Web::Application::Action'} = 'TransformAction'; |
| 244 | 25 |
| 238 | 26 $this->delimiter('[.]'); |
| 27 $this->prefix(''); | |
| 237 | 28 } |
| 29 | |
| 250 | 30 # inflate simple properties |
| 31 sub TransformPlain { | |
| 32 my ($this,$data) = @_; | |
| 33 | |
| 34 $this->currentNode->nodeProperty( rawValue => $data ); | |
| 387 | 35 $this->currentNode->nodeValue( $data ); |
| 250 | 36 return $this->currentNode; |
| 37 } | |
| 38 | |
| 39 # do not store complex data as node values | |
| 40 sub StoreObject { | |
| 41 my ($this,$node,$data) = @_; | |
| 42 | |
| 43 return $node; | |
| 44 } | |
| 45 | |
| 264 | 46 #TODO: support a.b[0][1].c[1] |
| 47 | |
| 237 | 48 sub TransformCGI { |
| 49 my ($this,$query) = @_; | |
|
323
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
50 |
| 237 | 51 my $data={}; |
| 52 | |
| 53 my $prefix = $this->prefix; | |
| 54 my $delim = $this->delimiter; | |
| 55 | |
| 56 foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) { | |
| 244 | 57 |
| 58 my @value = grep length($_), $query->param($param) or next; | |
| 237 | 59 |
| 238 | 60 my @parts = split /$delim/,$param; |
| 237 | 61 |
| 62 my $node = $data; | |
| 63 while ( my $part = shift @parts ) { | |
| 238 | 64 if (my ($name,$index) = ($part =~ m/^(\w+)(?:\[(\d+)\])?$/) ) { |
| 65 if (@parts) { | |
| 66 if(defined $index) { | |
| 325 | 67 $this->ValidateIndex($index); |
| 238 | 68 $node = ($node->{$name}[$index] ||= {}); |
| 69 } else { | |
| 70 $node = ($node->{$name} ||= {}); | |
| 71 } | |
| 72 } else { | |
| 73 if(defined $index) { | |
| 325 | 74 $this->ValidateIndex($index); |
| 244 | 75 $node->{$name}[$index] = (@value == 1 ? $value[0] : \@value); |
| 238 | 76 } else { |
| 244 | 77 $node->{$name} = (@value == 1 ? $value[0] : \@value); |
| 238 | 78 } |
| 79 } | |
| 237 | 80 } |
| 81 } | |
| 82 } | |
| 83 | |
| 84 return $this->Transform($data); | |
| 238 | 85 } |
| 86 | |
| 325 | 87 sub ValidateIndex { |
| 88 my ($this,$index) = @_; | |
| 89 | |
| 90 die OutOfRangeException->new() | |
| 91 unless $index >= 0 and $index <= $MAX_INDEX; | |
| 92 } | |
| 93 | |
|
323
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
94 sub TransformAction { |
|
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
95 my ($this,$action) = @_; |
|
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
96 |
|
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
97 return $this->Transform($action->isJson ? $action->jsonData : $action->query); |
|
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
98 } |
|
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
264
diff
changeset
|
99 |
| 264 | 100 1; |
| 101 | |
| 102 __END__ | |
| 103 | |
| 104 =pod | |
| 105 | |
| 106 =head1 NAME | |
| 107 | |
| 108 C<IMPL::DOM::Transform::QueryToDOM> - преобразование CGI запроса в DOM документ. | |
| 109 | |
| 110 =head1 SYNOPSIS | |
| 111 | |
| 112 =begin code | |
| 113 | |
| 114 use CGI(); | |
| 115 use IMPL::require { | |
| 116 Schema => 'IMPL::DOM::Schema', | |
| 117 Config => 'IMPL::Config', | |
| 118 QueryToDOM => 'IMPL::DOM::Transform::QueryToDOM' | |
| 119 } | |
| 120 | |
| 121 my $q = CGI->new(); | |
| 122 | |
| 123 my $schema = Schema->LoadSchema(Config->AppBase('schemas','person.xml')); | |
| 124 my $transorm = QueryToDOM->new('edit', $schema); | |
| 125 | |
| 126 my $form = $transform->Transform($q); | |
| 127 | |
| 128 my @errors; | |
| 129 | |
| 130 push @errors, $transform->buildErrors; | |
| 131 push @errors, $schema->Validate($doc); | |
| 132 | |
| 133 | |
| 134 =end code | |
| 135 | |
| 136 =head1 DESCRIPTION | |
| 137 | |
| 138 Наследует C<IMPL::DOM::Transform::ObjectToDOM>. Добавляет метод | |
| 139 C<TransformCGI> который применятеся к объектам типа C<CGI> (и производных). | |
| 140 | |
| 141 Запрос C<CGI> сначала приводится к хешу, затем полученный хеш преобразуется | |
| 142 в DOM документ при помощи вызова метода C<Transform>. | |
| 143 | |
| 144 Для этого выбираются параметры запроса, затем, имя каждого параметра | |
| 145 рассматривается в виде пути к свойству, создается структура из хешей и массивов | |
| 146 в которую по указанному пути кладется значение. | |
| 147 | |
| 148 Если параметр имеет несколько значений, значит свойство является массивом. | |
| 149 | |
| 150 Также изменено поведение некоторых методов преобразования. | |
| 151 | |
| 152 =over | |
| 153 | |
| 154 =item * C<TransformPlain($value)> | |
| 155 | |
| 156 Преобразование для простого значения свойства. Посокльку в запросе передаются | |
| 157 строковые значения, а схема документа может предполпгать другие типы, при | |
| 158 преобразовании значения параметра из запроса к значению узла используется | |
| 159 метод C<< $this->inflateNodeValue($value) >>, также помимо значения | |
| 160 C<< $this->currentNode->nodeValue >> задается атрибут | |
| 161 C<< $this->currentNode->nodeProperty( rawValue => $value) >>, для того, чтобы | |
| 162 была возможность получить оригинальное значение параметра запроса (например, | |
| 163 в случае когда его формат был не верным и C<nodeValue> будет C<undef>). | |
| 164 | |
| 165 =item * C<StoreObject($node,$object)> | |
| 166 | |
| 167 Данный метод вызывается если текущий узел (переданный в параметре C<$node>) | |
| 168 предполагает простое значение, однако в запросе для него было передано сложное | |
| 169 содержимое. Данная реализация просто игнорирует переданный объект C<$object> | |
| 170 и возвращает C<$node> без изменений. | |
| 171 | |
| 172 =back | |
| 173 | |
| 174 =head1 MEMBERS | |
| 175 | |
| 176 =head2 C<[get]delimiter> | |
| 177 | |
| 178 REGEX. Разделитель свойств в имени параметра, по-умолчанию C<'[.]'> | |
| 179 | |
| 180 =head2 C<[get]prefix> | |
| 181 | |
| 182 Строка, префикс имен параметров, которые участвуют в формировании документа. | |
| 183 По-умолчанию пусто. | |
| 184 | |
| 185 =cut |