# HG changeset patch # User wizard # Date 1281329136 -14400 # Node ID c2aa10fbb396e54f4eeae41959f08e92b34f3e19 # Parent 60fd224f3e3c9f6566141d9c4e924c23f04da222 Post to dom improved diff -r 60fd224f3e3c -r c2aa10fbb396 Lib/IMPL.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL.pm Mon Aug 09 08:45:36 2010 +0400 @@ -0,0 +1,13 @@ +package IMPL; +use strict; + +use Exporter; +our @EXPORT_OK = qw( &Debug ); + +our $Debug = 1 unless defined $Debug; + +sub Debug() { + $Debug +} + +1; \ No newline at end of file diff -r 60fd224f3e3c -r c2aa10fbb396 Lib/IMPL/Code/MethodCache.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Code/MethodCache.pm Mon Aug 09 08:45:36 2010 +0400 @@ -0,0 +1,29 @@ +package IMPL::Code::MethodCache; +use strict; +use IMPL qw(Debug); + +my %cachedMethods; + +sub dbgBuildCachedMethod { + my ($class,$method,$prefix,$mappers)= @_; + + no strict 'refs'; + + $prefix ||= 'call'; + + my $proxyMethod = "$prefix$method"; + + die new IMPL::Exception("A proxy method already exists") if *{"${class}::$proxyMethod"}{CODE}; + + my @methodCache = cacheMethod($class,$method,$mappers); + + *{"${class}::$proxyMethod"} = sub { + $_->(@_) foreach @methodCache; + } +} + +sub cacheMethod { + my ($class,$method,$mappers) = @_; +} + +1; \ No newline at end of file diff -r 60fd224f3e3c -r c2aa10fbb396 Lib/IMPL/DOM/Transform/PostToDOM.pm --- a/Lib/IMPL/DOM/Transform/PostToDOM.pm Mon Jul 26 03:19:06 2010 +0400 +++ b/Lib/IMPL/DOM/Transform/PostToDOM.pm Mon Aug 09 08:45:36 2010 +0400 @@ -44,9 +44,14 @@ my $navi = $this->_navi; - while (my ($key,$value) = each %$data) { + foreach my $key ( + sort { $a->[1] cmp $b->[1] || $a->[2] <=> $b->[2]} + map [$_,/(\w+)(?:\[(\d+)\])?/], keys %$data + ){ + my $value = $data->{$key->[0]}; + my $node = $navi->NavigateCreate($key->[1]); - $navi->NavigateCreate($key); + $node->nodeProperty(instanceId => $key->[2]) if $key->[2]; $this->Transform($value); @@ -68,9 +73,8 @@ my $data={}; my $prefix = $this->prefix; - $prefix = qr/$prefix/; - foreach my $param (grep $_=~/$prefix/, $query->param()) { + foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) { my $value = $query->param($param) or next; my @parts = split /\//,$param; @@ -85,10 +89,57 @@ } } + if (keys %$data > 1) { + $data = { document => $data }; + } + my $doc = $this->Transform($data); + $doc->nodeProperty( query => $query ); $this->Errors->Append( $this->_navi->BuildErrors); $this->Errors->Append( $this->_schema->Validate($doc)); return $doc; } 1; + +__END__ + +=pod + +=head1 NAME + +C - Преобразование объекта C в DOM документ. + +=head1 SINOPSYS + +=begin code + +my $transform = new IMPL::DOM::Transform::PostToDOM( + 'My::DOM::Document', + IMPL::DOM::Schema->LoadSchema('Data/user.add.schema.xml'), + 'myForm' +); + +=end code + +=head1 DESCRIPTION + +Используется для преобразования CGI запроса в DOM документ. Для этого используются параметры запроса, имена которых +начинаются со значение из свойства C. + +Имена параметров интерпретируются следующим образом + +=over + +=item 1 Имя параметра составляется из имени узла, имен всех его родителей и указанием номера экземпляра. + +=item 2 Имена узлов могут содержать только буквы, цифры и символ _ + +=item 3 В случае когда узел может повторяться несколько раз, в квадратных скобках указывается +послеовательный номер экземпляра. + +=item 4 Имена параметров объединяются через символ '/' + +=back + +=cut