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