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