File Coverage

blib/lib/IPC/PrettyPipe/Stream/Utils.pm

Criterion	Covered	Total	%
statement	22	22	100.0
branch	8	8	100.0
condition	6	6	100.0
subroutine	5	5	100.0
pod	1	1	100.0
total	42	42	100.0

package IPC::PrettyPipe::Stream::Utils;

# ABSTRACT: support utilities for streams

use strict;
use warnings;

our $VERSION = '0.13';

use parent 'Exporter';

our @EXPORT_OK = qw[ parse_spec ];


sub parse_spec {

    my $op = shift;

    # parse stream operator; shell syntax (similarity to IPC::Run's
    # syntax is no coincidence)

    # for consistency, N is always the descriptor which needs to
    # be opened or dup'ed to. M is never touched.

    return {}
      unless $op =~ /^(?:
                 # <, N<
                 # >, N>
                 # >>, N>>

                   (?'redirect'
                       (?'N' \d+ (?!<<) )?  # don't match N<<
                       (?'Op'
                           (?: [<>]{1,2} )
                       )
                    )

                 # >&, &>
                 | (?'redirect_stdout_stderr'
                       (?'Op' >& | &> )
                   )

                 # N<&-
                 | (?'close'
                       (?'N'  \d+ )
                       (?'Op' <&  )
                       (?'M'  -   )
                    )

                 # M<&N
                 | (?'dup'
                       (?'M'  \d+ )
                       (?'Op' <&  )
                       (?'N'  \d+ )
                   )

                 # N>&M
                 | (?'dup'
                       (?'N'  \d+ )
                       (?'Op' >&  )
                       (?'M'  \d+ )
                   )

               )$/x
      ;

    # force a copy of the hash; it's magical and a simple return
    # of the elements doesn't work.
    my %opc = map { $_ => $+{$_} } grep { exists $+{$_} } qw[ N M Op ];

    ( $opc{type} )
      = grep { defined $+{$_} } qw[ redirect redirect_stdout_stderr close dup ];

    # fill in default value for N for stdin & stdout
    $opc{N} = substr( $opc{Op}, 0, 1 ) eq '<' ? 0 : 1
      if $+{redirect} && !defined $opc{N};

    $opc{param}++
      if $+{redirect} || $+{redirect_stdout_stderr};

    return \%opc;
}

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__