lib/MooseX/Getopt/OptionTypeMap.pm

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