lib/Moose/Meta/TypeConstraint/Registry.pm

   1
   2 package Moose::Meta::TypeConstraint::Registry;
   3
   4 use strict;
   5 use warnings;
   6 use metaclass;
   7
   8 use Scalar::Util 'blessed';
   9
  10 our $AUTHORITY = 'cpan:STEVAN';
  11
  12 use base 'Class::MOP::Object';
  13
  14 __PACKAGE__->meta->add_attribute('parent_registry' => (
  15     reader    => 'get_parent_registry',
  16     writer    => 'set_parent_registry',
  17     predicate => 'has_parent_registry',
  18 ));
  19
  20 __PACKAGE__->meta->add_attribute('type_constraints' => (
  21     reader  => 'type_constraints',
  22     default => sub { {} }
  23 ));
  24
  25 sub new {
  26     my $class = shift;
  27     my $self  = $class->_new(@_);
  28     return $self;
  29 }
  30
  31 sub has_type_constraint {
  32     my ($self, $type_name) = @_;
  33     ($type_name and exists $self->type_constraints->{$type_name}) ? 1 : 0
  34 }
  35
  36 sub get_type_constraint {
  37     my ($self, $type_name) = @_;
  38     return unless defined $type_name;
  39     $self->type_constraints->{$type_name}
  40 }
  41
  42 sub add_type_constraint {
  43     my ($self, $type) = @_;
  44
  45     unless ( $type && blessed $type && $type->isa('Moose::Meta::TypeConstraint') ) {
  46         require Moose;
  47         Moose->throw_error("No type supplied / type is not a valid type constraint");
  48     }
  49
  50     $self->type_constraints->{$type->name} = $type;
  51 }
  52
  53 sub find_type_constraint {
  54     my ($self, $type_name) = @_;
  55     return $self->get_type_constraint($type_name)
  56         if $self->has_type_constraint($type_name);
  57     return $self->get_parent_registry->find_type_constraint($type_name)
  58         if $self->has_parent_registry;
  59     return;
  60 }
  61
  62 1;
  63
  64 # ABSTRACT: registry for type constraints
  65
  66 __END__
  67
  68
  69 =pod
  70
  71 =head1 DESCRIPTION
  72
  73 This class is a registry that maps type constraint names to
  74 L<Moose::Meta::TypeConstraint> objects.
  75
  76 Currently, it is only used internally by
  77 L<Moose::Util::TypeConstraints>, which creates a single global
  78 registry.
  79
  80 =head1 INHERITANCE
  81
  82 C<Moose::Meta::TypeConstraint::Registry> is a subclass of
  83 L<Class::MOP::Object>.
  84
  85 =head1 METHODS
  86
  87 =over 4
  88
  89 =item B<< Moose::Meta::TypeConstraint::Registry->new(%options) >>
  90
  91 This creates a new registry object based on the provided C<%options>:
  92
  93 =over 8
  94
  95 =item * parent_registry
  96
  97 This is an optional L<Moose::Meta::TypeConstraint::Registry>
  98 object.
  99
 100 =item * type_constraints
 101
 102 This is hash reference of type names to type objects. This is
 103 optional. Constraints can be added to the registry after it is
 104 created.
 105
 106 =back
 107
 108 =item B<< $registry->get_parent_registry >>
 109
 110 Returns the registry's parent registry, if it has one.
 111
 112 =item B<< $registry->has_parent_registry >>
 113
 114 Returns true if the registry has a parent.
 115
 116 =item B<< $registry->set_parent_registry($registry) >>
 117
 118 Sets the parent registry.
 119
 120 =item B<< $registry->get_type_constraint($type_name) >>
 121
 122 This returns the L<Moose::Meta::TypeConstraint> object from the
 123 registry for the given name, if one exists.
 124
 125 =item B<< $registry->has_type_constraint($type_name) >>
 126
 127 Returns true if the registry has a type of the given name.
 128
 129 =item B<< $registry->add_type_constraint($type) >>
 130
 131 Adds a new L<Moose::Meta::TypeConstraint> object to the registry.
 132
 133 =item B<< $registry->find_type_constraint($type_name) >>
 134
 135 This method looks in the current registry for the named type. If the
 136 type is not found, then this method will look in the registry's
 137 parent, if it has one.
 138
 139 =back
 140
 141 =head1 BUGS
 142
 143 See L<Moose/BUGS> for details on reporting bugs.
 144
 145 =cut