1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 16:45:40 -04:00

First attempt at actually having an optimized command regexp

This commit is contained in:
Ryan Voots 2020-08-20 11:45:09 -04:00
parent 71563e71f6
commit 86943e8d05
2 changed files with 35 additions and 8 deletions

View file

@ -84,7 +84,9 @@ sub get_plugin {
return $_; return $_;
} }
if( $_->{aliases} ) { if ( $_->{alias_re} ) {
return $_ if $name =~ $_->{alias_re};
} elsif( $_->{aliases} ) {
for my $alias ( @{ $_->{aliases} } ) { for my $alias ( @{ $_->{aliases} } ) {
return $_ if $name eq $alias; return $_ if $name eq $alias;
} }
@ -221,8 +223,10 @@ sub _pre_build_plugin_chain {
if( $opts->{command} ) { if( $opts->{command} ) {
$commands->{ $plugin->{name} } = $plugin; $commands->{ $plugin->{name} } = $plugin;
if( $plugin->{aliases} ) { if ($plugin->{alias_re}) {
$commands->{$plugin->{alias_re}} = $plugin;
} elsif( $plugin->{aliases} ) {
$commands->{ "\Q$_" } = $plugin $commands->{ "\Q$_" } = $plugin
for @{ $plugin->{aliases} }; for @{ $plugin->{aliases} };
} }
@ -357,9 +361,12 @@ sub _create_plugin_chain {
sub _parse_for_commands { sub _parse_for_commands {
my( $self, $said, $commands ) = @_; my( $self, $said, $commands ) = @_;
my $command_re = join '|', map "$_", keys %$commands; #my $command_re = join '|', map "$_", keys %$commands;
my $command_ra = Regexp::Assemble->new();
$command_ra->add(keys %$commands);
my $command_re = $command_ra->re;
warn "$command_re"; warn "$command_re";
$command_re = qr/$command_re/; #TODO move to _pre_build_chains and switch to Trie # $command_re = qr/$command_re/; #TODO move to _pre_build_chains and switch to Trie
#my $command_ra = Regexp::Assemble->new(); #my $command_ra = Regexp::Assemble->new();
#$command_ra->add(map {quotemeta $_} keys %$commands); #$command_ra->add(map {quotemeta $_} keys %$commands);

View file

@ -10,6 +10,8 @@ use DateTime::Event::Holiday::US;
use DateTime::Event::Cron; use DateTime::Event::Cron;
use LWP::UserAgent; use LWP::UserAgent;
use JSON::MaybeXS; use JSON::MaybeXS;
use Regexp::Optimizer;
use Regexp::Assemble;
use strict; use strict;
use utf8; use utf8;
@ -70,10 +72,28 @@ sub new {
command => 1, command => 1,
}; };
my @perl_aliases = map {("eval$_", "weval$_", "seval$_", "wseval$_", "sweval$_", "meval$_")} @versions; my $version_ra = Regexp::Assemble->new();
$version_ra->add(map {"\Q$_"} @versions);
my $version_re = $version_ra->re;
$self->{aliases} = [ map {$_, "${_}nl", "${_}pb", "${_}pbnl", "${_}nlpb"} qw/jseval rkeval r pleval perleval concise deparse2 swdeparse2 wsdeparse2 wdeparse2 sdeparse2 deparse swdeparse wsdeparse wdeparse sdeparse rbeval cpeval wscpeval swcpeval wcpeval scpeval bleval coboleval cbeval basheval/, @perl_aliases ]; my $strict_re = qr/(?:(?:ws?|sw?)|m)?/;
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=var/evallogs.db"); my $suffix_re = qr/(nl(pb)?|pb(nl)?)?/;
my $perlcommand_ra = Regexp::Assemble->new();
$perlcommand_ra->add(qw/eval pleval perleval cpeval bleval deparse deparse2/);
my $perlcommand_re = $perlcommand_ra->re;
my $othercommand_ra = Regexp::Assemble->new();
$othercommand_ra->add(qw/jseval rkeval coboleval cbeval basheval r concise/);
my $othercommand_re = $othercommand_ra->re;
my $newversion_re = Regexp::Optimizer->new->optimize($version_re);
my $complete_re = qr/${strict_re}${perlcommand_re}${newversion_re}${suffix_re}|${othercommand_re}/;
$self->{aliases_re} = $complete_re;
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=var/evallogs.db");
return $self; return $self;
} }