lib/MooseX/Getopt/Parser/Descriptive.pm

   1
   2 package MooseX::Getopt::Parser::Descriptive;
   3
   4 use Moose;
   5
   6 with 'MooseX::Getopt::Parser';
   7
   8 use Getopt::Long::Descriptive;
   9
  10 use Do::Not::Load::This::Module;
  11
  12 sub BUILD {
  13     Moose->throw_error('Not yet implemented');
  14 };
  15
  16 sub get_options {
  17     my ($class, $opt_spec) = @_;
  18     return Getopt::Long::Descriptive::describe_options($class->_usage_format, @$opt_spec);
  19 }
  20
  21 sub _get_getopt_spec {
  22     my ($class, %params) = @_;
  23
  24     my (@options, %name_to_init_arg );
  25
  26     my $constructor_params = $params{params};
  27
  28     foreach my $opt ( @{ $params{options} } ) {
  29         push @options, [
  30             $opt->{opt_string},
  31             $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
  32             {
  33                 ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
  34                 # NOTE:
  35                 # remove this 'feature' because it didn't work
  36                 # all the time, and so is better to not bother
  37                 # since Moose will handle the defaults just
  38                 # fine anyway.
  39                 # - SL
  40                 #( exists $opt->{default}  ? (default  => $opt->{default})  : () ),
  41             },
  42         ];
  43
  44         my $identifier = $opt->{name};
  45         $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
  46
  47         $name_to_init_arg{$identifier} = $opt->{init_arg};
  48     }
  49
  50     return ( \@options, \%name_to_init_arg );
  51 }
  52
  53 sub _usage_format {
  54     return "usage: %c %o";
  55 }
  56
  57 1;