#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use above "UR";
# Test PerlReference UR::Value Views
test_SCALAR_view();
test_ARRAY_view();
test_HASH_view();
done_testing();
sub test_SCALAR_view {
my $view = UR::Value::View::Default::Xml->create();
isa_ok($view, 'UR::Object::View', 'view');
my $string = 'abc';
my $scalar = \$string;
my $scalar_object = UR::Value::SCALAR->get($scalar);
isa_ok($scalar_object, 'UR::Value', 'scalar_object');
$view->subject($scalar_object);
my $xml = $view->content;
$xml =~ tr/\n//d; # remove newlines
$xml =~ s/>\s+</></g; # remove extra whitespace
$xml =~ s/0x[a-f0-9]{7}//g; # remove memory addresses
my $expected_xml = join('',
'<?xml version="1.0"?>',
'<object type="UR::Value::SCALAR" id="SCALAR()">',
'<display_name>SCALAR()</display_name>',
'<label_name>SCALA R</label_name>',
'<types>',
'<isa type="UR::Value::SCALAR"/>',
'<isa type="UR::Value::PerlReference"/>',
'<isa type="UR::Value"/>',
'<isa type="UR::Object"/>',
'</types>',
'<perldata>',
'<scalarref memory_address="">abc</scalarref>',
'</perldata>',
'</object>',
);
is($xml, $expected_xml, 'SCALAR xml matches expected output');
}
sub test_ARRAY_view {
my $view = UR::Value::View::Default::Xml->create();
isa_ok($view, 'UR::Object::View', 'view');
my $array = [ 1, 2, 4 ];
my $array_object = UR::Value::ARRAY->get($array);
isa_ok($array_object, 'UR::Value', 'array_object');
$view->subject($array_object);
my $xml = $view->content;
$xml =~ tr/\n//d; # remove newlines
$xml =~ s/>\s+</></g; # remove extra whitespace
$xml =~ s/0x[a-f0-9]{7}//g; # remove memory addresses
my $expected_xml = join('',
'<?xml version="1.0"?>',
'<object type="UR::Value::ARRAY" id="ARRAY()">',
'<display_name>ARRAY()</display_name>',
'<label_name>ARRA Y</label_name>',
'<types>',
'<isa type="UR::Value::ARRAY"/>',
'<isa type="UR::Value::PerlReference"/>',
'<isa type="UR::Value"/>',
'<isa type="UR::Object"/>',
'</types>',
'<perldata>',
'<arrayref memory_address="">',
'<item key="0">1</item>',
'<item key="1">2</item>',
'<item key="2">4</item>',
'</arrayref>',
'</perldata>',
'</object>',
);
is($xml, $expected_xml, 'ARRAY xml matches expected output');
}
sub test_HASH_view {
my $view = UR::Value::View::Default::Xml->create();
isa_ok($view, 'UR::Object::View', 'view');
my $hash = { a => 1, b => 2, c => 4 };
my $hash_object = UR::Value::HASH->get($hash);
isa_ok($hash_object, 'UR::Value', 'hash_object');
$view->subject($hash_object);
my $xml = $view->content;
$xml =~ tr/\n//d; # remove newlines
$xml =~ s/>\s+</></g; # remove extra whitespace
$xml =~ s/0x[a-f0-9]{7}//g; # remove memory addresses
my $expected_xml = join('',
'<?xml version="1.0"?>',
'<object type="UR::Value::HASH" id="HASH()">',
'<display_name>HASH()</display_name>',
'<label_name>HAS H</label_name>',
'<types>',
'<isa type="UR::Value::HASH"/>',
'<isa type="UR::Value::PerlReference"/>',
'<isa type="UR::Value"/>',
'<isa type="UR::Object"/>',
'</types>',
'<perldata>',
'<hashref memory_address="">',
'<item key="a">1</item>',
'<item key="b">2</item>',
'<item key="c">4</item>',
'</hashref>',
'</perldata>',
'</object>',
);
is($xml, $expected_xml, 'HASH xml matches expected output');
}