1 package MooseX::Types::Base;
6 MooseX::Types::Base - Type library base class
10 use Carp::Clan qw( ^MooseX::Types );
11 use MooseX::Types::Util qw( filter_tags );
12 use Sub::Exporter qw( build_exporter );
13 use Moose::Util::TypeConstraints;
15 use namespace::clean -except => [qw( meta )];
19 You normally won't need to interact with this class by yourself. It is
20 merely a collection of functionality that type libraries need to
21 interact with moose and the rest of the L<MooseX::Types> module.
25 my $UndefMsg = q{Unable to find type '%s' in library '%s'};
33 Provides the import mechanism for your library. See
34 L<MooseX::Types/"LIBRARY USAGE"> for syntax details on this.
39 my ($class, @args) = @_;
41 # filter or create options hash for S:E
42 my $options = (@args and (ref($args[0]) eq 'HASH')) ? $args[0] : undef;
44 $options = {foo => 23};
45 unshift @args, $options;
48 # all types known to us
49 my @types = $class->type_names;
51 # determine the wrapper, -into is supported for compatibility reasons
52 my $wrapper = $options->{ -wrapper } || 'MooseX::Types';
53 $args[0]->{into} = $options->{ -into }
54 if exists $options->{ -into };
56 my (%ex_spec, %ex_util);
58 for my $type_short (@types) {
60 # find type name and object, create undefined message
61 my $type_full = $class->get_type($type_short)
62 or croak "No fully qualified type name stored for '$type_short'";
63 my $type_cons = find_type_constraint($type_full);
64 my $undef_msg = sprintf($UndefMsg, $type_short, $class);
67 push @{ $ex_spec{exports} },
70 bless $wrapper->type_export_generator($type_short, $type_full),
71 'MooseX::Types::EXPORTED_TYPE_CONSTRAINT';
75 push @{ $ex_spec{exports} },
77 sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) };
79 # only export coercion helper if full (for libraries) or coercion is defined
81 unless $options->{ -full }
82 or ($type_cons and $type_cons->has_coercion);
83 push @{ $ex_spec{exports} },
85 sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) };
86 $ex_util{ $type_short }{to}++; # shortcut to remember this exists
89 # create S:E exporter and increase export level unless specified explicitly
90 my $exporter = build_exporter \%ex_spec;
91 $options->{into_level}++
92 unless $options->{into};
94 # remember requested symbols to determine what helpers to auto-export
100 # determine which additional symbols (helpers) to export along
103 for my $type (grep { exists $was_requested{ $_ } } @types) {
105 unless $was_requested{ "is_$type" };
107 unless exists $ex_util{ $type }{to};
109 unless $was_requested{ "to_$type" };
112 # and on to the real exporter
113 my @new_args = (@args, keys %add);
114 return $class->$exporter(@new_args);
119 This returns a type from the library's store by its name.
124 my ($class, $type) = @_;
126 # useful message if the type couldn't be found
127 croak "Unknown type '$type' in library '$class'"
128 unless $class->has_type($type);
130 # return real name of the type
131 return $class->type_storage->{ $type };
136 Returns a list of all known types by their name.
143 # return short names of all stored types
144 return keys %{ $class->type_storage };
149 Adds a new type to the library.
154 my ($class, $type) = @_;
156 # store type with library prefix as real name
157 $class->type_storage->{ $type } = "${class}::${type}";
162 Returns true or false depending on if this library knows a type by that
168 my ($class, $type) = @_;
170 # check if we stored a type under that name
171 return ! ! $class->type_storage->{ $type };
176 Returns the library's type storage hash reference. You shouldn't use this
177 method directly unless you know what you are doing. It is not an internal
178 method because overriding it makes virtual libraries very easy.
185 # return a reference to the storage in ourself
187 return \%{ $class . '::__MOOSEX_TYPELIBRARY_STORAGE' };
191 =head2 registered_class_types
193 Returns the class types registered within this library. Don't use directly.
197 sub registered_class_types {
202 return \%{ $class . '::__MOOSEX_TYPELIBRARY_CLASS_TYPES' };
206 =head2 register_class_type
208 Register a C<class_type> for use in this library by class name.
212 sub register_class_type {
213 my ($class, $type) = @_;
215 croak "Not a class_type"
216 unless $type->isa('Moose::Meta::TypeConstraint::Class');
218 $class->registered_class_types->{$type->class} = $type;
221 =head2 get_registered_class_type
223 Get a C<class_type> registered in this library by name.
227 sub get_registered_class_type {
228 my ($class, $name) = @_;
230 $class->registered_class_types->{$name};
233 =head2 registered_role_types
235 Returns the role types registered within this library. Don't use directly.
239 sub registered_role_types {
244 return \%{ $class . '::__MOOSEX_TYPELIBRARY_ROLE_TYPES' };
248 =head2 register_role_type
250 Register a C<role_type> for use in this library by role name.
254 sub register_role_type {
255 my ($class, $type) = @_;
257 croak "Not a role_type"
258 unless $type->isa('Moose::Meta::TypeConstraint::Role');
260 $class->registered_role_types->{$type->role} = $type;
263 =head2 get_registered_role_type
265 Get a C<role_type> registered in this library by role name.
269 sub get_registered_role_type {
270 my ($class, $name) = @_;
272 $class->registered_role_types->{$name};
277 L<MooseX::Types::Moose>
279 =head1 AUTHOR AND COPYRIGHT
281 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
282 the C<#moose> cabal on C<irc.perl.org>.
286 This program is free software; you can redistribute it and/or modify
287 it under the same terms as perl itself.