File Coverage

blib/lib/Repl/Loop.pm

Criterion	Covered	Total	%
statement	18	83	21.6
branch	0	18	0.0
condition	0	8	0.0
subroutine	6	17	35.2
pod	1	11	9.0
total	25	137	18.2

package Repl::Loop;

our $VERSION = '1.00';

use strict;
use warnings;

use Repl::Core::Parser;
use Repl::Core::Eval;

use constant PROMPT_NORMAL => "> ";
use constant PROMPT_CONTINUE => "+ > ";

sub new
{
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;

    my $self= {};
    $self->{PARSER} = new Repl::Core::Parser();
    $self->{EVAL} = new Repl::Core::Eval();
    $self->{STOPREQUESTED} = 0;
    $self->{PROMPT} = PROMPT_NORMAL;
    $self->{CURRCMD} = "";
    return bless $self, $class;
}

sub start
{
    my $self = shift;
    while(!$self->{STOPREQUESTED})
    {
        print $self->{PROMPT};
        my $line =  || '';
        $self->handleLine($line);
    }
    $self->{STOPREQUESTED} = 0;
}

sub stop
{
    my $self = shift;
    $self->{STOPREQUESTED} = 1;
}

sub handleLine
{
    my $self = shift;
    my $line = shift;

    return if(!$line || $line =~ /^\s*$/);
    if($line =~ /\s*break\s*/i)
    {
        $self->recover();
        print "Canceling the command.\n";
        return;
    }

    if($line =~ /^(.+)\\$/)
    {
        # The line ends with a backslash (line continuation).
        $self->{CURRCMD} = $self->{CURRCMD} . $1;
        $self->{PROMPT} = PROMPT_CONTINUE;
    }
    else
    {
        my $expr = $self->{CURRCMD} . $line;
        $self->{CURRCMD} = $expr;

        if(!($expr =~ /\A\s*\(.+\)\s*\Z/s ))
        {
            $expr = "(" . $expr . ")";
        }

        my $parsed = $self->{PARSER}->parseString($expr);
        if(ref($parsed) eq "ARRAY")
        {
            $self->recover();
            eval {$self->{EVAL}->evalExpr($parsed)};
            print cutat($@) if($@);
        }
        elsif (ref($parsed) eq "Repl::Core::Token")
        {
            if($parsed->isEof())
            {
                $self->{PROMPT} = PROMPT_CONTINUE;
            }
            else
            {
                print $parsed->getValue() . "\n";
                $self->recover();
            }
        }
        else
        {
            $self->recover();
        }
    }
}

# Ordinary function, not a method.
# Cut of the "at  ." part of the error message.
sub cutat
{
    my $msg = shift;
    # Note the 's' regexp option to allow . to match newlines.
    if($msg =~ /\A(.*) at .+ line .*\Z/s)
    {
         # Cut of the "at  line dddd." part.
         # Because it will always point to this location here.
        $msg = $1 . "\n";
    }
    return $msg;
}

sub recover
{
    my $self = shift;
    $self->{CURRCMD} = "";
    $self->{PROMPT} = PROMPT_NORMAL;
}

# Two parameters:
# - A name
# - A command instance.
sub registerCommand
{
    my $self = shift;
    my $name = shift;
    my $cmd = shift;
    $self->{EVAL}->registerCommand($name, $cmd);
}

# Two parameters:
# - A name
# - A command instance.
sub registerMacro
{
    my $self = shift;
    my $name = shift;
    my $cmd = shift;
    $self->{EVAL}->{MACREPO}->registerMacro($name, $cmd);
}

# One parameter
# An expression that will be evaluated in the repl.
# Can be useful to add pre-defined functions to the eval.
# Single string argument.
sub eval
{
    my $self = shift;
    my $expr = shift;

    return $self->{EVAL}->evalExpr($self->{PARSER}->parseString($expr));
}

# Single parsed expression argument.
sub evalExpr
{
    my $self = shift;
    my $expr = shift;

    return $self->{EVAL}->evalExpr($expr);
}

# Get the internal eval.
sub getEval
{
    my $self = shift;
    return $self->{EVAL};
}

1;

__END__