Mercurial > pub > Impl
diff _test/test_transform.pl @ 223:edf011437be8
updated resources schema
author | sergey |
---|---|
date | Tue, 28 Aug 2012 17:29:42 +0400 |
parents | |
children |
line wrap: on
line diff
--- /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 @_; +}