view release on metacpan or  search on metacpan

lib/Bat/Interpreter.pm  view on Meta::CPAN

package Bat::Interpreter;

use utf8;

use 5.014;
use Moo;
use Types::Standard qw(ConsumerOf);
use App::BatParser 0.011;
use Carp;
use Data::Dumper;
use Bat::Interpreter::Delegate::FileStore::LocalFileSystem;
use Bat::Interpreter::Delegate::Executor::PartialDryRunner;
use Bat::Interpreter::Delegate::LineLogger::Silent;
use File::Glob;
use namespace::autoclean;

our $VERSION = '0.025';    # VERSION

# ABSTRACT: Pure perl interpreter for a small subset of bat/cmd files

has 'batfilestore' => (
    is      => 'rw',
    isa     => ConsumerOf ['Bat::Interpreter::Role::FileStore'],
    default => sub {
        Bat::Interpreter::Delegate::FileStore::LocalFileSystem->new;
    }
);

has 'executor' => (
    is      => 'rw',
    isa     => ConsumerOf ['Bat::Interpreter::Role::Executor'],
    default => sub {
        Bat::Interpreter::Delegate::Executor::PartialDryRunner->new;
    }
);

has 'linelogger' => (
    is      => 'rw',
    isa     => ConsumerOf ['Bat::Interpreter::Role::LineLogger'],
    default => sub {
        Bat::Interpreter::Delegate::LineLogger::Silent->new;
    }
);

sub run {
    my $self         = shift();
    my $filename     = shift();
    my $external_env = shift() // \%ENV;

    my $parser = App::BatParser->new;

    my $ensure_last_line_has_carriage_return = "\r\n";
    if ( $^O eq 'MSWin32' ) {
        $ensure_last_line_has_carriage_return = "\n";
    }

    my $parse_tree =
      $parser->parse( $self->batfilestore->get_contents($filename) . $ensure_last_line_has_carriage_return );
    if ($parse_tree) {
        my $lines = $parse_tree->{'File'}{'Lines'};

        my %environment = %$external_env;

        # Index file based on labels
        #Only for perl >= 5.020
        #my %line_from_label = List::AllUtils::pairmap { $b->{'Label'}{'Identifier'} => $a }
        #%{$lines}[ List::AllUtils::indexes { exists $_->{'Label'} } @$lines ];
        my %line_from_label;
        for ( my $i = 0; $i < scalar @$lines; $i++ ) {
            my $line = $lines->[$i];
            if ( exists $line->{'Label'} ) {
                $line_from_label{ $line->{'Label'}{'Identifier'} } = $i;
            }
        }
        $line_from_label{'EOF'} = scalar @$lines;