File Coverage

blib/lib/IPC/PrettyPipe/Arg.pm

Criterion	Covered	Total	%
statement	42	46	91.3
branch	11	14	78.5
condition	6	12	50.0
subroutine	13	14	92.8
pod	6	7	85.7
total	78	93	83.8

package IPC::PrettyPipe::Arg;

# ABSTRACT: An argument to an IPC::PrettyPipe::Cmd command

use Carp;

use String::ShellQuote;

use Types::Standard qw[ Str ];
use IPC::PrettyPipe::Arg::Format;

use Moo;

our $VERSION = '0.13';

has name => (
    is       => 'ro',
    isa      => Str,
    required => 1,
);

has value => (
    is        => 'rwp',
    isa       => Str,
    predicate => 1,
);

use namespace::clean;


BEGIN {

    IPC::PrettyPipe::Arg::Format->shadow_attrs;

}

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


shadowable_attrs( 'fmt',
    values %{ IPC::PrettyPipe::Arg::Format->shadowed_attrs } );

with 'IPC::PrettyPipe::Queue::Element';

has fmt => (
    is      => 'ro',
    lazy    => 1,
    handles => [ keys %{ IPC::PrettyPipe::Arg::Format->shadowed_attrs } ],
    default => sub {
        IPC::PrettyPipe::Arg::Format->new_from_attrs( shift );
    },
);






# accept full attribute interface, or
#  new( name );
#  new( [ name, value ] );

sub BUILDARGS {

    my $class = shift;

    if ( @_ == 1 ) {

        return $_[0] if 'HASH' eq ref( $_[0] );

        return { name => $_[0][0], value => $_[0][1] }
          if 'ARRAY' eq ref( $_[0] ) && @{ $_[0] } == 2;

        return { name => $_[0] };

    }

    return {@_};
}

sub quoted_name { shell_quote( $_[0]->name ) }

sub quoted_value { shell_quote( $_[0]->value ) }


# for render templates
sub has_blank_value {

    return $_[0]->has_value && $_[0]->value eq '';

}

sub render {

    my $self = shift;

    my $fmt = $self->fmt;

    my $name = ( $fmt->has_pfx ? $fmt->pfx : '' ) . $self->name;

    if ( $self->has_value ) {

        if ( $fmt->has_sep ) {

            return join( '', $name, $fmt->sep, $self->value );

        }
        else {

            return $name, $self->value;
        }
    }

    else {

        return $name;
    }

}

sub valmatch {

    my $self    = shift;
    my $pattern = shift;

    return $self->has_value && $self->value =~ /$pattern/;
}

sub valsubst {

    my $self = shift;

    my ( $pattern, $rep ) = @_;

    if ( $self->has_value && ( my $value = $self->value ) =~ s/$pattern/$rep/ )
    {

        $self->_set_value( $value );

        return 1;

    }

    return 0;
}

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__