lib/MooseX/Types/UUID.pm

   1 package MooseX::Types::UUID;
   2 use strict;
   3 use warnings;
   4
   5 our $VERSION = '0.01';
   6 our $AUTHORITY = 'CPAN:JROCKWAY';
   7
   8 use MooseX::Types -declare => ['UUID'];
   9 use MooseX::Types::Moose qw(Str);
  10
  11 sub _validate_uuid {
  12     my ($str) = @_;
  13     return $str =~ /^[A-F0-9]{8}-[A-F0-9]{4}-[A-F0-9]{4}-[A-F0-9]{4}-[A-F0-9]{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.