mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-07 21:15:41 -04:00
adding the start of the substitution code
This commit is contained in:
parent
6703649c42
commit
62aebd91a1
1 changed files with 31 additions and 2 deletions
|
@ -29,11 +29,12 @@ my %commandhash = (
|
|||
"learn" => \&get_fact_learn,
|
||||
"relearn" => \&get_fact_learn,
|
||||
"literal" => \&get_fact_literal,
|
||||
"protect" => \&get_fact_protect,
|
||||
"revert" => \&get_fact_revert,
|
||||
"revisions" => \&get_fact_revisions,
|
||||
"search" => \&get_fact_search,
|
||||
"protect" => \&get_fact_protect,
|
||||
"unprotect" => \&get_fact_unprotect,
|
||||
"substitute"=> \&get_fact_substitute,
|
||||
);
|
||||
|
||||
|
||||
|
@ -92,7 +93,6 @@ sub postload {
|
|||
# with one active
|
||||
}
|
||||
|
||||
|
||||
# This whole code is a mess.
|
||||
# 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
|
||||
|
@ -324,6 +324,35 @@ sub get_fact_literal {
|
|||
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 {
|
||||
my( $self, $subject, $name, $said ) = @_;
|
||||
my $dbh = $self->dbh;
|
||||
|
|
Loading…
Add table
Reference in a new issue