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


use strict;
use lib "t/springfield";
use Springfield;

my @kids = qw( Bart Lisa Maggie );
my @population = sort qw( Homer Marge ), @kids;
my $children = 'children';

sub NaturalPerson::children
{
   my ($self) = @_;
   return wantarray ? @{ $self->{$children} }
      : join(' ', map { $_->{firstName} } @{ $self->{$children} } )
}

Springfield::begin_tests(15);

{
	my $storage = Springfield::connect_empty;

	my @children = map { NaturalPerson->new( firstName => $_, name => 'Simpson' ) } @kids;

	my $homer = NaturalPerson->new( firstName => 'Homer', name => 'Simpson',
									$children => [ @children ] );

	my $marge = NaturalPerson->new(firstName => 'Marge', name => 'Simpson',
								   $children => [ @children ] );

	$homer->{partner} = $marge;
	$marge->{partner} = $homer;

	$storage->insert( $homer, $marge );

	delete $homer->{partner};

	$storage->disconnect;
}

Springfield::leaktest;

{
   my $storage = Springfield::connect;

   my $cursor = $storage->cursor( 'NaturalPerson' );
   my @results;

   while (my $person = $cursor->current())
   {
      push @results, $person->{firstName};
      Springfield::test( $person->children eq "@kids" ) if $person->{firstName} eq 'Homer';
      $cursor->next();
   }

   @results = sort @results;

   Springfield::test( "@results" eq "@population" );

   $storage->disconnect;
}

Springfield::leaktest;

{
   my $storage = Springfield::connect;

   my $cursor1 = $storage->cursor( 'NaturalPerson' );
   my $cursor2 = $storage->cursor( 'NaturalPerson' );
   
   my (@r1, @r2);

   while ($cursor1->current())
   {
      my $p1 = $cursor1->current();
      my $p2 = $cursor2->current();
      
      push @r1, $p1->{firstName};
      push @r2, $p2->{firstName};

      Springfield::test( $p1->children eq "@kids" ) if $p1->{firstName} eq 'Homer';
      Springfield::test( $p2->children eq "@kids" ) if $p2->{firstName} eq 'Marge';

      $cursor1->next();
      $cursor2->next();
   }

   @r1 = sort @r1;
   @r2 = sort @r2;

   Springfield::test( "@r1" eq "@population" && "@r2" eq "@population" );

   $storage->disconnect;
}

Springfield::leaktest;

{
	my $storage = Springfield::connect;
	$storage->insert( NaturalPerson->new(firstName => 'Montgomery',	name => 'Burns' ) );
	$storage->disconnect;
}

{
   my $storage = Springfield::connect;

   my $remote = $storage->remote('NaturalPerson');

   my @results = $storage->select($remote,
	   order => [ $remote->{firstName}, $remote->{name} ] );

   @results = map { "$_->{firstName} $_->{name}"} @results;

   Springfield::test( "@results\n" eq <<CONTROL );
Bart Simpson Homer Simpson Lisa Simpson Maggie Simpson Marge Simpson Montgomery Burns
CONTROL

   $storage->disconnect;
}

{
   my $storage = Springfield::connect;

   my $remote = $storage->remote('NaturalPerson');

   my @results = $storage->select($remote,
       filter => $remote->{name} eq 'Simpson', 
	   order => [ $remote->{firstName}, $remote->{name} ] );

   @results = map { "$_->{firstName} $_->{name}"} @results;

   Springfield::test( "@results\n" eq <<CONTROL );
Bart Simpson Homer Simpson Lisa Simpson Maggie Simpson Marge Simpson
CONTROL

   $storage->disconnect;
}


Springfield::leaktest;

{
   my $storage = Springfield::connect;

   my ($person, $partner) = $storage->remote(qw( NaturalPerson NaturalPerson ));

   my $cursor = $storage->cursor($person,
       filter => $person->{partner} == $partner,
	   order => [ $partner->{firstName} ],
	   retrieve => [ $partner->{firstName}, $partner->{name} ]
	);

   my @results;

   while (my $p = $cursor->current())
   {
      push @results, $p->{firstName}, $cursor->residue();
      $cursor->next();
   }

   # print "@results\n";

   Springfield::test( "@results" eq 'Marge Homer Simpson Homer Marge Simpson');

   $storage->disconnect;
}

Springfield::leaktest;

{
   my $storage = Springfield::connect;

   my ($person, $partner) = $storage->remote(qw( NaturalPerson NaturalPerson ));

   my $cursor = $storage->cursor($person,
       filter => $person->{partner} == $partner,

	   # here we're ordering by an unselected foreign column; MySQL doesn't
           # mind, some other RDBMS' apparently do.
           # This extra column will end up in the $cursor->residue();
	   order => [ $partner->{firstName} ],
	);

   my @results;

   while (my $p = $cursor->current())
   {
      push @results, $p->{firstName}, $cursor->residue();
      $cursor->next();
   }

   # print "@results\n";

   Springfield::test( "@results" eq 'Marge Homer Homer Marge');

   $storage->disconnect;
}

Springfield::leaktest;

#{
#  my $storage = Springfield::connect;

#  my ($person) = $storage->remote(qw( NaturalPerson ));

#  my $cursor = $storage->cursor($person, limit => 1);

#  Springfield::test( $cursor->current() && !$cursor->next());

#  $storage->disconnect;
#}

#Springfield::leaktest;