lib/MooseX/Types/UUID.pm

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