view release on metacpan or  search on metacpan

lib/App/Task.pm  view on Meta::CPAN

package App::Task;

use strict;
use warnings;

our $VERSION = '0.03';

use IPC::Open3::Utils ();
use Text::OutputFilter;
use IO::Interactive::Tiny ();

BEGIN {
    no warnings "redefine";
    require Tie::Handle::Base;
    *Text::OutputFilter::OPEN = \&Tie::Handle::Base::OPEN;

    my $of_print = \&Text::OutputFilter::PRINT;
    *Text::OutputFilter::PRINT = sub { $of_print->(@_); return 1 };
}

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

our $depth      = 0;
our $level      = 0;
our $steps      = {};
our $prev_depth = 1;

sub _nl { local $depth = 0; print "\n" }

sub _sys {
    my @cmd = @_;

    my $rv = IPC::Open3::Utils::run_cmd(
        @cmd,
        {
            autoflush         => { stdout => 1, stderr => 1 },
            carp_open3_errors => 1,
            close_stdin       => 1,
        }
    );

    return $rv;
}

sub _escape {
    my ( $str, $leave_slashes ) = @_;

    $str =~ s/\\/\\\\/g unless $leave_slashes;
    $str =~ s/\n/\\n/g;
    $str =~ s/\t/\\t/g;

    return $str;
}

sub _indent {
    my ($string) = @_;

    warn "_indent() called outside of task()\n" if $depth < 0;
    my $i = $depth <= 0 ? "" : "    " x $depth;

    $string =~ s/\n/\n$i/msg;
    return "$i$string";
}

sub tie_task {
    close ORIGOUT;
    close ORIGERR;
    open( *ORIGOUT, ">&", \*STDOUT );
    open( *ORIGERR, ">&", \*STDERR );

    ORIGOUT->autoflush();
    ORIGERR->autoflush();
    my $o = tie( *STDOUT, "Text::OutputFilter", 0, \*ORIGOUT, \&_indent );
    my $e = tie( *STDERR, "Text::OutputFilter", 0, \*ORIGERR, \&_indent );

    return ( $o, $e );
}

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

    local *STDOUT  = *STDOUT;
    local *STDERR  = *STDERR;
    local *ORIGOUT = *ORIGOUT;
    local *ORIGERR = *ORIGERR;

    my ( $o, $e ) = tie_task();

    my $task = $code;
    my $type = ref($code);
    if ( $type eq 'ARRAY' ) {
        my $disp = join " ", map {
            my $copy = "$_";
            $copy = _escape( $copy, 1 );
            if ( $copy =~ m/ / ) { $copy =~ s/'/\\'/g; $copy = "'$copy'" }
            $copy
        } @{$code};
        if ( $ENV{App_Task_DRYRUN} ) {
            $task = sub { print "(DRYRUN) ＞＿ $disp\n" };
        }
        else {
            $task = $cmdhr->{fatal} ? sub { _sys( @{$code} ) or die "`$disp` did not exit cleanly: $?\n" } : sub { _sys( @{$code} ) };
        }

    }
    elsif ( !$type ) {
        my $disp = _escape( $code, 0 );
        if ( $ENV{App_Task_DRYRUN} ) {
            $task = sub { print "(DRYRUN) ＞＿ $disp\n" };
        }
        else {
            $task = $cmdhr->{fatal} ? sub { _sys($code) or die "`$disp` 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]";

    my $fmt_pre = IO::Interactive::Tiny::is_interactive() ? "\e[1;107;30m" : "";    # ANSI code to highlight the heading/footing
    my $fmt_pst = $fmt_pre ? "\e[0m" : "";

    {
        local $depth = $depth - 1;
        print "$fmt_pre➜➜➜➜ $pre $msg …$fmt_pst\n";
    }

    my $ok = $task->();

    {
        local $depth = $depth - 1;
        if ($ok) {
            print "$fmt_pre … $pre done ($msg).$fmt_pst\n";
        }
        else {
            warn "$fmt_pre … $pre failed ($msg).$fmt_pst\n";
        }
    }

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

    return $ok;
}

1;

__END__

=encoding utf-8