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

# 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',
    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',
    attributes_have => [
        meta_prop_a => { is => 'Boolean', is_optional => 1 },
        meta_prop_b => { is => 'String' },
    ],
    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_a          => { is => 'String', meta_prop_a => 1 },
        property_b          => { is => 'Integer', is_abstract => 1, meta_prop_b => 'metafoo', doc => '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', implied_by => 'subclass_by_obj' },
        subclass_by_id      => { is => 'Integer', implied_by => 'subclass_by_obj' },
        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%' } ] },
    ],
    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 => 'foo' ] },
        related_value => { is => 'StringSubclass', via => 'another_related' },
        related_value2 => { is => 'StringSubclass', via => 'another_related', to => 'related_value', is_mutable => 1 },
    ],
    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 = 'sdiff -s ';

if ($string ne $test_class_definition) {
    ok(0, 'Rewritten class definition matches original');
    #is($string, $test_class_definition, 'Rewritten class definition matches original');
    diag("Original definition string:\n$orig_test_class\n");
    diag("Generated definition:\n$orig_string\n");
    IO::File->new('>/tmp/old')->print($orig_test_class);
    IO::File->new('>/tmp/new')->print($orig_string);
    system "$diffcmd/tmp/old /tmp/new";
} else {
    ok(1, 'Rewritten class definition matches original');
}