view release on metacpan or  search on metacpan

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

    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',
);

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

    $self->log($self->bot->logger('core.parser')) unless $self->has_logger;

    $self->log->debug('Initialized parser type factory.');

    $self->tf(App::RoboBot::TypeFactory->new( bot => $self->bot ));
}

sub parse {
    my ($self, $text) = @_;

    $self->log->debug(sprintf('Received parse request (%d bytes).', length($text)));

    return unless defined $text && !ref($text);
    return unless $text =~ m{^\s*\(.+\)\s*$}s;

    # Refresh the lookup table of all known macro names for symbol resolution.
    $self->log->debug('Refreshing lookup cross-network table of macros.');

    $self->macros({});
    foreach my $nid (keys %{$self->bot->macros}) {
        foreach my $macro (keys %{$self->bot->macros->{$nid}}) {
            $self->macros->{lc($macro)} = 1;
        }
    }

    $self->log->debug('Resetting parser cursor and state.');

    $self->clear_err;
    $self->text($text);
    $self->_pos([0]);
    $self->_line([1]);
    $self->_col([1]);
    $self->_chr([]);

    my $expr = [];

    while (my $l = $self->_read_list) {
        push(@{$expr}, $l);
    }

    # Return nothing if there were no valid expressions.
    return unless @{$expr} > 0;

    # Unwind any single-element arrayrefs until we have reached down to the
    # first list of valid forms (if there were any).
    while (ref($expr) eq 'ARRAY' && @{$expr} == 1) {
        $expr = $expr->[0];
    }

    # If we're still an arrayref and we got nuthin' inside, then there was no
    # valid form detected and we just return.
    return if ref($expr) eq 'ARRAY' && @{$expr} == 0;

    # If we're left with something that is not an arrayref, then it was a
    # single valid form and we should return it.
    return $expr unless ref($expr) eq 'ARRAY';

    # Otherwise, we're still an arrayref, but with multiple elements, which we
    # will wrap up in a list form and return.
    return $self->tf->build('List', $expr);
}

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

    return unless $self->has_err;
    return sprintf('%s at %d (line %d, col %d)',
        $self->err, $self->_pos->[-1], $self->_line->[-1], $self->_col->[-1]
    );
}

sub _read_list {
    my ($self, $terminator) = @_;

    $terminator //= ')';

    $self->log->debug(sprintf('Beginning list read with terminator %s.', $terminator));

    my $l = [];

    while (defined (my $c = $self->_read_char)) {
        if ($c eq $terminator) {
            if ($terminator eq ')') {
                if (@{$l} > 0 && ref($l->[0]) && $l->[0]->type eq 'Function') {
                    return $self->tf->build('Expression', $l);
                } elsif (@{$l} > 0 && ref($l->[0]) && $l->[0]->type eq 'Macro') {