File Coverage

blib/lib/IPC/PrettyPipe/Format.pm

Criterion	Covered	Total	%
statement	40	43	93.0
branch	4	6	66.6
condition	1	3	33.3
subroutine	10	11	90.9
pod	4	4	100.0
total	59	67	88.0

package IPC::PrettyPipe::Format;

# ABSTRACT: Format role

## no critic (ProhibitAccessOfPrivateData)

use Try::Tiny;
use Module::Load;


use Moo::Role;
our $VERSION = '0.11'; # TRIAL

with 'MooX::Attributes::Shadow::Role';

requires 'copy_into';

use namespace::clean;

# IS THIS REALLY NEEDED?????  this will convert an attribute with a
# an undef value into a switch.
#
# undefined values are the same as not specifying a value at all
if ( 0 ) {
    around BUILDARGS => sub {

        my ( $orig, $class ) = ( shift, shift );

        my $attrs = $class->$orig( @_ );

        delete @{$attrs}{ grep { !defined $attrs->{$_} } keys %$attrs };

        return $attrs;
    };
}

sub _copy_attrs {

    my ( $from, $to ) = ( shift, shift );

    for my $attr ( @_ ) {


        next unless $from->${ \"has_$attr" };

        try {
            if ( defined( my $value = $from->$attr ) ) {

                $to->$attr( $value );

            }

            else {

                $to->${ \"clear_$attr" };

            }
        }
        catch {

            croak(
                "unable to copy into or clear attribute $attr in object of type ",
                ref $to,
                ": $_\n"
            );
        };

    }

    return;
}











sub copy_from {

    $_[1]->copy_into( $_[0] );

    return;
}









sub clone {

    my $class = ref( $_[0] );
    load $class;

    my $clone = $class->new;

    $_[0]->copy_into( $clone );

    return $clone;
}










sub new_from_attrs {

    my $class = shift;
    load $class;

    return $class->new( $class->xtract_attrs( @_ ) );
}













sub new_from_hash {

    my $contained = shift;
    my $hash      = pop;

    my $container = shift || caller();

    load $contained;

    my $shadowed = $contained->shadowed_attrs( $container );

    my %attr;
    while ( my ( $alias, $orig ) = each %{$shadowed} ) {

        $attr{$orig} = $hash->{$alias} if exists $hash->{$alias};

    }

    return $contained->new( \%attr );
}

1;

#
# This file is part of IPC-PrettyPipe
#
# This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__