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

use strict;
use warnings;

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

plan tests => 14;

use_ok('UR::Object::Type::ModuleWriter');

eval {
    my $f = \&UR::Object::Type::_quoted_value;
    my @tests = (
        [q(123), q(123)],
        [q(1.23), q(1.23)],
        [q(abc), q('abc')],
        [q(a'c), q(q(a'c))],
    );
    for my $test (@tests) {
        my ($i, $e) = @$test;
        is($f->($i), $e, "_quoted_value matched: $i");
    }
};

eval {
    my $f = \&UR::Object::Type::_idx;
    my @tests = (
        ['is', 0],
        ['foo', 2],
    );
    for my $test (@tests) {
        my ($i, $e) = @$test;
        is($f->($i), $e, "_idx matched: $i");
    }
};

eval {
    my $f = \&UR::Object::Type::_sort_keys;
    my @i = qw(foo bar is baz);
    my @e = qw(is bar baz foo);
    my @o = $f->(@i);
    is_deeply(\@o, \@e, "_sort_keys matched: " . join(', ', @i));
};

eval {
    my $f = \&UR::Object::Type::_exclude_items;
    my @i = qw(foo bar baz qux);
    my @x = qw(foo baz);
    my @e = qw(bar qux);
    my @o = $f->(\@i, \@x);
    is_deeply(\@o, \@e, "_exclude_items matched: [" . join(', ', @i) . "], [" . join(', ', @x) . "]");
};

# First, make a couple of classes we can point to
my $c = UR::Object::Type->define(
    class_name => 'URT::Related',
    id_by => [
        related_id  => { is => 'String' },
        related_id2 => { is => 'String' },
    ],
    has => [
        related_value => { is => 'String'},
    ],
);

ok($c, 'Defined URT::Related class');

$c = UR::Object::Type->define(
    class_name => 'URT::Parent',
    type_has => [
        some_type_meta => { is => 'ARRAY', is_optional => 1, },
    ],
    id_by => [
        parent_id => { is => 'String' },
    ],
    has => [
        parent_value => { is => 'String' },
    ],
);
ok($c, 'Defined URT::Parent class');

$c = UR::Object::Type->define(
    class_name => 'URT::Remote',
    id_by => [
        remote_id => { is => 'Integer' },
    ],
    has => [
#        test_obj => { is => 'URT::TestClass', id_by => ['prop1','prop2','prop3'] },
        something => { is => 'String' },
    ],
);
ok($c, 'Defined URT::Remote class');

# Make up a class definition with all the different kinds of properties we can think of...
# FIXME - I'm not sure how the attributes_have and id_implied stuff is meant to work
my $test_class_definition = q(
    is => 'URT::Parent',
    table_name => 'PARENT_TABLE',
    type_has => [
        some_new_property => {
            is => 'Integer',
            is_optional => 1,
        },
    ],
    attributes_have => [
        meta_prop_a => {
            is => 'Boolean',
            is_optional => 1,
        },
        meta_prop_b => { is => 'String' },
    ],
    some_type_meta => [ "foo" ],
    subclassify_by => 'my_subclass_name',
    id_by => [
        another_id => {
            is => 'String',
            doc => 'blahblah',
        },
        related => {
            is => 'URT::Related',
            id_by => [ 'parent_id', 'related_id' ],
            doc => 'related',
        },
        foobaz => { is => 'Integer' },
    ],
    has => [
        property_0 => {
            via => '__self__',
            to => 'property_a',
        },
        property_a => {
            is => 'String',
            meta_prop_a => 1,
        },
        property_b => {
            is => 'Integer',
            is_abstract => 1,
            meta_prop_b => 'metafoo',
            doc => q(property'b),
        },
        calc_sql => { calculate_sql => q(to_upper(property_b)) },
        some_enum => {
            is => 'Integer',
            column_name => 'SOME_ENUM',
            valid_values => [ 100, 200, 300 ],
        },
        another_enum => {
            is => 'String',
            column_name => 'different_name',
            valid_values => [ "one", "two", "three", 3, "four" ],
        },
        my_subclass_name => {
            is => 'Text',
            calculate_from => [ 'property_a', 'property_b' ],
            calculate => q("URT::TestClass"),
        },
        subclass_by_prop => { is => 'String' },
        subclass_by_id => { is => 'Integer' },
        subclass_by_obj => {
            is => 'UR::Object',
            id_by => 'subclass_by_id',
            id_class_by => 'subclass_by_prop',
        },
    ],
    has_many => [
        property_cs => {
            is => 'String',
            is_optional => 1,
        },
        remotes => {
            is => 'URT::Remote',
            reverse_as => 'testobj',
            where => [ something => { operator => 'like', value => '%match%' }  ],
        },
        set_remotes => {
            is => 'URT::Remote',
            reverse_as => 'testobj',
            is_mutable => 1,
            where => [ something => { operator => 'like', value => '%match%' }  ],
        },
    ],
    has_optional => [
        property_d => { is => 'Number' },
        calc_perl => {
            calculate_from => [ 'property_a', 'property_b' ],
            calculate => q($property_a . $property_b),
        },
        another_related => {
            is => 'URT::Related',
            id_by => [ 'rel_id1', 'rel_id2' ],
            where => [ 'property_a like' => 'foo', property_b => [ "foo", "bar" ] ],
            is_many => 1,
        },
        related_value => {
            is => 'StringSubclass',
            via => 'another_related',
            is_many => 1,
        },
        related_value2 => {
            is => 'StringSubclass',
            via => 'another_related',
            to => 'related_value',
            is_mutable => 1,
            is_many => 0,
        },
    ],
    schema_name => 'SomeFile',
    data_source => 'URT::DataSource::SomeFile',
    id_generator => 'the_sequence_seq',
    valid_signals => ['nonstandard1', 'something_else', 'third_thing'],
    doc => 'Hi there',
);
my $orig_test_class = $test_class_definition;
my $test_class_meta = eval "UR::Object::Type->define(class_name => 'URT::TestClass', $test_class_definition);";
ok($test_class_meta, 'Defined URT::TestClass class');
if ($@) {
    diag("Errors from class definition:\n$@");
    exit(1);
}

my $string = $test_class_meta->resolve_class_description_perl();
my $orig_string = $string;

# Normalize them by removing newlines, and multiple spaces
$test_class_definition =~ s/\n//gm;
$test_class_definition =~ s/\s+/ /gm;
$string =~ s/\n//gm;
$string =~ s/\s+/ /gm;

my $diffcmd = 'diff -u';

if ($string ne $test_class_definition) {
    ok(0, 'Rewritten class definition matches original');
    IO::File->new('>/tmp/old')->print($orig_test_class);
    IO::File->new('>/tmp/new')->print($orig_string);
    diag(qx($diffcmd /tmp/old /tmp/new));
} else {
    ok(1, 'Rewritten class definition matches original');
}