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 VERSION
  12
  13 0.01
  14
  15 =cut
  16
  17 our $VERSION = '0.01';
  18
  19 =head1 DESCRIPTION
  20
  21 STUB - TBD
  22
  23 =head1 TYPES
  24
  25 The following types are defined in this class.
  26
  27 =head2 Moose::Meta::TypeConstraint
  28
  29 Used to make sure we can properly validate incoming signatures.
  30
  31 =cut
  32
  33 class_type 'Moose::Meta::TypeConstraint';
  34
  35 =head1 ATTRIBUTES
  36
  37 This class defines the following attributes.
  38
  39 =head2 signature
  40
  41 This is a signature of internal contraints for the contents of the outer
  42 contraint container.
  43
  44 =cut
  45
  46 has 'signature' => (
  47     is=>'ro',
  48     isa=>'Ref',
  49     required=>1,
  50 );
  51
  52 =head2 optional_signature
  53
  54 This is a signature of internal contraints for the contents of the outer
  55 contraint container.  These are optional constraints.
  56
  57 =cut
  58
  59 has 'optional_signature' => (
  60     is=>'ro',
  61     isa=>'Ref',
  62     predicate=>'has_optional_signature',
  63 );
  64
  65 =head1 METHODS
  66
  67 This class defines the following methods.
  68
  69 =head2 _normalize_args
  70
  71 Get arguments into a known state or die trying.  Ideally we try to make this
  72 into a HashRef so we can match it up with the L</signature> HashRef.
  73
  74 =head2 constraint
  75
  76 The constraint is basically validating the L</signature> against the incoming
  77
  78 =head2 equals
  79
  80 modifier to make sure equals descends into the L</signature>
  81
  82 =cut
  83
  84 around 'equals' => sub {
  85     my ($equals, $self, $compared_type_constraint) = @_;
  86
  87     ## Make sure we are comparing typeconstraints of the same base class
  88     return unless $compared_type_constraint->isa(__PACKAGE__);
  89
  90     ## Make sure the base equals is also good
  91     return unless $self->$equals($compared_type_constraint);
  92
  93     ## Make sure the signatures match
  94     return unless $self->signature_equals($compared_type_constraint);
  95
  96     ## If we get this far, the two are equal
  97     return 1;
  98 };
  99
 100 =head2 signature_equals
 101
 102 Check that the signature equals another signature.
 103
 104 =head1 AUTHOR
 105
 106 John James Napiorkowski <jjnapiork@cpan.org>
 107
 108 =head1 LICENSE
 109
 110 You may distribute this code under the same terms as Perl itself.
 111
 112 =cut
 113
 114 1;