* Perltidy.

[gitmo/MooseX-Getopt.git] / lib / MooseX / Getopt / Session.pm

package MooseX::Getopt::Session;

use Moose;

use MooseX::Getopt::Parser::Default;


use constant _default_getopt_parser => 'MooseX::Getopt::Parser::Default';


# Pluggined MooseX::Getopt::Parser parser
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; } },
);

# Original @ARGV values
has ARGV => (
    is      => 'rw',
    isa     => 'ArrayRef[Str]',
    default => sub { [@ARGV] },
);

# Unrecognized @ARGV values
has extra_argv => (
    is      => 'rw',
    isa     => 'ArrayRef[Str]',
    default => sub { [] },
);

# Hash with options parsed from argv
has options => (
    is      => 'rw',
    isa     => 'HashRef',
    default => sub { {} },
);

# Status returned by Getopt parser
has status => (
    is        => 'rw',
    isa       => 'Bool',
    predicate => 'has_status',
);


sub build_options {
    my ($self) = @_;

    my @attrs = map { $_->_compute_getopt_attrs } $self->_compute_getopt_classes;

    return $self->parser->build_options( $self, @attrs );
};


sub _compute_getopt_classes {
    my $self = shift;

    return grep {
        $self->classes_filter->()
    } grep {
        $_->isa('Moose::Object') && $_->does('MooseX::Getopt')
    } Class::MOP->get_all_metaclasses;
};


sub _get_cmd_flags_for_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;
        @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
    };

    return ( $flag, @aliases );
};


sub _get_cmd_type_for_attr {
    my ( $self, $attr ) = @_;

    my $type;

    $type = $attr->type_constraint if $attr->has_type_constraint;

    if ( $attr->does('MooseX::Getopt::Meta::Attribute::Trait') ) {
        $type = $attr->cmd_type if $attr->has_cmd_type;
    };

    return $type;
};


1;


__END__

=pod

=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