The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 50;

# FIXME - This tests the simple case of a single indirect property.
# Need to add a test for a doubly-indirect property crossing 2 data
# sources, and a test where the numeric order of things is differen
# than the alphabetic order

use File::Basename;
use lib File::Basename::dirname(__FILE__)."/../../../lib";
use lib File::Basename::dirname(__FILE__)."/../..";
use URT; # dummy namespace

# Turn this on for debugging
#$ENV{UR_DBI_MONITOR_SQL}=1;


my $tmp_path = "/tmp/ur_testsuite$$";
ok(mkdir($tmp_path), "mkdir temp dir");
our $DB_FILE_1 = "$tmp_path/ur_testsuite_db1_$$.sqlite";
our $DB_FILE_2 = "$tmp_path/ur_testsuite_db2_$$.sqlite";
END {
    &clean_tmp_dir($tmp_path);
}

&create_data_sources($tmp_path);
&populate_databases($tmp_path);
&create_test_classes($tmp_path);


# Set up subscriptions to count queries and loads
my($db1_query_count, $primary_load_count, $db2_query_count, $related_load_count);
sub reset_counts {
    ($db1_query_count, $primary_load_count, $db2_query_count, $related_load_count) = (0,0,0,0);
}


ok(URT::38Primary->create_subscription(
                    method => 'load',
                    callback => sub {$primary_load_count++}),
     'Created a subscription for URT::38Primary load');
ok(URT::38Related->create_subscription(
                    method => 'load',
                    callback => sub {$related_load_count++}),
     'Created a subscription for URT::38Related load');
ok(URT::DataSource::SomeSQLite1->create_subscription(
                    method => 'query',
                    callback => sub {$db1_query_count++}),
    'Created a subscription for SomeSQLite1 query');
ok(URT::DataSource::SomeSQLite2->create_subscription(
                    method => 'query',
                    callback => sub {$db2_query_count++}),
    'Created a subscription for SomeSQLite2 query');


&reset_counts();
my @o = URT::38Primary->get(related_value => '1');
is(scalar(@o), 1, "contained_value => 1 returns one Primary object");
is($db1_query_count, 1, "Queried db 1 one time");
is($primary_load_count, 1, "Loaded 1 Primary object");
is($db2_query_count, 1, "Queried db 2 one time");
is($related_load_count, 1, "Loaded 1 Related object");


&reset_counts();
@o = URT::38Primary->get(primary_value => 'Two', related_value => '2');
is(scalar(@o), 1, "container_value => 'Two',contained_value=>2 returns one Primary object");
is($db1_query_count, 1, "Queried db 1 one time");
is($primary_load_count, 1, "Loaded 1 Primary object");
is($db2_query_count, 1, "Queried db 2 one time");
is($related_load_count, 1, "Loaded 1 Related object");



&reset_counts();
@o = URT::38Primary->get(related_value => '2');
is(scalar(@o), 2, "contained_value => 2 returns two Primary objects");
is($db1_query_count, 1, "Queried db 1 one time");
is($primary_load_count, 1, "Loaded 1 Primary object");
# FIXME - This next one should really be 0, as the resulting query against db2 is exactly the same as
# the prior get() above.  The problem is that the cross-datasource join logic is
# functioning at the database level, not the object level.  So there's no good way of
# knowing that we've already done that query.
is($db2_query_count, 1, "Correctly didn't query db 2 (same as previous query)");
is($related_load_count, 0, "Correctly loaded 0 Related objects (they're cached)");




&reset_counts();
@o = URT::38Primary->get(related_value => '3');
is(scalar(@o), 0, "contained_value => 3 correctly returns no Primary objects");
is($db1_query_count, 1, "Queried db 1 one time");
is($primary_load_count, 0, "correctly loaded 0 Primary objects");
# Note - it kind of doesn't make sense that we do a query against db2, and that query does 
# match one item in there.  UR doesn't go ahead and load it because the query against the
# primary DB returns no rows, so there's nothing to 'join' against, and no rows from db2's
# query are fetched
is($db2_query_count, 1, "Queried db 2 one time");
is($related_load_count, 0, "Correctly loaded 0 Related object");




&reset_counts();
@o = URT::38Primary->get(related_value => '4');
is(scalar(@o), 0, "contained_value => 4 correctly returns no Primary objects");
# Note - same thing here, the primary query fetches 1 row, but doesn't successfully
# join to any rows in the secondary query, so no objects get loaded.
is($db1_query_count, 1, "Queried db 1 one time");
is($primary_load_count, 0, "correctly loaded 0 Primary objects");
is($db2_query_count, 1, "Queried db 2 one time");
is($related_load_count, 0, "correctly loaded 0 Related objects");



&reset_counts();
@o = URT::38Related->get(related_value => 2, primary_values => 'Two');
is(scalar(@o), 1, 'URT::Related->get(primary_value => 2) returned 1 object');

# This actually ends up being 4 because of the way the Indexes get created.  Don't think it's
# useful to test it
#is($db1_query_count, 1, "Queried db 1 one time");
is($primary_load_count, 0, "correctly loaded 0 Primary objects");
is($db2_query_count, 1, "Queried db 2 one time");
is($related_load_count, 0, "correctly loaded 0 Related objects");




sub create_data_sources {

    IO::File->new($DB_FILE_1, 'w')->close();
    class URT::DataSource::SomeSQLite1 {
        is => 'UR::DataSource::SQLite',
    };
    sub URT::DataSource::SomeSQLite1::server { $DB_FILE_1 };

    IO::File->new($DB_FILE_2, 'w')->close();
    class URT::DataSource::SomeSQLite2 {
        is => 'UR::DataSource::SQLite',
    };
    sub URT::DataSource::SomeSQLite2::server { $DB_FILE_2 };
}


sub create_test_classes {
return;
    my $tmp_path = shift;

    # We have to write them out as files instead of calling UR::Object::Type->define()
    # because each class refers to the other

    unshift(@INC, $tmp_path);

    mkdir("$tmp_path/URT") || die "Can't create dir $tmp_path/URT";
    my $f = IO::File->new("$tmp_path/URT/Related.pm",'>');
    $f->print(q(
use File::Basename;
use lib File::Basename::dirname(__FILE__)."/../../../lib";
use lib File::Basename::dirname(__FILE__)."/../..";
use URT;
UR::Object::Type->define(
    class_name => 'URT::Related',
    id_by => [ related_id => { is => 'Integer' }, ],
    has => [
        related_value   => { is => 'String' },
        primary_objects => { is => 'URT::Primary', reverse_as => 'related_object', is_many => 1 },
        primary_values  => { vis => 'primary_object', to => 'primary_value', is_many => 1 },
    ],
    data_source => 'URT::DataSource::SomeSQLite2',
    table_name => 'related',
)
1;
));
    $f->close();

    $f = IO::File->new("$tmp_path/URT/Primary.pm",'>');
    $f->print(q(
use File::Basename;
use lib File::Basename::dirname(__FILE__)."/../../../lib";
use lib File::Basename::dirname(__FILE__)."/../..";
use URT;
UR::Object::Type->define(
    class_name => 'URT::Primary',
    id_by => [ primary_id => { is => 'Integer' }, ],
    has => [
        primary_value  => { is => 'String' },
        related_id     => { is => 'Integer'},
        related_object => { is => 'URT::Related', id_by => 'related_id' },
        related_value  => { via => 'related_object', to => 'related_value' },
    ],
    data_source => 'URT::DataSource::SomeSQLite1',
    table_name => 'primary_table',
);
1;
));
    $f->close();
}



sub populate_databases {
    my $dbh = URT::DataSource::SomeSQLite1->get_default_handle();
    ok($dbh, 'Got db handle for URT::DataSource::SomeSQLite1');

    ok($dbh->do("create table primary_table (primary_id integer PRIMARY KEY, primary_value varchar, rel_id integer)"),
       "create primary table");
    # This one will match one item in related
    ok($dbh->do("insert into primary_table values (1, 'One', 1)"),
       "insert row 1 into primary");
    # these two things will match one in related
    ok($dbh->do("insert into primary_table values (2, 'Two', 2)"),
       "insert row 2 into primary");
    ok($dbh->do("insert into primary_table values (3, 'Three', 2)"),
       "insert row 3 into primary");
    # Nothing here matches related's 3
    # This will match nothing in related
    ok($dbh->do("insert into primary_table values (4, 'Four', 4)"),
       "insert row 4 into primary");

    ok($dbh->commit(), "Commit SomeSQLite1 DB");

    $dbh = URT::DataSource::SomeSQLite2->get_default_handle();
    ok($dbh, 'Got db handle for URT::DataSource::SomeSQLite2');

    ok($dbh->do("create table related (related_id integer PRIMARY KEY, related_value varchar)"),
       "crate related table");
    ok($dbh->do("insert into related values (1, '1')"),
       "insert row 1 into related");
    ok($dbh->do("insert into related values (2, '2')"),
       "insert row 2 into related");
    ok($dbh->do("insert into related values (3, '3')"),
       "insert row 4 into related");

    ok($dbh->commit(), "Commit SomeSQLite2 DB");
}
    

sub clean_tmp_dir {
    my $tmp_dir = shift;

    my $dbh = URT::DataSource::SomeSQLite1->get_default_handle();
    $dbh->disconnect();
    $dbh = URT::DataSource::SomeSQLite2->get_default_handle();
    $dbh->disconnect();

    #diag("Cleanup tmp dir");
    # These _should_ be the only files in there...
    ok(unlink($DB_FILE_1), 'Remove sqlite DB 1');
    ok(unlink($DB_FILE_2), 'Remove sqlite DB 2');
    ok(rmdir($tmp_dir), "Remove tmp dir $tmp_dir");
}