#!perl -T
use
5.14.4;
Readonly
our
%payloadKeys
=> (
'uniqueField'
=> {
type
=>
$ProfileUUID
,
description
=>
'A field containing a number.'
,
},
'arrayField'
=> {
type
=>
$ProfileArray
,
subtype
=>
$ProfileUUID
,
description
=>
'An array of UUIDs'
,
}
);
Readonly
my
@tests
=> (
[
qw(6A93E3E9-85DA-4A73-B064-8DFF3EA243CC
0x6A93E3E985DA4A73B0648DFF3EA243CC
)
],
[
qw(A2B3B6A7-5DCF-4B3C-97F8-4CC27491A829
0xA2B3B6A75DCF4B3C97F84CC27491A829
)
],
[
qw(28138BE1-D8AA-4772-9A36-6B668FBF4146
0x28138BE1D8AA47729A366B668FBF4146
)
],
[
qw(4F46C108-CDE1-4338-A80E-EC134BFEF215
0x4F46C108CDE14338A80EEC134BFEF215
)
],
[
qw(7EC197CB-99DF-45B0-AA44-14ACEC08F1F5
0x7EC197CB99DF45B0AA4414ACEC08F1F5
)
],
[
qw(C3E48023-AB1A-4DBD-ACD6-AEC66B5A1966
0xC3E48023AB1A4DBDACD6AEC66B5A1966
)
],
[
qw(E1C26A6A-65AF-4BFF-A543-E31C74BB0198
0xE1C26A6A65AF4BFFA543E31C74BB0198
)
],
[
qw(3C5CDA84-8DA2-413F-9DF8-011397FE1A8C
0x3C5CDA848DA2413F9DF8011397FE1A8C
)
],
[
qw(D4A9414A-B8F0-469B-A280-DC544C53D635
0xD4A9414AB8F0469BA280DC544C53D635
)
],
[
qw(5121361D-B87E-4D5C-A757-E4A9A4E67633
0x5121361DB87E4D5CA757E4A9A4E67633
)
],
[
qw(D41DD955-427D-4EE5-8AEA-09C48175C1B9
0xD41DD955427D4EE58AEA09C48175C1B9
)
],
[
qw(7C7ABF90-EF73-4553-AB61-F97A5CE80A71
0x7C7ABF90EF734553AB61F97A5CE80A71
)
],
[
qw(7C8ED89B-ED40-4C31-BB65-809D235147EA
0x7C8ED89BED404C31BB65809D235147EA
)
],
[
qw(84B93B0F-ACBE-45BD-ADC1-4C12C4FBAE35
0x84B93B0FACBE45BDADC14C12C4FBAE35
)
],
[
qw(2DB0B929-6B64-4F66-B5CC-5468DA8F9A8E
0x2DB0B9296B644F66B5CC5468DA8F9A8E
)
],
[
qw(B566FF45-A67C-4A38-974A-CDEEAB05949F
0xB566FF45A67C4A38974ACDEEAB05949F
)
],
[
qw(F5B9D007-E460-4990-9BFE-5F5A2F6BBA14
0xF5B9D007E46049909BFE5F5A2F6BBA14
)
],
[
qw(9B5215D5-0B6D-40CA-812B-5254443F1D42
0x9B5215D50B6D40CA812B5254443F1D42
)
],
[
qw(B992639B-7E73-4B55-BFCF-BCF3848D2562
0xB992639B7E734B55BFCFBCF3848D2562
)
],
[
qw(772B5BC5-6A36-40E5-A2DC-917D286F61E0
0x772B5BC56A3640E5A2DC917D286F61E0
)
],
[
qw(E82C5090-FFE3-43A8-8627-13ED7F19D695
0xE82C5090FFE343A8862713ED7F19D695
)
],
[
qw(0E863150-FE2C-4EF8-8BB7-71C28BA5D4C5
0x0E863150FE2C4EF88BB771C28BA5D4C5
)
],
[
qw(2FE137E9-EE95-4D20-BF5D-171BB4FA2AD5
0x2FE137E9EE954D20BF5D171BB4FA2AD5
)
],
[
qw(7CFD23AF-C27B-497D-AF47-AC110B92622F
0x7CFD23AFC27B497DAF47AC110B92622F
)
],
[
qw(57FEB5B3-1411-44F2-B5FC-67162758DB88
0x57FEB5B3141144F2B5FC67162758DB88
)
],
[
qw(490D7BBC-94FF-449C-A16D-392E93058086
0x490D7BBC94FF449CA16D392E93058086
)
],
[
qw(83866343-A184-4630-978D-116CC2053488
0x83866343A1844630978D116CC2053488
)
],
[
qw(7DFF5833-7590-4970-8030-8D510267C669
0x7DFF58337590497080308D510267C669
)
],
[
qw(04253CA0-ABA1-4790-8180-D5472579DF04
0x04253CA0ABA147908180D5472579DF04
)
],
[
qw(39A89775-7C1D-4C20-B232-A85ECDFC4A17
0x39A897757C1D4C20B232A85ECDFC4A17
)
],
[
qw(A621A4C4-B680-48A8-A80F-6F6351307D86
0xA621A4C4B68048A8A80F6F6351307D86
)
],
[
qw(DB600BD8-43B5-42F6-887A-3B714A039A22
0xDB600BD843B542F6887A3B714A039A22
)
],
[
qw(BA075FD0-B049-491D-B28F-A306672113DE
0xBA075FD0B049491DB28FA306672113DE
)
],
[
qw(C89EA724-726F-45A1-95A9-F5013F9E02D5
0xC89EA724726F45A195A9F5013F9E02D5
)
],
[
qw(12B00B34-05CD-4719-B156-8367FBDC09A2
0x12B00B3405CD4719B1568367FBDC09A2
)
],
[
qw(1685A977-4EFC-4AA0-A506-A2521717EE62
0x1685A9774EFC4AA0A506A2521717EE62
)
],
[
qw(FA150B6D-115F-474B-9398-3BCB9C8E101F
0xFA150B6D115F474B93983BCB9C8E101F
)
],
[
qw(A67B8B3E-4F44-4DD4-931C-252DD9B24C7C
0xA67B8B3E4F444DD4931C252DD9B24C7C
)
],
[
qw(52ECDF01-738D-46DE-AA7E-D81F4AAD7E4F
0x52ECDF01738D46DEAA7ED81F4AAD7E4F
)
],
[
qw(2511766D-18D5-43F2-843D-64BD1BAF215D
0x2511766D18D543F2843D64BD1BAF215D
)
],
[
qw(4FA6ADED-5402-4CF5-AF47-21863728888E
0x4FA6ADED54024CF5AF4721863728888E
)
],
[
qw(26316F2F-D5A1-44E4-9EC0-BE682121352D
0x26316F2FD5A144E49EC0BE682121352D
)
],
[
qw(A3A6FA98-CA6B-46FD-8BAD-852F95C984BE
0xA3A6FA98CA6B46FD8BAD852F95C984BE
)
],
[
qw(CC6949B0-20B5-4A9C-B2FD-3CC3C4A79DE7
0xCC6949B020B54A9CB2FD3CC3C4A79DE7
)
],
[
qw(0DB06915-BEBE-4918-9C95-0EAC20FB2AAC
0x0DB06915BEBE49189C950EAC20FB2AAC
)
],
[
qw(59C84FD1-2DD8-45F8-9E71-301A8506E9EF
0x59C84FD12DD845F89E71301A8506E9EF
)
],
[
qw(1E7D225A-1129-4821-847E-0893D895E24B
0x1E7D225A11294821847E0893D895E24B
)
],
[
qw(2A62A35E-BE24-4426-882D-9CC1CBAEC0CF
0x2A62A35EBE244426882D9CC1CBAEC0CF
)
],
[
qw(BE4D4BC0-8BF5-444E-9CD4-142425668136
0xBE4D4BC08BF5444E9CD4142425668136
)
],
[
qw(0553443E-D355-47B1-800D-E741204B4CEF
0x0553443ED35547B1800DE741204B4CEF
)
],
);
Readonly
my
@baddies
=> (
undef
,
1,
-1,
3.14159265,
''
,
'Karl is awesome!'
,
new File::Temp,
);
plan
tests
=> (1+3+3+3+3+1+2)
*scalar
(
@tests
) + 1 + (3+6)
*scalar
(
@tests
) + 3
*scalar
(
@baddies
);
my
$uuid_array_object
= new Local::UUID;
my
$uuid_array
=
$uuid_array_object
->payload->{arrayField};
my
@reference_array
= ();
my
$i
= 1;
foreach
my
$guid_group
(
@tests
) {
Readonly
my
$guid_as_string
=>
$guid_group
->[0];
Readonly
my
$guid_as_hex
=>
$guid_group
->[1];
my
$guid1
= Data::GUID->from_string(
$guid_as_string
);
my
$guid2
= Data::GUID->from_hex(
$guid_as_hex
);
cmp_ok(
$guid1
,
'=='
,
$guid2
,
'Comparing '
.
$guid_as_string
.
' and '
.
$guid_as_hex
);
my
$guid_reference
= Data::GUID->from_string(
$guid_as_string
);
my
$guid1a
= Data::GUID->from_string(
$guid_as_string
);
my
$object
= new Local::UUID;
my
$payload
=
$object
->payload;
lives_ok {
$payload
->{uniqueField} =
$guid1a
}
'Write object'
;
my
$read_guid
=
$payload
->{uniqueField};
ok(
defined
(
$read_guid
),
'Read object back'
);
cmp_ok(
$read_guid
,
'=='
,
$guid_reference
,
'Compare objects'
);
undef
$object
;
undef
$payload
;
undef
$read_guid
;
$object
= new Local::UUID;
$payload
=
$object
->payload;
lives_ok {
$payload
->{uniqueField} =
$guid_as_string
}
'Write string'
;
$read_guid
=
$payload
->{uniqueField};
ok(
defined
(
$read_guid
),
'Read was-string-now-object back'
);
cmp_ok(
$read_guid
,
'=='
,
$guid_reference
,
'Compare string'
);
undef
$object
;
undef
$payload
;
undef
$read_guid
;
$object
= new Local::UUID;
$payload
=
$object
->payload;
lives_ok {
$payload
->{uniqueField} =
$guid_as_hex
}
'Write hex'
;
$read_guid
=
$payload
->{uniqueField};
ok(
defined
(
$read_guid
),
'Read was-hex-now-object back'
);
cmp_ok(
$read_guid
,
'=='
,
$guid_reference
,
'Compare hex'
);
undef
$read_guid
;
my
$orig_array_len
=
scalar
@$uuid_array
;
if
(
$i
% 2 == 0) {
lives_ok {
push
@$uuid_array
,
$guid1a
}
'Pushing object onto array'
;
push
@reference_array
,
$guid1a
;
lives_ok {
push
@$uuid_array
,
$guid_as_string
}
'Pushing string onto array'
;
push
@reference_array
,
$guid1
;
lives_ok {
push
@$uuid_array
,
$guid_as_hex
}
'Pushing hex onto array'
;
push
@reference_array
,
$guid2
;
}
else
{
lives_ok {
unshift
@$uuid_array
,
$guid1a
}
'Pushing object onto array'
;
unshift
@reference_array
,
$guid1a
;
lives_ok {
unshift
@$uuid_array
,
$guid_as_string
}
'Pushing string onto array'
;
unshift
@reference_array
,
$guid1
;
lives_ok {
unshift
@$uuid_array
,
$guid_as_hex
}
'Pushing hex onto array'
;
unshift
@reference_array
,
$guid2
;
}
cmp_ok(
scalar
@$uuid_array
,
'=='
,
$orig_array_len
+ 3,
"Confirm array's new size"
);
my
$plist
;
lives_ok {
$plist
=
$object
->plist}
'Convert to plist'
;
cmp_ok(
$plist
->value->{uniqueField}->value,
'eq'
,
$payload
->{uniqueField}->as_string,
'plist uuid matches'
);
$i
++;
}
cmp_ok(
scalar
@$uuid_array
,
'=='
,
scalar
@reference_array
,
'Confirm expected array size'
);
for
(
my
$i
= 0;
$i
<
scalar
@reference_array
;
$i
++) {
my
$string
=
$uuid_array
->[
$i
];
$string
=
"$string"
;
my
$reference_string
=
$reference_array
[
$i
];
$reference_string
=
"$reference_string"
;
cmp_ok(
$string
,
'eq'
,
$reference_string
,
"Confirm array index $i matches"
);
}
$i
= 0;
while
(
scalar
@reference_array
> 0) {
my
(
$string
,
$reference_string
);
if
(
$i
% 2 == 0) {
lives_ok {
$string
=
shift
@$uuid_array
}
'Shift string from array'
;
$reference_string
=
shift
@reference_array
;
}
else
{
lives_ok {
$string
=
pop
@$uuid_array
}
'Pop string from array'
;
$reference_string
=
pop
@reference_array
;
}
$string
=
"$string"
;
$reference_string
=
"$reference_string"
;
cmp_ok(
$string
,
'eq'
,
$reference_string
,
'Compare'
);
$i
++;
}
$i
= 1;
foreach
my
$baddie
(
@baddies
) {
my
$object
= new Local::UUID;
my
$payload
=
$object
->payload;
dies_ok {
$payload
->{uniqueField} =
$baddie
}
"Non-UUID $i"
;
dies_ok {
push
@{
$payload
->{arrayField}},
$baddie
}
'Pushing onto array'
;
dies_ok {
unshift
@{
$payload
->{arrayField}},
$baddie
}
'Unshifting onto array'
;
$i
++;
}
done_testing();