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 => 35;

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

my $c1 = UR::Object::Type->define(class_name => 'URT::Foo', data_source => "URT::DataSource::SomeSQLite", table_name => "FOO");
is($URT::Foo::ISA[0], 'UR::Entity', "defined class has correct inheritance");
is($URT::Foo::Type::ISA[0], 'UR::Entity::Type', "defined class' meta class has correct inheritance");

my $c1b = UR::Object::Type->get(data_source_id => "URT::DataSource::SomeSQLite", table_name => "FOO");
is($c1b,$c1, "defined class is gettable");

my $c2 = UR::Object::Type->create(class_name => 'URT::Bar', data_source => "URT::DataSource::SomeSQLite", table_name => "BAR");
is($URT::Bar::ISA[0], 'UR::Entity', "created class has correct inheritance");
is($URT::Bar::Type::ISA[0], 'UR::Entity::Type', "created class' meta class has correct inheritance");

my $c2b = UR::Object::Type->get(data_source_id => "URT::DataSource::SomeSQLite", table_name => "BAR");
is($c2b,$c2, "created class is gettable");

my $c3_parent = UR::Object::Type->define(
                    class_name => 'URT::BazParent',
                    id_by => ['id_prop_a','id_prop_b'],
                    has => [
                        id_prop_a => { is => 'Integer' },
                        id_prop_b => { is => 'String' },
                        prop_c    => { is => 'Number' },
                    ],
                );
ok($c3_parent, 'Created a parent class');
is($URT::BazParent::ISA[0], 'UR::Object', 'defined class has correct inheritance');
is($URT::BazParent::Type::ISA[0], 'UR::Object::Type', "defined class' meta class has correct inheritance");
my %props = map { $_->property_name => $_ } $c3_parent->properties;
is(scalar(keys %props), 4, 'Parent class property count correct');
is($props{'id_prop_a'}->is_id, '0 but true', 'id_prop_a is an ID property and has the correct rank');
is($props{'id_prop_b'}->is_id, '1', 'id_prop_b is an ID property and has the correct rank');
is($props{'prop_c'}->is_id, undef, 'prop_c is not an ID property');

my %id_props = map { $_->property_name => 1 } $c3_parent->id_properties;
is(scalar(keys %id_props), 3, 'Parent class id property count correct');
is_deeply(\%id_props,
          { id_prop_a => 1, id_prop_b => 1, id => 1 },
          'all ID properties are there');
        
my $c3 = UR::Object::Type->define(
             class_name => 'URT::Baz',
             is => 'URT::BazParent',
             has => [
                 prop_d    => { is => 'Number' },
             ],
          );
ok($c3, 'Created class with some properties and a parent class');
is($URT::Baz::ISA[0], 'URT::BazParent', 'defined class has correct inheritance');
is($URT::Baz::Type::ISA[0], 'URT::BazParent::Type', "defined class' meta class has correct inheritance");
%props = map { $_->property_name => $_ } $c3->properties;
is(scalar(keys %props), 5, 'property count correct');
is($props{'id_prop_a'}->is_id, '0 but true', 'id_prop_a is an ID property and has the correct rank');
is($props{'id_prop_b'}->is_id, '1', 'id_prop_b is an ID property and has the correct rank');
is($props{'prop_c'}->is_id, undef, 'prop_c is not an ID property');
is($props{'prop_d'}->is_id, undef, 'prop_d is not an ID property');


my $other_class = UR::Object::Type->define(
    class_name => 'URT::OtherClass',
    id_by => [
        id => { is => 'String' },
    ],
);
my $parent_with_id_prop = UR::Object::Type->define(
    class_name => 'URT::ParentWithProp',
    has => [
        other_id => { is => 'Integer' },
    ],
);

my $child_without_id_prop = UR::Object::Type->define(
    class_name => 'URT::ChildWithoutProp',
    is => 'URT::ParentWithProp',
    has => [
        other => { is => 'URT::OtherClass', id_by => 'other_id' }
    ],
);
is($child_without_id_prop->property_meta_for_name('other_id')->data_type,
    'Integer',
    'implied property gets data_type from parent when specified');


# Test that the id_generator value propogates properly

# in-memory class
UR::Object::Type->define(
    class_name => 'URT::InMemory',
    id_by => 'id'
);
is(URT::InMemory->__meta__->id_generator,
    '-urinternal',
    'in-memory class gets default id generator');

# usual case, use the data-source's default sequence generator based on the column and
# table name.  Blank value in the class meta means delegate to the data source
UR::Object::Type->define(
    class_name => 'URT::DS_No_Idgen',
    data_source => 'URT::DataSource::SomeSQLite',
    table_name => 'ds_no_idgen',
    id_by => 'id'
);
is(URT::DS_No_Idgen->__meta__->id_generator,
    undef,
    'parent SQL-stored class has blank id_generator');

UR::Object::Type->define(
    is => 'URT::DS_No_Idgen',
    class_name => 'URT::DS_No_Idgen::Child',
    data_source => 'URT::DataSource::SomeSQLite',
    table_name => 'ds_no_idgen_child',
    id_by => 'id'
);
is(URT::DS_No_Idgen::Child->__meta__->id_generator,
    undef,
    'child SQL-stored class has blank id_generator');

# Parent does not specify id_generator, child does
UR::Object::Type->define(
    is => 'URT::DS_No_Idgen',
    class_name => 'URT::DS_No_Idgen::Child_has_idgen',
    data_source => 'URT::DataSource::SomeSQLite',
    table_name => 'ds_no_idgen_child_has_idgen',
    id_generator => 'ds_no_idgen_child_has_idgen_seq',
    id_by => 'id'
);
is(URT::DS_No_Idgen::Child_has_idgen->__meta__->id_generator,
    'ds_no_idgen_child_has_idgen_seq',
    'Child SQL-stored class can override blank id_generator from parent');

# Parent specifies a sequence generator, the child uses the same one by default
UR::Object::Type->define(
    class_name => 'URT::DS_seq_idgen',
    data_source => 'URT::DataSource::SomeSQLite',
    table_name => 'ds_seq_idgen',
    id_generator => 'id_seq_idgen_seq',
    id_by => 'id',
);
is(URT::DS_seq_idgen->__meta__->id_generator,
    'id_seq_idgen_seq',
    'parent SQL-stored class has sequence id_generator');

UR::Object::Type->define(
    is => 'URT::DS_seq_idgen',
    class_name => 'URT::DS_seq_idgen::Child',
    data_source => 'URT::DataSource::SomeSQLite',
    table_name => 'ds_seq_idgen_child',
    id_by => 'id',
);
is(URT::DS_seq_idgen::Child->__meta__->id_generator,
    'id_seq_idgen_seq',
    "child SQL-stored class has parent's sequence id_generator");

# Parent specifies a sequence generator, child specifies a different one
UR::Object::Type->define(
    is => 'URT::DS_seq_idgen',
    class_name => 'URT::DS_seq_idgen::Child2',
    data_source => 'URT::DataSource::SomeSQLite',
    table_name => 'ds_seq_idgen_child2',
    id_generator => 'id_seq_idgen_child2_seq',
    id_by => 'id',
);
is(URT::DS_seq_idgen::Child2->__meta__->id_generator,
    'id_seq_idgen_child2_seq',
    'child class can specify a different sequence generator than parent');

# parent has uuid generator, child is blank and should inherit the parent's value
UR::Object::Type->define(
    class_name => 'URT::Uuid_idgen',
    data_source => 'URT::DataSource::SomeSQLite',
    table_name => 'uuid_idgen',
    id_generator => '-uuid',
    id_by => 'id',
);
is(URT::Uuid_idgen->__meta__->id_generator,
    '-uuid',
    'parent SQL-stored class uses uuid id_generator');

UR::Object::Type->define(
    is => 'URT::Uuid_idgen',
    class_name => 'URT::Uuid_idgen::Child',
    table_name => 'uuid_idgen_child',
    id_by => 'id',
);
is(URT::Uuid_idgen::Child->__meta__->id_generator,
    '-uuid',
    'child SQL-stored class definition has blank is_generator, but inherits parent value uuid');


subtest 'property_for_column()' => sub {
    plan tests => 26;

    my $parent_meta = UR::Object::Type->define(
        class_name => 'URT::PropForColumnParent',
        id_by => 'parent_id',
        has => [
            foo => { is => 'String' },
            bar => { is => 'Number', column_name => 'bar_custom' },
        ],
        table_name => 'parent_table',
        data_source => 'URT::DataSource::SomeSQLite',
    );

    my $child_meta = UR::Object::Type->define(
        class_name => 'URT::PropForColumnChild',
        is => 'URT::PropForColumnParent',
        id_by => 'child_id',
        has => [
            foo => { is => 'String' },
            bar => { is => 'Number', column_name => 'bar' },
            baz => { is => 'Number' },
        ],
        table_name => 'child_table',
        data_source => 'URT::DataSource::SomeSQLite',
    );

    my $do_tests = sub {
        my($class_meta, @tests) = @_;

        for (my $i = 0; $i < @tests; $i += 2) {
            my($column_name, $expected_property_name) = @tests[$i, $i+1];

            is($class_meta->property_for_column($column_name),
                $expected_property_name,
                $class_meta->class_name . " column $column_name");
        }
    };

    my @parent_tests = (
        parent_id => 'parent_id',
        bogus => undef,
        bar => undef,
        bar_custom => 'bar',
        'parent_table.parent_id' => 'parent_id',
        'parent_table.bogus' => undef,
        'parent_table.bar' => undef,
        'parent_table.bar_custom' => 'bar',
        'bogus_table.parent_id' => undef,
    );

    $do_tests->($parent_meta, @parent_tests);

    my @child_tests = (
        parent_id => 'parent_id',
        child_id => 'child_id',
        bogus => undef,
        foo => 'foo',
        bar => 'bar',
        bar_custom  => 'bar',
        baz => 'baz',
        'parent_table.parent_id' => 'parent_id',
        'child_table.parent_id' => undef,
        'parent_table.child_id' => undef,
        'child_table.child_id' => 'child_id',
        'parent_table.bar' => undef,
        'child_table.bar' => 'bar',
        'parent_table.bar_custom' => 'bar',
        'child_table.bar_custom' => undef,
        'parent_table.baz' => undef,
        'child_table.baz' => 'baz',
    );

    $do_tests->($child_meta, @child_tests);
};

subtest 'inline view property_for_column()' => sub {
    plan tests => 6;

    my $class_meta = UR::Object::Type->define(
        class_name => 'URT::ClassWithInlineView',
        id_by => 'id',
        has => [ 'prop_a', 'prop_b' ],
        data_source => 'URT::DataSource::SomeSQLite',
        table_name => '(select id, prop_a, prop_b from class_with_inline_view where id is not null) class_with_inline_view',
    );

    my @tests = (
        'id' => 'id',
        'prop_a' => 'prop_a',
        'bogus' => undef,
        'class_with_inline_view.prop_a' => 'prop_a',
        'class_with_inline_view.bogus' => undef,
        'bogus_table.prop_a' => undef,
    );

    for (my $i = 0; $i < @tests; $i += 2) {
        my($column_name, $expected_property_name) = @tests[$i, $i+1];
        is($class_meta->property_for_column($column_name),
            $expected_property_name,
            "column $column_name");
    }
};