File Coverage

blib/lib/MooseX/Types/UUID.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package MooseX::Types::UUID;
2 1     1   192609 use strict;
  1         2  
  1         34  
3 1     1   5 use warnings;
  1         1  
  1         64  
4              
5             our $VERSION = '0.03';
6             our $AUTHORITY = 'CPAN:JROCKWAY';
7              
8 1     1   557 use MooseX::Types -declare => ['UUID'];
  0            
  0            
9             use MooseX::Types::Moose qw(Str);
10              
11             sub _validate_uuid {
12             my ($str) = @_;
13             return $str =~ /^[[:xdigit:]]{8}-[[:xdigit:]]{4}-[[:xdigit:]]{4}-[[:xdigit:]]{4}-[[:xdigit:]]{12}$/;
14             }
15              
16             subtype UUID,
17             as Str, where { _validate_uuid($_) };
18              
19             coerce UUID,
20             # i've never seen lowercase UUIDs, but someone's bound to try it
21             from Str, via { uc };
22              
23             1;
24              
25             __END__
26              
27             =head1 NAME
28              
29             MooseX::Types::UUID - UUID type for Moose classes
30              
31             =head1 SYNOPSIS
32              
33             package Class;
34             use Moose;
35             use MooseX::Types::UUID qw(UUID);
36              
37             has 'uuid' => ( is => 'ro', isa => UUID );
38              
39             package main;
40             Class->new( uuid => '77C71F92-0EC7-11DD-B986-DF138EE79F6F' );
41              
42             =head1 DESCRIPTION
43              
44             This module lets you constrain attributes to only contain UUIDs (in
45             their usual human-readable form). No coercion is attempted.
46              
47             =head1 EXPORT
48              
49             None by default, you'll usually want to request C<UUID> explicitly.
50              
51             =head1 AUTHOR
52              
53             Jonathan Rockway C<< <jrockway@cpan.org> >>
54              
55             Infinity Interactive (L<http://www.iinteractive.com/>)
56              
57             =head1 COPYRIGHT
58              
59             This program is Free software, you may redistribute it under the same
60             terms as Perl itself.