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 'parser' => (
+has 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
- },
+ default => sub { $_[0]->_default_getopt_parser->new },
);
# Filter for classes which are searched for getopt trait
-has 'classes_filter' => (
+has classes_filter => (
is => 'rw',
isa => 'CodeRef',
default => sub { sub { 1 } },
);
# Explicite parameters for new_with_options
-has 'params' => (
+has params => (
is => 'rw',
isa => 'HashRef',
default => sub { {} },
);
# Original @ARGV values
-has 'argv' => (
+has ARGV => (
is => 'rw',
isa => 'ArrayRef[Str]',
- auto_deref => 1,
default => sub { [ @ARGV ] },
);
# Unrecognized @ARGV values
-has 'extra_argv' => (
+has extra_argv => (
is => 'rw',
isa => 'ArrayRef[Str]',
- auto_deref => 1,
default => sub { [] },
);
# Hash with options parsed from argv
-has 'options' => (
+has options => (
is => 'rw',
isa => 'HashRef',
- auto_deref => 1,
default => sub { {} },
);
-# Status of parser
-has 'status' => (
- is => 'rw',
- isa => 'Bool',
-);
-
-# Warnings collected by parser
-has 'warning' => (
- is => 'rw',
- isa => 'Str',
- predicate => 'has_warning',
-);
-# Die if warnings was occured
sub BUILD {
- ### MooseX::Getopt::Session::BUILD : @_
my ($self, $args) = @_;
$self->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->parser->build_options( $self, @attrs );
}
my ($self, $attr) = @_;
my $type;
-
+
$type = $attr->type_constraint if $attr->has_type_constraint;
if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
};
-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 for L<MooseX::Getopt> and calls
+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<params>
+
+This accessor contains the parameters which will be included to each
+L<MooseX::Getopt>->new_with_options call.
+
+=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>.
+
+=item B<BUILD>
+
+This is a default L<Moose> constructor.
+
+=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>
+
+=head1 CONTRIBUTORS
+
+Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
+
+Piotr Roszatycki, E<lt>dexter@cpan.orgE<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
projects / gitmo/MooseX-Getopt.git / blobdiff