Mercurial > pub > Impl
view Lib/IMPL/DOM/Transform/QueryToDOM.pm @ 258:91bae9f41a9c
Added class for referencing paths in configuration files
author | sergey |
---|---|
date | Tue, 18 Dec 2012 19:18:31 +0400 |
parents | 129e48bb5afb |
children | c9c2ec29793f |
line wrap: on
line source
package IMPL::DOM::Transform::QueryToDOM; use strict; use IMPL::Const qw(:prop); use IMPL::declare { base => [ 'IMPL::DOM::Transform::ObjectToDOM' => '@_' ], props => [ prefix => PROP_RO, delimiter => PROP_RO ] }; sub CTOR { my ($this) = @_; $this->templates->{'CGI'} = \&TransformCGI; $this->delimiter('[.]'); $this->prefix(''); } # inflate simple properties sub TransformPlain { my ($this,$data) = @_; $this->currentNode->nodeProperty( rawValue => $data ); $this->currentNode->nodeValue( $this->inflateNodeValue($data) ); return $this->currentNode; } # do not store complex data as node values sub StoreObject { my ($this,$node,$data) = @_; return $node; } sub TransformCGI { my ($this,$query) = @_; my $data={}; my $prefix = $this->prefix; my $delim = $this->delimiter; foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) { my @value = grep length($_), $query->param($param) or next; my @parts = split /$delim/,$param; my $node = $data; while ( my $part = shift @parts ) { if (my ($name,$index) = ($part =~ m/^(\w+)(?:\[(\d+)\])?$/) ) { if (@parts) { if(defined $index) { $node = ($node->{$name}[$index] ||= {}); } else { $node = ($node->{$name} ||= {}); } } else { if(defined $index) { $node->{$name}[$index] = (@value == 1 ? $value[0] : \@value); } else { $node->{$name} = (@value == 1 ? $value[0] : \@value); } } } } } return $this->Transform($data); } 1;