File Coverage

blib/lib/MooseX/App/Exporter.pm

Criterion	Covered	Total	%
statement	127	135	94.0
branch	22	34	64.7
condition	9	15	60.0
subroutine	23	26	88.4
pod	0	13	0.0
total	181	223	81.1

# ============================================================================
package MooseX::App::Exporter;
# ============================================================================

use 5.010;
use utf8;
use strict;
use warnings;

use Moose::Exporter;
use MooseX::App::Utils;
use MooseX::App::ParsedArgv;
use List::Util qw(first);

my %PLUGIN_SPEC;

sub import {
    my ( $class, @imports ) = @_;

    my $caller_class = caller();

    my $caller_stash = Package::Stash->new($caller_class);
    my $exporter_stash = Package::Stash->new(__PACKAGE__);

    foreach my $import (@imports) {
        my $symbol = $exporter_stash->get_symbol('&'.$import);
        Carp::confess(sprintf('Symbol %s not defined in %s',$import,__PACKAGE__))
            unless defined $symbol;
        $caller_stash->add_symbol('&'.$import, $symbol);
    }

    return;
}

sub parameter {
    my ($meta,$name,@rest) = @_;
    return _handle_attribute($meta,$name,'parameter',@rest);
}

sub option {
    my ($meta,$name,@rest) = @_;
    return _handle_attribute($meta,$name,'option',@rest);
}

sub _handle_attribute {
    my ($meta,$name,$type,@rest) = @_;

    Moose->throw_error('Usage: option \'name\' => ( key => value, ... )')
        if @rest % 2 == 1;

    my %info;
    @info{qw(package file line)} = caller(2);

    my %attributes = ( definition_context => \%info, @rest );
    my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];

    # We are in a command class
    if (! $meta->isa('Moose::Meta::Role')
        && $meta->meta->does_role('MooseX::App::Meta::Role::Class::Command')) {

        # Get required extra traits for this class on first attrubute
        unless ($meta->has_app_attribute_metaroles) {
            # Find MooseX::App::Meta::Role::Class::Base in ISA
            foreach my $parent ($meta->linearized_isa) {
                if ($parent->meta->does_role('MooseX::App::Meta::Role::Class::Base')) {
                    $meta->app_attribute_metaroles([]);
                    last;
                }
            }
            # Apply missing meta roles if required to do so
            unless ($meta->has_app_attribute_metaroles) {
                my @extra_classes;
                my $name = $meta->name;
                foreach my $class (keys %PLUGIN_SPEC) {
                    my @commands = $class->meta->command_classes;
                    if (first { $name eq $_ } @commands) {
                        my $attribute_metaclass = $class->meta->attribute_metaclass;
                        push @extra_classes,
                            map { $_->name }
                            grep { $_->name ne 'MooseX::App::Meta::Role::Attribute::Option' }
                            grep { ! $_->isa('Moose::Meta::Role::Composite')  }
                            map {
                                $_->isa('Moose::Meta::Role::Composite') ?
                                $_->calculate_all_roles : $_
                            }
                            $attribute_metaclass->meta->calculate_all_roles_with_inheritance;
                    }
                }

                $meta->app_attribute_metaroles_add(@extra_classes);
            }
        }

        $attributes{traits} ||= [];
        push(@{$attributes{traits}},$meta->app_attribute_metaroles_uniq);
    }

    $attributes{'cmd_type'} = $type;
    # Loop all attributes and check attribute traits
    foreach my $attr (@$attrs) {
        my %local_attributes = %attributes;
        if ($attr =~ m/^\+(.+)/) {
            my $meta_attribute = $meta->find_attribute_by_name($1);
            unless ($meta_attribute->does('MooseX::App::Meta::Role::Attribute::Option')) {
                $local_attributes{traits} ||= [];
                push @{$local_attributes{traits}},'MooseX::App::Meta::Role::Attribute::Option'
                    unless (first { $_ eq 'AppOption' || $_ eq 'MooseX::App::Meta::Role::Attribute::Option' }
                        @{$local_attributes{traits}});
            }
        }

        $meta->add_attribute($attr, %local_attributes);
    }

    return;
}

sub app_prefer_commandline($) {
    my ( $meta, $value ) = @_;
    return $meta->app_prefer_commandline($value);
}

sub app_strict($) {
    my ( $meta, $value ) = @_;
    return $meta->app_strict($value);
}

sub app_fuzzy($) {
    my ( $meta, $value ) = @_;
    return $meta->app_fuzzy($value);
}

sub app_permute($) {
    my ( $meta, $value ) = @_;
    return $meta->app_permute($value);
}

sub app_base($) {
    my ( $meta, $name ) = @_;
    return $meta->app_base($name);
}

sub process_plugins {
    my ($self,$caller_class,@plugins) = @_;

    # Loop all requested plugins
    my @plugin_classes;
    foreach my $plugin (@plugins) {
        my $plugin_class = 'MooseX::App::Plugin::'.$plugin;

        # TODO eval plugin class
        Class::Load::load_class($plugin_class);

        push (@plugin_classes,$plugin_class);
    }

    # Store plugin spec
    $PLUGIN_SPEC{$caller_class} = \@plugin_classes;
    return;
}

sub process_init_meta {
    my ($self,%args) = @_;

    Moose->init_meta( %args );

    my $plugins         = $PLUGIN_SPEC{$args{for_class}} || [];
    my $apply_metaroles = delete $args{metaroles} || {};
    my $apply_roles     = delete $args{roles} || [];

    # Add plugin roles
    foreach my $plugin (@$plugins) {
        push(@{$apply_roles},$plugin,{ -excludes => [ 'plugin_metaroles' ] } )
    }

    # Add common role
    push(@{$apply_roles},'MooseX::App::Role::Common')
        unless first { $_ eq 'MooseX::App::Role::Common' } @{$apply_roles};

    # Process all plugins in the given order
    foreach my $plugin_class (@{$plugins}) {
        if ($plugin_class->can('plugin_metaroles')) {
            my ($metaroles) = $plugin_class->plugin_metaroles($args{for_class});
            if (ref $metaroles eq 'HASH') {
                foreach my $type (keys %$metaroles) {
                    $apply_metaroles->{$type} ||= [];
                    push (@{$apply_metaroles->{$type}},@{$metaroles->{$type}});
                }
            }
        }
    }

    # Add meta roles
    Moose::Util::MetaRole::apply_metaroles(
        for             => $args{for_class},
        class_metaroles => $apply_metaroles
    );

    # Add class roles
    Moose::Util::apply_all_roles($args{for_class},@{$apply_roles});

    # Init plugins
    foreach my $plugin_class (@{$plugins}) {
        if ($plugin_class->can('init_plugin')) {
            $plugin_class->init_plugin($args{for_class});
        }
    }

    # Return meta
    my $meta = $args{for_class}->meta;

    return $meta;
}

sub command_short_description($) {
    my ( $meta, $description ) = @_;
    return $meta->command_short_description($description);
}

sub command_long_description($) {
    my ( $meta, $description ) = @_;
    return $meta->command_long_description($description);
}

sub command_usage($) {
    my ( $meta, $usage ) = @_;
    return $meta->command_usage($usage);
}

*app_description    = \&command_long_description;
*app_usage          = \&command_usage;

sub command_strict($) {
    my ( $meta, $value ) = @_;
    return $meta->command_strict($value);
}

1;