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