Commit | Line | Data |
8034a232 |
1 | package MooseX::Getopt::OptionTypeMap; |
669588e2 |
2 | # ABSTRACT: Storage for the option to type mappings |
8034a232 |
3 | |
365e5784 |
4 | use Moose 'confess', 'blessed'; |
8034a232 |
5 | use Moose::Util::TypeConstraints 'find_type_constraint'; |
6 | |
8034a232 |
7 | my %option_type_map = ( |
8 | 'Bool' => '!', |
9 | 'Str' => '=s', |
10 | 'Int' => '=i', |
d64acebb |
11 | 'Num' => '=f', |
8034a232 |
12 | 'ArrayRef' => '=s@', |
669588e2 |
13 | 'HashRef' => '=s%', |
8034a232 |
14 | ); |
15 | |
f63e6310 |
16 | sub has_option_type { |
365e5784 |
17 | my (undef, $type_or_name) = @_; |
f63e6310 |
18 | |
416dcb2e |
19 | if (blessed($type_or_name) |
20 | && $type_or_name->isa('Moose::Meta::TypeConstraint::Union')) { |
21 | foreach my $union_type (@{$type_or_name->type_constraints}) { |
22 | return 1 |
23 | if __PACKAGE__->has_option_type($union_type); |
24 | } |
25 | return 0; |
26 | } |
27 | |
365e5784 |
28 | return 1 if exists $option_type_map{blessed($type_or_name) ? $type_or_name->name : $type_or_name}; |
29 | |
30 | my $current = blessed($type_or_name) ? $type_or_name : find_type_constraint($type_or_name); |
669588e2 |
31 | |
2482085f |
32 | (defined $current) |
365e5784 |
33 | || confess "Could not find the type constraint for '$type_or_name'"; |
669588e2 |
34 | |
f63e6310 |
35 | while (my $parent = $current->parent) { |
36 | return 1 if exists $option_type_map{$parent->name}; |
37 | $current = $parent; |
38 | } |
39 | |
40 | return 0; |
41 | } |
42 | |
43 | sub get_option_type { |
365e5784 |
44 | my (undef, $type_or_name) = @_; |
45 | |
416dcb2e |
46 | if (blessed($type_or_name) |
47 | && $type_or_name->isa('Moose::Meta::TypeConstraint::Union')) { |
48 | foreach my $union_type (@{$type_or_name->type_constraints}) { |
49 | my $option_type = __PACKAGE__->get_option_type($union_type); |
50 | return $option_type |
51 | if defined $option_type; |
52 | } |
53 | return; |
54 | } |
55 | |
365e5784 |
56 | my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_name; |
f63e6310 |
57 | |
365e5784 |
58 | return $option_type_map{$name} if exists $option_type_map{$name}; |
59 | |
60 | my $current = ref $type_or_name ? $type_or_name : find_type_constraint($type_or_name); |
669588e2 |
61 | |
2482085f |
62 | (defined $current) |
669588e2 |
63 | || confess "Could not find the type constraint for '$type_or_name'"; |
365e5784 |
64 | |
65 | while ( $current = $current->parent ) { |
66 | return $option_type_map{$current->name} |
67 | if exists $option_type_map{$current->name}; |
f63e6310 |
68 | } |
69 | |
70 | return; |
71 | } |
72 | |
8034a232 |
73 | sub add_option_type_to_map { |
74 | my (undef, $type_name, $option_string) = @_; |
75 | (defined $type_name && defined $option_string) |
76 | || confess "You must supply both a type name and an option string"; |
365e5784 |
77 | |
78 | if ( blessed($type_name) ) { |
79 | $type_name = $type_name->name; |
80 | } else { |
81 | (find_type_constraint($type_name)) |
82 | || confess "The type constraint '$type_name' does not exist"; |
83 | } |
84 | |
8034a232 |
85 | $option_type_map{$type_name} = $option_string; |
86 | } |
87 | |
669588e2 |
88 | no Moose::Util::TypeConstraints; |
89 | no Moose; |
8034a232 |
90 | |
669588e2 |
91 | 1; |
8034a232 |
92 | |
93 | =head1 DESCRIPTION |
94 | |
95 | See the I<Custom Type Constraints> section in the L<MooseX::Getopt> docs |
96 | for more info about how to use this module. |
97 | |
669588e2 |
98 | =method B<has_option_type ($type_or_name)> |
8034a232 |
99 | |
669588e2 |
100 | =method B<get_option_type ($type_or_name)> |
8034a232 |
101 | |
669588e2 |
102 | =method B<add_option_type_to_map ($type_name, $option_spec)> |
8034a232 |
103 | |
f63e6310 |
104 | =cut |