# HG changeset patch # User sergey # Date 1346160582 -14400 # Node ID edf011437be8feb6f968da1252f9a748e16a54d3 # Parent 84a6382b49c814ab71362c37d8ce134e44805d2f updated resources schema diff -r 84a6382b49c8 -r edf011437be8 _test/Resources/resources.xsd --- a/_test/Resources/resources.xsd Mon Aug 27 17:28:32 2012 +0400 +++ b/_test/Resources/resources.xsd Tue Aug 28 17:29:42 2012 +0400 @@ -5,17 +5,18 @@ - - + + - - - - + + + + + @@ -29,7 +30,7 @@ - + @@ -51,54 +52,74 @@ - - - + + + - + - - - - - - - - - + + - + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + + + - + - - + + - + - + @@ -109,15 +130,15 @@ - + - - + @@ -125,20 +146,26 @@ - + - + - + - + + + + + + + \ No newline at end of file diff -r 84a6382b49c8 -r edf011437be8 _test/Resources/sample.xml --- a/_test/Resources/sample.xml Mon Aug 27 17:28:32 2012 +0400 +++ b/_test/Resources/sample.xml Tue Aug 28 17:29:42 2012 +0400 @@ -3,41 +3,56 @@ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://implab.org/schemas/resources resources.xsd "> - - - + + + + projects + + + + + + + + + - - - - - - - - - - - - - - - - - - + + (\w+) + + + + + + + + library + + + + + sources + + + + - - + + + Benzin::Model::Project + + + - - + + - - + + diff -r 84a6382b49c8 -r edf011437be8 _test/temp.pl --- a/_test/temp.pl Mon Aug 27 17:28:32 2012 +0400 +++ b/_test/temp.pl Tue Aug 28 17:29:42 2012 +0400 @@ -14,7 +14,7 @@ my $reader = $schema->compile( READER => $type, xsi_type => { - pack_type('http://implab.org/schemas/resources','abstractResult') => 'AUTO' + pack_type('http://implab.org/schemas/resources','AbstractResult') => 'AUTO' } ); diff -r 84a6382b49c8 -r edf011437be8 _test/test_transform.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/test_transform.pl Tue Aug 28 17:29:42 2012 +0400 @@ -0,0 +1,131 @@ +use strict; +package Person; +use IMPL::lang qw(:declare); +use IMPL::declare { + base => [ + 'IMPL::Object' => undef, + 'IMPL::Object::Autofill' => '@_' + ] +}; + +BEGIN { + public property name => PROP_ALL; + public property age => PROP_ALL; + public property addresses => PROP_ALL | PROP_LIST; +} + +package Address; +use IMPL::lang qw(:declare); +use IMPL::declare { + base => [ + 'IMPL::Object' => undef, + 'IMPL::Object::Autofill' => '@_' + ] +}; + +BEGIN { + public property country => PROP_ALL; + public property city => PROP_ALL; +} + +package main; + +my $data = { + name => 'Peter', + age => '99', + addresses => { + address => [ + { + country => 'Airot', + city => 'Torhiq', + street => 'avenu1' + }, + { + country => 'Olkson', + city => 'Zoxs', + street => 'av2' + } + ] + } +}; + +use Carp qw(confess); + +sub Rule(&) { + my ($block) = @_; + + return sub { + local $_ = shift; + $block->(); + } +} + +sub Inspect($$) { + my ($path,$block) = @_; + my $data = $_; + + foreach my $name (@$path) { + $data = ref $data ? $data->{$name} : undef; + print "$name = $data\n"; + } + + local $_ = $data; + $block->($data); +} + +sub Required(@); + +sub Required(@) { + if(@_) { + Inspect([@_],Rule { Required }); + } else { + confess "required" unless $_; + } +} + +sub Regexp($) { + my $rx = shift; + die "Regular expression doesn't match" unless m/$rx/; +} + +my $validate = Rule { + Required('name'); + + Inspect ['age'] => Rule { + Regexp(qr/^\d+$/); + die "invalid person age" unless $_ > 0 && $_ < 200; + }; + + Inspect ['addresses', 'address'] => Rule { + Required; + foreach(@{$_}) { + Required('street'); + } + } +}; + +$validate->($data); + +my ($person) = + map { + Person->new( + name => $_->{name}, + age => $_->{age}, + addresses => [ + map { + Address->new( + country => $_->{country}, + city => $_->{city} + ) + } as_list( $_->{addresses}{address} ) + ] + ) + } $data; + +use Data::Dumper; +print Dumper($person); + +sub as_list { + return @{ $_[0] } if ref $_[0] eq 'ARRAY'; + return @_; +}