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;