Perlbot/perlbuut
1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 22:15:45 -04:00
Code Issues Releases Wiki Activity

Add Regexp::Assemble for work

Browse source
This commit is contained in:
Ryan Voots 2020-08-20 11:02:34 -04:00
parent d4cd4be2cd
commit 8f5cf56bc4
2 changed files with 9 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
cpanfile
View file

@ -161,3 +161,4 @@ requires 'Path::Tiny';
requires 'CryptX'; requires 'CryptX';
requires 'MIME::Base64'; requires 'MIME::Base64';
requires 'DateTime::Event::Cron'; requires 'DateTime::Event::Cron';
requires 'Regexp::Assemble';

10
lib/Bot/BB3/PluginManager.pm
View file

@ -6,6 +6,7 @@ use POE;
use Data::Dumper; use Data::Dumper;
use Text::Glob qw/match_glob/; use Text::Glob qw/match_glob/;
use Memoize; use Memoize;
use Regexp::Assemble;
use strict; use strict;
sub new { sub new {
@ -222,7 +223,7 @@ sub _pre_build_plugin_chain {
$commands->{ $plugin->{name} } = $plugin; $commands->{ $plugin->{name} } = $plugin;
if( $plugin->{aliases} ) { if( $plugin->{aliases} ) {
$commands->{ $_ } = $plugin $commands->{ "\Q$_" } = $plugin
for @{ $plugin->{aliases} }; for @{ $plugin->{aliases} };
} }
} }
@ -356,10 +357,15 @@ 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 "\Q$_", keys %$commands; my $command_re = join '|', map "$_", keys %$commands;
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();
#$command_ra->add(map {quotemeta $_} keys %$commands);
#my $command_re = $command_ra->re;
#warn "$command_re";
if( (!$said->{addressed} && $said->{body} =~ s/^\s*($command_re)[:,;]\s*(.+)/$2/) if( (!$said->{addressed} && $said->{body} =~ s/^\s*($command_re)[:,;]\s*(.+)/$2/)
or ($said->{addressed} && $said->{body} =~ s/^\s*($command_re)[ :,;-]\s*(.+)/$2/) or ($said->{addressed} && $said->{body} =~ s/^\s*($command_re)[ :,;-]\s*(.+)/$2/)
or $said->{body} =~ s/^\s*($command_re)\s*$// ) { or $said->{body} =~ s/^\s*($command_re)\s*$// ) {