1 package MooseX::Types::Base;
4 # ABSTRACT: Type library base class
6 use Carp::Clan qw( ^MooseX::Types );
7 use MooseX::Types::Util qw( filter_tags );
8 use Sub::Exporter qw( build_exporter );
9 use Moose::Util::TypeConstraints;
11 use namespace::autoclean;
15 You normally won't need to interact with this class by yourself. It is
16 merely a collection of functionality that type libraries need to
17 interact with moose and the rest of the L<MooseX::Types> module.
21 my $UndefMsg = q{Unable to find type '%s' in library '%s'};
29 Provides the import mechanism for your library. See
30 L<MooseX::Types/"LIBRARY USAGE"> for syntax details on this.
35 my ($class, @args) = @_;
37 # filter or create options hash for S:E
38 my $options = (@args and (ref($args[0]) eq 'HASH')) ? $args[0] : undef;
40 $options = {foo => 23};
41 unshift @args, $options;
44 # all types known to us
45 my @types = $class->type_names;
47 # determine the wrapper, -into is supported for compatibility reasons
48 my $wrapper = $options->{ -wrapper } || 'MooseX::Types';
49 $args[0]->{into} = $options->{ -into }
50 if exists $options->{ -into };
52 my (%ex_spec, %ex_util);
54 for my $type_short (@types) {
56 # find type name and object, create undefined message
57 my $type_full = $class->get_type($type_short)
58 or croak "No fully qualified type name stored for '$type_short'";
59 my $type_cons = find_type_constraint($type_full);
60 my $undef_msg = sprintf($UndefMsg, $type_short, $class);
63 push @{ $ex_spec{exports} },
66 bless $wrapper->type_export_generator($type_short, $type_full),
67 'MooseX::Types::EXPORTED_TYPE_CONSTRAINT';
71 push @{ $ex_spec{exports} },
73 sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) };
75 # only export coercion helper if full (for libraries) or coercion is defined
77 unless $options->{ -full }
78 or ($type_cons and $type_cons->has_coercion);
79 push @{ $ex_spec{exports} },
81 sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) };
82 $ex_util{ $type_short }{to}++; # shortcut to remember this exists
85 # create S:E exporter and increase export level unless specified explicitly
86 my $exporter = build_exporter \%ex_spec;
87 $options->{into_level}++
88 unless $options->{into};
90 # remember requested symbols to determine what helpers to auto-export
96 # determine which additional symbols (helpers) to export along
99 for my $type (grep { exists $was_requested{ $_ } } @types) {
101 unless $was_requested{ "is_$type" };
103 unless exists $ex_util{ $type }{to};
105 unless $was_requested{ "to_$type" };
108 # and on to the real exporter
109 my @new_args = (@args, keys %add);
110 return $class->$exporter(@new_args);
115 This returns a type from the library's store by its name.
120 my ($class, $type) = @_;
122 # useful message if the type couldn't be found
123 croak "Unknown type '$type' in library '$class'"
124 unless $class->has_type($type);
126 # return real name of the type
127 return $class->type_storage->{ $type };
132 Returns a list of all known types by their name.
139 # return short names of all stored types
140 return keys %{ $class->type_storage };
145 Adds a new type to the library.
150 my ($class, $type) = @_;
152 # store type with library prefix as real name
153 $class->type_storage->{ $type } = "${class}::${type}";
158 Returns true or false depending on if this library knows a type by that
164 my ($class, $type) = @_;
166 # check if we stored a type under that name
167 return ! ! $class->type_storage->{ $type };
172 Returns the library's type storage hash reference. You shouldn't use this
173 method directly unless you know what you are doing. It is not an internal
174 method because overriding it makes virtual libraries very easy.
181 # return a reference to the storage in ourself
183 return \%{ $class . '::__MOOSEX_TYPELIBRARY_STORAGE' };
187 =head2 registered_class_types
189 Returns the class types registered within this library. Don't use directly.
193 sub registered_class_types {
198 return \%{ $class . '::__MOOSEX_TYPELIBRARY_CLASS_TYPES' };
202 =head2 register_class_type
204 Register a C<class_type> for use in this library by class name.
208 sub register_class_type {
209 my ($class, $type) = @_;
211 croak "Not a class_type"
212 unless $type->isa('Moose::Meta::TypeConstraint::Class');
214 $class->registered_class_types->{$type->class} = $type;
217 =head2 get_registered_class_type
219 Get a C<class_type> registered in this library by name.
223 sub get_registered_class_type {
224 my ($class, $name) = @_;
226 $class->registered_class_types->{$name};
229 =head2 registered_role_types
231 Returns the role types registered within this library. Don't use directly.
235 sub registered_role_types {
240 return \%{ $class . '::__MOOSEX_TYPELIBRARY_ROLE_TYPES' };
244 =head2 register_role_type
246 Register a C<role_type> for use in this library by role name.
250 sub register_role_type {
251 my ($class, $type) = @_;
253 croak "Not a role_type"
254 unless $type->isa('Moose::Meta::TypeConstraint::Role');
256 $class->registered_role_types->{$type->role} = $type;
259 =head2 get_registered_role_type
261 Get a C<role_type> registered in this library by role name.
265 sub get_registered_role_type {
266 my ($class, $name) = @_;
268 $class->registered_role_types->{$name};
273 L<MooseX::Types::Moose>
277 This program is free software; you can redistribute it and/or modify
278 it under the same terms as perl itself.