1 package MooseX::Types::Base;
6 MooseX::Types::Base - Type library base class
10 #use Data::Dump qw( dump );
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} },
70 sub { $wrapper->type_export_generator($type_short, $type_full) };
73 push @{ $ex_spec{exports} },
75 sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) };
77 # only export coercion helper if full (for libraries) or coercion is defined
79 unless $options->{ -full }
80 or ($type_cons and $type_cons->has_coercion);
81 push @{ $ex_spec{exports} },
83 sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) };
84 $ex_util{ $type_short }{to}++; # shortcut to remember this exists
87 # create S:E exporter and increase export level unless specified explicitly
88 my $exporter = build_exporter \%ex_spec;
89 $options->{into_level}++
90 unless $options->{into};
92 # remember requested symbols to determine what helpers to auto-export
98 # determine which additional symbols (helpers) to export along
101 for my $type (grep { exists $was_requested{ $_ } } @types) {
103 unless $was_requested{ "is_$type" };
105 unless exists $ex_util{ $type }{to};
107 unless $was_requested{ "to_$type" };
110 # and on to the real exporter
111 my @new_args = (@args, keys %add);
112 return $class->$exporter(@new_args);
117 This returns a type from the library's store by its name.
122 my ($class, $type) = @_;
124 # useful message if the type couldn't be found
125 croak "Unknown type '$type' in library '$class'"
126 unless $class->has_type($type);
128 # return real name of the type
129 return $class->type_storage->{ $type };
134 Returns a list of all known types by their name.
141 # return short names of all stored types
142 return keys %{ $class->type_storage };
147 Adds a new type to the library.
152 my ($class, $type) = @_;
154 # store type with library prefix as real name
155 $class->type_storage->{ $type } = "${class}::${type}";
160 Returns true or false depending on if this library knows a type by that
166 my ($class, $type) = @_;
168 # check if we stored a type under that name
169 return ! ! $class->type_storage->{ $type };
174 Returns the library's type storage hash reference. You shouldn't use this
175 method directly unless you know what you are doing. It is not an internal
176 method because overriding it makes virtual libraries very easy.
183 # return a reference to the storage in ourself
185 return \%{ $class . '::__MOOSEX_TYPELIBRARY_STORAGE' };
191 L<MooseX::Types::Moose>
193 =head1 AUTHOR AND COPYRIGHT
195 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
196 the C<#moose> cabal on C<irc.perl.org>.
200 This program is free software; you can redistribute it and/or modify
201 it under the same terms as perl itself.