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

=head1 NAME

graph.t - create a graph of records

=head1 DESCRIPTION

This is a more thorough testing of foreign object relationships.

=cut

use Test::More tests => 2003;
use_ok('DustyDB');

# Declare a model
package Square;
use DustyDB::Object;

has key x => (
    is => 'rw',
    isa => 'Int',
);

has key y => (
    is => 'rw',
    isa => 'Int',
);

has north => (
    is => 'rw',
    isa => 'Square',
);

has east => (
    is => 'rw',
    isa => 'Square',
);

has south => (
    is => 'rw',
    isa => 'Square',
);

has west => (
    is => 'rw',
    isa => 'Square',
);

package main;

my $db = DustyDB->new( path => 't/graph.db' );
ok($db, 'Loaded the database object');
isa_ok($db, 'DustyDB');

my $square = $db->model('Square');
for my $x (0 .. 9) {
    for my $y (0 .. 9) {
        my $this_square = $square->create( x => $x, y => $y );

        ok($this_square, 'created this square');
        is($this_square->x, $x, "this square.x = $x");
        is($this_square->y, $y, "this square.y = $y");
    }
}

for my $x (0 .. 9) {
    for my $y (0 .. 9) {
        my $this_square = $square->load( x => $x, y => $y );
        ok($this_square, "got this square for ($x, $y)");

        my $north_x = ($x + 9) % 10;
        my $east_y  = ($y + 1) % 10;
        my $south_x = ($x + 1) % 10;
        my $west_y  = ($y + 9) % 10;

        my $north_square = $square->load( x => $north_x, y => $y );
        my $east_square  = $square->load( x => $x, y => $east_y );
        my $south_square = $square->load( x => $south_x, y => $y );
        my $west_square  = $square->load( x => $x, y => $west_y );

        ok($north_square, "got a north square for ($x, $y): ($north_x, $y)");
        ok($east_square,  "got an east square for ($x, $y): ($x, $east_y)");
        ok($west_square,  "got a west square for ($x, $y): ($south_x, $y)");
        ok($south_square, "got a south square for ($x, $y): ($x, $west_y)");

        $this_square->north( $north_square );
        $this_square->east( $east_square );
        $this_square->south( $south_square );
        $this_square->west( $west_square );
        $this_square->save;
    }
}

sub is_point($$$) {
    my ($a, $b, $msg) = @_;
    is($a->x, $b->x, $msg . " x");
    is($a->y, $b->y, $msg . " y");
}

for my $x (0 .. 9) {
    for my $y (0 .. 9) {
        my $this_square = $square->load( x => $x, y => $y );

        my $north_x = ($x + 9) % 10;
        my $east_y  = ($y + 1) % 10;
        my $south_x = ($x + 1) % 10;
        my $west_y  = ($y + 9) % 10;

        my $north_square = $square->load( x => $north_x, y => $y );
        my $east_square  = $square->load( x => $x, y => $east_y );
        my $south_square = $square->load( x => $south_x, y => $y );
        my $west_square  = $square->load( x => $x, y => $west_y );

        ok($north_square, "got a north square for ($x, $y)");
        ok($east_square,  "got an east square for ($x, $y)");
        ok($west_square,  "got a west square for ($x, $y)");
        ok($south_square, "got a south square for ($x, $y)");

        is_point($this_square->north, $north_square, "north is north ($x, $y)");
        is_point($this_square->east,  $east_square,  "east is east ($x, $y)");
        is_point($this_square->south, $south_square, "south is south ($x, $y)");
        is_point($this_square->west,  $west_square,  "west is west ($x, $y)");
    }
}

unlink 't/graph.db';