File | /usr/local/lib/perl5/site_perl/5.10.1/UUID/Tiny.pm |
Statements Executed | 732 |
Statement Execution Time | 4.35ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 634µs | 6.80ms | BEGIN@10 | UUID::Tiny::
1 | 1 | 1 | 358µs | 721µs | BEGIN@7 | UUID::Tiny::
37 | 2 | 1 | 250µs | 470µs | _init_globals | UUID::Tiny::
9 | 1 | 1 | 234µs | 1.01ms | _create_v4_uuid | UUID::Tiny::
9 | 1 | 1 | 214µs | 289µs | uuid_to_string | UUID::Tiny::
36 | 1 | 1 | 205µs | 675µs | _rand_32bit | UUID::Tiny::
9 | 1 | 1 | 167µs | 1.22ms | create_uuid | UUID::Tiny::
9 | 1 | 1 | 76µs | 1.58ms | create_uuid_as_string | UUID::Tiny::
46 | 2 | 2 | 59µs | 59µs | CORE:unpack (opcode) | UUID::Tiny::
9 | 1 | 1 | 57µs | 57µs | _set_uuid_version | UUID::Tiny::
1 | 1 | 1 | 51µs | 217µs | _generate_clk_seq | UUID::Tiny::
1 | 1 | 1 | 50µs | 50µs | _fold_into_octets | UUID::Tiny::
36 | 1 | 2 | 45µs | 45µs | CORE:pack (opcode) | UUID::Tiny::
1 | 1 | 1 | 43µs | 43µs | BEGIN@3 | UUID::Tiny::
9 | 1 | 1 | 40µs | 40µs | string_to_uuid | UUID::Tiny::
1 | 1 | 1 | 39µs | 104µs | _digest_as_octets | UUID::Tiny::
9 | 1 | 2 | 26µs | 26µs | CORE:regcomp (opcode) | UUID::Tiny::
1 | 1 | 1 | 21µs | 24µs | BEGIN@639 | UUID::Tiny::
2 | 1 | 1 | 14µs | 62µs | BEGIN@246 | UUID::Tiny::
74 | 2 | 2 | 12µs | 12µs | CORE:lock (opcode) | UUID::Tiny::
1 | 1 | 1 | 12µs | 42µs | BEGIN@8 | UUID::Tiny::
1 | 1 | 1 | 12µs | 63µs | BEGIN@200 | UUID::Tiny::
1 | 1 | 1 | 11µs | 99µs | BEGIN@9 | UUID::Tiny::
1 | 1 | 1 | 11µs | 15µs | BEGIN@309 | UUID::Tiny::
2 | 1 | 1 | 10µs | 62µs | BEGIN@245 | UUID::Tiny::
2 | 1 | 1 | 10µs | 55µs | BEGIN@244 | UUID::Tiny::
2 | 1 | 1 | 10µs | 56µs | BEGIN@243 | UUID::Tiny::
1 | 1 | 1 | 10µs | 29µs | BEGIN@147 | UUID::Tiny::
1 | 1 | 1 | 10µs | 12µs | BEGIN@573 | UUID::Tiny::
1 | 1 | 1 | 10µs | 59µs | BEGIN@6 | UUID::Tiny::
1 | 1 | 1 | 9µs | 12µs | BEGIN@516 | UUID::Tiny::
1 | 1 | 1 | 9µs | 11µs | BEGIN@756 | UUID::Tiny::
1 | 1 | 1 | 9µs | 10µs | BEGIN@594 | UUID::Tiny::
1 | 1 | 1 | 8µs | 19µs | BEGIN@4 | UUID::Tiny::
1 | 1 | 1 | 8µs | 10µs | BEGIN@550 | UUID::Tiny::
1 | 1 | 1 | 7µs | 10µs | BEGIN@5 | UUID::Tiny::
3 | 3 | 2 | 7µs | 7µs | CORE:qr (opcode) | UUID::Tiny::
1 | 1 | 1 | 7µs | 30µs | BEGIN@221 | UUID::Tiny::
1 | 1 | 1 | 6µs | 30µs | BEGIN@217 | UUID::Tiny::
1 | 1 | 1 | 6µs | 32µs | BEGIN@215 | UUID::Tiny::
1 | 1 | 1 | 6µs | 30µs | BEGIN@219 | UUID::Tiny::
9 | 1 | 2 | 2µs | 2µs | CORE:match (opcode) | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | UUID_SHA1_AVAIL | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | _create_v1_uuid | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | _create_v3_uuid | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | _create_v5_uuid | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | _get_clk_seq | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | _random_node_id | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | clk_seq_of_uuid | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | equal_uuids | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | is_uuid_string | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | time_of_uuid | UUID::Tiny::
0 | 0 | 0 | 0s | 0s | version_of_uuid | UUID::Tiny::
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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
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 # 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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 # 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 | ||||
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 # 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 # 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 # 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 # 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 | 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 | ||||
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 | ||||
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 | ||||
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 # 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 | ||||
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 | |||||
# 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 | |||||
# 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 | |||||
# 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 | |||||
# 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 | |||||
# 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 |