File Coverage

blib/lib/Data/TUID/BestUUID.pm
Criterion Covered Total %
statement 28 33 84.8
branch 13 24 54.1
condition 1 3 33.3
subroutine 5 5 100.0
pod 0 2 0.0
total 47 67 70.1


line stmt bran cond sub pod time code
1             package Data::TUID::BestUUID;
2              
3 4     4   102480 use strict;
  4         5  
  4         129  
4 4     4   15 use warnings;
  4         4  
  4         304  
5              
6             our ( %loaded, %skip );
7              
8             BEGIN {
9             eval {
10 3         502 $loaded{LibUUID} = require Data::UUID::LibUUID;
11 0         0 1;
12 4 100   4   16 } unless $skip{LibUUID};
13              
14             eval {
15 3         1143 $loaded{DataUUID} = require Data::UUID;
16 3         2224 1;
17 4 100       260 } unless $skip{DataUUID};
18             }
19              
20             sub new_uuid {
21 12     12 0 843 my $self = shift;
22              
23 12 50       27 return &Data::UUID::LibUUID::new_uuid_string if $loaded{LibUUID};
24 12 50       2630 return Data::UUID->new->create_str if $loaded{DataUUID};
25              
26 0         0 die "No UUID package loaded";
27             }
28              
29             sub uuid_to_canonical {
30 13     13 0 1160 my $self = shift;
31 13         15 my ( $uuid ) = @_;
32              
33 13 50       31 die "Missing/invalid uuid" unless $uuid;
34              
35 13         10 my $result;
36              
37 13 50       33 if ( $loaded{LibUUID} ) {
    50          
38 0         0 $result = &Data::UUID::LibUUID::uuid_to_binary( $uuid );
39 0 0       0 $result = &Data::UUID::LibUUID::uuid_to_string( $result ) if $result;
40             }
41             elsif ( $loaded{DataUUID} ) {
42 13         14 eval {
43 13         12 while ( 1 ) {
44             $result =
45             eval { Data::UUID->new->from_string( $uuid ) } ||
46             eval { Data::UUID->new->from_hexstring( $uuid ) } ||
47 13   33     11 eval { Data::UUID->new->from_b64string( $uuid ) };
48 13 50       35 last if $result;
49 0         0 $result = $uuid; # Assume already binary
50             }
51 13 50       484 $result = Data::UUID->new->to_string( $result ) if $result;
52             };
53 13 50       640 undef $result if $@;
54             };
55              
56 13         25 $result = lc $result;
57              
58 13 50       74 die "Invalid uuid ($uuid): Unable to convert"
59             unless $result =~ m/^
60             (?:[a-f0-9]{8}) -
61             (?:[a-f0-9]{4}) -
62             (?:[a-f0-9]{4}) -
63             (?:[a-f0-9]{4}) -
64             (?:[a-f0-9]{12})
65             $/x;
66              
67 13         40 return $result;
68             }
69              
70             1;