File Coverage

blib/lib/UUID4/Tiny.pm
Criterion Covered Total %
statement 37 37 100.0
branch 6 8 75.0
condition n/a
subroutine 12 12 100.0
pod 6 6 100.0
total 61 63 96.8


line stmt bran cond sub pod time code
1             package UUID4::Tiny;
2             # ABSTRACT: Cryptographically secure v4 UUIDs for Linux x64
3              
4 1     1   41227 use 5.008;
  1         10  
5 1     1   5 use strict;
  1         1  
  1         16  
6 1     1   3 use warnings;
  1         2  
  1         39  
7              
8             our $VERSION = '0.002';
9              
10 1     1   6 use Carp qw/carp croak/;
  1         1  
  1         37  
11 1     1   4 use Exporter;
  1         1  
  1         291  
12             our @ISA = qw/Exporter/;
13              
14             our @EXPORT_OK = qw/
15             create_uuid
16             create_uuid_string
17             is_uuid_string
18             is_uuid4_string
19             string_to_uuid
20             uuid_to_string
21             /;
22              
23             our %EXPORT_TAGS = (all => \@EXPORT_OK);
24              
25             use constant {
26 1         446 GRND_NONBLOCK => 0x0001,
27             RANDOM_BYTES => 16,
28 1     1   6 };
  1         2  
29              
30             sub create_uuid {
31 2     2 1 956 my $call = syscall( 318, my $uuid = "\0" x RANDOM_BYTES,
32             RANDOM_BYTES, GRND_NONBLOCK );
33 2 50       8 croak "Syscall Error: $!" if $call == -1;
34 2 50       4 croak 'Insufficient Bytes Copied' if $call < RANDOM_BYTES;
35              
36 2         5 vec( $uuid, 13, 4 ) = 0x4; # version
37 2         6 vec( $uuid, 35, 2 ) = 0x2; # variant
38              
39 2         6 return $uuid;
40             }
41              
42 1     1 1 3 sub create_uuid_string { uuid_to_string( create_uuid() ) }
43              
44             sub is_uuid_string {
45 10     10 1 4801 $_[0] =~ /^[0-9a-f]{8}(?:-[0-9a-f]{4}){3}-[0-9a-f]{12}$/i;
46             }
47              
48             sub is_uuid4_string {
49 11     11 1 1759 $_[0] =~ /^[0-9a-f]{8}-[0-9a-f]{4}-4[0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$/i;
50             }
51              
52             sub string_to_uuid {
53 4     4 1 1755 my $string = shift;
54 4 100       8 if ( length $string == 16 ) {
55             # Emulates UUID::Tiny behavior to
56             # prevent accidental double conversion
57 1         179 carp 'Input not converted: assumed to be UUID bytes';
58 1         10 return $string;
59             }
60 3         8 (my $hex = $string) =~ y/-//d;
61 3         15 pack 'H*', $hex;
62             }
63              
64             sub uuid_to_string {
65 6     6 1 1385 my $uuid = shift;
66 6 100       13 if ( is_uuid_string $uuid ) {
67             # Emulates UUID::Tiny behavior to
68             # prevent accidental double conversion
69 1         88 carp 'Input not converted: identified as UUID string';
70 1         7 return $uuid;
71             }
72 5         29 join '-', unpack 'H8H4H4H4H12', $uuid;
73             }
74              
75             1;
76              
77             __END__