File Coverage

blib/lib/Data/TUID.pm
Criterion Covered Total %
statement 49 50 98.0
branch 13 16 81.2
condition 15 24 62.5
subroutine 9 9 100.0
pod 1 3 33.3
total 87 102 85.2


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