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