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__;