The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
BEGIN {
    # This test requires committing to be enabled
    delete $ENV{UR_DBI_NO_COMMIT};
}
use strict;
use warnings;

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

use Test::More tests => 91;
use URT::DataSource::SomeSQLite;
use File::Temp;
use File::Spec;

# Make a few couple classes attached to a data source.  Load some of the objects.
# The data should be copied to the test database

fill_primary_db();
setup_classes();

foreach my $no_commit ( 0, 1 ) {
    diag("no_commit $no_commit");
    UR::DBI->no_commit($no_commit);

    diag('sqlite file');
    my $db_file = load_objects_fill_file();
    test_results_db_file($db_file);

    diag('sqlite directory');
    my $db_dir = load_objects_fill_dir();
    test_results_db_dir($db_dir);
}

sub fill_primary_db {
    my $dbh = URT::DataSource::SomeSQLite->get_default_handle;

    $dbh->do('PRAGMA foreign_keys = ON');

    # "simple" is a basic table, no inheritance or hangoffs
    ok($dbh->do('create table simple (simple_id integer NOT NULL PRIMARY KEY, name varchar)'),
        'create table simple');
    my $sth = $dbh->prepare('insert into simple (simple_id, name) values (?,?)') || die "prepare simple: $DBI::errstr";
    foreach my $row ( [1, 'use'], [2, 'ignore'] ) {
        $sth->execute(@$row) || die "execute simple: $DBI::errstr";
    }
    $sth->finish;

    # "parent" and "child" tables with inheritance
    ok($dbh->do('create table parent (parent_id integer NOT NULL PRIMARY KEY, name varchar)'),
        'create table parent');
    ok($dbh->do('create table child (child_id integer NOT NULL PRIMARY KEY REFERENCES parent(parent_id), data varchar)'),
        'create table child');
    $sth = $dbh->prepare('insert into parent (parent_id, name) values (?,?)') || die "prepare parent: $DBI::errstr";
    foreach my $row ( [1, 'use'], [2, 'ignore']) {
        $sth->execute(@$row) || die "execute parent: $DBI::errstr";
    }
    $sth->finish;

    $sth = $dbh->prepare('insert into child (child_id, data) values (?,?)') || die "prepare child: $DBI::errstr";
    foreach my $row ( [1, 'child data 1'], [2, 'child data 2'] ) {
        $sth->execute(@$row) || die "execute child: $DBI::errstr";
    }
    $sth->finish;


    # "obj" and "hangoff" tables
    ok($dbh->do('create table obj (obj_id integer NOT NULL PRIMARY KEY, name varchar)'),
        'create table obj');
    ok($dbh->do('create table hangoff (hangoff_id integer NOT NULL PRIMARY KEY, value varchar, obj_id integer REFERENCES obj(obj_id))'),
        'create table hangoff');
    $sth = $dbh->prepare('insert into obj (obj_id, name) values (?,?)') || die "prepare obj: $DBI::errstr";
    foreach my $row ( [1, 'use'], [2, 'ignore'], [3, 'keep'] ) {
        $sth->execute(@$row) || die "execute hangoff: $DBI::errstr";
    }
    $sth->finish;

    $sth = $dbh->prepare('insert into hangoff (hangoff_id, value, obj_id) values (?,?,?)') || die "prepare hangoff: $DBI::errstr";
    foreach my $row ( [1, 'use', 1], [2, 'ignore', 2], [3, 'keep', 3] ) {
        $sth->execute(@$row) || die "execute obj: $DBI::errstr";
    }
    $sth->finish;


    # data and data_attribute tables
    ok($dbh->do('create table data (data_id integer NOT NULL PRIMARY KEY, name varchar)'),
        'create table data');
    ok($dbh->do('create table data_attribute (data_id integer, name varchar, value varchar, PRIMARY KEY (data_id, name, value))'),
        'create table data_attribute');
    $sth = $dbh->prepare('insert into data (data_id, name) values (?,?)') || die "prepare data: $DBI::errstr";
    foreach my $row ( [ 1, 'use'], [2, 'ignore'], [3, 'use'] ) {
        $sth->execute(@$row) || die "execute data: $DBI::errstr";
    }
    $sth->finish;

    $sth = $dbh->prepare('insert into data_attribute (data_id, name, value) values (?,?,?)') || die "prepare data_attribute: $DBI::errstr";
    # data_id 3 has no data_attributes
    foreach my $row ( [1, 'coolness', 'high'], [1, 'foo', 'bar'], [2, 'coolness', 'low']) {
        $sth->execute(@$row) || die "execute data_attribute: $DBI::errstr";
    }
    $sth->finish;


    # a table that references itself
    ok($dbh->do('create table self_reference (sr_id integer NOT NULL PRIMARY KEY, prev_id integer REFERENCES self_reference(sr_id), name varchar)'),
        'create table self_reference');
    $sth = $dbh->prepare('insert into self_reference (sr_id, prev_id, name) values (?,?,?)');
    foreach my $row ( [1, undef, 'use parent'], [2, 1, 'use'], [3, undef, 'ignore parent'], [4, 3, 'ignore']) {
        $sth->execute(@$row) || die "execute self_reference: $DBI::errstr";
    }

    # Entities and relationships
    ok($dbh->do('create table entity (entity_id integer NOT NULL PRIMARY KEY, name VARCHAR)'),
        'create entity table');
    ok($dbh->do('create table relationship (from_entity_id integer NOT NULL REFERENCES entity(entity_id), to_entity_id integer NOT NULL REFERENCES entity(entity_id), label varchar, PRIMARY KEY (from_entity_id, to_entity_id))'),
        'create entity relationship table');
    $sth = $dbh->prepare('insert into entity (entity_id, name) values (?,?)');
    foreach my $row ( [1, 'use parent'], [2, 'ignore parent'], [3, 'use child'], [4, 'ignore child'] ) {
        $sth->execute(@$row) || die "execute entity insert: $DBI::errstr";
    }
    $sth = $dbh->prepare('insert into relationship (from_entity_id, to_entity_id, label) values (?,?,?)');
    foreach my $row ( [1,3,'use'], [2,4,'ignore']) {
        $sth->execute(@$row) || die "execute relationship insert: $DBI::errstr";
    }

    # subclassable hangoff data
    ok($dbh->do('create table obj_with_subclassable_hangoff (obj_id integer NOT NULL PRIMARY KEY, name varchar)'),
        'create table obj_with_subclassable_hangoff');
    ok($dbh->do('create table subclassable_hangoff (hangoff_id integer NOT NULL PRIMARY KEY, value varchar, obj_id integer REFERENCES obj(obj_id), subclass_name varchar NOT NULL)'),
        'create table subclassable_hangoff');
    $sth = $dbh->prepare('insert into obj_with_subclassable_hangoff (obj_id, name) values (?,?)') || die "prepare obj_with_subclassable_hangoff: $DBI::errstr";
    foreach my $row ( [1, 'use'], [2, 'ignore'], [3, 'keep'] ) {
        $sth->execute(@$row) || die "execute hangoff: $DBI::errstr";
    }
    $sth->finish;

    $sth = $dbh->prepare('insert into subclassable_hangoff (hangoff_id, value, obj_id, subclass_name) values (?,?,?,?)') || die "prepare subclassable_hangoff: $DBI::errstr";
    foreach my $row ( [1, 'use', 1, 'URT::SubclassedHangoff'], [2, 'ignore', 2, 'URT::SubclassedHangoff'], [3, 'keep', 3, 'URT::SubclassedHangoff'] ) {
        $sth->execute(@$row) || die "execute obj: $DBI::errstr";
    }
    $sth->finish;

    ok($dbh->commit(), 'Commit initial database state');
}

sub setup_classes {
    UR::Object::Type->define(
        class_name => 'URT::Simple',
        id_by => 'simple_id',
        has => ['name'],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'simple',
    );

    UR::Object::Type->define(
        class_name => 'URT::Parent',
        id_by => 'parent_id',
        has => ['name'],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'parent',
    );

    UR::Object::Type->define(
        class_name => 'URT::Child',
        is => 'URT::Parent',
        id_by => 'child_id',
        has => ['data'],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'child',
    );

    UR::Object::Type->define(
        class_name => 'URT::Obj',
        id_by => 'obj_id',
        has => [
            name => { is => 'String' },
            hangoff => { is => 'URT::Hangoff', reverse_as => 'obj', is_many => 1 },
            hangoff_value => { via => 'hangoff', to => 'value' },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'obj',
    );

    UR::Object::Type->define(
        class_name => 'URT::Hangoff',
        id_by => 'hangoff_id',
        has => [
            value => { is => 'String' },
            obj => { is => 'URT::Obj', id_by => 'obj_id' },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'hangoff',
    );


    UR::Object::Type->define(
        class_name => 'URT::Data',
        id_by => 'data_id',
        has => [
            name => { is => 'String' },
            attributes => { is => 'URT::DataAttribute', reverse_as => 'data', is_many => 1 },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'data',
    );

    UR::Object::Type->define(
        class_name => 'URT::DataAttribute',
        id_by => ['data_id', 'name', 'value' ],
        has => [
            data => { is => 'URT::Data', id_by => 'data_id' },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'data_attribute',
    );

    UR::Object::Type->define(
        class_name => 'URT::SelfReferencing',
        id_by => 'sr_id',
        has => [
            prev => { is => 'URT::SelfReferencing', id_by => 'prev_id', is_optional => 1 },
            name => { is => 'String' },
        ],
        data_source  => 'URT::DataSource::SomeSQLite',
        table_name => 'self_reference',
    );

    UR::Object::Type->define(
        class_name => 'URT::Entity',
        id_by => 'entity_id',
        has => [
            name => { is => 'String' },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'entity',
    );

    UR::Object::Type->define(
        class_name => 'URT::Relationship',
        id_by => ['from_entity_id','to_entity_id'],
        has => [
            label => { is => 'String' },
            from_entity => { is => 'URT::Entity', id_by => 'from_entity_id' },
            to_entity => { is => 'URT::Entity', id_by => 'to_entity_id' },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'relationship',
    );

    UR::Object::Type->define(
        class_name => 'URT::ObjWithSubclassedHangoff',
        id_by => 'obj_id',
        has => [
            name => { is => 'String' },
            hangoff => { is => 'URT::SubclassedHangoff', reverse_as => 'obj', is_many => 1 },
            hangoff_value => { via => 'hangoff', to => 'value' },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'obj_with_subclassable_hangoff',
    );

    UR::Object::Type->define(
        class_name => 'URT::SubclassableHangoff',
        is_abstract => 1,
        subclassify_by => 'subclass_name',
        id_by => 'hangoff_id',
        has => [
            value => { is => 'String' },
            obj => { is => 'URT::ObjWithSubclassedHangoff', id_by => 'obj_id' },
            subclass_name => { is => 'String' },
        ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => 'subclassable_hangoff',
    );

    UR::Object::Type->define(
        class_name => 'URT::SubclassedHangoff',
        is => 'URT::SubclassableHangoff',
    );
}


sub load_objects_fill_file {
    my $temp_db_file = File::Temp->new();
    $temp_db_file->close();
    URT::DataSource::SomeSQLite->alternate_db_dsn('dbi:SQLite:dbname='.$temp_db_file->filename);
    _load_objects();
    URT::DataSource::SomeSQLite->alternate_db_dsn('');
    return $temp_db_file;
}

sub _load_objects {
    ok(scalar(URT::Simple->get(name => 'use')), 'Get simple object');

    ok(scalar(URT::Child->get(name => 'use')), 'Get child object');

    my @got = URT::Obj->get(hangoff_value => 'use');
    ok(scalar(@got), 'Get obj with hangoff');

    ok(scalar(URT::Hangoff->get(value => 'keep')), 'Get hangoff data directly');

    @got = URT::Data->get(name => 'use', -hints => 'attributes');
    ok(scalar(@got), 'Get data and and data attributes');

    ok(scalar(URT::SelfReferencing->get(name => 'use')), 'Get object via self-referencing table');

    ok(scalar(URT::Relationship->get(label => 'use')), 'Get relationship with two PKs');

    @got = URT::ObjWithSubclassedHangoff->get(hangoff_value => 'use');
    ok(scalar(@got), 'Get obj with subclassed hangoff');

    # The Obj is a prerequisite of the Hangoff.  Create the Obj with a dummy ID, which won't
    # be inserted to the alternate DB, which means the Hangoff can't be inserted either.
    eval {
        UR::DBI->no_commit(1);
        my $obj = URT::Obj->create(id => 999, name => 'use');
        ok($obj, 'Create URT::Obj with dummy IDs on');

        my $hangoff = URT::Hangoff->create(value => 'use', obj => $obj, id => $$);

        UR::Context->commit();
        UR::Context->current->reload('URT::Obj', hangoff_value => 'use');
        UR::Context->rollback;
        $obj->delete;  # need delete because no-commit is on inside here
    };
    UR::DBI->no_commit(0);

    $_->unload() foreach ( qw( URT::Simple
                                URT::Child URT::Obj URT::Hangoff
                                URT::Data URT::DataAttribute
                                URT::SelfReferencing
                                URT::Entity URT::Relationship
                                URT::ObjWithSubclassedHangoff URT::SubclassableHangoff ) );
}

sub test_results_db_file {
    my $db_file = shift;

    my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file",'','');
    $dbh->{FetchHashKeyName} = 'NAME_lc';

    my $simple = $dbh->selectall_hashref('select * from simple', 'simple_id');
    is_deeply($simple,
                { 1 => { simple_id => 1, name => 'use' } },
                'simple table created with correct column names');

    my $parent = $dbh->selectall_hashref('select * from parent', 'parent_id');
    is_deeply($parent,
        { 1 => { parent_id => 1, name => 'use' } },
        'table parent');

    my $child = $dbh->selectall_hashref('select * from child', 'child_id');
    is_deeply($child,
        { 1 => { child_id => 1, data => 'child data 1' } },
        'table child');

    my $obj = $dbh->selectall_hashref('select * from obj', 'obj_id');
    is_deeply($obj,
        { 1 => { obj_id => 1, name => 'use' },
          3 => { obj_id => 3, name => 'keep' },
         },
        'table obj');

    my $hangoff = $dbh->selectall_hashref('select * from hangoff', 'hangoff_id');
    is_deeply($hangoff,
        {
          1 => { hangoff_id => 1, obj_id => 1, value => 'use' },
          3 => { hangoff_id => 3, obj_id => 3, value => 'keep'},
         },
        'table hangoff');

    my $data = $dbh->selectall_hashref('select * from data', 'data_id');
    is_deeply($data,
        { 1 => { data_id => 1, name => 'use' },
          3 => { data_id => 3, name => 'use' },
        },
        'table data');

    my $data_attribute = $dbh->selectall_hashref('select * from data_attribute', 'name');
    is_deeply($data_attribute,
        { coolness  => { data_id => 1, name => 'coolness', value => 'high' },
          foo       => { data_id => 1, name => 'foo', value => 'bar' }
        },
        'table data_attribute'
    );

    my $self_referencing = $dbh->selectall_hashref('select * from self_reference', 'name');
    is_deeply($self_referencing,
        { 'use parent' => { sr_id => 1, prev_id => undef, name => 'use parent' },
          use => { sr_id => 2, prev_id => 1, name => 'use' },
        },
        'table self_referencing');

    my $entities = $dbh->selectall_hashref('select * from entity', 'entity_id');
    is_deeply($entities,
        { 1 => { entity_id => 1, name => 'use parent' },
          3 => { entity_id => 3, name => 'use child' },
        },
        'table entity',
    );

    my $relationships = $dbh->selectall_hashref('select * from relationship', 'from_entity_id');
    is_deeply($relationships,
        { 1 => { from_entity_id => 1, to_entity_id => 3, label => 'use'} },
        'table relationship',
    );
}

sub load_objects_fill_dir {
    my $temp_db_dir = File::Temp::tempdir( CLEANUP => 1 );
    URT::DataSource::SomeSQLite->alternate_db_dsn('dbi:SQLite:dbname='.$temp_db_dir);
    _load_objects();
    URT::DataSource::SomeSQLite->alternate_db_dsn('');
    return $temp_db_dir;
}

sub test_results_db_dir {
    my $temp_db_dir = shift;
    my $main_schema_file = File::Spec->catfile($temp_db_dir, 'main.sqlite3');
    ok(-f $main_schema_file, 'main schema file main.sqlite3');
    test_results_db_file($main_schema_file);
}