view release on metacpan or  search on metacpan

lib/App/RoboBot/Parser.pm  view on Meta::CPAN

package App::RoboBot::Parser;
$App::RoboBot::Parser::VERSION = '4.004';
use v5.20;

use namespace::autoclean;

use Moose;
use MooseX::ClassAttribute;
use MooseX::SetOnce;

use App::RoboBot::TypeFactory;

use Scalar::Util qw( looks_like_number );

has 'bot' => (
    is       => 'ro',
    isa      => 'App::RoboBot',
    required => 1,
);

has 'err' => (
    is        => 'rw',
    isa       => 'Str',
    predicate => 'has_err',
    clearer   => 'clear_err',
);

has 'text' => (
    is        => 'rw',
    isa       => 'Str',
    predicate => 'has_text',
    clearer   => 'clear_text',
);

has '_pos' => (
    is      => 'rw',
    isa     => 'ArrayRef[Int]',
    default => sub { [0] },
);

has '_line' => (
    is      => 'rw',
    isa     => 'ArrayRef[Int]',
    default => sub { [1] },
);

has '_col' => (
    is      => 'rw',
    isa     => 'ArrayRef[Int]',
    default => sub { [1] },
);

has '_chr' => (
    is      => 'rw',
    isa     => 'ArrayRef[Str]',
    default => sub { [] },
);

class_has 'tf' => (
    is     => 'rw',
    isa    => 'App::RoboBot::TypeFactory',
);

class_has 'macros' => (
    is      => 'rw',
    isa     => 'HashRef',
    default => sub { {} },
);

class_has 'log' => (
    is        => 'rw',
    predicate => 'has_logger',
);

lib/App/RoboBot/Parser.pm  view on Meta::CPAN

            $self->_step_back;
            last;
        } elsif (exists $escs{$c} && $chr_esc) {
            $el .= $escs{$c};
            $chr_esc = 0;
# TODO: If adding support for , shorthand operator (opposite of '), it needs to
#       to be checked here (along with ensuring we're at the first character in
#       this element), prior to the generic "whitespace" check (since commans
#       in between list elements are treated as whitespace).
        } elsif ($c =~ m{[\s,]}) {
            if ($in_str) {
                $el .= $c;
            } else {
                last;
            }
        } elsif ($c eq '\\') {
            if ($chr_esc) {
                $el .= $c;
                $chr_esc = 0;
            } else {
                $chr_esc = 1;
            }
        } elsif ($c eq "'" && length($el) == 0) {
            my $peek = $self->_peek_char;

            if ($peek =~ m/[\(\|\{\[]/) {
                my $form;

                my $opener = $self->_read_char;

                if ($opener eq '(') {
                    $form = $self->_read_list;
                } elsif ($opener eq '{') {
                    $form = $self->_read_map;
                } elsif ($opener eq '[') {
                    $form = $self->_read_vec;
                } elsif ($opener eq '|') {
                    $form = $self->_read_set;
                }

                $form->quoted(1);
                return $form;
            } else {
                $el = $self->_read_element;
                $el->quoted(1);
                return $el;
            }
        } else {
            $el .= $c;
        }
    }

    if ($in_str) {
        return;
    }

    if (defined $el && length($el) > 0) {
        if (substr($el, 0, 1) eq ':') {
            $self->log->debug(sprintf('Treating non-list element "%s" as Symbol.', $el));
            return $self->tf->build('Symbol', $el);
        } elsif (looks_like_number($el)) {
            $self->log->debug(sprintf('Treating non-list element "%s" as Number.', $el));
            return $self->tf->build('Number', $el);
        } elsif (exists $self->bot->commands->{lc($el)}) {
            $self->log->debug(sprintf('Treating non-list element "%s" as Function.', $el));
            return $self->tf->build('Function', $el);
        } elsif (exists $self->macros->{lc($el)}) {
            $self->log->debug(sprintf('Treating non-list element "%s" as Macro.', $el));
            return $self->tf->build('Macro', $el);
        } else {
            $self->log->debug(sprintf('Treating non-list element "%s" as String.', $el));
            return $self->tf->build('String', $el);
        }
    } else {
        $self->log->debug('Expected an element, but there turned out to be nothing to read.');
        return undef;
    }
}

sub _read_char {
    my ($self) = @_;

    return unless length($self->text) >= $self->_pos->[-1];
    my $c = substr($self->text, $self->_pos->[-1], 1);
    return unless defined $c;

    push(@{$self->_pos}, $self->_pos->[-1] + 1);

    if (scalar(@{$self->_chr}) > 0 && $self->_chr->[-1] eq "\n") {
        push(@{$self->_line}, $self->_line->[-1] + 1);
        push(@{$self->_col}, 1);
    } else {
        push(@{$self->_line}, $self->_line->[-1]);
        push(@{$self->_col},  $self->_col->[-1] + 1);
    }

    push(@{$self->_chr}, $c);

    return $c;
}

sub _peek_char {
    my ($self) = @_;

    my $c = $self->_read_char;
    $self->_step_back;
    return unless defined $c;

    return $c;
}

sub _step_back {
    my ($self) = @_;

    pop(@{$self->_pos});
    pop(@{$self->_line});
    pop(@{$self->_col});
    pop(@{$self->_chr});
}

1;