File Coverage

blib/lib/Data/Cuid.pm
Criterion Covered Total %
statement 39 39 100.0
branch 4 4 100.0
condition n/a
subroutine 15 15 100.0
pod 2 2 100.0
total 60 60 100.0


line stmt bran cond sub pod time code
1             package Data::Cuid;
2              
3 2     2   87721 use strict;
  2         17  
  2         62  
4 2     2   13 use warnings;
  2         5  
  2         91  
5              
6             our @EXPORT_OK;
7              
8             BEGIN {
9 2     2   12 use Exporter 'import';
  2         3  
  2         100  
10 2     2   56 @EXPORT_OK = qw(cuid slug);
11             }
12              
13 2     2   13 use List::Util 'reduce';
  2         4  
  2         281  
14 2     2   907 use Sys::Hostname 'hostname';
  2         2205  
  2         126  
15 2     2   1068 use Time::HiRes ();
  2         2724  
  2         1157  
16              
17             our $size = 4;
18             our $base = 36;
19             our $cmax = ($base)**($size);
20              
21             our $VERSION = "0.05";
22              
23             {
24             my $c = 0;
25              
26             sub _safe_counter {
27 1679617 100   1679617   2215404 $c = $c < $cmax ? $c : 0;
28 1679617         1729075 $c++;
29             }
30             }
31              
32             # from Math::Base36, but without using Math::BigInt (since only
33             # timestamp is the largest int used here )
34             sub _encode_base36 {
35 26     26   13207 my ( $n, $max ) = ( @_, 1 );
36              
37 26         31 my @res;
38 26         41 while ($n) {
39 83         90 my $remainder = $n % 36;
40 83 100       140 unshift @res, $remainder <= 9 ? $remainder : chr( 55 + $remainder );
41 83         142 $n = int $n / 36;
42             }
43              
44             # also return this as a string of exactly $max characters; note
45             # that this means numbers above 36**$max - 1 will be truncated to
46             # $max size and be incorrect, unless $max is increased
47 26         48 unshift @res, '0' while @res < $max;
48 26         112 join '' => @res[ @res - $max .. $#res ];
49             }
50              
51             # taken from the NodeJS version of fingerprint
52             # https://github.com/ericelliott/cuid/blob/master/lib/fingerprint.js
53             sub _fingerprint {
54 6     6   3136 my $padding = 2;
55 6         9 my $pid = _encode_base36 $$, $padding;
56              
57 6         13 my $hostname = hostname;
58 6     72   76 my $id = reduce { $a + ord($b) } length($hostname) + $base,
  72         70  
59             split // => $hostname;
60              
61 6         29 join '' => $pid, _encode_base36 $id, $padding;
62             }
63              
64 5     5   37 sub _random_block { _encode_base36 $cmax * rand() << 0, $size }
65              
66             sub _timestamp {
67 4     4   316 _encode_base36 sprintf( '%.0f' => Time::HiRes::time * 1000 ), 8;
68             }
69              
70             sub cuid {
71 1     1 1 1752 lc join '' => 'c',
72             _timestamp,
73             _encode_base36( _safe_counter, $size ),
74             _fingerprint,
75             _random_block, _random_block;
76             }
77              
78             sub slug {
79 1     1 1 1535 lc join '' => substr( _timestamp, -2 ),
80             substr( _encode_base36(_safe_counter), -4 ),
81             substr( _fingerprint, 0, 1 ), substr( _fingerprint, -1 ),
82             substr( _random_block, -2 );
83             }
84              
85             1;
86             __END__