1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
#!perl
use strict;
use warnings;
use Test::More 0.88;
BEGIN { use_ok('Data::GUID'); }
my $guid = Data::GUID->new;
isa_ok($guid, 'Data::GUID');
like(
$guid->as_string,
Data::GUID->string_guid_regex,
"GUID as_string looks OK",
);
like(
"$guid",
Data::GUID->string_guid_regex,
"stringified GUID looks OK",
);
like(
$guid->as_hex,
Data::GUID->hex_guid_regex,
"GUID as_hex looks OK",
);
like(
$guid->as_base64,
Data::GUID->base64_guid_regex,
"GUID as_hex looks OK",
);
ok(
($guid <=> $guid) == 0,
"guid is equal to itself",
);
{
my $non_guid_value = 10;
is(
(($non_guid_value <=> $guid) * +1),
(($guid <=> $non_guid_value) * -1),
"guid on rhs of unbalanced <=> is (x * -1)",
);
}
{
my $uuid = Data::UUID->new->create;
isa_ok(
Data::GUID->from_data_uuid($uuid),
'Data::GUID',
"from_data_uuid",
);
for my $value (undef, '', 'foo') {
eval { Data::GUID->from_data_uuid($value) };
like($@, qr/not a valid Data::UUID/, "invalid Data::UUID value rejected");
}
}
for my $type (qw(hex string base64)) {
my $as = "as_$type";
my $from = "from_$type";
my $copy = Data::GUID->$from($guid->$as);
isa_ok($copy, 'Data::GUID', "guid from $type");
is(
$guid <=> $copy,
0,
"original guid is equal to copy round-tripped via $type",
);
my $guid_str_method = "guid_$type";
my $guid_str = Data::GUID->$guid_str_method;
for my $value (undef, '', 'foo') {
eval { Data::GUID->$from($value); };
like($@, qr/not a valid $type/, "invalid input to $from croaks");
}
my $re_method = "$type\_guid_regex";
like($guid_str, Data::GUID->$re_method, "guid_$type method ok");
}
{
my $guid = Data::GUID->new;
my $str = $guid->as_string;
$str =~ s/-//g;
my $copy = Data::GUID->from_string($str);
is($guid->as_string, $copy->as_string, "we can from_string a dash-less str");
}
done_testing;
|
