File Coverage

blib/lib/Math/SymbolicX/Calculator/Interface/Shell.pm

Criterion	Covered	Total	%
statement	21	106	19.8
branch	0	42	0.0
condition	0	13	0.0
subroutine	7	17	41.1
pod	6	6	100.0
total	34	184	18.4

package Math::SymbolicX::Calculator::Interface::Shell;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.02';

use Term::ReadLine;
use Params::Util qw/_INSTANCE/;
use Math::SymbolicX::Calculator;
use base 'Math::SymbolicX::Calculator::Interface';

# For convenience, we extend the Math::Symbolic parser.
# This will become the shortcut derive() => partial derivative.
$Math::Symbolic::Operator::Op_Symbols{derive} = Math::Symbolic::ExportConstants::U_P_DERIVATIVE;
$Math::Symbolic::Parser = Math::Symbolic::Parser->new();
$Math::Symbolic::Parser->Extend(<<'GRAMMAR');
    function_name: 'derive'
GRAMMAR

# Matches identifiers
my $Ident = $Math::SymbolicX::Calculator::Identifier_Regex;

=head1 NAME

Math::SymbolicX::Calculator::Interface::Shell - A Calculator Shell

=head1 SYNOPSIS

  # simplest form of usage:
  use Math::SymbolicX::Calculator::Interface::Shell;
  my $shell = Math::SymbolicX::Calculator::Interface::Shell->new();
  $shell->run();

=head1 DESCRIPTION

This module implements a shell interface to the Math::SymbolicX::Calculator.

=head1 METHODS

=cut


# defined or
sub _dor {
    foreach (@_) {
        return $_ if defined $_;
    }
    return(undef);
}


=head2 new

Returns a new shell application object. Call the C method on it
to run the application.

Optional parameters: (default in parenthesis)

  calc => a Math::SymbolicX::Calculator object to use
  input_handle => a file handle to read from (\*STDIN)
  prompt => the prompt string to use ('~> ')
  continued_prompt => prompt string to use for continued lines ('>> ')
  app_name => the name of the application ('Symbolic Calculator Shell')

=cut

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

    my %args = @_;

    my $self = {
        calc             => $args{calculator}
                            || Math::SymbolicX::Calculator->new(),
        input_handle     => $args{input_handle} || \*STDIN,
        prompt           => _dor($args{prompt}, '~> '),
        continued_prompt => _dor($args{continued_prompt}, '>> '),
        app_name         => _dor($args{app_name}, 'Symbolic Calculator Shell'),
    };
    bless $self => $class;

    $self->_setup_readline();

    return $self;
}

sub _setup_readline {
    my $self = shift;
    $self->{readline} = Term::ReadLine->new(
        $self->{app_name}, $self->{input_handle}, *STDOUT,
    );
    $self->{readline}->ornaments(0);
}


=head2 run

Runs the main loop of the shell.

=cut

sub run {
    my $self = shift;

    # FIXME refactor
    # Main Loop
    while (1) {
        # get a new expression.
        my $expr = $self->get_expression();

        return $self->exit_hook() if not defined $expr;

        my $cmd;
        # What type of command?
        if ($expr =~ /=~~?/) {
            $cmd = $self->_parse_transformation($expr);
        }
        elsif ($expr =~ /=/) {
            $cmd = $self->_parse_assignment($expr);
        }
        else {
            $cmd = $self->_parse_command($expr);
        }

        if (not defined $cmd) {
            next;
        }
        elsif (_INSTANCE($cmd, 'Math::SymbolicX::Calculator::Command')) {
            my @output = $self->calc->execute($cmd);
            $self->_generic_out(@output);
        }
        elsif (ref($cmd) eq 'ARRAY') {
            if ($cmd->[0] eq 'print') {
                $self->_generic_out(@{$cmd}[1..$#$cmd]);
            }
        }
        elsif ($cmd eq 'exit') {
            return $self->exit_hook();
        }
        else {

        }

    }

    return();
}

=head2 calc

Returns the Calculator object of this Shell.

=cut

sub calc {
    my $self = shift;
    return $self->{calc};
}

=head2 exit_hook

Call this before stopping the shell. It runs all cleanup actions
such as those needed for a possible persistance.

This method doesn't actually kill your script, but returns after
doing the cleanup.

=cut

sub exit_hook {
    my $self = shift;
    return();
}


=head2 error

Used to issue a warning to the user. First argument must be an error
message to display.

=cut

sub error {
    my $self = shift;
    my $message = shift;
    print "!!! $message\n";
}

=head2 get_expression

Reads a new expression from the input handle. An expression ends
in a semicolon followed by a newline.

Used internally by the run loop. Probably not that useful outside of
that.

Returns the expression or the empty list on error.

=cut

sub get_expression {
    my $self = shift;

    my $readline = $self->{readline};
    my $expr;
    while (1) {
        my $prompt = '';
        if (not defined $expr and defined $self->{prompt}) {
            $prompt = $self->{prompt}
        }
        else {
            $prompt = $self->{continued_prompt}
        }
        my $line = $readline->readline($prompt);
        return() if not defined $line;
        chomp $line;
        $line .= ' ';
        $expr .= $line;
        last if $line =~ /;\s*$/;
    }
    $expr =~ s/;\s*$//;
    return $expr;
}


=head2 _parse_command

Parses generic commands such as exit and print.

This might change. (Name and implementation)

First argument: Expression to parse.

FIXME: Document what this does or refactor

=cut

sub _parse_command {
    my $self = shift;
    my $expr = shift;

    if ($expr =~ /^\s*exit\s*$/i) {
        return 'exit';
    }
    elsif ($expr =~ /^\s*print\s+($Ident)\s*$/) {
        my $id = $1;
        return [
            'print', $id, "==", _dor($self->calc->stash($id), '/Undefined/')
        ];
    }
    elsif ($expr =~ /^\s*apply_deriv\s+($Ident)(?:\s*|\s+(\d+))$/) {
        my $level = $2||undef;
        my $id = $1;
        my $cmd = $self->calc->new_command(
            type => 'DerivativeApplication', symbol => $id,
            level => $level,
        );
        return $cmd;
    }
    elsif ($expr =~ /^\s*insert\s+($Ident|\*)\s+in\s+($Ident)\s*$/) {
        my $what = $1;
        my $where = $2;
        my $cmd = $self->calc->new_command(
            type => 'Insertion', symbol => $where,
            what => $what
        );
        return $cmd;
    }
    elsif ($expr =~ /^\s*$/) {
        return();
    }
    else {
        $self->error("Could not parse command '$expr'.");
        return();
    }

    die "Sanity check";
}

=head2 _generic_out

Generic output routine: Print Formulas and messages alike

FIXME: Subject to change and refactoring.

=cut

sub _generic_out {
    my $self = shift;
    my @out = @_;
    if (not @out) {
        print "\n";
        return();
    }

    my $str = join ' ',
        map {
            if (not defined) {
                "\n"
            }
            # insert special cases here...
            elsif (_INSTANCE($_, 'Math::Symbolic::Custom::Transformation')) {
                $_->to_string();
            }
            else {
                "$_"
            }
        } @out;

    $str .= "\n" if not $str =~ /\n$/;
    print $str;
    return(1);
}



1;
__END__