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.01';
  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
  67
  68 =head1 DESCRIPTION
  69
  70 =head1 METHODS
  71
  72 =over 4
  73
  74 =item B<meta>
  75
  76 =item B<new>
  77
  78 =item B<get_parent_registry>
  79
  80 =item B<set_parent_registry ($registry)>
  81
  82 =item B<has_parent_registry>
  83
  84 =item B<type_constraints>
  85
  86 =item B<has_type_constraint ($type_name)>
  87
  88 =item B<get_type_constraint ($type_name)>
  89
  90 =item B<add_type_constraint ($type)>
  91
  92 =item B<find_type_constraint ($type_name)>
  93
  94 =back
  95
  96 =head1 BUGS
  97
  98 All complex software has bugs lurking in it, and this module is no
  99 exception. If you find a bug please either email me, or add the bug
 100 to cpan-RT.
 101
 102 =head1 AUTHOR
 103
 104 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 105
 106 =head1 COPYRIGHT AND LICENSE
 107
 108 Copyright 2006, 2007 by Infinity Interactive, Inc.
 109
 110 L<http://www.iinteractive.com>
 111
 112 This library is free software; you can redistribute it and/or modify
 113 it under the same terms as Perl itself.
 114
 115 =cut