File Coverage

blib/lib/MooseX/App/Meta/Role/Class/Documentation.pm

Criterion	Covered	Total	%
statement	48	56	85.7
branch	9	14	64.2
condition	8	12	66.6
subroutine	14	16	87.5
pod	3	3	100.0
total	82	101	81.1

# ============================================================================
package MooseX::App::Meta::Role::Class::Documentation;
# ============================================================================

use utf8;
use 5.010;

use namespace::autoclean;
use Moose::Role;

use Pod::Elemental;
use Pod::Elemental::Selectors qw();
use Pod::Elemental::Transformer::Pod5;
use Pod::Elemental::Transformer::Nester;

has 'command_short_description' => (
    is          => 'rw',
    isa         => 'Maybe[Str]',
    lazy        => 1,
    builder     => '_build_command_short_description',
);

has 'command_long_description' => (
    is          => 'rw',
    isa         => 'Maybe[Str]',
    lazy        => 1,
    builder     => '_build_command_long_description',
);

has 'command_usage' => (
    is          => 'rw',
    isa         => 'Maybe[Str]',
    lazy        => 1,
    builder     => '_build_command_usage',
);

has 'command_strict' => (
    is          => 'rw',
    isa         => 'Bool',
    default     => sub {0},
);

sub command_short_description_predicate {
    my ($self) = @_;
    return $self->_command_pod_predicate('command_short_description');
}

sub _build_command_short_description {
    my ($self) = @_;
    my %pod = $self->_build_command_pod();
    return $pod{'command_short_description'}
        if defined $pod{'command_short_description'};
    return;
}

sub command_long_description_predicate {
    my ($self) = @_;
    return $self->_command_pod_predicate('command_long_description');
}

sub _build_command_long_description {
    my ($self) = @_;
    my %pod = $self->_build_command_pod();
    return $pod{'command_long_description'}
        if defined $pod{'command_long_description'};
    return;
}

sub command_usage_predicate {
    my ($self) = @_;
    return $self->_command_pod_predicate('command_usage');
}

sub _build_command_usage {
    my ($self) = @_;
    my %pod = $self->_build_command_pod();
    return $pod{'command_usage'}
        if defined $pod{'command_usage'};
    return;
}

sub _command_pod_predicate {
    my ($self,$field) = @_;

    my $attribute = $self->meta->find_attribute_by_name($field);

    unless ($attribute->has_value($self)) {
        $self->_build_command_pod($field);
    }

    my $value = $attribute->get_value($self);

    return (defined $value && $value ? 1:0);
}


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

    my %pod_raw = MooseX::App::Utils::parse_pod($self->name);

    my %pod = (
        command_usage               => ($pod_raw{SYNOPSIS} || $pod_raw{USAGE}),
        command_long_description    => ($pod_raw{DESCRIPTION} || $pod_raw{OVERVIEW}),
        command_short_description   => ($pod_raw{NAME} || $pod_raw{ABSTRACT}),
    );

    # Loop sections that need to be extracted from POD
    foreach my $key (keys %pod) {
        my $meta_attribute = $self->meta->find_attribute_by_name($key);
        next
            unless defined $meta_attribute;
        next
            if $meta_attribute->has_value($self);
        $meta_attribute->set_raw_value($self,$pod{$key});
    }

    return %pod;
}

#{
#    package Moose::Meta::Class::Custom::Trait::AppCommand;
#    sub register_implementation { return 'MooseX::App::Meta::Role::Class::Documentation' }
#}

1;

__END__

=pod

=encoding utf8

=head1 NAME

MooseX::App::Meta::Role::Class::Documentation - Meta class role for command classes

=head1 DESCRIPTION

This meta class role will automatically be applied to all command classes.
This documentation is only of interest if you intend to write plugins for
MooseX::App.

=head1 ACCESSORS

=head2 command_short_description

Read/set the short command description. Will be extracted from the Pod NAME
or ABSTRACT section if not set. Alternative this will be taken from the
DistZilla ABSTRACT tag.

=head2 command_long_description

Read/set the long command description. Will be extracted from the Pod
DESCRIPTION or OVERVIEW section if not set.

=head2 command_usage

Read/set the long command usage. Will be extracted from the Pod
SYNOPSIS or USAGE section if not set. If these Pod sections are not defined
the usage will be autogenerated.

=head2 command_short_description_predicate

Checks if command_short_description is available

=head2 command_long_description_predicate

Checks if command_long_description is available

=head2 command_usage_predicate

Checks if command_usage is available

=head2 command_strict

Read/set the strict command flag. If strict is enabled the command will
terminate with an error message if superfluous/unknown positional parameters
are supplied. If disabled all extra parameters will be copied to the
L<extra_argv> attribute.

The app_strict function in the app classes allows one to set this option
globally.

=head1 METHODS

=head2 _build_command_pod

Parses the Pod from the command class.

=cut