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:
parent
71563e71f6
commit
86943e8d05
2 changed files with 35 additions and 8 deletions
|
@ -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);
|
||||||
|
|
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Add table
Reference in a new issue