lib/MooseX/Meta/TypeConstraint/Role/Structured.pm

   1 package MooseX::Meta::TypeConstraint::Role::Structured;
   2
   3 use Moose::Role;
   4 use Moose::Util::TypeConstraints;
   5 requires qw(_normalize_args signature_equals);
   6
   7 =head1 NAME
   8
   9 MooseX::Meta::TypeConstraint::Role::Structured - Structured Type Constraints
  10
  11 =head1 DESCRIPTION
  12
  13 This Role defines the interface and basic behavior of Structured Type Constraints.
  14
  15 =head1 TYPES
  16
  17 The following types are defined in this class.
  18
  19 =head2 Moose::Meta::TypeConstraint
  20
  21 Used to make sure we can properly validate incoming signatures.
  22
  23 =cut
  24
  25 class_type 'Moose::Meta::TypeConstraint';
  26
  27 =head1 ATTRIBUTES
  28
  29 This class defines the following attributes.
  30
  31 =head2 signature
  32
  33 This is a signature of internal contraints for the contents of the outer
  34 contraint container.
  35
  36 =cut
  37
  38 has 'signature' => (
  39     is=>'ro',
  40     isa=>'Ref',
  41     required=>1,
  42 );
  43
  44 =head2 optional_signature
  45
  46 This is a signature of internal contraints for the contents of the outer
  47 contraint container.  These are optional constraints.
  48
  49 =cut
  50
  51 has 'optional_signature' => (
  52     is=>'ro',
  53     isa=>'Ref',
  54     predicate=>'has_optional_signature',
  55 );
  56
  57 =head1 METHODS
  58
  59 This class defines the following methods.
  60
  61 =head2 equals
  62
  63 modifier to make sure equals descends into the L</signature>
  64
  65 =cut
  66
  67 around 'equals' => sub {
  68     my ($equals, $self, $compared_type_constraint) = @_;
  69
  70     ## Make sure we are comparing typeconstraints of the same base class
  71     return unless $compared_type_constraint->isa(__PACKAGE__);
  72
  73     ## Make sure the base equals is also good
  74     return unless $self->$equals($compared_type_constraint);
  75
  76     ## Make sure the signatures match
  77     return unless $self->signature_equals($compared_type_constraint);
  78
  79     ## If we get this far, the two are equal
  80     return 1;
  81 };
  82
  83 =head1 AUTHOR
  84
  85 John James Napiorkowski <jjnapiork@cpan.org>
  86
  87 =head1 LICENSE
  88
  89 You may distribute this code under the same terms as Perl itself.
  90
  91 =cut
  92
  93 1;