File Coverage

blib/lib/Moose/Meta/TypeConstraint/Registry.pm
Criterion Covered Total %
statement 30 34 88.2
branch 5 10 50.0
condition 9 9 100.0
subroutine 10 11 90.9
pod 5 5 100.0
total 59 69 85.5


line stmt bran cond sub pod time code
1             package Moose::Meta::TypeConstraint::Registry;
2             our $VERSION = '2.2203';
3              
4 401     401   2664 use strict;
  401         842  
  401         11186  
5 401     401   1873 use warnings;
  401         778  
  401         8332  
6 401     401   1841 use metaclass;
  401         978  
  401         1924  
7              
8 401     401   3897 use Scalar::Util 'blessed';
  401         1050  
  401         19429  
9              
10 401     401   2689 use parent 'Class::MOP::Object';
  401         989  
  401         2416  
11              
12 401     401   27798 use Moose::Util 'throw_exception';
  401         1069  
  401         2520  
13              
14             __PACKAGE__->meta->add_attribute('parent_registry' => (
15             reader => 'get_parent_registry',
16             writer => 'set_parent_registry',
17             predicate => 'has_parent_registry',
18             Class::MOP::_definition_context(),
19             ));
20              
21             __PACKAGE__->meta->add_attribute('type_constraints' => (
22             reader => 'type_constraints',
23             default => sub { {} },
24             Class::MOP::_definition_context(),
25             ));
26              
27             sub new {
28 402     402 1 36182 my $class = shift;
29 402         3634 my $self = $class->_new(@_);
30 402         1150 return $self;
31             }
32              
33             sub has_type_constraint {
34 18510     18510 1 32983 my ($self, $type_name) = @_;
35 18510 100 100     577860 ($type_name and exists $self->type_constraints->{$type_name}) ? 1 : 0
36             }
37              
38             sub get_type_constraint {
39 27009     27009 1 48389 my ($self, $type_name) = @_;
40 27009 50       49891 return unless defined $type_name;
41 27009         752288 $self->type_constraints->{$type_name}
42             }
43              
44             sub add_type_constraint {
45 11835     11835 1 26565 my ($self, $type) = @_;
46              
47 11835 100 100     35043 unless ( $type && blessed $type && $type->isa('Moose::Meta::TypeConstraint') ) {
      100        
48 4         20 throw_exception( InvalidTypeConstraint => registry_object => $self,
49             type => $type
50             );
51             }
52              
53 11831         351048 $self->type_constraints->{$type->name} = $type;
54             }
55              
56             sub find_type_constraint {
57 0     0 1   my ($self, $type_name) = @_;
58 0 0         return $self->get_type_constraint($type_name)
59             if $self->has_type_constraint($type_name);
60 0 0         return $self->get_parent_registry->find_type_constraint($type_name)
61             if $self->has_parent_registry;
62 0           return;
63             }
64              
65             1;
66              
67             # ABSTRACT: registry for type constraints
68              
69             __END__
70              
71             =pod
72              
73             =encoding UTF-8
74              
75             =head1 NAME
76              
77             Moose::Meta::TypeConstraint::Registry - registry for type constraints
78              
79             =head1 VERSION
80              
81             version 2.2203
82              
83             =head1 DESCRIPTION
84              
85             This class is a registry that maps type constraint names to
86             L<Moose::Meta::TypeConstraint> objects.
87              
88             Currently, it is only used internally by
89             L<Moose::Util::TypeConstraints>, which creates a single global
90             registry.
91              
92             =head1 INHERITANCE
93              
94             C<Moose::Meta::TypeConstraint::Registry> is a subclass of
95             L<Class::MOP::Object>.
96              
97             =head1 METHODS
98              
99             =head2 Moose::Meta::TypeConstraint::Registry->new(%options)
100              
101             This creates a new registry object based on the provided C<%options>:
102              
103             =over 4
104              
105             =item * parent_registry
106              
107             This is an optional L<Moose::Meta::TypeConstraint::Registry>
108             object.
109              
110             =item * type_constraints
111              
112             This is hash reference of type names to type objects. This is
113             optional. Constraints can be added to the registry after it is
114             created.
115              
116             =back
117              
118             =head2 $registry->get_parent_registry
119              
120             Returns the registry's parent registry, if it has one.
121              
122             =head2 $registry->has_parent_registry
123              
124             Returns true if the registry has a parent.
125              
126             =head2 $registry->set_parent_registry($registry)
127              
128             Sets the parent registry.
129              
130             =head2 $registry->get_type_constraint($type_name)
131              
132             This returns the L<Moose::Meta::TypeConstraint> object from the
133             registry for the given name, if one exists.
134              
135             =head2 $registry->has_type_constraint($type_name)
136              
137             Returns true if the registry has a type of the given name.
138              
139             =head2 $registry->add_type_constraint($type)
140              
141             Adds a new L<Moose::Meta::TypeConstraint> object to the registry.
142              
143             =head2 $registry->find_type_constraint($type_name)
144              
145             This method looks in the current registry for the named type. If the
146             type is not found, then this method will look in the registry's
147             parent, if it has one.
148              
149             =head1 BUGS
150              
151             See L<Moose/BUGS> for details on reporting bugs.
152              
153             =head1 AUTHORS
154              
155             =over 4
156              
157             =item *
158              
159             Stevan Little <stevan@cpan.org>
160              
161             =item *
162              
163             Dave Rolsky <autarch@urth.org>
164              
165             =item *
166              
167             Jesse Luehrs <doy@cpan.org>
168              
169             =item *
170              
171             Shawn M Moore <sartak@cpan.org>
172              
173             =item *
174              
175             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
176              
177             =item *
178              
179             Karen Etheridge <ether@cpan.org>
180              
181             =item *
182              
183             Florian Ragwitz <rafl@debian.org>
184              
185             =item *
186              
187             Hans Dieter Pearcey <hdp@cpan.org>
188              
189             =item *
190              
191             Chris Prather <chris@prather.org>
192              
193             =item *
194              
195             Matt S Trout <mstrout@cpan.org>
196              
197             =back
198              
199             =head1 COPYRIGHT AND LICENSE
200              
201             This software is copyright (c) 2006 by Infinity Interactive, Inc.
202              
203             This is free software; you can redistribute it and/or modify it under
204             the same terms as the Perl 5 programming language system itself.
205              
206             =cut