view release on metacpan or  search on metacpan

lib/App/Cleo/Patra.pm  view on Meta::CPAN

}

#-----------------------------------------------------------------------------

sub run {
    my ($self, $input, $multiline) = @_;

    my $type = ref $input;
#    my @commands_raw = !$type ? read_file($commands_raw)
#        : $type eq 'SCALAR' ? split "\n",    ${$commands_raw}
##: $type eq 'SCALAR' and     $multiline ? split /^\$\s/m,${$commands_raw}
#            : $type eq 'ARRAY' ? @{$commands_raw}
#                : die "Unsupported type: $type";

    my @commands = ();
    if (!$type) {
        if ($multiline) {
            my $data = read_file($input);
            @commands = split /^\$\s/m, $data;
        }
        else {
            @commands = read_file($input);
        }
    }

    open my $fh, '|-', $self->{shell} or die $!;
    $self->{fh} = $fh;
    ReadMode('raw');
    local $| = 1;

    local $SIG{CHLD} = sub {
        print "Child shell exited!\n";
        ReadMode('restore');
        exit;
    };

    chomp @commands;
    @commands = grep { /^\s*[^\#;]\S+/ } @commands;
    @commands = grep { /.+/ } @commands if $multiline;

#    # squeeze multi line commands into one array slot (indicated by ~~~)
#    my @commands = ();
#    for (my $i=0; $i<@commands_raw; $i++) {
#        if ($commands_raw[$i] =~ /[~]{3}(.*)/ and $i != 0) {
#            $commands[@commands - 1] .= "\n$1";
#        }
#        else {
#            push @commands, $commands_raw[$i];
#        }
#    }

    my $continue_to_end = 0;

    CMD:
    for (my $i = 0; $i < @commands; $i++) {

        my $cmd = defined $commands[$i] ? $commands[$i] : die "no command $i";
        chomp $cmd;

        my $keep_going = $cmd =~ s/^\.\.\.//;
        my $run_in_background = $cmd =~ s/^!!!//;

        $self->do_cmd($cmd) and next CMD
            if $run_in_background;

        no warnings 'redundant';
        my $prompt_state = $self->{state};
        print sprintf $self->{$prompt_state}, $i;

        my @steps = split /%%%/, $cmd;
        while (my $step = shift @steps) {

            my $should_pause = !($keep_going || $continue_to_end);
            my  $key  = $should_pause ? ReadKey(0) : '';
            if ($key  =~ /^\d$/) {
                $key .= $1 while (ReadKey(0) =~ /^(\d)/);
            }
            print "\n" if $key =~ m/^[srp]|[0-9]+/;

            last CMD             if $key eq 'q';
            next CMD             if $key eq 's';
            redo CMD             if $key eq 'r';
            $i--, redo CMD       if $key eq 'p';
            $i = $key, redo CMD  if $key =~ /^\d+$/;
            $continue_to_end = 1 if $key eq 'c';

            $step .= ' ' if not @steps;
            my @chars = split '', $step;
            print and usleep $self->{delay} for @chars;
        }

        my $should_pause = !($keep_going || $continue_to_end);
        my  $key  = $should_pause ? ReadKey(0) : '';
        if ($key  =~ /^\d$/) {
            $key .= $1 while (ReadKey(0) =~ /^(\d)/);
        }
        print "\n";

        last CMD             if $key eq 'q';
        next CMD             if $key eq 's';
        redo CMD             if $key eq 'r';
        $i--, redo CMD       if $key eq 'p';
        $i = $key, redo CMD  if $key =~ /^\d+$/;
        $continue_to_end = 1 if $key eq 'c';

        $self->do_cmd($cmd);
    }

    ReadMode('restore');
    print "\n";

    return $self;
}

#-----------------------------------------------------------------------------

sub do_cmd {
    my ($self, $cmd) = @_;

    my $cmd_is_finished;
    local $SIG{ALRM} = sub {$cmd_is_finished = 1};

    $cmd =~ s/%%%//g;
    my $fh = $self->{fh};