lib/MooseX/Getopt/GLD.pm

   1 package MooseX::Getopt::GLD;
   2 # ABSTRACT: A Moose role for processing command line options with Getopt::Long::Descriptive
   3
   4 use MooseX::Role::Parameterized;
   5
   6 use Getopt::Long::Descriptive 0.081;
   7
   8 with 'MooseX::Getopt::Basic';
   9
  10 parameter getopt_conf => (
  11     isa => 'ArrayRef[Str]',
  12     default => sub { [] },
  13 );
  14
  15 role {
  16
  17     my $p = shift;
  18     my $getopt_conf = $p->getopt_conf;
  19
  20     has usage => (
  21         is => 'rw', isa => 'Getopt::Long::Descriptive::Usage',
  22         traits => ['NoGetopt'],
  23     );
  24
  25     # captures the options: --help --usage --?
  26     has help_flag => (
  27         is => 'ro', isa => 'Bool',
  28         traits => ['Getopt'],
  29         cmd_flag => 'help',
  30         cmd_aliases => [ qw(usage ?) ],
  31         documentation => 'Prints this usage information.',
  32     );
  33
  34     around _getopt_spec => sub {
  35         shift;
  36         shift->_gld_spec(@_);
  37     };
  38
  39     around _getopt_get_options => sub {
  40         shift;
  41         my ($class, $params, $opt_spec) = @_;
  42         # Check if a special args hash were already passed, or create a new one
  43         my $args = ref($opt_spec->[-1]) eq 'HASH' ? pop @$opt_spec : {};
  44         unshift @{$args->{getopt_conf}}, @$getopt_conf;
  45         push @$opt_spec, $args;
  46         return Getopt::Long::Descriptive::describe_options($class->_usage_format(%$params), @$opt_spec);
  47     };
  48
  49     method _gld_spec => sub {
  50         my ( $class, %params ) = @_;
  51
  52         my ( @options, %name_to_init_arg );
  53
  54         my $constructor_params = $params{params};
  55
  56         foreach my $opt ( @{ $params{options} } ) {
  57             push @options, [
  58                 $opt->{opt_string},
  59                 $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
  60                 {
  61                     ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
  62                     # NOTE:
  63                     # remove this 'feature' because it didn't work
  64                     # all the time, and so is better to not bother
  65                     # since Moose will handle the defaults just
  66                     # fine anyway.
  67                     # - SL
  68                     #( exists $opt->{default}  ? (default  => $opt->{default})  : () ),
  69                 },
  70             ];
  71
  72             my $identifier = lc($opt->{name});
  73             $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
  74
  75             $name_to_init_arg{$identifier} = $opt->{init_arg};
  76         }
  77
  78         return ( \@options, \%name_to_init_arg );
  79     }
  80 };
  81
  82
  83 1;
  84
  85 =head1 SYNOPSIS
  86
  87   ## In your class
  88   package My::App;
  89   use Moose;
  90
  91   with 'MooseX::Getopt::GLD';
  92
  93   has 'out' => (is => 'rw', isa => 'Str', required => 1);
  94   has 'in'  => (is => 'rw', isa => 'Str', required => 1);
  95
  96   # ... rest of the class here
  97
  98   ## in your script
  99   #!/usr/bin/perl
 100
 101   use My::App;
 102
 103   my $app = My::App->new_with_options();
 104   # ... rest of the script here
 105
 106   ## on the command line
 107   % perl my_app_script.pl -in file.input -out file.dump
 108
 109 =cut