Mercurial > pub > Impl
view Lib/IMPL/DOM/Transform/PostToDOM.pm @ 143:d9dd3500ead3
Singleton behavior changed
author | wizard |
---|---|
date | Thu, 08 Jul 2010 23:46:49 +0400 |
parents | 06a34c197b05 |
children | b56ebc31bf18 |
line wrap: on
line source
package IMPL::DOM::Transform::PostToDOM; use strict; use warnings; use IMPL::DOM::Navigator::Builder; use IMPL::Class::Property; use base qw(IMPL::Transform); BEGIN { public property documentClass => prop_get | owner_set; public property documentSchema => prop_get | owner_set; public property prefix => prop_get | owner_set; private property _navi => prop_all; public property Errors => prop_all | prop_list; private property _schema => prop_all; } our %CTOR = ( 'IMPL::Transform' => sub { -plain => \&TransformPlain, HASH => \&TransformContainer, CGI => \&TransformCGI, CGIWrapper => \&TransformCGI } ); sub CTOR { my ($this,$docClass,$docSchema,$prefix) = @_; $docClass ||= 'IMPL::DOM::Document'; $this->_navi( IMPL::DOM::Navigator::Builder->new( $docClass, $docSchema ) ); $this->_schema($docSchema); $this->prefix($prefix) if $prefix; } sub TransformContainer { my ($this,$data) = @_; my $navi = $this->_navi; while (my ($key,$value) = each %$data) { $navi->NavigateCreate($key); $this->Transform($value); $navi->Back(); } return $navi->Current; } sub TransformPlain { my ($this,$data) = @_; $this->_navi->Current->nodeValue( $this->_navi->inflateValue($data) ); } sub TransformCGI { my ($this,$query) = @_; my $data={}; my $prefix = $this->prefix; $prefix = qr/$prefix/; foreach my $param (grep $_=~/$prefix/, $query->param()) { my $value = $query->param($param); my @parts = split /\//,$param; my $node = $data; while ( my $part = shift @parts ) { if (@parts) { $node = ($node->{$part} ||= {}); } else { $node->{$part} = $value; } } } my $doc = $this->Transform($data); $this->Errors->Append( $this->_navi->BuildErrors); $this->Errors->Append( $this->_schema->Validate($doc)); return $doc; } 1;