|
223
|
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 }
|
