#!/usr/bin/env perl
use Test::More tests => 38;
use File::Basename;
use lib File::Basename::dirname(__FILE__)."/../../../lib";
use lib File::Basename::dirname(__FILE__)."/../..";
use URT;
use strict;
use warnings;
use Data::UUID;
my $tc1 = class TestClass1 {
id_by => 'foo',
has => [
foo => { is => 'String' },
value => { is => 'String' },
],
};
my $tc2 = class TestClass2 {
id_by => ['foo','bar'],
has => [
foo => { is => 'String' },
bar => { is => 'String' },
value => { is => 'String' },
],
};
my $tc3 = class TestClass3 {
id_by => 'foo',
has => [
foo => { is => 'String' },
value => { is => 'String' },
],
id_generator => '-uuid',
};
my $class_tc4_generator = 0;
my $tc4 = class TestClass4 {
id_by => 'foo',
has => [
foo => { is => 'String' },
value => { is => 'String' },
],
id_generator => sub { ++$class_tc4_generator },
};
my $o;
$o = TestClass1->create(foo => 'aaaa', value => '1234');
ok($o, "Created TestClass1 object with explicit ID");
is($o->foo, 'aaaa', "Object's explicit ID has the correct value");
is($o->foo, $o->id, "Object's implicit ID property is equal to the explicit property's value");
$o = TestClass1->create(value => '2345');
ok($o, "Created another TestClass1 object with an autogenerated ID");
ok($o->foo, "The object has an autogenerated ID");
is($o->foo, $o->id, "The object's implicit ID property is equal to the explicit property's value");
my @id_parts = split(' ',$o->id);
is($id_parts[0], Sys::Hostname::hostname(), 'hostname part of ID seen');
is($id_parts[1], $$, 'process ID part of ID seen');
# the 2nd part is the time and not reliably checked
is($id_parts[3], $UR::Object::Type::autogenerate_id_iter, 'Iterator number part of ID seen');
TestClass1->dump_error_messages(0);
TestClass1->queue_error_messages(1);
my $error_messages = TestClass1->error_messages_arrayref();
$o = TestClass1->create(foo => 'aaaa', value => '123456');
ok(!$o, "Correctly couldn't create an object with a duplicated ID");
is(scalar(@$error_messages), 1, 'Correctly trapped 1 error message');
like($error_messages->[0], qr/An object of class TestClass1 already exists with id value 'aaaa'/,
'The error message was correct');
$o = TestClass2->create(foo => 'aaaa', bar => 'bbbb', value => '1');
ok($o, "Created a TestClass2 object with both explicit ID properties");
is($o->foo, 'aaaa', "First explicit ID property has the right value");
is($o->bar, 'bbbb', "Second explicit ID property has the right value");
is($o->id, join("\t",'aaaa','bbbb'), "Implicit ID property has the right value");
TestClass2->dump_error_messages(0);
TestClass2->queue_error_messages(1);
$error_messages = TestClass2->error_messages_arrayref();
$o = TestClass2->create(foo => 'qqqq', value => 'blah');
ok(!$o, "Correctly couldn't create a multi-ID property object without specifying all the IDs");
is(scalar(@$error_messages), 1, 'Correctly trapped 1 error messages');
like($error_messages->[0], qr/Attempt to create TestClass2 with multiple ids without these properties: bar/,
'The error message was correct');
@$error_messages = ();
$o = TestClass2->create(bar => 'wwww', value => 'blah');
ok(!$o, "Correctly couldn't create a multi-ID property object without specifying all the IDs, again");
is(scalar(@$error_messages), 1, 'Correctly trapped 1 error messages');
like($error_messages->[0], qr/Attempt to create TestClass2 with multiple ids without these properties: foo/,
'The error message was correct');
@$error_messages = ();
$o = TestClass2->create(value => 'asdf');
ok(!$o, "Correctly couldn't create a multi-ID property object without specifying all the IDs, again");
is(scalar(@$error_messages), 1, 'Correctly trapped 1 error messages');
like($error_messages->[0], qr/Attempt to create TestClass2 with multiple ids without these properties: foo, bar/,
'The error message was correct');
@$error_messages = ();
$o = TestClass2->create(foo => 'aaaa', bar => 'bbbb', value => '2');
ok(!$o, "Correctly couldn't create another object with duplicated ID properites");
like($error_messages->[0], qr/An object of class TestClass2 already exists with id value 'aaaa\tbbbb'/,
'The error message was correct');
$o = TestClass3->create(foo => 'aaaa', value => '1234');
ok($o, "Created TestClass3 object with explicit ID");
is($o->foo, 'aaaa', "Object's explicit ID has the correct value");
is($o->foo, $o->id, "Object's implicit ID property is equal to the explicit property's value");
my $ug = eval { Data::UUID->new->from_hexstring('0x' . $o->foo) };
ok(((! $ug) or ($ug eq pack('x16'))), 'It was not a properly formatted UUID');
$o = TestClass3->create(value => '2345');
ok($o, "Created another TestClass3 object with an autogenerated ID");
ok($o->foo, "The object has an autogenerated ID");
is($o->foo, $o->id, "The object's implicit ID property is equal to the explicit property's value");
$ug = Data::UUID->new->from_hexstring($o->foo);
ok($ug, 'It was a properly formatted UUID');
$o = TestClass4->create(value => '12344');
ok($o, 'Created TestClass4 object with an autogenerated ID');
is($class_tc4_generator, 1, 'The generator anonymous sub was called');
is($o->id, $class_tc4_generator, 'The object ID is as expected');