File Coverage

blib/lib/MooX/Attributes/Shadow/Role.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	6	6	100.0
condition	5	6	83.3
subroutine	8	8	100.0
pod	2	2	100.0
total	55	56	98.2

# --8<--8<--8<--8<--
#
# Copyright (C) 2012 Smithsonian Astrophysical Observatory
#
# This file is part of MooX-Attributes-Shadow
#
# MooX-Attributes-Shadow 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::Attributes::Shadow::Role;

use strict;

our $VERSION = '0.02';

use Moo::Role;

use MooX::Attributes::Shadow ':all';

## no critic (ProhibitSubroutinePrototypes)
sub shadowable_attrs (@) {

    my $attrs = [@_];

    ## no critic (ProhibitNoStrict)
    no strict 'refs';
    no warnings 'redefine';

    *{ caller() . '::shadowable_attrs' } = sub (@) { @{$attrs} };

    return;
}

sub new_from_attrs (@) {

    my $contained = shift;

    my $container = shift;

    # handle the following cases:
    # @args = ( \%options );
    # @args = ( \%options, %attr );
    # @args = ( \%options, \%attrs );
    # @args = ( %attr );

    my $options = {};
    my %attrs;

    if ( @_ == 1 ) {

	$options = shift;

    }

    elsif ( @_ == 2 && 'HASH' eq ref $_[0] && 'HASH' eq ref $_[1] ) {

	$options = shift;
	%attrs = %{ shift() };

    }

    elsif ( @_ % 2 ) {

	$options = shift;
	%attrs = @_;

    }

    else {

	%attrs = @_;

    }

    return $contained->new( $contained->xtract_attrs( $container, $options ), %attrs );
}

1;


__END__