File Coverage

blib/lib/App/Task.pm

Criterion	Covered	Total	%
statement	88	104	84.6
branch	26	40	65.0
condition	3	3	100.0
subroutine	10	14	71.4
pod	1	2	50.0
total	128	163	78.5

package App::Task;

use strict;
use warnings;

our $lastprintchar;
our $VERSION = '0.01';
our $depth   = 0;
our $level   = 0;

package App::Task::Tie {
    require Tie::Handle;
    our @ISA = ('Tie::Handle');

    sub FILENO {
        my ($tie) = @_;
        return fileno( $tie->{orig} );
    }

    sub WRITE {
        my ( $tie, $buf, $len, $offset ) = @_;
        print substr $buf, $offset, $len;

        return 1;
    }

    sub PRINT {
        my ( $tie, @args ) = @_;

        ($lastprintchar) = substr( $args[-1], -1, 1 );
        chomp( $args[-1] );
        my $i = App::Task::indent();

        # print { $tie->{orig} } "DEBUG: -$App::Task::depth-\n";
        # use Data::Dumper;print { $tie->{orig} } Dumper({ $App::Task::depth => \@args});
        print { $tie->{orig} } map { my $p = $_; $p =~ s/\n/\n$i/msg; "$i$p" } @args;
        print { $tie->{orig} } "\n" if $lastprintchar eq "\n";

        return 1;
    }

    sub PRINTF {
        my ( $tie, $pattern, @args ) = @_;

        ($lastprintchar) = substr( $pattern, -1, 1 );
        chomp($pattern);
        my $i = App::Task::indent();

        my $new = sprintf( "$i$pattern", @args );
        if ( substr( $new, -1, 1 ) eq "\n" ) {
            chomp($new);
            $lastprintchar = "\n";
        }
        $new =~ s/\n/\n$i/msg;
        print { $tie->{orig} } $new;
        print { $tie->{orig} } "\n" if $lastprintchar eq "\n";

        return 1;
    }

    sub TIEHANDLE { my ( $self, $orig ) = @_; bless { orig => $orig }, $self }
};

sub import {
    no strict 'refs';    ## no critic
    *{ caller() . '::task' } = \&task;
}

sub indent {
    warn "indent() called outside of run()\n" if $depth < 0;
    return "" if $depth <= 0;
    return "    " x $depth;
}

our $steps      = {};
our $prev_depth = 1;

sub _sys {
    my @cmd = @_;

    my $rv = system(@cmd) ? 0 : 1;    # TODO: indent **line at a time** i.e. not run it all and dump it all at once
    print "\n";

    return $rv;
}

sub task($$) {
    my ( $msg, $code, $cmdhr ) = @_;
    chomp($msg);

    local *STDOUT = *STDOUT;
    local *STDERR = *STDERR;
    open( local *ORIGOUT, ">&", \*STDOUT );
    open( local *ORIGERR, ">&", \*STDERR );

    # close STDOUT;
    # close STDERR;

    ORIGOUT->autoflush();
    ORIGERR->autoflush();
    my $o = tie( *STDOUT, __PACKAGE__ . "::Tie", \*ORIGOUT );
    my $e = tie( *STDERR, __PACKAGE__ . "::Tie", \*ORIGERR );

    my $task = $code;
    my $type = ref($code);
    if ( $type eq 'ARRAY' ) {
        $task = $cmdhr->{fatal} ? sub { _sys( @{$code} ) or die "`@{$code}` did not exit cleanly: $?\n" } : sub { _sys( @{$code} ) };
    }
    elsif ( !$type ) {
        $task = $cmdhr->{fatal} ? sub { _sys($code) or die "`$code` did not exit cleanly: $?\n" } : sub { _sys($code) };
    }

    my $cur_depth = $depth;
    local $depth = $depth + 1;
    local $level = $level + 1;

    $steps->{$depth} = defined $steps->{$depth} ? $steps->{$depth} + 1 : 1;

    if ( $prev_depth > $cur_depth ) {
        for my $k ( keys %{$steps} ) {
            delete $steps->{$k} if $k > $depth;
        }
    }

    $prev_depth = $depth;

    my $pre = $steps->{$depth} ? "[$level.$steps->{$depth}]" : "[$level]";

    {

        local $depth = $depth - 1;
        if ( !defined $lastprintchar || $lastprintchar ne "\n" ) {
            local $depth = 0;
            print "\n";
        }
        print "➜➜➜➜ $pre $msg …\n";
    }

    my $ok = $task->();

    {
        local $depth = $depth - 1;
        if ( $lastprintchar ne "\n" ) {
            local $depth = 0;
            print "\n";
        }

        if ($ok) {
            print " … $pre done ($msg).\n\n";
        }
        else {
            warn " … $pre failed ($msg).\n\n";
        }
    }

    if ( $depth < 2 ) {
        undef $o;
        untie *STDOUT;
        undef $e;
        untie *STDERR;
    }

    return $ok;
}

1;

__END__