lib/MooseX/Getopt/Session.pm

   1
   2 package MooseX::Getopt::Session;
   3
   4 use Moose;
   5
   6 use MooseX::Getopt::Parser::Long;
   7 use maybe 'MooseX::Getopt::Parser::Descriptive';
   8
   9 #use Smart::Comments;
  10
  11 # Pluggined MooseX::Getopt::Parser parser
  12 has 'getopt_parser' => (
  13     is => 'rw',
  14     does => 'MooseX::Getopt::Parser',
  15     default => sub {
  16         maybe::HAVE_MOOSEX_GETOPT_PARSER_DESCRIPTIVE
  17         ? MooseX::Getopt::Parser::Descriptive->new
  18         : MooseX::Getopt::Parser::Long->new
  19     },
  20 );
  21
  22 # Filter for classes which are searched for getopt trait
  23 has 'classes_filter' => (
  24     is => 'rw',
  25     isa => 'CodeRef',
  26     default => sub { sub { 1 } },
  27 );
  28
  29 # Original @ARGV values
  30 has 'argv' => (
  31     is => 'rw',
  32     isa => 'ArrayRef[Str]',
  33     auto_deref => 1,
  34     default => sub { [ @ARGV ] },
  35 );
  36
  37 # Unrecognized @ARGV values
  38 has 'extra_argv' => (
  39     is => 'rw',
  40     isa => 'ArrayRef[Str]',
  41     auto_deref => 1,
  42     default => sub { [] },
  43 );
  44
  45 # Hash with options parsed from argv
  46 has 'options' => (
  47     is => 'rw',
  48     isa => 'HashRef',
  49     auto_deref => 1,
  50     default => sub { {} },
  51 );
  52
  53 # Status of parser
  54 has 'status' => (
  55     is => 'rw',
  56     isa => 'Bool',
  57 );
  58
  59 # Warnings collected by parser
  60 has 'warning' => (
  61     is => 'rw',
  62     isa => 'Str',
  63     predicate => 'has_warning',
  64 );
  65
  66 # Die if warnings was occured
  67 has 'die_on_warning' => (
  68     is => 'rw',
  69     isa => 'Bool',
  70     default => 1,
  71 );
  72
  73
  74 sub BUILD {
  75     ### MooseX::Getopt::Session::BUILD : @_
  76     my ($self, $args) = @_;
  77
  78     $self->build_options;
  79 };
  80
  81
  82 sub build_options {
  83     my ($self) = @_;
  84
  85     my @attrs = map { $_->_compute_getopt_attrs } $self->_compute_getopt_classes;
  86     ### MooseX::Getopt::Session::build_options @attrs -> name : map { $_->name } @attrs
  87
  88     return $self->getopt_parser->build_options( $self, @attrs );
  89 }
  90
  91
  92 sub _compute_getopt_classes {
  93     my $self = shift;
  94
  95     return grep {
  96         $self->classes_filter->()
  97     } grep {
  98         $_->isa('Moose::Object') && $_->does('MooseX::Getopt')
  99     } Class::MOP->get_all_metaclasses;
 100 };
 101
 102
 103 1;