lib/MooseX/Getopt/OptionTypeMap.pm

   1 package MooseX::Getopt::OptionTypeMap;
   2 # ABSTRACT: Storage for the option to type mappings
   3
   4 use Moose 'confess', 'blessed';
   5 use Moose::Util::TypeConstraints 'find_type_constraint';
   6
   7 my %option_type_map = (
   8     'Bool'     => '!',
   9     'Str'      => '=s',
  10     'Int'      => '=i',
  11     'Num'      => '=f',
  12     'ArrayRef' => '=s@',
  13     'HashRef'  => '=s%',
  14 );
  15
  16 sub has_option_type {
  17     my (undef, $type_or_name) = @_;
  18
  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
  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);
  31
  32     (defined $current)
  33         || confess "Could not find the type constraint for '$type_or_name'";
  34
  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 {
  44     my (undef, $type_or_name) = @_;
  45
  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
  56     my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_name;
  57
  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);
  61
  62     (defined $current)
  63         || confess "Could not find the type constraint for '$type_or_name'";
  64
  65     while ( $current = $current->parent ) {
  66         return $option_type_map{$current->name}
  67             if exists $option_type_map{$current->name};
  68     }
  69
  70     return;
  71 }
  72
  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";
  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
  85     $option_type_map{$type_name} = $option_string;
  86 }
  87
  88 no Moose::Util::TypeConstraints;
  89 no Moose;
  90
  91 1;
  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
  98 =method B<has_option_type ($type_or_name)>
  99
 100 =method B<get_option_type ($type_or_name)>
 101
 102 =method B<add_option_type_to_map ($type_name, $option_spec)>
 103
 104 =cut