File Coverage

blib/lib/Mite/App/Command/exec.pm

Criterion	Covered	Total	%
statement	12	46	26.0
branch	0	16	0.0
condition			n/a
subroutine	5	6	83.3
pod	0	2	0.0
total	17	70	24.2

use 5.010001;
use strict;
use warnings;

use Mite::Miteception -all;
extends qw(Mite::App::Command);

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.011000';

    return "Compile the project in memory and run a script.";
}

around _build_kingpin_command => sub {
    my ( $next, $self, @args ) = @_;

    my $command = $self->$next( @args );
    $command->flag( 'oneliner', 'Script is a oneliner, not a filename.' )->short( 'e' )->bool;
    $command->arg( 'script', 'Script to run.' )->file;
    $command->arg( 'args', 'Arguments to pass to script.' )->string_list;

    return $command;
};

    my $self = shift;

    return 0 if $self->should_exit_quietly;

    my $oneliner = $self->kingpin_command->flags->get( 'oneliner' )->value;
    my $script   = $self->kingpin_command->args->get( 'script' )->value;
    my $args     = $self->kingpin_command->args->get( 'args' )->value;

    unless ( defined $script ) {
        printf STDERR "%s: error: expected oneliner or script, try --help\n",
            $self->kingpin_command->parent->name;
        return 1;
    }

    my $project = $self->project;
    $project->load_directory;

    for my $source ( values %{ $project->sources } ) {
        local $@;
        eval( $source->compile ) or die $@;
    }

    {
        local @ARGV = @{ $args || [] };
        if ( $oneliner ) {
            local $@;
            my $r = eval "$script; 1";
            if ( $r ) {
                return 0;
            }
            else {
                warn "$@\n";
                return 1;
            }
        }
        else {
            if ( not $script->exists ) {
                printf STDERR "%s: error: %s does not exist, try --help\n",
                    $self->kingpin_command->parent->name, $script;
                return 1;
            }
            local $@;
            do $script;
            if ( $@ ) {
                warn "$@\n";
                return 1;
            }
            return 0;
        }
    }

    return 0;
}

1;