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