The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

#!perl -T
# Test suite 17-uuid: Test for proper handling of UUIDs.
#
# Copyright © 2014 A. Karl Kornel.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of either: the GNU General Public License as published
# by the Free Software Foundation; or the Artistic License.
#
# See http://dev.perl.org/licenses/ for more information.
use 5.14.4;
use strict;
use warnings FATAL => 'all';
package Local::UUID;
use Config::Apple::Profile::Payload::Types qw($ProfileArray $ProfileUUID);
Readonly our %payloadKeys => (
'uniqueField' => {
type => $ProfileUUID,
description => 'A field containing a number.',
},
'arrayField' => {
type => $ProfileArray,
subtype => $ProfileUUID,
description => 'An array of UUIDs',
}
);
package main;
use Config;
# @tests has the set of test GUIDs. Each GUID is listed in two forms:
# * As a regular GUID string
# * As a hex string
# The 50 GUIDs below were generated by the `uuidgen` program on Mac OS X 10.8.5.
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
)],
);
# Here are some things that are definitely not UUIDs (or even GUIDs!)
Readonly my @baddies => (
# Undef is wrong
undef,
# Numbers are wrong
1,
-1,
3.14159265,
# Almost all strings are wrong
'',
'Karl is awesome!',
# Almost all objects are wrong!
new File::Temp,
);
# For each GUID,
# * Make 2 Data::GUID objects, one from each string (normal and hex)
# * Compare the two objects for equality.
# * Make a copy, and hand the copy off to the payload
# * Read the payload back, and make sure nothing was changed.
# * Push or unshift the payload onto the array.
# * Check the array length
# * Write in a string to the payload; make sure it reads & compares OK.
# * Write in hex to the payload; make sure it reads & compares OK.
plan tests => (1+3+3+3+3+1+2)*scalar(@tests) + 1 + (3+6)*scalar(@tests) + 3*scalar(@baddies);
# Make an object that we'll use for array testing
my $uuid_array_object = new Local::UUID;
my $uuid_array = $uuid_array_object->payload->{arrayField};
my @reference_array = ();
# Test all of the numbers that should be good.
my $i = 1;
foreach my $guid_group (@tests) {
Readonly my $guid_as_string => $guid_group->[0];
Readonly my $guid_as_hex => $guid_group->[1];
# Make sure we're reading GUIDs properly
# (Keep $guid1 and $guid2 for array test)
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);
# undef $guid1;
# undef $guid2;
# Keep a GUID copy for reference
my $guid_reference = Data::GUID->from_string($guid_as_string);
# See if our payload can accept the Data::GUID object
# (Keep $guid1a for array test)
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 $guid1a;
undef $object;
undef $payload;
undef $read_guid;
# Now, let's try again, but with a string as the payload input
$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;
# And now, once again, but with the hex value as the payload input
# (This is our last payload class test, so keep $object and $payload
# around for plist testing)
$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 $object;
# undef $payload;
undef $read_guid;
# TODO: Create Data::UUID object and use that for testing
# TODO: Create base64-encoded version and use that for testing
# Put all forms (object, string, hex) of the UUID onto the array.
# If even, push; if odd, unshift
# The reference array does not convert, so only add objects there
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;
}
# Make sure the array count is updated
cmp_ok(scalar @$uuid_array, '==', $orig_array_len + 3,
"Confirm array's new size"
);
# Make sure we get a correct plist out
# (We'll check the array at the end)
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++;
}
# Compare our regular array to our array of objects
cmp_ok(scalar @$uuid_array, '==', scalar @reference_array,
'Confirm expected array size'
);
# Go through each array item, and compare
# (FYI: `my $i` is OK here because we're making a new lexical layer!)
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"
);
}
# Alternate pop and shift, make sure the array drains
$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++;
}
# Make sure each of the baddies fails to process
$i = 1;
foreach my $baddie (@baddies) {
my $object = new Local::UUID;
my $payload = $object->payload;
# Make sure every method of reading fails
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!
done_testing();