Mercurial > pub > Impl

comparison _test/test_transform.pl @ 223:edf011437be8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
updated resources schema
author sergey
date Tue, 28 Aug 2012 17:29:42 +0400
parents
children
comparison
equal deleted inserted replaced
222:84a6382b49c8 223:edf011437be8
1 use strict;
2 package Person;
3 use IMPL::lang qw(:declare);
4 use IMPL::declare {
5 base => [
6 'IMPL::Object' => undef,
7 'IMPL::Object::Autofill' => '@_'
8 ]
9 };
10
11 BEGIN {
12 public property name => PROP_ALL;
13 public property age => PROP_ALL;
14 public property addresses => PROP_ALL | PROP_LIST;
15 }
16
17 package Address;
18 use IMPL::lang qw(:declare);
19 use IMPL::declare {
20 base => [
21 'IMPL::Object' => undef,
22 'IMPL::Object::Autofill' => '@_'
23 ]
24 };
25
26 BEGIN {
27 public property country => PROP_ALL;
28 public property city => PROP_ALL;
29 }
30
31 package main;
32
33 my $data = {
34 name => 'Peter',
35 age => '99',
36 addresses => {
37 address => [
38 {
39 country => 'Airot',
40 city => 'Torhiq',
41 street => 'avenu1'
42 },
43 {
44 country => 'Olkson',
45 city => 'Zoxs',
46 street => 'av2'
47 }
48 ]
49 }
50 };
51
52 use Carp qw(confess);
53
54 sub Rule(&) {
55 my ($block) = @_;
56
57 return sub {
58 local $_ = shift;
59 $block->();
60 }
61 }
62
63 sub Inspect($$) {
64 my ($path,$block) = @_;
65 my $data = $_;
66
67 foreach my $name (@$path) {
68 $data = ref $data ? $data->{$name} : undef;
69 print "$name = $data\n";
70 }
71
72 local $_ = $data;
73 $block->($data);
74 }
75
76 sub Required(@);
77
78 sub Required(@) {
79 if(@_) {
80 Inspect([@_],Rule { Required });
81 } else {
82 confess "required" unless $_;
83 }
84 }
85
86 sub Regexp($) {
87 my $rx = shift;
88 die "Regular expression doesn't match" unless m/$rx/;
89 }
90
91 my $validate = Rule {
92 Required('name');
93
94 Inspect ['age'] => Rule {
95 Regexp(qr/^\d+$/);
96 die "invalid person age" unless $_ > 0 && $_ < 200;
97 };
98
99 Inspect ['addresses', 'address'] => Rule {
100 Required;
101 foreach(@{$_}) {
102 Required('street');
103 }
104 }
105 };
106
107 $validate->($data);
108
109 my ($person) =
110 map {
111 Person->new(
112 name => $_->{name},
113 age => $_->{age},
114 addresses => [
115 map {
116 Address->new(
117 country => $_->{country},
118 city => $_->{city}
119 )
120 } as_list( $_->{addresses}{address} )
121 ]
122 )
123 } $data;
124
125 use Data::Dumper;
126 print Dumper($person);
127
128 sub as_list {
129 return @{ $_[0] } if ref $_[0] eq 'ARRAY';
130 return @_;
131 }