1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
use strict;
package SpringfieldObject;
sub new
{
my $class = shift;
bless { @_ }, $class;
}
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
$AUTOLOAD =~ s{.*::}{};
if ( @_ ) {
$self->{$AUTOLOAD} = shift;
} else {
$self->{$AUTOLOAD};
}
}
package Person;
use vars qw(@ISA);
@ISA = qw( SpringfieldObject );
package NaturalPerson;
use vars qw(@ISA);
@ISA = qw( Person );
package LegalPerson;
use vars qw(@ISA);
@ISA = qw( Person );
package Address;
use vars qw(@ISA);
@ISA = qw( SpringfieldObject );
package Tangram::Springfield;
use Exporter;
use vars qw(@ISA);
@ISA = qw( Exporter );
use vars qw( @EXPORT $schema $raw_schema );
@EXPORT = qw( $schema );
$schema = {
classes =>
{
Person =>
{
id => 1,
abstract => 1,
fields =>
{
iarray =>
{
addresses => { class => 'Address',
aggreg => 1 }
}
}
},
Address =>
{
id => 2,
fields =>
{
string => [ qw( type city ) ],
}
},
NaturalPerson =>
{
id => 3,
bases => [ qw( Person ) ],
fields =>
{
string => [ qw( firstName name ) ],
int => [ qw( age ) ],
ref => [ qw( partner ) ],
array => { children => 'NaturalPerson' },
},
},
LegalPerson =>
{
id => 4,
bases => [ qw( Person ) ],
fields =>
{
string => [ qw( name ) ],
ref => [ qw( manager ) ],
},
},
}
} );
sub schema {
shift if @_ and UNIVERSAL::isa($_[0], __PACKAGE__);
if ( my @classes = @_ ) {
my %classes = map { $_ => 1 } @classes;
my @gonners;
while ( my $class = each %{$schema->{classes}}) {
push @gonners, $class unless exists $classes{$class};
}
delete @{$schema->{classes}}{@gonners} if @gonners;
}
Tangram::Schema->new($schema);
}
1;
|
