line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::TUID; |
2
|
|
|
|
|
|
|
BEGIN { |
3
|
3
|
|
|
3
|
|
254959
|
$Data::TUID::VERSION = '0.0122'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
# ABSTRACT: A smaller and more communicable pseudo-UUID |
6
|
|
|
|
|
|
|
|
7
|
3
|
|
|
3
|
|
28
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
79
|
|
8
|
3
|
|
|
3
|
|
14
|
use strict; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
95
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
|
11
|
3
|
|
|
3
|
|
40
|
use vars qw/@ISA @EXPORT/; @ISA = qw/Exporter/; @EXPORT = qw/tuid/; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
245
|
|
12
|
|
|
|
|
|
|
|
13
|
3
|
|
|
3
|
|
6604
|
use Encode::Base32::Crockford qw/base32_encode/; |
|
3
|
|
|
|
|
3665
|
|
|
3
|
|
|
|
|
216
|
|
14
|
|
|
|
|
|
|
|
15
|
3
|
|
|
3
|
|
2061
|
use Data::TUID::BestUUID; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
1364
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new_uuid { |
18
|
10
|
|
|
10
|
0
|
43
|
return Data::TUID::BestUUID->new_uuid( @_ ); |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub uuid_to_canonical { |
22
|
10
|
|
|
10
|
0
|
48
|
return Data::TUID::BestUUID->uuid_to_canonical( @_ ); |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub tuid { |
26
|
10
|
100
|
100
|
10
|
1
|
131
|
shift if @_ && $_[0] eq __PACKAGE__; |
27
|
10
|
|
|
|
|
13
|
my %given; |
28
|
10
|
100
|
|
|
|
23
|
if ( @_ == 1 ) { |
29
|
3
|
|
|
|
|
9
|
%given = ( length => shift ); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
else { |
32
|
7
|
|
|
|
|
21
|
%given = @_; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
10
|
|
33
|
|
|
36
|
my $uuid = $given{uuid} || new_uuid; |
36
|
10
|
|
|
|
|
1191
|
$uuid = uuid_to_canonical( $uuid ); |
37
|
|
|
|
|
|
|
|
38
|
10
|
|
|
|
|
15
|
my @tuid; |
39
|
|
|
|
|
|
|
{ |
40
|
10
|
|
|
|
|
11
|
my $uuid = $uuid; |
|
10
|
|
|
|
|
14
|
|
41
|
10
|
|
|
|
|
51
|
$uuid =~ s/-//g; |
42
|
10
|
|
|
|
|
69
|
my @hex = unpack( 'A8 A8 A8 A8', $uuid ); |
43
|
10
|
|
|
|
|
20
|
my @value = map { hex $_ } @hex; |
|
40
|
|
|
|
|
76
|
|
44
|
10
|
|
|
|
|
16
|
my @base32 = map { base32_encode $_ } @value; |
|
40
|
|
|
|
|
790
|
|
45
|
10
|
|
|
|
|
232
|
@tuid = @base32; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
10
|
|
|
|
|
13
|
my $all; |
49
|
10
|
|
|
|
|
13
|
my $size = $given{size}; |
50
|
10
|
|
|
|
|
35
|
my $length = $given{length}; |
51
|
10
|
50
|
33
|
|
|
80
|
if ( $length && ( $length == -1 || $length >= 28 ) || $size && $size == -1 ) { |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
52
|
0
|
|
|
|
|
0
|
return join '', @tuid; |
53
|
|
|
|
|
|
|
} |
54
|
10
|
100
|
100
|
|
|
45
|
$length = 8 unless $length || $size; |
55
|
10
|
100
|
66
|
|
|
70
|
if ( ! $all && $length ) { |
56
|
7
|
|
|
|
|
12
|
$size = int( $length / 4 ); |
57
|
7
|
|
|
|
|
11
|
$size += $length % 4; |
58
|
|
|
|
|
|
|
} |
59
|
10
|
50
|
|
|
|
31
|
$size = $size < 1 ? 1 : $size > 7 ? 7 : $size; |
|
|
50
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
10
|
|
|
|
|
12
|
@tuid = map { substr $_, -$size, $size } @tuid; |
|
40
|
|
|
|
|
96
|
|
62
|
10
|
|
|
|
|
24
|
my $tuid = join '', @tuid; |
63
|
10
|
100
|
|
|
|
26
|
$tuid = substr $tuid, 0, $length if $length; |
64
|
|
|
|
|
|
|
|
65
|
10
|
|
|
|
|
72
|
return $tuid; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
1; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
__END__ |
72
|
|
|
|
|
|
|
=pod |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head1 NAME |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Data::TUID - A smaller and more communicable pseudo-UUID |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head1 VERSION |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
version 0.0122 |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 SYNOPSIS |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
use Data::TUID |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my $tuid = tuid # Generate a TUID of (default) length 8 |
87
|
|
|
|
|
|
|
$tuid = tuid length => 4 # Generate a TUID of length 4 |
88
|
|
|
|
|
|
|
$tuid = Data::TUID->tuid # Generate a TUID with the default length |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
$tuid = tuid uuid => '1bf4d967-9e4c-4414-9be0-26f31c16fb53' # Generate a TUID based off of the given UUID |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
A sample run (length 4): |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
rrry |
95
|
|
|
|
|
|
|
ggf5 |
96
|
|
|
|
|
|
|
m1qb |
97
|
|
|
|
|
|
|
xczx |
98
|
|
|
|
|
|
|
pv9y |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
A sample run (length 8): |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
5xcfw8nj |
103
|
|
|
|
|
|
|
2q255fyg |
104
|
|
|
|
|
|
|
pn3xns4k |
105
|
|
|
|
|
|
|
1xcamd3y |
106
|
|
|
|
|
|
|
eczzca9c |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
A sample run (no length limit): |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
2kdk8wzjmfapj28cvexj6qndq7 |
111
|
|
|
|
|
|
|
2tmzr1f3k46tr813dtrxx2vhkqkd |
112
|
|
|
|
|
|
|
1x3608c39mb1n726dhmxedjy72d |
113
|
|
|
|
|
|
|
pre6tg2dm37zbw9amxg2c8bghn |
114
|
|
|
|
|
|
|
3ys0kw21rmtpf54gsmnd28r99pj |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 DESCRIPTION |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Data::TUID is a tool for creating small, communicable pseudo-unique identifiers. Essentially it |
119
|
|
|
|
|
|
|
will take a UUID, pass the result through L<Encode::Base32::Crockford>, and resize accordingly (via |
120
|
|
|
|
|
|
|
C<substr>) |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Although I've tried to sample the UUID evenly, this technique does not give any guarantee on uniqueness. Caveat emptor. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Finally, the result is more communicable (and smaller) due to the Crockford base-32 encoding. The Crockford technique |
125
|
|
|
|
|
|
|
uses: |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
A case-insensitive mapping |
128
|
|
|
|
|
|
|
1 in place of '1','I', 'i', and 'L' |
129
|
|
|
|
|
|
|
0 in place of '0', 'O', and 'o' |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
So, given a TUID (say something a user typed in for a URL), you can translate ambiguous characters (1, I, i, L, 0, 0, and o) into to 1 and 0. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head1 USAGE |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 Data::TUID->tuid( ... ) |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 Data::TUID::tuid( ... ) |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 tuid ... |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
The arguments are: |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
uuid The UUID to use as a basis for the TUID. If none is given, one will be generated for you |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
length The length of the TUID returned. By default 8. A length of -1 will result in the whole |
146
|
|
|
|
|
|
|
UUID being used, and a variable length TUID being returned (somewhere between 25 to 28) |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 SEE ALSO |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
L<Encode::Base32::Crockford> |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
L<Data::UUID::LibUUID> |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
L<http://www.crockford.com/wrmg/base32.html> |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head1 AUTHOR |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
Robert Krimen <robertkrimen@gmail.com> |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
This software is copyright (c) 2010 by Robert Krimen. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
167
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=cut |
170
|
|
|
|
|
|
|
|