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 use Carp         'confess';
  10
  11 our $VERSION   = '0.55_01';
  12 $VERSION = eval $VERSION;
  13 our $AUTHORITY = 'cpan:STEVAN';
  14
  15 use base 'Class::MOP::Object';
  16
  17 __PACKAGE__->meta->add_attribute('parent_registry' => (
  18     reader    => 'get_parent_registry',
  19     writer    => 'set_parent_registry',
  20     predicate => 'has_parent_registry',
  21 ));
  22
  23 __PACKAGE__->meta->add_attribute('type_constraints' => (
  24     reader  => 'type_constraints',
  25     default => sub { {} }
  26 ));
  27
  28 sub new {
  29     my $class = shift;
  30     my $self  = $class->_new(@_);
  31     return $self;
  32 }
  33
  34 sub has_type_constraint {
  35     my ($self, $type_name) = @_;
  36     exists $self->type_constraints->{$type_name} ? 1 : 0
  37 }
  38
  39 sub get_type_constraint {
  40     my ($self, $type_name) = @_;
  41     $self->type_constraints->{$type_name}
  42 }
  43
  44 sub add_type_constraint {
  45     my ($self, $type) = @_;
  46     $self->type_constraints->{$type->name} = $type;
  47 }
  48
  49 sub find_type_constraint {
  50     my ($self, $type_name) = @_;
  51     return $self->get_type_constraint($type_name)
  52         if $self->has_type_constraint($type_name);
  53     return $self->get_parent_registry->find_type_constraint($type_name)
  54         if $self->has_parent_registry;
  55     return;
  56 }
  57
  58 1;
  59
  60 __END__
  61
  62
  63 =pod
  64
  65 =head1 NAME
  66
  67 Moose::Meta::TypeConstraint::Registry - registry for type constraints
  68
  69 =head1 DESCRIPTION
  70
  71 This module is currently only use internally by L<Moose::Util::TypeConstraints>.
  72 It can be used to create your own private type constraint registry as well, but
  73 the details of that are currently left as an exercise to the reader. (One hint:
  74 You can use the 'parent_registry' feature to connect your private version with the
  75 base Moose registry and base Moose types will automagically be found too).
  76
  77 =head1 METHODS
  78
  79 =over 4
  80
  81 =item B<meta>
  82
  83 =item B<new>
  84
  85 =item B<get_parent_registry>
  86
  87 =item B<set_parent_registry ($registry)>
  88
  89 =item B<has_parent_registry>
  90
  91 =item B<type_constraints>
  92
  93 =item B<has_type_constraint ($type_name)>
  94
  95 =item B<get_type_constraint ($type_name)>
  96
  97 =item B<add_type_constraint ($type)>
  98
  99 =item B<find_type_constraint ($type_name)>
 100
 101 =back
 102
 103 =head1 BUGS
 104
 105 All complex software has bugs lurking in it, and this module is no
 106 exception. If you find a bug please either email me, or add the bug
 107 to cpan-RT.
 108
 109 =head1 AUTHOR
 110
 111 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 112
 113 =head1 COPYRIGHT AND LICENSE
 114
 115 Copyright 2006-2008 by Infinity Interactive, Inc.
 116
 117 L<http://www.iinteractive.com>
 118
 119 This library is free software; you can redistribute it and/or modify
 120 it under the same terms as Perl itself.
 121
 122 =cut