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

adding the start of the substitution code

Browse source
This commit is contained in:
Ryan Voots 2010-03-12 15:26:52 -05:00
parent 6703649c42
commit 62aebd91a1
1 changed files with 31 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
plugins/factoids.pm
View file

@ -29,11 +29,12 @@ my %commandhash = (
"learn" => \&get_fact_learn, "learn" => \&get_fact_learn,
"relearn" => \&get_fact_learn, "relearn" => \&get_fact_learn,
"literal" => \&get_fact_literal, "literal" => \&get_fact_literal,
"protect" => \&get_fact_protect,
"revert" => \&get_fact_revert, "revert" => \&get_fact_revert,
"revisions" => \&get_fact_revisions, "revisions" => \&get_fact_revisions,
"search" => \&get_fact_search, "search" => \&get_fact_search,
"protect" => \&get_fact_protect,
"unprotect" => \&get_fact_unprotect, "unprotect" => \&get_fact_unprotect,
"substitute"=> \&get_fact_substitute,
); );
@ -92,7 +93,6 @@ sub postload {
# with one active # with one active
} }
# This whole code is a mess. # This whole code is a mess.
# Essentially we need to check if the user's text either matches a # Essentially we need to check if the user's text either matches a
# 'store command' such as "subject is predicate" or we need to check # 'store command' such as "subject is predicate" or we need to check
@ -324,6 +324,35 @@ sub get_fact_literal {
return _fact_literal_format($fact); return _fact_literal_format($fact);
} }
sub get_fact_substitute {
my( $self, $subject, $name, $said ) = @_;
if ($said->{body} =~ m|^(?:\s*substitute)?\s*(.*?)\s*=~\s*s/([^/]+)/([^/]+)/([a-z]*)\s*$|i)
{
my ($subject, $match, $subst, $flags) = ($1, $2, $3);
my $fact = $self->_db_get_fact( _clean_subject( $subject ), $name );
if ($fact && $fact->{predicate} =~ /\S/)
{ #we've got a fact to operate on
if ($match !~ /(?:\(\?\??\{)/)
{ #ok, match has checked out to be "safe", this will likely be extended later
my $pred = $fact->{predicate};
$pred =~ s/$match/$subst/; #XXX: i need to use flags here too!
return "Change WOULD have been: [$pred]";
}
else
{
return "Can't use dangerous things in a regex, you naughty user you";
}
}
else
{
return "Can't substitute on unknown factoid [$subject]";
}
}
}
sub get_fact_revert { sub get_fact_revert {
my( $self, $subject, $name, $said ) = @_; my( $self, $subject, $name, $said ) = @_;
my $dbh = $self->dbh; my $dbh = $self->dbh;