The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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)');
    };
};