File Coverage

blib/lib/Data/Unixish.pm

Criterion	Covered	Total	%
statement	137	148	92.5
branch	52	66	78.7
condition			n/a
subroutine	31	34	91.1
pod	21	21	100.0
total	241	269	89.5

package Data::Unixish;

our $DATE = '2019-01-06'; # DATE
our $VERSION = '1.570'; # VERSION

use 5.010001;
use strict;
use warnings;

use Module::Load;
use Package::Util::Lite qw(package_exists);

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK =
    qw(
          aduxa cduxa fduxa lduxa
          aduxc cduxc fduxc lduxc
          aduxf cduxf fduxf lduxf
          aduxl cduxl fduxl lduxl

          siduxs
          aiduxa aiduxl
          liduxa liduxl
  );
our %EXPORT_TAGS = (
    all => [
        qw/
              aduxa cduxa fduxa lduxa
              aduxc cduxc fduxc lduxc
              aduxf cduxf fduxf lduxf
              aduxl cduxl fduxl lduxl

              siduxs
              aiduxa aiduxl
              liduxa liduxl
          /],
);

sub _dux {
    my $accepts = shift;
    my $returns = shift;

    my $func = shift;

    my %args;

    my ($icallback, $ocallback);
    if ($accepts eq 'c') {
        $icallback = shift;
    }
    if ($returns eq 'c') {
        $ocallback = shift;
    }

    if ($accepts eq 'f') {
        require Tie::File;
        my @in;
        tie @in, "Tie::File", @_;
        $args{in} = \@in;
    } elsif ($accepts eq 'c') {
        require Tie::Simple;
        my @in;
        my @els;
        my $elcount = 0;
        tie(@in, "Tie::Simple", undef,
            FETCHSIZE => sub {
                my $data = shift; # from Tie::Simple
                my @res = $icallback->();
                $elcount += @res;
                push @els, @res;
                #say "D: res=[".join(",", @res), "], elcount=$elcount";
                $elcount;
            },
            FETCH => sub {
                my $data = shift; # from Tie::Simple
                shift @els;
            }
        );
        $args{in} = \@in;
    } elsif ($accepts eq 'l') {
        $args{in} = \@_;
    } elsif ($accepts eq 'a') {
        $args{in} = $_[0];
    } else {
        die "Invalid accepts, must be a|c|f|l";
    }

    if (ref($func) eq 'ARRAY') {
        $args{$_} = $func->[1]{$_} for grep {/\A\w+\z/} keys %{$func->[1]};
        $func = $func->[0];
    }

    my $pkg = "Data::Unixish::$func";
    load $pkg unless package_exists($pkg);
    my $funcleaf = $func; $funcleaf =~ s/.+:://;
    my $funcname = "Data::Unixish::$func\::$funcleaf";
    die "Subroutine &$funcname not defined" unless defined &$funcname;

    my @out;
    my $kidfh;
    my $pid;
    if ($returns eq 'c') {
        require Tie::Simple;
        tie @out, "Tie::Simple", undef,
            PUSH => sub {
                my $data = shift; # from Tie::Simple
                $ocallback->($_) for @_;
            };
        $args{out} = \@out;
    } elsif ($returns eq 'f') {
        require Tie::Simple;
        tie @out, "Tie::Simple", undef,
            PUSH => sub {
                my $data = shift; # from Tie::Simple
                for my $item (@_) {
                    $item .= "\n" unless $item =~ /\n\z/;
                    print STDOUT $item;
                }
            };
        $args{out} = \@out;
        $pid = open $kidfh, "-|";
        defined $pid or die "Can't fork: $!";
    } else {
        $args{out} = \@out;
    }

    unless ($pid) {
        no strict 'refs';
        my $res = $funcname->(%args);
        die "Dux function $funcname failed: $res->[0] - $res->[1]"
            unless $res->[0] == 200;
    }

    if ($returns eq 'l') {
        if (wantarray) {
            return @out;
        } else {
            return $out[0];
        }
    } elsif ($returns eq 'a') {
        return \@out;
    } elsif ($returns eq 'c') {
        return;
    } elsif ($returns eq 'f') {
        if ($pid) {
            return $kidfh;
        } else {
            exit;
        }
    } else {
        die "Invalid returns, must be a|c|f|l";
    }
}

sub aduxa { _dux('a', 'a', @_) }
sub cduxa { _dux('c', 'a', @_) }
sub fduxa { _dux('f', 'a', @_) }
sub lduxa { _dux('l', 'a', @_) }

sub aduxc { _dux('a', 'c', @_) }
sub cduxc { _dux('c', 'c', @_) }
sub fduxc { _dux('f', 'c', @_) }
sub lduxc { _dux('l', 'c', @_) }

sub aduxf { _dux('a', 'f', @_) }
sub cduxf { _dux('c', 'f', @_) }
sub fduxf { _dux('f', 'f', @_) }
sub lduxf { _dux('l', 'f', @_) }

sub aduxl { _dux('a', 'l', @_) }
sub cduxl { _dux('c', 'l', @_) }
sub fduxl { _dux('f', 'l', @_) }
sub lduxl { _dux('l', 'l', @_) }

sub _idux {
    my $accepts = shift;
    my $returns = shift;

    my $func = shift;

    my %args;
    my @items;

    if ($accepts eq 's') {
        @items = ($_[0]);
    } elsif ($accepts eq 'a') {
        @items = @{ $_[0] };
    } elsif ($accepts eq 'l') {
        @items = @_;
    } else {
        die "Invalid accepts, must be a|l|s";
    }

    if (ref($func) eq 'ARRAY') {
        $args{$_} = $func->[1]{$_} for keys %{$func->[1]};
        $func = $func->[0];
    }

    my $pkg = "Data::Unixish::$func";
    load $pkg unless package_exists($pkg);
    my $funcleaf = $func; $funcleaf =~ s/.+:://;
    my $funcname_i = "Data::Unixish::$func\::_${funcleaf}_item";
    die "Subroutine &$funcname_i not defined" unless defined &$funcname_i;
    my $funcname_b = "Data::Unixish::$func\::_${funcleaf}_begin";
    my $funcname_e = "Data::Unixish::$func\::_${funcleaf}_end";

    my @res;
    {
        no strict 'refs';
        my @bres; @bres = $funcname_b->(\%args) if defined &$funcname_b;
        for (@items) {
            push @res, $funcname_i->($_, \%args);
        }
        $funcname_e->(\%args, @bres) if defined &$funcname_e;
    }

    if ($returns eq 's') {
        return $res[0];
    } elsif ($returns eq 'l') {
        if (wantarray) {
            return @res;
        } else {
            return $res[0];
        }
    } elsif ($returns eq 'a') {
        return \@res;
    } else {
        die "Invalid returns, must be a|l|s";
    }
}

sub siduxs { _idux('s', 's', @_) }

sub aiduxa { _idux('a', 'a', @_) }
sub aiduxl { _idux('a', 'l', @_) }

sub liduxa { _idux('l', 'a', @_) }
sub liduxl { _idux('l', 'l', @_) }

1;
# ABSTRACT: Implementation for Unixish, a data transformation framework

__END__