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 @_;
+}