1 package MooseX::Types::Base;
7 MooseX::Types::Base - Type library base class
11 use Carp::Clan qw( ^MooseX::Types );
12 use MooseX::Types::Util qw( filter_tags );
13 use Sub::Exporter qw( build_exporter );
14 use Moose::Util::TypeConstraints;
16 use namespace::clean -except => [qw( meta )];
20 You normally won't need to interact with this class by yourself. It is
21 merely a collection of functionality that type libraries need to
22 interact with moose and the rest of the L<MooseX::Types> module.
26 my $UndefMsg = q{Unable to find type '%s' in library '%s'};
34 Provides the import mechanism for your library. See
35 L<MooseX::Types/"LIBRARY USAGE"> for syntax details on this.
40 my ($class, @args) = @_;
42 # filter or create options hash for S:E
43 my $options = (@args and (ref($args[0]) eq 'HASH')) ? $args[0] : undef;
45 $options = {foo => 23};
46 unshift @args, $options;
49 # all types known to us
50 my @types = $class->type_names;
52 # determine the wrapper, -into is supported for compatibility reasons
53 my $wrapper = $options->{ -wrapper } || 'MooseX::Types';
54 $args[0]->{into} = $options->{ -into }
55 if exists $options->{ -into };
57 my (%ex_spec, %ex_util);
59 for my $type_short (@types) {
61 # find type name and object, create undefined message
62 my $type_full = $class->get_type($type_short)
63 or croak "No fully qualified type name stored for '$type_short'";
64 my $type_cons = find_type_constraint($type_full);
65 my $undef_msg = sprintf($UndefMsg, $type_short, $class);
68 push @{ $ex_spec{exports} },
71 bless $wrapper->type_export_generator($type_short, $type_full),
72 'MooseX::Types::EXPORTED_TYPE_CONSTRAINT';
76 push @{ $ex_spec{exports} },
78 sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) };
80 # only export coercion helper if full (for libraries) or coercion is defined
82 unless $options->{ -full }
83 or ($type_cons and $type_cons->has_coercion);
84 push @{ $ex_spec{exports} },
86 sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) };
87 $ex_util{ $type_short }{to}++; # shortcut to remember this exists
90 # create S:E exporter and increase export level unless specified explicitly
91 my $exporter = build_exporter \%ex_spec;
92 $options->{into_level}++
93 unless $options->{into};
95 # remember requested symbols to determine what helpers to auto-export
101 # determine which additional symbols (helpers) to export along
104 for my $type (grep { exists $was_requested{ $_ } } @types) {
106 unless $was_requested{ "is_$type" };
108 unless exists $ex_util{ $type }{to};
110 unless $was_requested{ "to_$type" };
113 # and on to the real exporter
114 my @new_args = (@args, keys %add);
115 return $class->$exporter(@new_args);
120 This returns a type from the library's store by its name.
125 my ($class, $type) = @_;
127 # useful message if the type couldn't be found
128 croak "Unknown type '$type' in library '$class'"
129 unless $class->has_type($type);
131 # return real name of the type
132 return $class->type_storage->{ $type };
137 Returns a list of all known types by their name.
144 # return short names of all stored types
145 return keys %{ $class->type_storage };
150 Adds a new type to the library.
155 my ($class, $type) = @_;
157 # store type with library prefix as real name
158 $class->type_storage->{ $type } = "${class}::${type}";
163 Returns true or false depending on if this library knows a type by that
169 my ($class, $type) = @_;
171 # check if we stored a type under that name
172 return ! ! $class->type_storage->{ $type };
177 Returns the library's type storage hash reference. You shouldn't use this
178 method directly unless you know what you are doing. It is not an internal
179 method because overriding it makes virtual libraries very easy.
186 # return a reference to the storage in ourself
188 return \%{ $class . '::__MOOSEX_TYPELIBRARY_STORAGE' };
192 =head2 registered_class_types
194 Returns the class types registered within this library. Don't use directly.
198 sub registered_class_types {
203 return \%{ $class . '::__MOOSEX_TYPELIBRARY_CLASS_TYPES' };
207 =head2 register_class_type
209 Register a C<class_type> for use in this library by class name.
213 sub register_class_type {
214 my ($class, $type) = @_;
216 croak "Not a class_type"
217 unless $type->isa('Moose::Meta::TypeConstraint::Class');
219 $class->registered_class_types->{$type->class} = $type;
222 =head2 get_registered_class_type
224 Get a C<class_type> registered in this library by name.
228 sub get_registered_class_type {
229 my ($class, $name) = @_;
231 $class->registered_class_types->{$name};
234 =head2 registered_role_types
236 Returns the role types registered within this library. Don't use directly.
240 sub registered_role_types {
245 return \%{ $class . '::__MOOSEX_TYPELIBRARY_ROLE_TYPES' };
249 =head2 register_role_type
251 Register a C<role_type> for use in this library by role name.
255 sub register_role_type {
256 my ($class, $type) = @_;
258 croak "Not a role_type"
259 unless $type->isa('Moose::Meta::TypeConstraint::Role');
261 $class->registered_role_types->{$type->role} = $type;
264 =head2 get_registered_role_type
266 Get a C<role_type> registered in this library by role name.
270 sub get_registered_role_type {
271 my ($class, $name) = @_;
273 $class->registered_role_types->{$name};
278 L<MooseX::Types::Moose>
282 See L<MooseX::Types/AUTHOR>.
286 This program is free software; you can redistribute it and/or modify
287 it under the same terms as perl itself.