Commit | Line | Data |
c6c1f628 |
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; |