package SimpleLexer;
use strict;
use warnings;
our $VERSION = 1.0;
# Generate a new lexical analyzer from the factory.
sub get_engine {
my ( $this, $lexer, $init_state ) = @_;
my $class = ref $this || $this;
my $self = {
STATE => ['DEFAULT'],
LEXER => $lexer,
};
$self->{STATE} = [$init_state] if $init_state;
return bless $self, $class;
}
# Lex the input.
sub lex {
my ( $self, $text ) = @_;
my $lexer = $self->{LEXER};
FOUND_LEX_AGAIN: {
for my $lex ( @{ $lexer->{ $self->{STATE}[-1] } } ) {
my ( $regex, $action ) = @$lex;
if ( $text =~ /\G$regex/gc ) {
$action->($1||$text, $self);
redo FOUND_LEX_AGAIN;
}
}
}
}
sub begin_state {
my ( $self, $state ) = @_;
push @{$self->{STATE}}, $state;
}
sub end_state {
my $self = shift;
pop @{$self->{STATE}};
}
### Standalone ###
sub bold_begin {
my ( $arg, $lexer ) = @_;
print "BOLD ";
$lexer->begin_state('bold');
}
sub bold_end {
my ( $arg, $lexer ) = @_;
print " NO BOLD";
$lexer->end_state;
}
sub main {
# Our lexer
my $lexer = {
DEFAULT => [
[ qr//, \&bold_begin ],
[ qr//, sub { $_[1]->begin_state('uppercase') } ],
[ qr/(.)/s, sub { print $1 } ], # echo
#[ qr/./s, sub { } ], # no echo
],
bold => [
[ qr{}, \&bold_end ],
[ qr//, sub { $_[1]->begin_state('uppercase') } ],
[ qr/(.)/s, sub { print $1 } ], # echo
],
uppercase => [
[ qr{}, sub { $_[1]->end_state } ],
[ qr/(.)/s, sub { print "\U$1" } ], # echo
],
};
# Usage
if ( scalar @ARGV < 0 ) {
print "Usage: $0\n";
exit(1);
}
my $engine = get_engine( __PACKAGE__, $lexer );
$engine->lex("This is a nifty uppercase test to see what this thing can do.\n");
}
main(@ARGV) unless caller;
my $package = __PACKAGE__;