File Coverage

blib/lib/MooX/Cmd/ChainedOptions/Base.pm

Criterion	Covered	Total	%
statement	15	15	100.0
branch	4	4	100.0
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	22	22	100.0

# --8<--8<--8<--8<--
#
# Copyright (C) 2015 Smithsonian Astrophysical Observatory
#
# This file is part of MooX-Cmd-ChainedOptions
#
# MooX-Cmd-ChainedOptions is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see .
#
# -->8-->8-->8-->8--

package MooX::Cmd::ChainedOptions::Base;

use Moo::Role;
use Scalar::Util qw[ blessed ];

has _parent => (
    is       => 'lazy',
    init_arg => undef,
    builder  => sub {

        my $class = blessed $_[0];

        # Find the element in command chain array which directly
        # precedes the element containing the current class.

        # There is a single array used for the command chain, and it
        # is populated by MooX::Cmd as it processes the command line.
        # This builder may be called for a class after MooX::Cmd has
        # added entries for the class' subcommands, so we can't simply
        # assume that the last element in the array is for this class.

        my $last;
        for ( reverse @{ $_[0]->command_chain } ) {
            next unless $last;
            return $_ if blessed $last eq $class;
        }
        continue { $last = $_ }

	require Carp;
        Carp::croak( "unable to determine parent in chain hierarchy\n" );
    },
);

1;

__END__