2 package MooseX::Getopt::OptionTypeMap;
4 use Moose 'confess', 'blessed';
5 use Moose::Util::TypeConstraints 'find_type_constraint';
8 our $AUTHORITY = 'cpan:STEVAN';
10 my %option_type_map = (
20 my (undef, $type_or_name) = @_;
22 return 1 if exists $option_type_map{blessed($type_or_name) ? $type_or_name->name : $type_or_name};
24 my $current = blessed($type_or_name) ? $type_or_name : find_type_constraint($type_or_name);
27 || confess "Could not find the type constraint for '$type_or_name'";
29 while (my $parent = $current->parent) {
30 return 1 if exists $option_type_map{$parent->name};
38 my (undef, $type_or_name) = @_;
40 my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_name;
42 return $option_type_map{$name} if exists $option_type_map{$name};
44 my $current = ref $type_or_name ? $type_or_name : find_type_constraint($type_or_name);
47 || confess "Could not find the type constraint for '$type_or_name'";
49 while ( $current = $current->parent ) {
50 return $option_type_map{$current->name}
51 if exists $option_type_map{$current->name};
57 sub add_option_type_to_map {
58 my (undef, $type_name, $option_string) = @_;
59 (defined $type_name && defined $option_string)
60 || confess "You must supply both a type name and an option string";
62 if ( blessed($type_name) ) {
63 $type_name = $type_name->name;
65 (find_type_constraint($type_name))
66 || confess "The type constraint '$type_name' does not exist";
69 $option_type_map{$type_name} = $option_string;
72 no Moose; no Moose::Util::TypeConstraints; 1;
81 MooseX::Getopt::OptionTypeMap - Storage for the option to type mappings
85 See the I<Custom Type Constraints> section in the L<MooseX::Getopt> docs
86 for more info about how to use this module.
90 These are all class methods and should be called as such.
94 =item B<has_option_type ($type_or_name)>
96 =item B<get_option_type ($type_or_name)>
98 =item B<add_option_type_to_map ($type_name, $option_spec)>
106 All complex software has bugs lurking in it, and this module is no
107 exception. If you find a bug please either email me, or add the bug
112 Stevan Little E<lt>stevan@iinteractive.comE<gt>
114 =head1 COPYRIGHT AND LICENSE
116 Copyright 2007-2008 by Infinity Interactive, Inc.
118 L<http://www.iinteractive.com>
120 This library is free software; you can redistribute it and/or modify
121 it under the same terms as Perl itself.