Commit | Line | Data |
8034a232 |
1 | |
2 | package MooseX::Getopt::OptionTypeMap; |
3 | |
365e5784 |
4 | use Moose 'confess', 'blessed'; |
8034a232 |
5 | use Moose::Util::TypeConstraints 'find_type_constraint'; |
6 | |
8b9e50c3 |
7 | our $VERSION = '0.26'; |
8034a232 |
8 | our $AUTHORITY = 'cpan:STEVAN'; |
9 | |
10 | my %option_type_map = ( |
11 | 'Bool' => '!', |
12 | 'Str' => '=s', |
13 | 'Int' => '=i', |
d64acebb |
14 | 'Num' => '=f', |
8034a232 |
15 | 'ArrayRef' => '=s@', |
16 | 'HashRef' => '=s%', |
17 | ); |
18 | |
f63e6310 |
19 | sub has_option_type { |
365e5784 |
20 | my (undef, $type_or_name) = @_; |
f63e6310 |
21 | |
365e5784 |
22 | return 1 if exists $option_type_map{blessed($type_or_name) ? $type_or_name->name : $type_or_name}; |
23 | |
24 | my $current = blessed($type_or_name) ? $type_or_name : find_type_constraint($type_or_name); |
2482085f |
25 | |
26 | (defined $current) |
365e5784 |
27 | || confess "Could not find the type constraint for '$type_or_name'"; |
2482085f |
28 | |
f63e6310 |
29 | while (my $parent = $current->parent) { |
30 | return 1 if exists $option_type_map{$parent->name}; |
31 | $current = $parent; |
32 | } |
33 | |
34 | return 0; |
35 | } |
36 | |
37 | sub get_option_type { |
365e5784 |
38 | my (undef, $type_or_name) = @_; |
39 | |
40 | my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_name; |
f63e6310 |
41 | |
365e5784 |
42 | return $option_type_map{$name} if exists $option_type_map{$name}; |
43 | |
44 | my $current = ref $type_or_name ? $type_or_name : find_type_constraint($type_or_name); |
2482085f |
45 | |
46 | (defined $current) |
365e5784 |
47 | || confess "Could not find the type constraint for '$type_or_name'"; |
48 | |
49 | while ( $current = $current->parent ) { |
50 | return $option_type_map{$current->name} |
51 | if exists $option_type_map{$current->name}; |
f63e6310 |
52 | } |
53 | |
54 | return; |
55 | } |
56 | |
8034a232 |
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"; |
365e5784 |
61 | |
62 | if ( blessed($type_name) ) { |
63 | $type_name = $type_name->name; |
64 | } else { |
65 | (find_type_constraint($type_name)) |
66 | || confess "The type constraint '$type_name' does not exist"; |
67 | } |
68 | |
8034a232 |
69 | $option_type_map{$type_name} = $option_string; |
70 | } |
71 | |
72 | no Moose; no Moose::Util::TypeConstraints; 1; |
73 | |
74 | __END__ |
75 | |
76 | |
77 | =pod |
78 | |
79 | =head1 NAME |
80 | |
81 | MooseX::Getopt::OptionTypeMap - Storage for the option to type mappings |
82 | |
83 | =head1 DESCRIPTION |
84 | |
85 | See the I<Custom Type Constraints> section in the L<MooseX::Getopt> docs |
86 | for more info about how to use this module. |
87 | |
88 | =head1 METHODS |
89 | |
90 | These are all class methods and should be called as such. |
91 | |
92 | =over 4 |
93 | |
365e5784 |
94 | =item B<has_option_type ($type_or_name)> |
8034a232 |
95 | |
365e5784 |
96 | =item B<get_option_type ($type_or_name)> |
8034a232 |
97 | |
98 | =item B<add_option_type_to_map ($type_name, $option_spec)> |
99 | |
edfb736c |
100 | =item B<meta> |
101 | |
8034a232 |
102 | =back |
103 | |
104 | =head1 BUGS |
105 | |
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 |
108 | to cpan-RT. |
109 | |
110 | =head1 AUTHOR |
111 | |
112 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
113 | |
114 | =head1 COPYRIGHT AND LICENSE |
115 | |
adbe3e57 |
116 | Copyright 2007-2008 by Infinity Interactive, Inc. |
8034a232 |
117 | |
118 | L<http://www.iinteractive.com> |
119 | |
120 | This library is free software; you can redistribute it and/or modify |
121 | it under the same terms as Perl itself. |
122 | |
f63e6310 |
123 | =cut |