Profile of /usr/local/lib/perl5/site_perl/5.10.1/UUID/Tiny.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:21 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/UUID/Tiny.pm
Statements Executed | 732
Statement Execution Time | 4.35ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 634µs | 6.80ms | UUID::Tiny::::BEGIN@10UUID::Tiny::BEGIN@10
1 | 1 | 1 | 358µs | 721µs | UUID::Tiny::::BEGIN@7UUID::Tiny::BEGIN@7
37 | 2 | 1 | 250µs | 470µs | UUID::Tiny::::_init_globalsUUID::Tiny::_init_globals
9 | 1 | 1 | 234µs | 1.01ms | UUID::Tiny::::_create_v4_uuidUUID::Tiny::_create_v4_uuid
9 | 1 | 1 | 214µs | 289µs | UUID::Tiny::::uuid_to_stringUUID::Tiny::uuid_to_string
36 | 1 | 1 | 205µs | 675µs | UUID::Tiny::::_rand_32bitUUID::Tiny::_rand_32bit
9 | 1 | 1 | 167µs | 1.22ms | UUID::Tiny::::create_uuidUUID::Tiny::create_uuid
9 | 1 | 1 | 76µs | 1.58ms | UUID::Tiny::::create_uuid_as_stringUUID::Tiny::create_uuid_as_string
46 | 2 | 2 | 59µs | 59µs | UUID::Tiny::::CORE:unpackUUID::Tiny::CORE:unpack (opcode)
9 | 1 | 1 | 57µs | 57µs | UUID::Tiny::::_set_uuid_versionUUID::Tiny::_set_uuid_version
1 | 1 | 1 | 51µs | 217µs | UUID::Tiny::::_generate_clk_seqUUID::Tiny::_generate_clk_seq
1 | 1 | 1 | 50µs | 50µs | UUID::Tiny::::_fold_into_octetsUUID::Tiny::_fold_into_octets
36 | 1 | 2 | 45µs | 45µs | UUID::Tiny::::CORE:packUUID::Tiny::CORE:pack (opcode)
1 | 1 | 1 | 43µs | 43µs | UUID::Tiny::::BEGIN@3UUID::Tiny::BEGIN@3
9 | 1 | 1 | 40µs | 40µs | UUID::Tiny::::string_to_uuidUUID::Tiny::string_to_uuid
1 | 1 | 1 | 39µs | 104µs | UUID::Tiny::::_digest_as_octetsUUID::Tiny::_digest_as_octets
9 | 1 | 2 | 26µs | 26µs | UUID::Tiny::::CORE:regcompUUID::Tiny::CORE:regcomp (opcode)
1 | 1 | 1 | 21µs | 24µs | UUID::Tiny::::BEGIN@639UUID::Tiny::BEGIN@639
2 | 1 | 1 | 14µs | 62µs | UUID::Tiny::::BEGIN@246UUID::Tiny::BEGIN@246
74 | 2 | 2 | 12µs | 12µs | UUID::Tiny::::CORE:lockUUID::Tiny::CORE:lock (opcode)
1 | 1 | 1 | 12µs | 42µs | UUID::Tiny::::BEGIN@8UUID::Tiny::BEGIN@8
1 | 1 | 1 | 12µs | 63µs | UUID::Tiny::::BEGIN@200UUID::Tiny::BEGIN@200
1 | 1 | 1 | 11µs | 99µs | UUID::Tiny::::BEGIN@9UUID::Tiny::BEGIN@9
1 | 1 | 1 | 11µs | 15µs | UUID::Tiny::::BEGIN@309UUID::Tiny::BEGIN@309
2 | 1 | 1 | 10µs | 62µs | UUID::Tiny::::BEGIN@245UUID::Tiny::BEGIN@245
2 | 1 | 1 | 10µs | 55µs | UUID::Tiny::::BEGIN@244UUID::Tiny::BEGIN@244
2 | 1 | 1 | 10µs | 56µs | UUID::Tiny::::BEGIN@243UUID::Tiny::BEGIN@243
1 | 1 | 1 | 10µs | 29µs | UUID::Tiny::::BEGIN@147UUID::Tiny::BEGIN@147
1 | 1 | 1 | 10µs | 12µs | UUID::Tiny::::BEGIN@573UUID::Tiny::BEGIN@573
1 | 1 | 1 | 10µs | 59µs | UUID::Tiny::::BEGIN@6UUID::Tiny::BEGIN@6
1 | 1 | 1 | 9µs | 12µs | UUID::Tiny::::BEGIN@516UUID::Tiny::BEGIN@516
1 | 1 | 1 | 9µs | 11µs | UUID::Tiny::::BEGIN@756UUID::Tiny::BEGIN@756
1 | 1 | 1 | 9µs | 10µs | UUID::Tiny::::BEGIN@594UUID::Tiny::BEGIN@594
1 | 1 | 1 | 8µs | 19µs | UUID::Tiny::::BEGIN@4UUID::Tiny::BEGIN@4
1 | 1 | 1 | 8µs | 10µs | UUID::Tiny::::BEGIN@550UUID::Tiny::BEGIN@550
1 | 1 | 1 | 7µs | 10µs | UUID::Tiny::::BEGIN@5UUID::Tiny::BEGIN@5
3 | 3 | 2 | 7µs | 7µs | UUID::Tiny::::CORE:qrUUID::Tiny::CORE:qr (opcode)
1 | 1 | 1 | 7µs | 30µs | UUID::Tiny::::BEGIN@221UUID::Tiny::BEGIN@221
1 | 1 | 1 | 6µs | 30µs | UUID::Tiny::::BEGIN@217UUID::Tiny::BEGIN@217
1 | 1 | 1 | 6µs | 32µs | UUID::Tiny::::BEGIN@215UUID::Tiny::BEGIN@215
1 | 1 | 1 | 6µs | 30µs | UUID::Tiny::::BEGIN@219UUID::Tiny::BEGIN@219
9 | 1 | 2 | 2µs | 2µs | UUID::Tiny::::CORE:matchUUID::Tiny::CORE:match (opcode)
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::UUID_SHA1_AVAILUUID::Tiny::UUID_SHA1_AVAIL
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::_create_v1_uuidUUID::Tiny::_create_v1_uuid
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::_create_v3_uuidUUID::Tiny::_create_v3_uuid
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::_create_v5_uuidUUID::Tiny::_create_v5_uuid
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::_get_clk_seqUUID::Tiny::_get_clk_seq
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::_random_node_idUUID::Tiny::_random_node_id
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::clk_seq_of_uuidUUID::Tiny::clk_seq_of_uuid
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::equal_uuidsUUID::Tiny::equal_uuids
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::is_uuid_stringUUID::Tiny::is_uuid_string
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::time_of_uuidUUID::Tiny::time_of_uuid
0 | 0 | 0 | 0s | 0s | UUID::Tiny::::version_of_uuidUUID::Tiny::version_of_uuid

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package UUID::Tiny;
2 |  |  |  |  |
3 | 3 | 56µs | 1 | 43µs | # spent 43µs within UUID::Tiny::BEGIN@3 which was called # once (43µs+0s) by SimpleDB::Class::Item::BEGIN@18 at line 3 use 5.008; # spent 43µs making 1 call to UUID::Tiny::BEGIN@3
4 | 3 | 29µs | 2 | 29µs | # spent 19µs (8+10) within UUID::Tiny::BEGIN@4 which was called # once (8µs+10µs) by SimpleDB::Class::Item::BEGIN@18 at line 4 use warnings; # spent 19µs making 1 call to UUID::Tiny::BEGIN@4 # spent 10µs making 1 call to warnings::import
5 | 3 | 18µs | 2 | 12µs | # spent 10µs (7+2) within UUID::Tiny::BEGIN@5 which was called # once (7µs+2µs) by SimpleDB::Class::Item::BEGIN@18 at line 5 use strict; # spent 10µs making 1 call to UUID::Tiny::BEGIN@5 # spent 2µs making 1 call to strict::import
6 | 3 | 24µs | 2 | 108µs | # spent 59µs (10+49) within UUID::Tiny::BEGIN@6 which was called # once (10µs+49µs) by SimpleDB::Class::Item::BEGIN@18 at line 6 use Carp; # spent 59µs making 1 call to UUID::Tiny::BEGIN@6 # spent 49µs making 1 call to Exporter::import
7 | 3 | 110µs | 2 | 742µs | # spent 721µs (358+363) within UUID::Tiny::BEGIN@7 which was called # once (358µs+363µs) by SimpleDB::Class::Item::BEGIN@18 at line 7 use Digest::MD5; # spent 721µs making 1 call to UUID::Tiny::BEGIN@7 # spent 21µs making 1 call to Exporter::import
8 | 3 | 26µs | 2 | 71µs | # spent 42µs (12+29) within UUID::Tiny::BEGIN@8 which was called # once (12µs+29µs) by SimpleDB::Class::Item::BEGIN@18 at line 8 use MIME::Base64; # spent 42µs making 1 call to UUID::Tiny::BEGIN@8 # spent 29µs making 1 call to Exporter::import
9 | 3 | 27µs | 2 | 188µs | # spent 99µs (11+88) within UUID::Tiny::BEGIN@9 which was called # once (11µs+88µs) by SimpleDB::Class::Item::BEGIN@18 at line 9 use Time::HiRes; # spent 99µs making 1 call to UUID::Tiny::BEGIN@9 # spent 88µs making 1 call to Time::HiRes::import
10 | 3 | 208µs | 2 | 10.7ms | # spent 6.80ms (634µs+6.17) within UUID::Tiny::BEGIN@10 which was called # once (634µs+6.17ms) by SimpleDB::Class::Item::BEGIN@18 at line 10 use POSIX; # spent 6.80ms making 1 call to UUID::Tiny::BEGIN@10 # spent 3.90ms making 1 call to POSIX::import
11 |  |  |  |  |
12 | 1 | 300ns |  |  | our $SHA1_CALCULATOR = undef;
13 |  |  |  |  |
14 |  |  |  |  | {
15 |  |  |  |  | # Check for availability of SHA-1 ...
16 | 2 | 500ns |  |  | local $@; # don't leak an error condition
17 | 2 | 6µs | 1 | 62µs | eval { require Digest::SHA; $SHA1_CALCULATOR = Digest::SHA->new(1) } || # spent 62µs making 1 call to Digest::SHA::new
18 |  |  |  |  | eval { require Digest::SHA1; $SHA1_CALCULATOR = Digest::SHA1->new() } ||
19 | 1 | 1µs |  |  | eval {
20 |  |  |  |  | require Digest::SHA::PurePerl;
21 |  |  |  |  | $SHA1_CALCULATOR = Digest::SHA::PurePerl->new(1)
22 |  |  |  |  | };
23 |  |  |  |  | };
24 |  |  |  |  |
25 | 1 | 12µs | 1 | 7µs | our $MD5_CALCULATOR = Digest::MD5->new(); # spent 7µs making 1 call to Digest::MD5::new
26 |  |  |  |  |
27 |  |  |  |  |
28 |  |  |  |  |
29 |  |  |  |  |
30 |  |  |  |  | =head1 NAME
31 |  |  |  |  |
32 |  |  |  |  | UUID::Tiny - Pure Perl UUID Support With Functional Interface
33 |  |  |  |  |
34 |  |  |  |  | =head1 VERSION
35 |  |  |  |  |
36 |  |  |  |  | Version 1.02
37 |  |  |  |  |
38 |  |  |  |  | =cut
39 |  |  |  |  |
40 | 1 | 400ns |  |  | our $VERSION = '1.02';
41 |  |  |  |  |
42 |  |  |  |  |
43 |  |  |  |  | =head1 SYNOPSIS
44 |  |  |  |  |
45 |  |  |  |  | Create version 1, 3, 4 and 5 UUIDs:
46 |  |  |  |  |
47 |  |  |  |  | use UUID::Tiny;
48 |  |  |  |  |
49 |  |  |  |  | my $v1_mc_UUID = create_UUID();
50 |  |  |  |  | my $v3_md5_UUID = create_UUID(UUID_V3, $str);
51 |  |  |  |  | my $v3_md5_UUID = create_UUID(UUID_V3, UUID_NS_DNS, 'caugustin.de');
52 |  |  |  |  | my $v4_rand_UUID = create_UUID(UUID_V4);
53 |  |  |  |  | my $v5_sha1_UUID = create_UUID(UUID_V5, $str);
54 |  |  |  |  | my $v5_with_NS_UUID = create_UUID(UUID_V5, UUID_NS_DNS, 'caugustin.de');
55 |  |  |  |  |
56 |  |  |  |  | my $v1_mc_UUID_string = create_UUID_as_string(UUID_V1);
57 |  |  |  |  | my $v3_md5_UUID_string = UUID_to_string($v3_md5_UUID);
58 |  |  |  |  |
59 |  |  |  |  | if ( version_of_UUID($v1_mc_UUID) == 1 ) { ... };
60 |  |  |  |  | if ( version_of_UUID($v5_sha1_UUID) == 5 ) { ... };
61 |  |  |  |  | if ( is_UUID_string($v1_mc_UUID_string) ) { ... };
62 |  |  |  |  | if ( equal_UUIDs($uuid1, $uuid2) ) { ... };
63 |  |  |  |  |
64 |  |  |  |  | my $uuid_time = time_of_UUID($v1_mc_UUID);
65 |  |  |  |  | my $uuid_clk_seq = clk_seq_of_UUID($v1_mc_UUID);
66 |  |  |  |  |
67 |  |  |  |  | =cut
68 |  |  |  |  |
69 |  |  |  |  |
70 |  |  |  |  | =head1 DESCRIPTION
71 |  |  |  |  |
72 |  |  |  |  | UUID::Tiny is a lightweight, low dependency Pure Perl module for UUID
73 |  |  |  |  | creation and testing. This module provides the creation of version 1 time
74 |  |  |  |  | based UUIDs (using random multicast MAC addresses), version 3 MD5 based UUIDs,
75 |  |  |  |  | version 4 random UUIDs, and version 5 SHA-1 based UUIDs.
76 |  |  |  |  |
77 |  |  |  |  | ATTENTION! UUID::Tiny uses Perl's C<rand()> to create the basic random
78 |  |  |  |  | numbers, so the created v4 UUIDs are B<not> cryptographically strong!
79 |  |  |  |  |
80 |  |  |  |  | No fancy OO interface, no plethora of different UUID representation formats
81 |  |  |  |  | and transformations - just string and binary. Conversion, test and time
82 |  |  |  |  | functions equally accept UUIDs and UUID strings, so don't bother to convert
83 |  |  |  |  | UUIDs for them!
84 |  |  |  |  |
85 |  |  |  |  | All constants and public functions are exported by default, because if you
86 |  |  |  |  | didn't need/want them, you wouldn't use this module ...
87 |  |  |  |  |
88 |  |  |  |  | UUID::Tiny deliberately uses a minimal functional interface for UUID creation
89 |  |  |  |  | (and conversion/testing), because in this case OO looks like overkill to me
90 |  |  |  |  | and makes the creation and use of UUIDs unnecessarily complicated.
91 |  |  |  |  |
92 |  |  |  |  | If you need raw performance for UUID creation, or the real MAC address in
93 |  |  |  |  | version 1 UUIDs, or an OO interface, and if you can afford module compilation
94 |  |  |  |  | and installation on the target system, then better look at other CPAN UUID
95 |  |  |  |  | modules like L<Data::UUID>.
96 |  |  |  |  |
97 |  |  |  |  | This module is "fork safe", especially for random UUIDs (it works around
98 |  |  |  |  | Perl's rand() problem when forking processes).
99 |  |  |  |  |
100 |  |  |  |  | This module should be "thread safe," because its global variables
101 |  |  |  |  | are locked in the functions that access them. (Not tested - if you can provide
102 |  |  |  |  | some tests, please tell me!)
103 |  |  |  |  |
104 |  |  |  |  | =cut
105 |  |  |  |  |
106 |  |  |  |  |
107 |  |  |  |  | =head1 DEPENDENCIES
108 |  |  |  |  |
109 |  |  |  |  | This module should run from Perl 5.8 up and uses mostly standard (5.8 core)
110 |  |  |  |  | modules for its job. No compilation or installation required. These are the
111 |  |  |  |  | modules UUID::Tiny depends on:
112 |  |  |  |  |
113 |  |  |  |  | Carp
114 |  |  |  |  | Digest::MD5 Perl 5.8 core
115 |  |  |  |  | Digest::SHA Perl 5.10 core (or Digest::SHA1, or Digest::SHA::PurePerl)
116 |  |  |  |  | MIME::Base64 Perl 5.8 core
117 |  |  |  |  | Time::HiRes Perl 5.8 core
118 |  |  |  |  | POSIX Perl 5.8 core
119 |  |  |  |  |
120 |  |  |  |  | If you are using this module on a Perl prior to 5.10 and you don't have
121 |  |  |  |  | Digest::SHA1 installed, you can use Digest::SHA::PurePerl instead.
122 |  |  |  |  |
123 |  |  |  |  | =cut
124 |  |  |  |  |
125 |  |  |  |  |
126 |  |  |  |  | =head1 ATTENTION! NEW STANDARD INTERFACE (IN PREPARATION FOR V2.00)
127 |  |  |  |  |
128 |  |  |  |  | After some debate I'm convinced that it is more Perlish (and far easier to
129 |  |  |  |  | write) to use all-lowercase function names - without exceptions. And that it
130 |  |  |  |  | is more polite to export symbols only on demand.
131 |  |  |  |  |
132 |  |  |  |  | While the 1.0x versions will continue to export the old, "legacy" interface on
133 |  |  |  |  | default, the future standard interface is available using the C<:std> tag on
134 |  |  |  |  | import from version 1.02 on:
135 |  |  |  |  |
136 |  |  |  |  | use UUID::Tiny ':std';
137 |  |  |  |  | my $md5_uuid = create_uuid(UUID_MD5, $str);
138 |  |  |  |  |
139 |  |  |  |  | In preparation for the upcoming version 2.00 of UUID::Tiny you should use the
140 |  |  |  |  | C<:legacy> tag if you want to stay with the version 1.0x interface:
141 |  |  |  |  |
142 |  |  |  |  | use UUID::Tiny ':legacy';
143 |  |  |  |  | my $md5_uuid = create_UUID(UUID_V3, $str);
144 |  |  |  |  |
145 |  |  |  |  | =cut
146 |  |  |  |  |
147 | 3 | 97µs | 2 | 48µs | # spent 29µs (10+19) within UUID::Tiny::BEGIN@147 which was called # once (10µs+19µs) by SimpleDB::Class::Item::BEGIN@18 at line 147 use Exporter; # spent 29µs making 1 call to UUID::Tiny::BEGIN@147 # spent 19µs making 1 call to Exporter::import
148 | 1 | 7µs |  |  | our @ISA = qw(Exporter);
149 | 1 | 100ns |  |  | our @EXPORT;
150 | 1 | 100ns |  |  | our @EXPORT_OK;
151 | 1 | 8µs |  |  | our %EXPORT_TAGS = (
152 |  |  |  |  | std => [qw(
153 |  |  |  |  | UUID_NIL
154 |  |  |  |  | UUID_NS_DNS UUID_NS_URL UUID_NS_OID UUID_NS_X500
155 |  |  |  |  | UUID_V1 UUID_TIME
156 |  |  |  |  | UUID_V3 UUID_MD5
157 |  |  |  |  | UUID_V4 UUID_RANDOM
158 |  |  |  |  | UUID_V5 UUID_SHA1
159 |  |  |  |  | UUID_SHA1_AVAIL
160 |  |  |  |  | create_uuid create_uuid_as_string
161 |  |  |  |  | is_uuid_string
162 |  |  |  |  | uuid_to_string string_to_uuid
163 |  |  |  |  | version_of_uuid time_of_uuid clk_seq_of_uuid
164 |  |  |  |  | equal_uuids
165 |  |  |  |  | )],
166 |  |  |  |  | legacy => [qw(
167 |  |  |  |  | UUID_NIL
168 |  |  |  |  | UUID_NS_DNS UUID_NS_URL UUID_NS_OID UUID_NS_X500
169 |  |  |  |  | UUID_V1
170 |  |  |  |  | UUID_V3
171 |  |  |  |  | UUID_V4
172 |  |  |  |  | UUID_V5
173 |  |  |  |  | UUID_SHA1_AVAIL
174 |  |  |  |  | create_UUID create_UUID_as_string
175 |  |  |  |  | is_UUID_string
176 |  |  |  |  | UUID_to_string string_to_UUID
177 |  |  |  |  | version_of_UUID time_of_UUID clk_seq_of_UUID
178 |  |  |  |  | equal_UUIDs
179 |  |  |  |  | )],
180 |  |  |  |  | );
181 |  |  |  |  |
182 | 1 | 2µs | 1 | 25µs | Exporter::export_tags('legacy'); # spent 25µs making 1 call to Exporter::export_tags
183 | 1 | 2µs | 1 | 14µs | Exporter::export_ok_tags('std'); # spent 14µs making 1 call to Exporter::export_ok_tags
184 |  |  |  |  |
185 |  |  |  |  |
186 |  |  |  |  | =head1 CONSTANTS
187 |  |  |  |  |
188 |  |  |  |  | =cut
189 |  |  |  |  |
190 |  |  |  |  | =over 4
191 |  |  |  |  |
192 |  |  |  |  | =item B<NIL UUID>
193 |  |  |  |  |
194 |  |  |  |  | This module provides the NIL UUID (shown with its string representation):
195 |  |  |  |  |
196 |  |  |  |  | UUID_NIL: '00000000-0000-0000-0000-000000000000'
197 |  |  |  |  |
198 |  |  |  |  | =cut
199 |  |  |  |  |
200 | 3 | 39µs | 2 | 114µs | # spent 63µs (12+51) within UUID::Tiny::BEGIN@200 which was called # once (12µs+51µs) by SimpleDB::Class::Item::BEGIN@18 at line 200 use constant UUID_NIL => "\x00" x 16; # spent 63µs making 1 call to UUID::Tiny::BEGIN@200 # spent 51µs making 1 call to constant::import
201 |  |  |  |  |
202 |  |  |  |  |
203 |  |  |  |  | =item B<Pre-defined Namespace UUIDs>
204 |  |  |  |  |
205 |  |  |  |  | This module provides the common pre-defined namespace UUIDs (shown with their
206 |  |  |  |  | string representation):
207 |  |  |  |  |
208 |  |  |  |  | UUID_NS_DNS: '6ba7b810-9dad-11d1-80b4-00c04fd430c8'
209 |  |  |  |  | UUID_NS_URL: '6ba7b811-9dad-11d1-80b4-00c04fd430c8'
210 |  |  |  |  | UUID_NS_OID: '6ba7b812-9dad-11d1-80b4-00c04fd430c8'
211 |  |  |  |  | UUID_NS_X500: '6ba7b814-9dad-11d1-80b4-00c04fd430c8'
212 |  |  |  |  |
213 |  |  |  |  | =cut
214 |  |  |  |  |
215 |  |  |  |  | # spent 32µs (6+26) within UUID::Tiny::BEGIN@215 which was called # once (6µs+26µs) by SimpleDB::Class::Item::BEGIN@18 at line 216 use constant UUID_NS_DNS => # spent 26µs making 1 call to constant::import
216 | 3 | 28µs | 1 | 32µs | "\x6b\xa7\xb8\x10\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8"; # spent 32µs making 1 call to UUID::Tiny::BEGIN@215
217 |  |  |  |  | # spent 30µs (6+24) within UUID::Tiny::BEGIN@217 which was called # once (6µs+24µs) by SimpleDB::Class::Item::BEGIN@18 at line 218 use constant UUID_NS_URL => # spent 24µs making 1 call to constant::import
218 | 3 | 27µs | 1 | 30µs | "\x6b\xa7\xb8\x11\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8"; # spent 30µs making 1 call to UUID::Tiny::BEGIN@217
219 |  |  |  |  | # spent 30µs (6+24) within UUID::Tiny::BEGIN@219 which was called # once (6µs+24µs) by SimpleDB::Class::Item::BEGIN@18 at line 220 use constant UUID_NS_OID => # spent 24µs making 1 call to constant::import
220 | 3 | 28µs | 1 | 30µs | "\x6b\xa7\xb8\x12\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8"; # spent 30µs making 1 call to UUID::Tiny::BEGIN@219
221 |  |  |  |  | # spent 30µs (7+24) within UUID::Tiny::BEGIN@221 which was called # once (7µs+24µs) by SimpleDB::Class::Item::BEGIN@18 at line 222 use constant UUID_NS_X500 => # spent 24µs making 1 call to constant::import
222 | 3 | 24µs | 1 | 30µs | "\x6b\xa7\xb8\x14\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8"; # spent 30µs making 1 call to UUID::Tiny::BEGIN@221
223 |  |  |  |  |
224 |  |  |  |  |
225 |  |  |  |  | =item B<UUID versions>
226 |  |  |  |  |
227 |  |  |  |  | This module provides the UUID version numbers as constants:
228 |  |  |  |  |
229 |  |  |  |  | UUID_V1
230 |  |  |  |  | UUID_V3
231 |  |  |  |  | UUID_V4
232 |  |  |  |  | UUID_V5
233 |  |  |  |  |
234 |  |  |  |  | With C<use UUID::Tiny ':std';> you get additional, "speaking" constants:
235 |  |  |  |  |
236 |  |  |  |  | UUID_TIME
237 |  |  |  |  | UUID_MD5
238 |  |  |  |  | UUID_RANDOM
239 |  |  |  |  | UUID_SHA1
240 |  |  |  |  |
241 |  |  |  |  | =cut
242 |  |  |  |  |
243 | 6 | 41µs | 4 | 101µs | # spent 56µs (10+45) within UUID::Tiny::BEGIN@243 which was called 2 times, avg 28µs/call: # 2 times (10µs+45µs) by SimpleDB::Class::Item::BEGIN@18 at line 243, avg 28µs/call use constant UUID_V1 => 1; use constant UUID_TIME => 1; # spent 56µs making 2 calls to UUID::Tiny::BEGIN@243, avg 28µs/call # spent 45µs making 2 calls to constant::import, avg 23µs/call
244 | 6 | 40µs | 4 | 100µs | # spent 55µs (10+45) within UUID::Tiny::BEGIN@244 which was called 2 times, avg 28µs/call: # 2 times (10µs+45µs) by SimpleDB::Class::Item::BEGIN@18 at line 244, avg 28µs/call use constant UUID_V3 => 3; use constant UUID_MD5 => 3; # spent 55µs making 2 calls to UUID::Tiny::BEGIN@244, avg 28µs/call # spent 45µs making 2 calls to constant::import, avg 22µs/call
245 | 6 | 43µs | 4 | 113µs | # spent 62µs (10+51) within UUID::Tiny::BEGIN@245 which was called 2 times, avg 31µs/call: # 2 times (10µs+51µs) by SimpleDB::Class::Item::BEGIN@18 at line 245, avg 31µs/call use constant UUID_V4 => 4; use constant UUID_RANDOM => 4; # spent 62µs making 2 calls to UUID::Tiny::BEGIN@245, avg 31µs/call # spent 51µs making 2 calls to constant::import, avg 26µs/call
246 | 6 | 80µs | 4 | 112µs | # spent 62µs (14+49) within UUID::Tiny::BEGIN@246 which was called 2 times, avg 31µs/call: # 2 times (14µs+49µs) by SimpleDB::Class::Item::BEGIN@18 at line 246, avg 31µs/call use constant UUID_V5 => 5; use constant UUID_SHA1 => 5; # spent 62µs making 2 calls to UUID::Tiny::BEGIN@246, avg 31µs/call # spent 49µs making 2 calls to constant::import, avg 24µs/call
247 |  |  |  |  |
248 |  |  |  |  |
249 |  |  |  |  | =item B<UUID_SHA1_AVAIL>
250 |  |  |  |  |
251 |  |  |  |  | my $uuid = create_UUID( UUID_SHA1_AVAIL? UUID_V5 : UUID_V3, $str );
252 |  |  |  |  |
253 |  |  |  |  | This function returns 1 if a module to create SHA-1 digests could be loaded, 0
254 |  |  |  |  | otherwise.
255 |  |  |  |  |
256 |  |  |  |  | UUID::Tiny (since version 1.02) tries to load Digest::SHA, Digest::SHA1 or
257 |  |  |  |  | Digest::SHA::PurePerl, but does not die if none of them is found. Instead
258 |  |  |  |  | C<create_UUID()> and C<create_UUID_as_string()> die when trying to create an
259 |  |  |  |  | SHA-1 based UUID without an appropriate module available.
260 |  |  |  |  |
261 |  |  |  |  | =cut
262 |  |  |  |  |
263 |  |  |  |  | sub UUID_SHA1_AVAIL {
264 |  |  |  |  | return defined $SHA1_CALCULATOR ? 1 : 0;
265 |  |  |  |  | }
266 |  |  |  |  |
267 |  |  |  |  | =back
268 |  |  |  |  |
269 |  |  |  |  | =cut
270 |  |  |  |  |
271 |  |  |  |  | =head1 FUNCTIONS
272 |  |  |  |  |
273 |  |  |  |  | All public functions are exported by default (they should not collide with
274 |  |  |  |  | other functions).
275 |  |  |  |  |
276 |  |  |  |  | C<create_UUID()> creates standard binary UUIDs in network byte order
277 |  |  |  |  | (MSB first), C<create_UUID_as_string()> creates the standard string
278 |  |  |  |  | represantion of UUIDs.
279 |  |  |  |  |
280 |  |  |  |  | All query and test functions (except C<is_UUID_string>) accept both
281 |  |  |  |  | representations.
282 |  |  |  |  |
283 |  |  |  |  | =over 4
284 |  |  |  |  |
285 |  |  |  |  | =cut
286 |  |  |  |  |
287 |  |  |  |  | =item B<create_UUID()>, B<create_uuid()> (:std)
288 |  |  |  |  |
289 |  |  |  |  | my $v1_mc_UUID = create_UUID();
290 |  |  |  |  | my $v1_mc_UUID = create_UUID(UUID_V1);
291 |  |  |  |  | my $v3_md5_UUID = create_UUID(UUID_V3, $ns_uuid, $name_or_filehandle);
292 |  |  |  |  | my $v3_md5_UUID = create_UUID(UUID_V3, $name_or_filehandle);
293 |  |  |  |  | my $v4_rand_UUID = create_UUID(UUID_V4);
294 |  |  |  |  | my $v5_sha1_UUID = create_UUID(UUID_V5, $ns_uuid $name_or_filehandle);
295 |  |  |  |  | my $v5_sha1_UUID = create_UUID(UUID_V5, $name_or_filehandle);
296 |  |  |  |  |
297 |  |  |  |  | Creates a binary UUID in network byte order (MSB first). For v3 and v5 UUIDs a
298 |  |  |  |  | C<SCALAR> (normally a string), C<GLOB> ("classic" file handle) or C<IO> object
299 |  |  |  |  | (i.e. C<IO::File>) can be used; files have to be opened for reading.
300 |  |  |  |  |
301 |  |  |  |  | I found no hint if and how UUIDs should be created from file content. It seems
302 |  |  |  |  | to be undefined, but it is useful - so I would suggest to use UUID_NIL as the
303 |  |  |  |  | namespace UUID, because no "real name" is used; UUID_NIL is used by default if
304 |  |  |  |  | a namespace UUID is missing (only 2 arguments are used).
305 |  |  |  |  |
306 |  |  |  |  | =cut
307 |  |  |  |  |
308 |  |  |  |  | # spent 1.22ms (167µs+1.05) within UUID::Tiny::create_uuid which was called 9 times, avg 135µs/call: # 9 times (167µs+1.05ms) by UUID::Tiny::create_uuid_as_string at line 482, avg 135µs/call sub create_uuid {
309 | 3 | 711µs | 2 | 20µs | # spent 15µs (11+5) within UUID::Tiny::BEGIN@309 which was called # once (11µs+5µs) by SimpleDB::Class::Item::BEGIN@18 at line 309 use bytes; # spent 15µs making 1 call to UUID::Tiny::BEGIN@309 # spent 5µs making 1 call to bytes::import
310 | 63 | 145µs |  |  | my ($v, $arg2, $arg3) = (shift || UUID_V1, shift, shift);
311 |  |  |  |  | my $uuid = UUID_NIL;
312 |  |  |  |  | my $ns_uuid = string_to_uuid(defined $arg3 ? $arg2 : UUID_NIL); # spent 40µs making 9 calls to UUID::Tiny::string_to_uuid, avg 4µs/call
313 |  |  |  |  | my $name = defined $arg3 ? $arg3 : $arg2;
314 |  |  |  |  |
315 |  |  |  |  | if ($v == UUID_V1) { # spent 1.01ms making 9 calls to UUID::Tiny::_create_v4_uuid, avg 112µs/call
316 |  |  |  |  | $uuid = _create_v1_uuid();
317 |  |  |  |  | }
318 |  |  |  |  | elsif ($v == UUID_V3 ) {
319 |  |  |  |  | $uuid = _create_v3_uuid($ns_uuid, $name);
320 |  |  |  |  | }
321 |  |  |  |  | elsif ($v == UUID_V4) {
322 |  |  |  |  | $uuid = _create_v4_uuid();
323 |  |  |  |  | }
324 |  |  |  |  | elsif ($v == UUID_V5) {
325 |  |  |  |  | $uuid = _create_v5_uuid($ns_uuid, $name);
326 |  |  |  |  | }
327 |  |  |  |  | else {
328 |  |  |  |  | croak __PACKAGE__ . "::create_uuid(): Invalid UUID version '$v'!";
329 |  |  |  |  | }
330 |  |  |  |  |
331 |  |  |  |  | # Set variant 2 in UUID ...
332 |  |  |  |  | substr $uuid, 8, 1, chr(ord(substr $uuid, 8, 1) & 0x3f | 0x80);
333 |  |  |  |  |
334 |  |  |  |  | return $uuid;
335 |  |  |  |  | }
336 |  |  |  |  |
337 | 1 | 1µs |  |  | *create_UUID = \&create_uuid;
338 |  |  |  |  |
339 |  |  |  |  |
340 |  |  |  |  | sub _create_v1_uuid {
341 |  |  |  |  | my $uuid = '';
342 |  |  |  |  |
343 |  |  |  |  | # Create time and clock sequence ...
344 |  |  |  |  | my $timestamp = Time::HiRes::time();
345 |  |  |  |  | my $clk_seq = _get_clk_seq($timestamp);
346 |  |  |  |  |
347 |  |  |  |  | # hi = time mod (1000000 / 0x100000000)
348 |  |  |  |  | my $hi = floor( $timestamp / 65536.0 / 512 * 78125 );
349 |  |  |  |  | $timestamp -= $hi * 512.0 * 65536 / 78125;
350 |  |  |  |  | my $low = floor( $timestamp * 10000000.0 + 0.5 );
351 |  |  |  |  |
352 |  |  |  |  | # MAGIC offset: 01B2-1DD2-13814000
353 |  |  |  |  | if ( $low < 0xec7ec000 ) {
354 |  |  |  |  | $low += 0x13814000;
355 |  |  |  |  | }
356 |  |  |  |  | else {
357 |  |  |  |  | $low -= 0xec7ec000;
358 |  |  |  |  | $hi++;
359 |  |  |  |  | }
360 |  |  |  |  |
361 |  |  |  |  | if ( $hi < 0x0e4de22e ) {
362 |  |  |  |  | $hi += 0x01b21dd2;
363 |  |  |  |  | }
364 |  |  |  |  | else {
365 |  |  |  |  | $hi -= 0x0e4de22e; # wrap around
366 |  |  |  |  | }
367 |  |  |  |  |
368 |  |  |  |  | # Set time in UUID ...
369 |  |  |  |  | substr $uuid, 0, 4, pack( 'N', $low ); # set time low
370 |  |  |  |  | substr $uuid, 4, 2, pack( 'n', $hi & 0xffff ); # set time mid
371 |  |  |  |  | substr $uuid, 6, 2, pack( 'n', ( $hi >> 16 ) & 0x0fff ); # set time high
372 |  |  |  |  |
373 |  |  |  |  | # Set clock sequence in UUID ...
374 |  |  |  |  | substr $uuid, 8, 2, pack( 'n', $clk_seq );
375 |  |  |  |  |
376 |  |  |  |  | # Set random node in UUID ...
377 |  |  |  |  | substr $uuid, 10, 6, _random_node_id();
378 |  |  |  |  |
379 |  |  |  |  | return _set_uuid_version($uuid => 0x10);
380 |  |  |  |  | }
381 |  |  |  |  |
382 |  |  |  |  | sub _create_v3_uuid {
383 |  |  |  |  | my $ns_uuid = shift;
384 |  |  |  |  | my $name = shift;
385 |  |  |  |  | my $uuid = '';
386 |  |  |  |  |
387 |  |  |  |  | lock $MD5_CALCULATOR;
388 |  |  |  |  |
389 |  |  |  |  | # Create digest in UUID ...
390 |  |  |  |  | $MD5_CALCULATOR->reset();
391 |  |  |  |  | $MD5_CALCULATOR->add($ns_uuid);
392 |  |  |  |  |
393 |  |  |  |  | if ( ref($name) =~ m/^(?:GLOB|IO::)/ ) {
394 |  |  |  |  | $MD5_CALCULATOR->addfile($name);
395 |  |  |  |  | }
396 |  |  |  |  | elsif ( ref $name ) {
397 |  |  |  |  | croak __PACKAGE__
398 |  |  |  |  | . '::create_uuid(): Name for v3 UUID'
399 |  |  |  |  | . ' has to be SCALAR, GLOB or IO object, not '
400 |  |  |  |  | . ref($name) .'!'
401 |  |  |  |  | ;
402 |  |  |  |  | }
403 |  |  |  |  | elsif ( defined $name ) {
404 |  |  |  |  | $MD5_CALCULATOR->add($name);
405 |  |  |  |  | }
406 |  |  |  |  | else {
407 |  |  |  |  | croak __PACKAGE__
408 |  |  |  |  | . '::create_uuid(): Name for v3 UUID is not defined!';
409 |  |  |  |  | }
410 |  |  |  |  |
411 |  |  |  |  | # Use only first 16 Bytes ...
412 |  |  |  |  | $uuid = substr( $MD5_CALCULATOR->digest(), 0, 16 );
413 |  |  |  |  |
414 |  |  |  |  | return _set_uuid_version( $uuid => 0x30 );
415 |  |  |  |  | }
416 |  |  |  |  |
417 |  |  |  |  | # spent 1.01ms (234µs+778µs) within UUID::Tiny::_create_v4_uuid which was called 9 times, avg 112µs/call: # 9 times (234µs+778µs) by UUID::Tiny::create_uuid at line 315, avg 112µs/call sub _create_v4_uuid {
418 |  |  |  |  | # Create random value in UUID ...
419 | 63 | 230µs |  |  | my $uuid = '';
420 |  |  |  |  | for ( 1 .. 4 ) {
421 |  |  |  |  | $uuid .= pack 'I', _rand_32bit(); # spent 675µs making 36 calls to UUID::Tiny::_rand_32bit, avg 19µs/call # spent 45µs making 36 calls to UUID::Tiny::CORE:pack, avg 1µs/call
422 |  |  |  |  | }
423 |  |  |  |  |
424 |  |  |  |  | return _set_uuid_version($uuid => 0x40); # spent 57µs making 9 calls to UUID::Tiny::_set_uuid_version, avg 6µs/call
425 |  |  |  |  | }
426 |  |  |  |  |
427 |  |  |  |  | sub _create_v5_uuid {
428 |  |  |  |  | my $ns_uuid = shift;
429 |  |  |  |  | my $name = shift;
430 |  |  |  |  | my $uuid = '';
431 |  |  |  |  |
432 |  |  |  |  | if (!$SHA1_CALCULATOR) {
433 |  |  |  |  | croak __PACKAGE__
434 |  |  |  |  | . '::create_uuid(): No SHA-1 implementation available! '
435 |  |  |  |  | . 'Please install Digest::SHA1, Digest::SHA or '
436 |  |  |  |  | . 'Digest::SHA::PurePerl to use SHA-1 based UUIDs.'
437 |  |  |  |  | ;
438 |  |  |  |  | }
439 |  |  |  |  |
440 |  |  |  |  | lock $SHA1_CALCULATOR;
441 |  |  |  |  |
442 |  |  |  |  | $SHA1_CALCULATOR->reset();
443 |  |  |  |  | $SHA1_CALCULATOR->add($ns_uuid);
444 |  |  |  |  |
445 |  |  |  |  | if ( ref($name) =~ m/^(?:GLOB|IO::)/ ) {
446 |  |  |  |  | $SHA1_CALCULATOR->addfile($name);
447 |  |  |  |  | } elsif ( ref $name ) {
448 |  |  |  |  | croak __PACKAGE__
449 |  |  |  |  | . '::create_uuid(): Name for v5 UUID'
450 |  |  |  |  | . ' has to be SCALAR, GLOB or IO object, not '
451 |  |  |  |  | . ref($name) .'!'
452 |  |  |  |  | ;
453 |  |  |  |  | } elsif ( defined $name ) {
454 |  |  |  |  | $SHA1_CALCULATOR->add($name);
455 |  |  |  |  | } else {
456 |  |  |  |  | croak __PACKAGE__
457 |  |  |  |  | . '::create_uuid(): Name for v5 UUID is not defined!';
458 |  |  |  |  | }
459 |  |  |  |  |
460 |  |  |  |  | # Use only first 16 Bytes ...
461 |  |  |  |  | $uuid = substr( $SHA1_CALCULATOR->digest(), 0, 16 );
462 |  |  |  |  |
463 |  |  |  |  | return _set_uuid_version($uuid => 0x50);
464 |  |  |  |  | }
465 |  |  |  |  |
466 |  |  |  |  | # spent 57µs within UUID::Tiny::_set_uuid_version which was called 9 times, avg 6µs/call: # 9 times (57µs+0s) by UUID::Tiny::_create_v4_uuid at line 424, avg 6µs/call sub _set_uuid_version {
467 | 36 | 57µs |  |  | my $uuid = shift;
468 |  |  |  |  | my $version = shift;
469 |  |  |  |  | substr $uuid, 6, 1, chr( ord( substr( $uuid, 6, 1 ) ) & 0x0f | $version );
470 |  |  |  |  |
471 |  |  |  |  | return $uuid;
472 |  |  |  |  | }
473 |  |  |  |  |
474 |  |  |  |  |
475 |  |  |  |  | =item B<create_UUID_as_string()>, B<create_uuid_as_string()> (:std)
476 |  |  |  |  |
477 |  |  |  |  | Similar to C<create_UUID>, but creates a UUID string.
478 |  |  |  |  |
479 |  |  |  |  | =cut
480 |  |  |  |  |
481 |  |  |  |  | # spent 1.58ms (76µs+1.51) within UUID::Tiny::create_uuid_as_string which was called 9 times, avg 176µs/call: # 9 times (76µs+1.51ms) by SimpleDB::Class::Item::generate_uuid at line 463 of ../lib/SimpleDB/Class/Item.pm, avg 176µs/call sub create_uuid_as_string {
482 | 9 | 70µs | 18 | 1.51ms | return uuid_to_string(create_uuid(@_)); # spent 1.22ms making 9 calls to UUID::Tiny::create_uuid, avg 135µs/call # spent 289µs making 9 calls to UUID::Tiny::uuid_to_string, avg 32µs/call
483 |  |  |  |  | }
484 |  |  |  |  |
485 | 1 | 500ns |  |  | *create_UUID_as_string = \&create_uuid_as_string;
486 |  |  |  |  |
487 |  |  |  |  |
488 |  |  |  |  | =item B<is_UUID_string()>, B<is_uuid_string()> (:std)
489 |  |  |  |  |
490 |  |  |  |  | my $bool = is_UUID_string($str);
491 |  |  |  |  |
492 |  |  |  |  | =cut
493 |  |  |  |  |
494 | 1 | 10µs | 1 | 6µs | our $IS_UUID_STRING = qr/^[0-9a-f]{8}(?:-[0-9a-f]{4}){3}-[0-9a-f]{12}$/is; # spent 6µs making 1 call to UUID::Tiny::CORE:qr
495 | 1 | 2µs | 1 | 800ns | our $IS_UUID_HEX = qr/^[0-9a-f]{32}$/is; # spent 800ns making 1 call to UUID::Tiny::CORE:qr
496 | 1 | 3µs | 1 | 700ns | our $IS_UUID_Base64 = qr/^[+\/0-9A-Za-z]{22}(?:==)?$/s; # spent 700ns making 1 call to UUID::Tiny::CORE:qr
497 |  |  |  |  |
498 |  |  |  |  | sub is_uuid_string {
499 |  |  |  |  | my $uuid = shift;
500 |  |  |  |  | return $uuid =~ m/$IS_UUID_STRING/;
501 |  |  |  |  | }
502 |  |  |  |  |
503 | 1 | 600ns |  |  | *is_UUID_string = \&is_uuid_string;
504 |  |  |  |  |
505 |  |  |  |  |
506 |  |  |  |  | =item B<UUID_to_string()>, B<uuid_to_string()> (:std)
507 |  |  |  |  |
508 |  |  |  |  | my $uuid_str = UUID_to_string($uuid);
509 |  |  |  |  |
510 |  |  |  |  | This function returns C<$uuid> unchanged if it is a UUID string already.
511 |  |  |  |  |
512 |  |  |  |  | =cut
513 |  |  |  |  |
514 |  |  |  |  | # spent 289µs (214+75) within UUID::Tiny::uuid_to_string which was called 9 times, avg 32µs/call: # 9 times (214µs+75µs) by UUID::Tiny::create_uuid_as_string at line 482, avg 32µs/call sub uuid_to_string {
515 | 36 | 289µs |  |  | my $uuid = shift;
516 | 3 | 94µs | 2 | 14µs | # spent 12µs (9+2) within UUID::Tiny::BEGIN@516 which was called # once (9µs+2µs) by SimpleDB::Class::Item::BEGIN@18 at line 516 use bytes; # spent 12µs making 1 call to UUID::Tiny::BEGIN@516 # spent 2µs making 1 call to bytes::import
517 |  |  |  |  | return $uuid # spent 26µs making 9 calls to UUID::Tiny::CORE:regcomp, avg 3µs/call # spent 2µs making 9 calls to UUID::Tiny::CORE:match, avg 222ns/call
518 |  |  |  |  | if $uuid =~ m/$IS_UUID_STRING/;
519 |  |  |  |  | croak __PACKAGE__ . "::uuid_to_string(): Invalid UUID!"
520 |  |  |  |  | unless length $uuid == 16;
521 |  |  |  |  | return join q{-},
522 |  |  |  |  | map { unpack 'H*', $_ }
523 |  |  |  |  | map { substr $uuid, 0, $_, q{} } # spent 48µs making 45 calls to UUID::Tiny::CORE:unpack, avg 1µs/call
524 |  |  |  |  | ( 4, 2, 2, 2, 6 );
525 |  |  |  |  | }
526 |  |  |  |  |
527 | 1 | 300ns |  |  | *UUID_to_string = \&uuid_to_string;
528 |  |  |  |  |
529 |  |  |  |  |
530 |  |  |  |  | =item B<string_to_UUID()>, B<string_to_uuid()> (:std)
531 |  |  |  |  |
532 |  |  |  |  | my $uuid = string_to_UUID($uuid_str);
533 |  |  |  |  |
534 |  |  |  |  | This function returns C<$uuid_str> unchanged if it is a UUID already.
535 |  |  |  |  |
536 |  |  |  |  | In addition to the standard UUID string representation and its URN forms
537 |  |  |  |  | (starting with C<urn:uuid:> or C<uuid:>), this function accepts 32 digit hex
538 |  |  |  |  | strings, variants with different positions of C<-> and Base64 encoded UUIDs.
539 |  |  |  |  |
540 |  |  |  |  | Throws an exception if string can't be interpreted as a UUID.
541 |  |  |  |  |
542 |  |  |  |  | If you want to make shure to have a "pure" standard UUID representation, check
543 |  |  |  |  | with C<is_UUID_string>!
544 |  |  |  |  |
545 |  |  |  |  | =cut
546 |  |  |  |  |
547 |  |  |  |  | # spent 40µs within UUID::Tiny::string_to_uuid which was called 9 times, avg 4µs/call: # 9 times (40µs+0s) by UUID::Tiny::create_uuid at line 312, avg 4µs/call sub string_to_uuid {
548 | 18 | 51µs |  |  | my $uuid = shift;
549 |  |  |  |  |
550 | 3 | 123µs | 2 | 12µs | # spent 10µs (8+2) within UUID::Tiny::BEGIN@550 which was called # once (8µs+2µs) by SimpleDB::Class::Item::BEGIN@18 at line 550 use bytes; # spent 10µs making 1 call to UUID::Tiny::BEGIN@550 # spent 2µs making 1 call to bytes::import
551 |  |  |  |  | return $uuid if length $uuid == 16;
552 |  |  |  |  | return decode_base64($uuid) if ($uuid =~ m/$IS_UUID_Base64/);
553 |  |  |  |  | my $str = $uuid;
554 |  |  |  |  | $uuid =~ s/^(?:urn:)?(?:uuid:)?//io;
555 |  |  |  |  | $uuid =~ tr/-//d;
556 |  |  |  |  | return pack 'H*', $uuid if $uuid =~ m/$IS_UUID_HEX/;
557 |  |  |  |  | croak __PACKAGE__ . "::string_to_uuid(): '$str' is no UUID string!";
558 |  |  |  |  | }
559 |  |  |  |  |
560 | 1 | 300ns |  |  | *string_to_UUID = \&string_to_uuid;
561 |  |  |  |  |
562 |  |  |  |  |
563 |  |  |  |  | =item B<version_of_UUID()>, B<version_of_uuid()> (:std)
564 |  |  |  |  |
565 |  |  |  |  | my $version = version_of_UUID($uuid);
566 |  |  |  |  |
567 |  |  |  |  | This function accepts binary and string UUIDs.
568 |  |  |  |  |
569 |  |  |  |  | =cut
570 |  |  |  |  |
571 |  |  |  |  | sub version_of_uuid {
572 |  |  |  |  | my $uuid = shift;
573 | 3 | 72µs | 2 | 14µs | # spent 12µs (10+2) within UUID::Tiny::BEGIN@573 which was called # once (10µs+2µs) by SimpleDB::Class::Item::BEGIN@18 at line 573 use bytes; # spent 12µs making 1 call to UUID::Tiny::BEGIN@573 # spent 2µs making 1 call to bytes::import
574 |  |  |  |  | $uuid = string_to_uuid($uuid);
575 |  |  |  |  | return (ord(substr($uuid, 6, 1)) & 0xf0) >> 4;
576 |  |  |  |  | }
577 |  |  |  |  |
578 | 1 | 300ns |  |  | *version_of_UUID = \&version_of_uuid;
579 |  |  |  |  |
580 |  |  |  |  |
581 |  |  |  |  | =item B<time_of_UUID()>, B<time_of_uuid()> (:std)
582 |  |  |  |  |
583 |  |  |  |  | my $uuid_time = time_of_UUID($uuid);
584 |  |  |  |  |
585 |  |  |  |  | This function accepts UUIDs and UUID strings. Returns the time as a floating
586 |  |  |  |  | point value, so use C<int()> to get a C<time()> compatible value.
587 |  |  |  |  |
588 |  |  |  |  | Returns C<undef> if the UUID is not version 1.
589 |  |  |  |  |
590 |  |  |  |  | =cut
591 |  |  |  |  |
592 |  |  |  |  | sub time_of_uuid {
593 |  |  |  |  | my $uuid = shift;
594 | 3 | 198µs | 2 | 12µs | # spent 10µs (9+2) within UUID::Tiny::BEGIN@594 which was called # once (9µs+2µs) by SimpleDB::Class::Item::BEGIN@18 at line 594 use bytes; # spent 10µs making 1 call to UUID::Tiny::BEGIN@594 # spent 2µs making 1 call to bytes::import
595 |  |  |  |  | $uuid = string_to_uuid($uuid);
596 |  |  |  |  | return unless version_of_uuid($uuid) == 1;
597 |  |  |  |  |
598 |  |  |  |  | my $low = unpack 'N', substr($uuid, 0, 4);
599 |  |  |  |  | my $mid = unpack 'n', substr($uuid, 4, 2);
600 |  |  |  |  | my $high = unpack('n', substr($uuid, 6, 2)) & 0x0fff;
601 |  |  |  |  |
602 |  |  |  |  | my $hi = $mid | $high << 16;
603 |  |  |  |  |
604 |  |  |  |  | # MAGIC offset: 01B2-1DD2-13814000
605 |  |  |  |  | if ($low >= 0x13814000) {
606 |  |  |  |  | $low -= 0x13814000;
607 |  |  |  |  | }
608 |  |  |  |  | else {
609 |  |  |  |  | $low += 0xec7ec000;
610 |  |  |  |  | $hi --;
611 |  |  |  |  | }
612 |  |  |  |  |
613 |  |  |  |  | if ($hi >= 0x01b21dd2) {
614 |  |  |  |  | $hi -= 0x01b21dd2;
615 |  |  |  |  | }
616 |  |  |  |  | else {
617 |  |  |  |  | $hi += 0x0e4de22e; # wrap around
618 |  |  |  |  | }
619 |  |  |  |  |
620 |  |  |  |  | $low /= 10000000.0;
621 |  |  |  |  | $hi /= 78125.0 / 512 / 65536; # / 1000000 * 0x10000000
622 |  |  |  |  |
623 |  |  |  |  | return $hi + $low;
624 |  |  |  |  | }
625 |  |  |  |  |
626 | 1 | 300ns |  |  | *time_of_UUID = \&time_of_uuid;
627 |  |  |  |  |
628 |  |  |  |  |
629 |  |  |  |  | =item B<clk_seq_of_UUID()>, B<clk_seq_of_uuid()> (:std)
630 |  |  |  |  |
631 |  |  |  |  | my $uuid_clk_seq = clk_seq_of_UUID($uuid);
632 |  |  |  |  |
633 |  |  |  |  | This function accepts UUIDs and UUID strings. Returns the clock sequence for a
634 |  |  |  |  | version 1 UUID. Returns C<undef> if UUID is not version 1.
635 |  |  |  |  |
636 |  |  |  |  | =cut
637 |  |  |  |  |
638 |  |  |  |  | sub clk_seq_of_uuid {
639 | 3 | 406µs | 2 | 27µs | # spent 24µs (21+3) within UUID::Tiny::BEGIN@639 which was called # once (21µs+3µs) by SimpleDB::Class::Item::BEGIN@18 at line 639 use bytes; # spent 24µs making 1 call to UUID::Tiny::BEGIN@639 # spent 3µs making 1 call to bytes::import
640 |  |  |  |  | my $uuid = shift;
641 |  |  |  |  | $uuid = string_to_uuid($uuid);
642 |  |  |  |  | return unless version_of_uuid($uuid) == 1;
643 |  |  |  |  |
644 |  |  |  |  | my $r = unpack 'n', substr($uuid, 8, 2);
645 |  |  |  |  | my $v = $r >> 13;
646 |  |  |  |  | my $w = ($v >= 6) ? 3 # 11x
647 |  |  |  |  | : ($v >= 4) ? 2 # 10-
648 |  |  |  |  | : 1 # 0--
649 |  |  |  |  | ;
650 |  |  |  |  | $w = 16 - $w;
651 |  |  |  |  |
652 |  |  |  |  | return $r & ((1 << $w) - 1);
653 |  |  |  |  | }
654 |  |  |  |  |
655 | 1 | 300ns |  |  | *clk_seq_of_UUID = \&clk_seq_of_uuid;
656 |  |  |  |  |
657 |  |  |  |  |
658 |  |  |  |  | =item B<equal_UUIDs()>, B<equal_uuids()> (:std)
659 |  |  |  |  |
660 |  |  |  |  | my $bool = equal_UUIDs($uuid1, $uuid2);
661 |  |  |  |  |
662 |  |  |  |  | Returns true if the provided UUIDs are equal. Accepts UUIDs and UUID strings
663 |  |  |  |  | (can be mixed).
664 |  |  |  |  |
665 |  |  |  |  | =cut
666 |  |  |  |  |
667 |  |  |  |  | sub equal_uuids {
668 |  |  |  |  | my ($u1, $u2) = @_;
669 |  |  |  |  | return unless defined $u1 && defined $u2;
670 |  |  |  |  | return string_to_uuid($u1) eq string_to_uuid($u2);
671 |  |  |  |  | }
672 |  |  |  |  |
673 | 1 | 300ns |  |  | *equal_UUIDs = \&equal_uuids;
674 |  |  |  |  |
675 |  |  |  |  |
676 |  |  |  |  | #
677 |  |  |  |  | # Private functions ...
678 |  |  |  |  | #
679 | 1 | 100ns |  |  | my $Last_Pid;
680 | 1 | 100ns |  |  | my $Clk_Seq;
681 |  |  |  |  |
682 |  |  |  |  | # There is a problem with $Clk_Seq and rand() on forking a process using
683 |  |  |  |  | # UUID::Tiny, because the forked process would use the same basic $Clk_Seq and
684 |  |  |  |  | # the same seed (!) for rand(). $Clk_Seq is UUID::Tiny's problem, but with
685 |  |  |  |  | # rand() it is Perl's bad behavior. So _init_globals() has to be called every
686 |  |  |  |  | # time before using $Clk_Seq or rand() ...
687 |  |  |  |  |
688 |  |  |  |  | # spent 470µs (250+220) within UUID::Tiny::_init_globals which was called 37 times, avg 13µs/call: # 36 times (241µs+229µs) by UUID::Tiny::_rand_32bit at line 749, avg 13µs/call # once (9µs+-9µs) by UUID::Tiny::_generate_clk_seq at line 721 sub _init_globals {
689 | 151 | 284µs | 37 | 9µs | lock $Last_Pid; # spent 9µs making 37 calls to UUID::Tiny::CORE:lock, avg 251ns/call
690 |  |  |  |  | lock $Clk_Seq; # spent 3µs making 37 calls to UUID::Tiny::CORE:lock, avg 84ns/call
691 |  |  |  |  |
692 |  |  |  |  | if (!defined $Last_Pid || $Last_Pid != $$) {
693 |  |  |  |  | $Last_Pid = $$;
694 |  |  |  |  | $Clk_Seq = _generate_clk_seq(); # spent 217µs making 1 call to UUID::Tiny::_generate_clk_seq
695 |  |  |  |  | srand();
696 |  |  |  |  | }
697 |  |  |  |  |
698 |  |  |  |  | return;
699 |  |  |  |  | }
700 |  |  |  |  |
701 |  |  |  |  |
702 | 1 | 0s |  |  | my $Last_Timestamp;
703 |  |  |  |  |
704 |  |  |  |  | sub _get_clk_seq {
705 |  |  |  |  | my $ts = shift;
706 |  |  |  |  | _init_globals();
707 |  |  |  |  |
708 |  |  |  |  | lock $Last_Timestamp;
709 |  |  |  |  | lock $Clk_Seq;
710 |  |  |  |  |
711 |  |  |  |  | if (!defined $Last_Timestamp || $ts <= $Last_Timestamp) {
712 |  |  |  |  | $Clk_Seq = ($Clk_Seq + 1) % 65536;
713 |  |  |  |  | }
714 |  |  |  |  | $Last_Timestamp = $ts;
715 |  |  |  |  |
716 |  |  |  |  | return $Clk_Seq & 0x03ff;
717 |  |  |  |  | }
718 |  |  |  |  |
719 |  |  |  |  | # spent 217µs (51+166) within UUID::Tiny::_generate_clk_seq which was called # once (51µs+166µs) by UUID::Tiny::_init_globals at line 694 sub _generate_clk_seq {
720 | 6 | 98µs |  |  | my $self = shift;
721 |  |  |  |  | _init_globals(); # spent 9µs making 1 call to UUID::Tiny::_init_globals, recursion: max depth 1, time 9µs
722 |  |  |  |  |
723 |  |  |  |  | my @data;
724 |  |  |  |  | push @data, q{} . $$;
725 |  |  |  |  | push @data, q{:} . Time::HiRes::time(); # spent 40µs making 1 call to Time::HiRes::time
726 |  |  |  |  |
727 |  |  |  |  | # 16 bit digest
728 |  |  |  |  | return unpack 'n', _digest_as_octets(2, @data); # spent 104µs making 1 call to UUID::Tiny::_digest_as_octets # spent 12µs making 1 call to UUID::Tiny::CORE:unpack
729 |  |  |  |  | }
730 |  |  |  |  |
731 |  |  |  |  | sub _random_node_id {
732 |  |  |  |  | my $self = shift;
733 |  |  |  |  |
734 |  |  |  |  | my $r1 = _rand_32bit();
735 |  |  |  |  | my $r2 = _rand_32bit();
736 |  |  |  |  |
737 |  |  |  |  | my $hi = ($r1 >> 8) ^ ($r2 & 0xff);
738 |  |  |  |  | my $lo = ($r2 >> 8) ^ ($r1 & 0xff);
739 |  |  |  |  |
740 |  |  |  |  | $hi |= 0x80;
741 |  |  |  |  |
742 |  |  |  |  | my $id = substr pack('V', $hi), 0, 3;
743 |  |  |  |  | $id .= substr pack('V', $lo), 0, 3;
744 |  |  |  |  |
745 |  |  |  |  | return $id;
746 |  |  |  |  | }
747 |  |  |  |  |
748 |  |  |  |  | # spent 675µs (205+470) within UUID::Tiny::_rand_32bit which was called 36 times, avg 19µs/call: # 36 times (205µs+470µs) by UUID::Tiny::_create_v4_uuid at line 421, avg 19µs/call sub _rand_32bit {
749 | 144 | 178µs | 36 | 470µs | _init_globals(); # spent 470µs making 36 calls to UUID::Tiny::_init_globals, avg 13µs/call
750 |  |  |  |  | my $v1 = int(rand(65536)) % 65536;
751 |  |  |  |  | my $v2 = int(rand(65536)) % 65536;
752 |  |  |  |  | return ($v1 << 16) | $v2;
753 |  |  |  |  | }
754 |  |  |  |  |
755 |  |  |  |  | # spent 50µs within UUID::Tiny::_fold_into_octets which was called # once (50µs+0s) by UUID::Tiny::_digest_as_octets at line 782 sub _fold_into_octets {
756 | 3 | 202µs | 2 | 14µs | # spent 11µs (9+2) within UUID::Tiny::BEGIN@756 which was called # once (9µs+2µs) by SimpleDB::Class::Item::BEGIN@18 at line 756 use bytes; # spent 11µs making 1 call to UUID::Tiny::BEGIN@756 # spent 2µs making 1 call to bytes::import
757 | 84 | 45µs |  |  | my ($num_octets, $s) = @_;
758 |  |  |  |  |
759 |  |  |  |  | my $x = "\x0" x $num_octets;
760 |  |  |  |  |
761 |  |  |  |  | while (length $s > 0) {
762 |  |  |  |  | my $n = q{};
763 |  |  |  |  | while (length $x > 0) {
764 |  |  |  |  | my $c = ord(substr $x, -1, 1, q{}) ^ ord(substr $s, -1, 1, q{});
765 |  |  |  |  | $n = chr($c) . $n;
766 |  |  |  |  | last if length $s <= 0;
767 |  |  |  |  | }
768 |  |  |  |  | $n = $x . $n;
769 |  |  |  |  |
770 |  |  |  |  | $x = $n;
771 |  |  |  |  | }
772 |  |  |  |  |
773 |  |  |  |  | return $x;
774 |  |  |  |  | }
775 |  |  |  |  |
776 |  |  |  |  | # spent 104µs (39+65) within UUID::Tiny::_digest_as_octets which was called # once (39µs+65µs) by UUID::Tiny::_generate_clk_seq at line 728 sub _digest_as_octets {
777 | 5 | 52µs |  |  | my $num_octets = shift;
778 |  |  |  |  |
779 |  |  |  |  | $MD5_CALCULATOR->reset(); # spent 2µs making 1 call to Digest::MD5::new
780 |  |  |  |  | $MD5_CALCULATOR->add($_) for @_; # spent 6µs making 2 calls to Digest::MD5::add, avg 3µs/call
781 |  |  |  |  |
782 |  |  |  |  | return _fold_into_octets($num_octets, $MD5_CALCULATOR->digest); # spent 50µs making 1 call to UUID::Tiny::_fold_into_octets # spent 6µs making 1 call to Digest::MD5::digest
783 |  |  |  |  | }
784 |  |  |  |  |
785 |  |  |  |  |
786 |  |  |  |  | =back
787 |  |  |  |  |
788 |  |  |  |  | =cut
789 |  |  |  |  |
790 |  |  |  |  |
791 |  |  |  |  | =head1 DISCUSSION
792 |  |  |  |  |
793 |  |  |  |  | =over
794 |  |  |  |  |
795 |  |  |  |  | =item B<Why version 1 only with random multi-cast MAC addresses?>
796 |  |  |  |  |
797 |  |  |  |  | The random multi-cast MAC address gives privacy, and getting the real MAC
798 |  |  |  |  | address with Perl is really dirty (and slow);
799 |  |  |  |  |
800 |  |  |  |  | =item B<Should version 3 or version 5 be used?>
801 |  |  |  |  |
802 |  |  |  |  | Using SHA-1 reduces the probabillity of collisions and provides a better
803 |  |  |  |  | "randomness" of the resulting UUID compared to MD5. Version 5 is recommended
804 |  |  |  |  | in RFC 4122 if backward compatibility is not an issue.
805 |  |  |  |  |
806 |  |  |  |  | Using MD5 (version 3) has a better performance. This could be important with
807 |  |  |  |  | creating UUIDs from file content rather than names.
808 |  |  |  |  |
809 |  |  |  |  | =back
810 |  |  |  |  |
811 |  |  |  |  |
812 |  |  |  |  | =head1 UUID DEFINITION
813 |  |  |  |  |
814 |  |  |  |  | See RFC 4122 (L<http://www.ietf.org/rfc/rfc4122.txt>) for technical details on
815 |  |  |  |  | UUIDs.
816 |  |  |  |  |
817 |  |  |  |  |
818 |  |  |  |  | =head1 AUTHOR
819 |  |  |  |  |
820 |  |  |  |  | Much of this code is borrowed from UUID::Generator by ITO Nobuaki
821 |  |  |  |  | E<lt>banb@cpan.orgE<gt>. But that module is announced to be marked as
822 |  |  |  |  | "deprecated" in the future and it is much too complicated for my liking.
823 |  |  |  |  |
824 |  |  |  |  | So I decided to reduce it to the necessary parts and to re-implement those
825 |  |  |  |  | parts with a functional interface ...
826 |  |  |  |  |
827 |  |  |  |  | Jesse Vincent, C<< <jesse at bestpractical.com> >>, improved version 1.02 with
828 |  |  |  |  | his tips and a heavy refactoring. Consider him a co-author of UUID::Tiny.
829 |  |  |  |  |
830 |  |  |  |  | -- Christian Augustin, C<< <mail at caugustin.de> >>
831 |  |  |  |  |
832 |  |  |  |  |
833 |  |  |  |  | =head1 BUGS
834 |  |  |  |  |
835 |  |  |  |  | Please report any bugs or feature requests to C<bug-uuid-tiny at rt.cpan.org>,
836 |  |  |  |  | or through the web interface at
837 |  |  |  |  | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=UUID-Tiny>.
838 |  |  |  |  | I will be notified, and then you'll automatically be notified of progress on
839 |  |  |  |  | your bug as I make changes.
840 |  |  |  |  |
841 |  |  |  |  |
842 |  |  |  |  | =head1 SUPPORT
843 |  |  |  |  |
844 |  |  |  |  | You can find documentation for this module with the perldoc command.
845 |  |  |  |  |
846 |  |  |  |  | perldoc UUID::Tiny
847 |  |  |  |  |
848 |  |  |  |  | You can also look for information at:
849 |  |  |  |  |
850 |  |  |  |  | =over 4
851 |  |  |  |  |
852 |  |  |  |  | =item * RT: CPAN's request tracker
853 |  |  |  |  |
854 |  |  |  |  | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=UUID-Tiny>
855 |  |  |  |  |
856 |  |  |  |  | =item * AnnoCPAN: Annotated CPAN documentation
857 |  |  |  |  |
858 |  |  |  |  | L<http://annocpan.org/dist/UUID-Tiny>
859 |  |  |  |  |
860 |  |  |  |  | =item * CPAN Ratings
861 |  |  |  |  |
862 |  |  |  |  | L<http://cpanratings.perl.org/d/UUID-Tiny>
863 |  |  |  |  |
864 |  |  |  |  | =item * Search CPAN
865 |  |  |  |  |
866 |  |  |  |  | L<http://search.cpan.org/dist/UUID-Tiny/>
867 |  |  |  |  |
868 |  |  |  |  | =back
869 |  |  |  |  |
870 |  |  |  |  |
871 |  |  |  |  | =head1 ACKNOWLEDGEMENTS
872 |  |  |  |  |
873 |  |  |  |  | Kudos to ITO Nobuaki E<lt>banb@cpan.orgE<gt> for his UUID::Generator::PurePerl
874 |  |  |  |  | module! My work is based on his code, and without it I would've been lost with
875 |  |  |  |  | all those incomprehensible RFC texts and C codes ...
876 |  |  |  |  |
877 |  |  |  |  | Thanks to Jesse Vincent (C<< <jesse at bestpractical.com> >>) for his feedback, tips and refactoring!
878 |  |  |  |  |
879 |  |  |  |  |
880 |  |  |  |  | =head1 COPYRIGHT & LICENSE
881 |  |  |  |  |
882 |  |  |  |  | Copyright 2009 Christian Augustin, all rights reserved.
883 |  |  |  |  |
884 |  |  |  |  | This program is free software; you can redistribute it and/or modify it
885 |  |  |  |  | under the same terms as Perl itself.
886 |  |  |  |  |
887 |  |  |  |  |
888 |  |  |  |  | =cut
889 |  |  |  |  |
890 | 1 | 43µs |  |  | 1; # End of UUID::Tiny
|  |  |  |  | # spent 12µs within UUID::Tiny::CORE:lock which was called 74 times, avg 168ns/call: # 37 times (9µs+0s) by UUID::Tiny::_init_globals at line 689 of UUID/Tiny.pm, avg 251ns/call # 37 times (3µs+0s) by UUID::Tiny::_init_globals at line 690 of UUID/Tiny.pm, avg 84ns/call sub UUID::Tiny::CORE:lock; # xsub
|  |  |  |  | # spent 2µs within UUID::Tiny::CORE:match which was called 9 times, avg 222ns/call: # 9 times (2µs+0s) by UUID::Tiny::uuid_to_string at line 517 of UUID/Tiny.pm, avg 222ns/call sub UUID::Tiny::CORE:match; # xsub
|  |  |  |  | # spent 45µs within UUID::Tiny::CORE:pack which was called 36 times, avg 1µs/call: # 36 times (45µs+0s) by UUID::Tiny::_create_v4_uuid at line 421 of UUID/Tiny.pm, avg 1µs/call sub UUID::Tiny::CORE:pack; # xsub
|  |  |  |  | # spent 7µs within UUID::Tiny::CORE:qr which was called 3 times, avg 2µs/call: # once (6µs+0s) by SimpleDB::Class::Item::BEGIN@18 at line 494 of UUID/Tiny.pm # once (800ns+0s) by SimpleDB::Class::Item::BEGIN@18 at line 495 of UUID/Tiny.pm # once (700ns+0s) by SimpleDB::Class::Item::BEGIN@18 at line 496 of UUID/Tiny.pm sub UUID::Tiny::CORE:qr; # xsub
|  |  |  |  | # spent 26µs within UUID::Tiny::CORE:regcomp which was called 9 times, avg 3µs/call: # 9 times (26µs+0s) by UUID::Tiny::uuid_to_string at line 517 of UUID/Tiny.pm, avg 3µs/call sub UUID::Tiny::CORE:regcomp; # xsub
|  |  |  |  | # spent 59µs within UUID::Tiny::CORE:unpack which was called 46 times, avg 1µs/call: # 45 times (48µs+0s) by UUID::Tiny::uuid_to_string at line 523 of UUID/Tiny.pm, avg 1µs/call # once (12µs+0s) by UUID::Tiny::_generate_clk_seq at line 728 of UUID/Tiny.pm sub UUID::Tiny::CORE:unpack; # xsub