The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.


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;