use Moose;
-use MooseX::Getopt::Parser::Long;
-use maybe 'MooseX::Getopt::Parser::Descriptive';
+use MooseX::Getopt::Parser::Default;
+
+
+use constant _default_getopt_parser => 'MooseX::Getopt::Parser::Default';
-#use Smart::Comments;
# Pluggined MooseX::Getopt::Parser parser
-has 'getopt_parser' => (
- is => 'rw',
- does => 'MooseX::Getopt::Parser',
- default => sub {
- maybe::HAVE_MOOSEX_GETOPT_PARSER_DESCRIPTIVE
- ? MooseX::Getopt::Parser::Descriptive->new
- : MooseX::Getopt::Parser::Long->new
- },
+has parser => (
+ is => 'rw',
+ does => 'MooseX::Getopt::Parser',
+ default => sub { $_[0]->_default_getopt_parser->new },
);
# Filter for classes which are searched for getopt trait
-has 'classes_filter' => (
- is => 'rw',
- isa => 'CodeRef',
- default => sub { sub { 1 } },
+has classes_filter => (
+ is => 'rw',
+ isa => 'CodeRef',
+ default => sub { sub { 1; } },
);
# Original @ARGV values
-has 'argv' => (
- is => 'rw',
- isa => 'ArrayRef[Str]',
- auto_deref => 1,
- default => sub { [ @ARGV ] },
+has ARGV => (
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ default => sub { [@ARGV] },
);
# Unrecognized @ARGV values
-has 'extra_argv' => (
- is => 'rw',
- isa => 'ArrayRef[Str]',
- auto_deref => 1,
+has extra_argv => (
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
default => sub { [] },
);
# Hash with options parsed from argv
-has 'options' => (
- is => 'rw',
- isa => 'HashRef',
- auto_deref => 1,
+has options => (
+ is => 'rw',
+ isa => 'HashRef',
default => sub { {} },
);
-# Status of parser
-has 'status' => (
- is => 'rw',
- isa => 'Bool',
+# Status returned by Getopt parser
+has status => (
+ is => 'rw',
+ isa => 'Bool',
+ predicate => 'has_status',
);
-# Warnings collected by parser
-has 'warning' => (
- is => 'rw',
- isa => 'Str',
- predicate => 'has_warning',
-);
-
-# Die if warnings was occured
-has 'die_on_warning' => (
- is => 'rw',
- isa => 'Bool',
- default => 1,
-);
-
-
-sub BUILD {
- ### MooseX::Getopt::Session::BUILD : @_
- my ($self, $args) = @_;
-
- $self->build_options;
-};
-
sub build_options {
my ($self) = @_;
my @attrs = map { $_->_compute_getopt_attrs } $self->_compute_getopt_classes;
- ### MooseX::Getopt::Session::build_options @attrs -> name : map { $_->name } @attrs
- return $self->getopt_parser->build_options( $self, @attrs );
-}
+ return $self->parser->build_options( $self, @attrs );
+};
sub _compute_getopt_classes {
sub _get_cmd_flags_for_attr {
- my ($self, $attr) = @_;
+ my ( $self, $attr ) = @_;
my $flag = $attr->name;
my @aliases;
- if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
- $flag = $attr->cmd_flag if $attr->has_cmd_flag;
+ if ( $attr->does('MooseX::Getopt::Meta::Attribute::Trait') ) {
+ $flag = $attr->cmd_flag if $attr->has_cmd_flag;
@aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
};
- return ($flag, @aliases);
+ return ( $flag, @aliases );
};
sub _get_cmd_type_for_attr {
- my ($self, $attr) = @_;
+ my ( $self, $attr ) = @_;
my $type;
-
+
$type = $attr->type_constraint if $attr->has_type_constraint;
- if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
+ if ( $attr->does('MooseX::Getopt::Meta::Attribute::Trait') ) {
$type = $attr->cmd_type if $attr->has_cmd_type;
};
};
-sub strcat_warning {
- my ($self, $string) = @_;
+1;
+
- return $self->warning( ($self->has_warning ? $self->warning : '') . $string );
-};
+__END__
+=pod
-1;
+=head1 NAME
+
+MooseX::Getopt::Session - A CLI session for MooseX::Getopt
+
+=head1 SYNOPSIS
+
+ ## in your script
+ #!/usr/bin/perl
+
+ use My::App;
+
+ my $getopt = MooseX::Getopt::Session->new;
+
+ my $app = My::App->new_with_options( getopt => $getopt );
+ my $cmd = My::App::Cmd->new_with_options( getopt => $getopt );
+
+=head1 DESCRIPTION
+
+This class handles CLI session for L<MooseX::Getopt>. The session can
+be shared between more than one classes which does L<MooseX::Getopt>.
+If C<getopt> parameter is missing, new session is created for one class.
+
+The L<MooseX::Getopt::Session> scans all classes and gets these which do
+L<MooseX::Getopt>. These classes will make an option list for
+L<MooseX::Getopt::Parser>.
+
+=head1 METHODS
+
+=over 4
+
+=item B<new (%params)>
+
+This method creates new CLI session object for L<MooseX::Getopt>. The
+session should be started with C<build_options> method.
+
+=item B<build_options>
+
+This method creates the list of attributes which contains options and
+calls C<build_options> method from L<MooseX::Getopt::Parser> with this
+object and attributes list as parameters.
+
+=item B<parser>
+
+This accessor contains a parser object which does
+L<MooseX::Getopt::Parser>. It can be set explicite, i.e. if you need to
+modify the way parser works, or new object via
+L<MooseX::Getopt::Parser::Default> factory will be created.
+
+=item B<classes_filter>
+
+This accessor contains a coderef with classes filter which is used for
+searching proper classes to create options list. The filter passes any
+class by default but L<MooseX::Getopt> will search the attributes only
+in own class, if new session is created implicity.
+
+=item B<ARGV>
+
+This accessor contains a reference to a copy of the C<@ARGV> array as it
+originally existed at the time of C<new_with_options>.
+
+=item B<extra_argv>
+
+This accessor contains an arrayref of leftover C<@ARGV> elements that
+L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
+un-mangled.
+
+=item B<options>
+
+This accessor contains an arrayref of options parsed from command line by
+L<MooseX::Getopt::Parser>. If the options list are not empty before parsing
+the command line, the old list will be included to new list.
+
+=item B<status>
+
+This accessor contains a true value if L<MooseX::Getopt::Parser> was
+called via C<build_options> method and it succeeded.
+
+=item B<meta>
+
+This returns the role meta object.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<MooseX::Getopt>
+
+=item L<MooseX::Getopt::Parser>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+Brandon L. Black, E<lt>blblack@gmail.comE<gt>
+
+Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
+
+Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
+
+=head1 CONTRIBUTORS
+
+Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut