use warnings; use strict; use File::Basename; use lib File::Basename::dirname(__FILE__)."/../../../lib"; use lib File::Basename::dirname(__FILE__)."/../.."; use UR; use Test::More tests => 86; require File::Temp; my $s1 = UR::Value::Text->get('hi there'); ok($s1, 'Got an object for string "hi there"'); is($s1->id, 'hi there', 'It has the right id'); my $s2 = UR::Value::Text->get('hi there'); ok($s2, 'Got another object for the same string'); is($s1,$s2, 'They are the same object'); my $s3 = UR::Value::Text->get('something else'); ok($s3, 'Got an object for a different string'); isnt($s1,$s3, 'They are different objects'); my $s4 = UR::Value::Text->get('0'); ok(defined($s4), 'Got an object for the string "0"'); # Note that $s4 stringifies to "0" which is boolean false is($s4->id, '0', 'The ID is correct'); is($s4, '0', 'It stringifies correctly'); my $text = UR::Value::Text->get('metagenomic composition 16s is awesome'); ok($text, 'Got an object for string "metagenomic composition 16s is awesome"'); is($text->id, 'metagenomic composition 16s is awesome', 'Id is correct'); my $capitalized = $text->capitalize; isa_ok($capitalized, 'UR::Value::Text'); is($capitalized->id, 'Metagenomic Composition 16s Is Awesome', 'Capitalized for is "Metagenomic Composition 16s Is Awesome"'); my $camel = $text->to_camel; isa_ok($camel, 'UR::Value::Text'); is($camel->id, 'MetagenomicComposition16sIsAwesome', 'Text To camel case for is "MetagenomicComposition16sIsAwesome"'); my $lemac = $camel->to_lemac; isa_ok($lemac, 'UR::Value::Text'); is($lemac->id, 'metagenomic composition 16s is awesome', 'Camel case to text for is "MetagenomicComposition16sIsAwesome"'); is($lemac, $text, 'Got the same UR::Value::Text object back for camel case to text'); ok(!$text->to_hash, 'Failed to convert text object "' . $text->id . '"to a hash when does not start with a dash (-)'); my $text_for_text_to_hash = '-aa foo -b1b -1 bar --c22 baz baz -ddd -11 -eee -f -g22g text -1111 --h_h 44 --i-i -5 -j-----j -5 -6 hello -k -l_l-l g a p -m'; my $text_to_hash = UR::Value::Text->get($text_for_text_to_hash); ok($text_to_hash, 'Got object for param text'); my $hash = $text_to_hash->to_hash; ok($hash, 'Got hash for text'); is_deeply($hash->id, { aa => 'foo', b1b => '-1 bar', c22 => 'baz baz', ddd => -11, eee => '', f => '', g22g => 'text -1111', h_h => 44, 'i-i' => -5, 'j-----j' => '-5 -6 hello', k => '', 'l_l-l' => 'g a p', m => '', }, 'Text to hash id is correct'); is($hash->__display_name__, "aa => 'foo',b1b => '-1 bar',c22 => 'baz baz',ddd => '-11',eee => '',f => '',g22g => 'text -1111',h_h => '44',i-i => '-5',j-----j => '-5 -6 hello',k => '',l_l-l => 'g a p',m => ''", 'Hash display name'); my $hash_to_text = $hash->to_text; ok($hash_to_text, 'Got hash to text'); is($hash_to_text, '-aa foo -b1b -1 bar -c22 baz baz -ddd -11 -eee -f -g22g text -1111 -h_h 44 -i-i -5 -j-----j -5 -6 hello -k -l_l-l g a p -m', 'Hash to text is correct'); my $s1_refaddr = Scalar::Util::refaddr($s1); ok($s1->unload(), 'Unload the original string object'); isa_ok($s1, 'UR::DeletedRef'); isa_ok($s2, 'UR::DeletedRef'); $s1 = UR::Value::Text->get('hi there'); ok($s1, 're-get the original string object'); is($s1->id, 'hi there', 'It has the right id'); isnt(Scalar::Util::refaddr($s1), $s1_refaddr, 'It is not the original object reference'); UR::Object::Type->define( class_name => 'Test::Value', is => 'UR::Value', id_by => [ string => { is => 'Text' } ] ); eval { Test::Value->get() }; like($@, qr/Can't load an infinite set of Test::Value/, 'Getting infinite set of Test::Values threw an exception'); my $x1 = Test::Value->get('xyz'); ok($x1,"get('xyz') returned on first call"); my $x2 = Test::Value->get('xyz'); ok($x2,"get('xyz') returned on second call"); is($x1, $x2, 'They were the same object'); my $a1 = Test::Value->get(string => 'abc'); ok($a1,"get(string => 'abc') returned on first call"); my $a2 = Test::Value->get(string => 'abc'); ok($a2,"get(string => 'abc') returned on second call"); is($a1, $a2, 'They were the same object'); my $n1 = Test::Value->get('123'); ok($n1, "get('123') returned on first call"); my $n2 = Test::Value->get(string => '123'); ok($n2,"get(string => '123') returned on second call"); is($n1, $n2, 'They were the same object'); my @o = Test::Value->get(['xyz','abc','123','456']); is(scalar(@o), 4, 'Got 4 Test::Values in a single get()'); is_deeply([ map { $_->id} @o], ['123','456','abc','xyz'], 'Values were returned in ID order'); my %o = map { $_->id => $_ } @o; is($o{'123'}, $n1, "Object with id '123' is the same as the one from earlier"); is($o{'abc'}, $a1, "Object with id 'abc' is the same as the one from earlier"); is($o{'xyz'}, $x1, "Object with id 'xyz' is the same as the one from earlier"); is($o{'456'}->string, '456', 'The 4th value in the last get() constructed the correct object'); UR::Object::Type->define( class_name => 'Test::Value2', is => 'UR::Value', id_by => [ string1 => { is => 'Text' }, string2 => { is => 'Text' }, ], has => [ other_prop => { is => 'Text' }, ], ); eval { Test::Value2->get(string1 => 'abc') }; like($@, qr/Can't load an infinite set of Test::Value2/, 'Getting infinite set of Test::Value2s threw an exception'); $a1 = Test::Value2->get(string1 => 'qwe', string2 => undef); ok($a1, "get(string1 => 'qwe', string2 => undef) worked"); $a2 = Test::Value2->get(id => 'qwe'); ok($a2, "get(id => 'qwe') worked"); is($a1, $a2, 'They were the same object'); $a1 = Test::Value2->get(string1 => 'abc', string2 => 'def'); ok($a1, 'get() with both ID properties worked'); my $sep = Test::Value2->__meta__->_resolve_composite_id_separator; $a2 = Test::Value2->get('abc' . $sep . 'def'); ok($a2, 'get() with the composite ID property worked'); is($a1, $a2, 'They are the same object'); is($a1->other_prop, undef, 'The non-id property is undefined'); $x1 = Test::Value2->get(string1 => 'xyz', string2 => 'xyz', other_prop => 'hi there'); ok($x1, 'get() including a non-id property worked'); is($x1->other_prop, 'hi there', 'The non-id property has the right value'); TODO: { local $TODO = "Can't normalize a composite id in-clause rule"; # This isn't working properly because of a shortcoming in BoolExpr normalization. It ends up making # a rule like id => [abc,xyz], when we really want something like # ( string1 => 'abc' and string2 => 'abc) or ( string1 => 'xyz' and string2 => 'xyz') local $SIG{'__WARN__'} = sub {}; # Suppress warnings about is_unique during boolexpr construction @o = Test::Value2->get(['xyz'.$sep.'xyz', 'abc'.$sep.'abc']); is(scalar(@o), 2, 'get() with 2 composite IDs worked'); } { local $SIG{'__WARN__'} = sub {}; # Suppress warnings about is_unique during boolexpr construction eval { Test::Value2->get(id => ['xyz'.$sep.'xyz', 'abc'.$sep.'abc'], other_prop => 'somethign else') }; like($@, qr/Cannot load class Test::Value2 via UR::DataSource::Default when 'id' is a listref and non-id properties appear in the rule/, 'Getting with multiple IDs and including non-id properites threw an exception'); } do { do { my $pathname = 'foo'; my $path = UR::Value::FilesystemPath->get($pathname); isa_ok($path, 'UR::Value::FilesystemPath', 'path'); is($path, $pathname, 'comparing path object to string works'); }; do { my $pathname = 'foo'; my $path = UR::Value::FilesystemPath->get($pathname); $path .= 'a'; $pathname .= 'a'; isa_ok($path, 'UR::Value::FilesystemPath', 'after concatenation path still'); is($path, $pathname, 'string concatenation works'); }; do { my $pathname = 'foo'; my $path = UR::Value::FilesystemPath->get($pathname); like($path, qr/foo/, 'matching works'); }; }; do { # file test "operators" my $temp_file = File::Temp->new(); ok(-f $temp_file, 'created temp_file'); my $temp_dir = File::Temp->newdir(); ok(-d $temp_dir, 'created temp_dir'); my $temp_filename = $temp_file->filename; my $temp_dirname = $temp_dir->dirname; my $symlink_filename_a = $temp_dirname . '/symlink_a'; symlink($temp_filename, $symlink_filename_a); ok(-l $symlink_filename_a, 'created symlink'); do { # file my $path = UR::Value::FilePath->get($temp_filename); isa_ok($path, 'UR::Value::FilesystemPath', 'file path'); is($path->exists, 1, 'file path exists'); is($path->is_dir, '', 'file path is not a dir'); is($path->is_file, 1, 'file path is a file'); is($path->is_symlink, '', 'file path is not a symlink'); is($path->size, 0, 'file path size is zero'); system("echo hello > $path"); isnt($path->size, 0, "file path size isn't zero"); is($path->line_count, 1, 'file path has one line'); }; do { # dir my $path = UR::Value::FilesystemPath->get($temp_dirname); isa_ok($path, 'UR::Value::FilesystemPath', 'dir path'); is($path->exists, 1, 'dir path exists'); is($path->is_dir, 1, 'dir path is a dir'); is($path->is_file, '', 'dir path is not a file'); is($path->is_symlink, '', 'dir path is not a symlink'); }; do { # symlink my $path = UR::Value::FilesystemPath->get($symlink_filename_a); isa_ok($path, 'UR::Value::FilesystemPath', 'symlink path'); is($path->exists, 1, ' symlink path exists'); is($path->is_dir, '', ' symlink path is not a dir'); is($path->is_file, 1, ' symlink path is a file'); is($path->is_symlink, 1, ' symlink path is a symlink'); my $symlink_filename_b = "$temp_dirname/symlink_b"; symlink($path, $symlink_filename_b); ok(-l $symlink_filename_b, 'created symlink_b (from an object)'); }; };