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

looks ok

Browse source
This commit is contained in:
Ryan Voots 2020-10-30 22:52:04 -07:00
parent 8bde0b52af
commit 0e17dea271
2 changed files with 16 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
cpanfile
View file

@ -61,6 +61,7 @@ requires "POE::Session";
requires "POE::Wheel::ReadWrite"; requires "POE::Wheel::ReadWrite";
requires "POE::Wheel::Run"; requires "POE::Wheel::Run";
requires "POE::Wheel::SocketFactory"; requires "POE::Wheel::SocketFactory";
requires "PPI";
requires "Regexp::Assemble"; requires "Regexp::Assemble";
requires "Regexp::Optimizer"; requires "Regexp::Optimizer";
requires "Socket"; requires "Socket";

26
plugins/factoids.pm
View file

@ -10,6 +10,8 @@ use Text::Metaphone;
use strict; use strict;
use Encode qw/decode/; use Encode qw/decode/;
use JSON::MaybeXS qw/encode_json/; use JSON::MaybeXS qw/encode_json/;
use PPI;
use PPI::Dumper;
use Data::Dumper; use Data::Dumper;
use List::Util qw/min max/; use List::Util qw/min max/;
@ -553,13 +555,20 @@ sub get_fact_substitute ($self, $subject, $name, $said) {
my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said); my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said);
my ($server, $namespace) = $self->get_namespace($said); my ($server, $namespace) = $self->get_namespace($said);
if ( ($said->{body} =~ m{^(?:\s*substitute)?\s*(.*?)\s*=~\s*s /([^/]+ ) /([^/]* )/([gi]*)\s*$}ix) if ($said->{body} =~ m{^(?:\s*substitute)?\s*(.*?)\s*=~\s*s(.*)$}ix)
|| ($said->{body} =~ m{^(?:\s*substitute)?\s*(.*?)\s*=~\s*s\|([^|]+ ) \|([^|]* )\|([gi]*)\s*$}ix)
|| ($said->{body} =~ m{^(?:\s*substitute)?\s*(.*?)\s*=~\s*s\{([^\}]+)\}\{([^\}]*?)\}([gi]*)\s*$}ix)
|| ($said->{body} =~ m{^(?:\s*substitute)?\s*(.*?)\s*=~\s*s\(([^)]+ )\)\(([^)]*? )\)([gi]*)\s*$}ix)
|| ($said->{body} =~ m{^(?:\s*substitute)?\s*(.*?)\s*=~\s*s <([^>]+ ) > <([^>]*? ) >([gi]*)\s*$}ix))
{ {
my ($subject, $match, $subst, $flags) = ($1, $2, $3, $4); my ($subject, $regex) = ($1, $2);
my $pdoc = PPI::Document->new(\$regex);
return "Failed to parse $regex" unless $pdoc;
# TODO handle tr|y///
my $token = $pdoc->find(sub {$_[1]->isa('PPI::Token::Regexp::Substitute')})->[0];
return "Couldn't find s/// in $regex" unless $token;
my $match = $token->get_match_string;
my $subst = $token->get_substitute_string;
my $flags = join '', keys +{$token->get_modifiers()}->%*;
# TODO does this need to be done via the ->get_fact() instead now? # TODO does this need to be done via the ->get_fact() instead now?
my $fact = $self->_db_get_fact(_clean_subject($subject), 0, $server, $namespace); my $fact = $self->_db_get_fact(_clean_subject($subject), 0, $server, $namespace);
@ -572,11 +581,6 @@ sub get_fact_substitute ($self, $subject, $name, $said) {
#moving this to its own function for cleanliness #moving this to its own function for cleanliness
$result = $self->_fact_substitute($pred, $match, $subst, $flags); $result = $self->_fact_substitute($pred, $match, $subst, $flags);
# my( $self, $body, $name, $said ) = @_;
# $body =~ s/^\s*learn\s+//;
# my( $subject, $predicate ) = split /\s+as\s+/, $body, 2;
# TODO why is this calling there? # TODO why is this calling there?
# let this fail for now # let this fail for now
my $ret = $self->get_fact_learn("learn $subject as $result", $name, $said, $subject, $result); my $ret = $self->get_fact_learn("learn $subject as $result", $name, $said, $subject, $result);