mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-08 10:45:41 -04:00
tidied
This commit is contained in:
parent
6ade1a4b4c
commit
0ed7f4a51c
1 changed files with 669 additions and 583 deletions
|
|
@ -37,11 +37,14 @@ chomp $dbpass;
|
|||
|
||||
my $fsep = "\034"; # ASCII file seperator
|
||||
|
||||
my $COPULA = join '|', qw/is are was isn't were being am/, "to be", "will be", "has been", "have been", "shall be", "can has", "wus liek", "iz liek", "used to be";
|
||||
my $COPULA = join '|', qw/is are was isn't were being am/, "to be", "will be",
|
||||
"has been", "have been", "shall be", "can has", "wus liek", "iz liek",
|
||||
"used to be";
|
||||
my $COPULA_RE = qr/\b(?:$COPULA)\b/i;
|
||||
|
||||
#this is a hash that gives all the commands their names and functions, added to avoid some symbol table funkery that happened originally.
|
||||
my %commandhash = (
|
||||
|
||||
# "" => \&get_fact, #don't ever add the default like this, it'll cause issues! i plan on changing that!
|
||||
"forget" => \&get_fact_forget,
|
||||
"learn" => \&get_fact_learn,
|
||||
|
|
@ -58,7 +61,6 @@ my %commandhash = (
|
|||
my $commands_re = join '|', keys %commandhash;
|
||||
$commands_re = qr/$commands_re/;
|
||||
|
||||
|
||||
sub new($class) {
|
||||
my $self = bless {}, $class;
|
||||
$self->{name} = 'factoids'; # Shouldn't matter since we aren't a command
|
||||
|
|
@ -76,12 +78,9 @@ sub dbh($self) {
|
|||
return $self->{dbh};
|
||||
}
|
||||
|
||||
my $dbh = $self->{dbh} = DBI->connect(
|
||||
"dbi:Pg:dbname=$dbname",
|
||||
$dbuser,
|
||||
$dbpass,
|
||||
{ RaiseError => 1, PrintError => 0 }
|
||||
);
|
||||
my $dbh = $self->{dbh} =
|
||||
DBI->connect( "dbi:Pg:dbname=$dbname", $dbuser, $dbpass,
|
||||
{ RaiseError => 1, PrintError => 0 } );
|
||||
|
||||
# DBD::SQLite::BundledExtensions->load_spellfix($dbh);
|
||||
|
||||
|
|
@ -89,6 +88,7 @@ sub dbh($self) {
|
|||
}
|
||||
|
||||
sub get_conf_for_channel ( $self, $pm, $server, $channel ) {
|
||||
|
||||
# TODO this needs to use the tables now
|
||||
my $gc = sub { $pm->plugin_conf( $_[0], $server, $channel ) };
|
||||
|
||||
|
|
@ -104,7 +104,8 @@ sub __get_namespaced_factoid {
|
|||
my $command;
|
||||
|
||||
my ( $channel, $server ) = @{$said}{qw/channel server/};
|
||||
$server =~ s/^.*?([^.]+\.(?:com|net|co.uk|org|bot|info))$/$1/; # grab just the domain and tld, will expand to more domains later
|
||||
$server =~ s/^.*?([^.]+\.(?:com|net|co.uk|org|bot|info))$/$1/
|
||||
; # grab just the domain and tld, will expand to more domains later
|
||||
|
||||
$channel = $forcechan // $channel;
|
||||
$server = $forceserver // $server;
|
||||
|
|
@ -112,6 +113,7 @@ sub __get_namespaced_factoid {
|
|||
return $body if $channel eq '*irc_msg' or $channel eq '##NULL';
|
||||
|
||||
if ( $body =~ /^(?:\s*(?<command>$commands_re|macro)\s+)?(?<body>.*)$/ ) {
|
||||
|
||||
#my ($command, $body);
|
||||
( $command, $body ) = @+{qw/command body/};
|
||||
}
|
||||
|
|
@ -136,7 +138,8 @@ sub __get_namespaced_factoid {
|
|||
sub __namespace_filter {
|
||||
my ( $self, $body, $enabled ) = @_;
|
||||
|
||||
return $body =~ s|$fsep[^$fsep]*?$fsep[^$fsep]*?$fsep(\S+)|$1|rg if $enabled;
|
||||
return $body =~ s|$fsep[^$fsep]*?$fsep[^$fsep]*?$fsep(\S+)|$1|rg
|
||||
if $enabled;
|
||||
$body;
|
||||
}
|
||||
|
||||
|
|
@ -176,7 +179,8 @@ sub postload {
|
|||
sub command ( $self, $_said, $pm ) {
|
||||
my $said = +{ $_said->%* };
|
||||
|
||||
my $conf = $self->get_conf_for_channel($pm, $said->{server}, $said->{channel});
|
||||
my $conf =
|
||||
$self->get_conf_for_channel( $pm, $said->{server}, $said->{channel} );
|
||||
|
||||
open( my $fh, ">/tmp/wut" );
|
||||
print $fh "COMMAND INCOMING\n";
|
||||
|
|
@ -189,6 +193,7 @@ sub command($self, $_said, $pm) {
|
|||
# I want to rework this TODO
|
||||
|
||||
if ( $conf->{namespaced} || $said->{channel} eq '*irc_msg' ) {
|
||||
|
||||
# Parse body here
|
||||
my $body = $said->{body};
|
||||
$said->{channel} = "##NULL" if $said->{channel} eq '*irc_msg';
|
||||
|
|
@ -204,28 +209,35 @@ sub command($self, $_said, $pm) {
|
|||
$body = $+{fact};
|
||||
}
|
||||
|
||||
if ($said->{channel} ne '##NULL') { # fuck ##NULL, they don't get factoids
|
||||
($realserver, $realchannel) = $self->get_namespaced_factoid($pm, $fact, $said);
|
||||
if ( $said->{channel} ne '##NULL' )
|
||||
{ # fuck ##NULL, they don't get factoids
|
||||
( $realserver, $realchannel ) =
|
||||
$self->get_namespaced_factoid( $pm, $fact, $said );
|
||||
print $fh "New body is $body\n";
|
||||
} else {
|
||||
}
|
||||
else {
|
||||
$body = $command . " " . $body;
|
||||
}
|
||||
} else {
|
||||
}
|
||||
else {
|
||||
# handle a channel prefix on everything
|
||||
if ( $body =~ /^\s*(?<channel>#\S+)\s+(?<fact>.*)$/ ) {
|
||||
$said->{channel} = $+{channel};
|
||||
$body = $+{fact};
|
||||
}
|
||||
|
||||
if ($said->{channel} ne '##NULL') { # fuck ##NULL, they don't get factoids
|
||||
($realserver, $realchannel) = $self->get_namespaced_factoid($pm, $body, $said);
|
||||
if ( $said->{channel} ne '##NULL' )
|
||||
{ # fuck ##NULL, they don't get factoids
|
||||
( $realserver, $realchannel ) =
|
||||
$self->get_namespaced_factoid( $pm, $body, $said );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print $fh Dumper($said);
|
||||
|
||||
my ($handled, $fact_out) = $self->sub_command($said, $pm, $realchannel, $realserver);
|
||||
my ( $handled, $fact_out ) =
|
||||
$self->sub_command( $said, $pm, $realchannel, $realserver );
|
||||
|
||||
$fact_out = $self->namespace_filter( $fact_out, $conf->{filtersep} );
|
||||
|
||||
|
|
@ -245,18 +257,20 @@ sub sub_command ($self, $said, $pm, $realchannel, $realserver) {
|
|||
my $fact_string; # used to capture return values
|
||||
|
||||
if ( !$call_only && $subject =~ s/^\s*($commands_re)\s+// ) {
|
||||
|
||||
#i lost the object oriented calling here, but i don't care too much, BECAUSE this avoids using strings for the calling, i might change that.
|
||||
$fact_string = $commandhash{$1}->($self,$subject, $said->{name}, $said);
|
||||
$fact_string =
|
||||
$commandhash{$1}->( $self, $subject, $said->{name}, $said );
|
||||
}
|
||||
elsif (
|
||||
($subject =~ m{\w\s*=~\s*s /.+ / .* /[gi]*\s*$}ix) ||
|
||||
($subject =~ m{\w\s*=~\s*s\|.+\| .*\|[gi]*\s*$}ix) ||
|
||||
($subject =~ m{\w\s*=~\s*s\{.+\}\{.*\}[gi]*\s*$}ix) ||
|
||||
($subject =~ m{\w\s*=~\s*s <.+ > <.* >[gi]*\s*$}ix) ||
|
||||
($subject =~ m{\w\s*=~\s*s\(.+\)\(.*\)[gi]*\s*$}ix)
|
||||
)
|
||||
elsif (( $subject =~ m{\w\s*=~\s*s /.+ / .* /[gi]*\s*$}ix )
|
||||
|| ( $subject =~ m{\w\s*=~\s*s\|.+\| .*\|[gi]*\s*$}ix )
|
||||
|| ( $subject =~ m{\w\s*=~\s*s\{.+\}\{.*\}[gi]*\s*$}ix )
|
||||
|| ( $subject =~ m{\w\s*=~\s*s <.+ > <.* >[gi]*\s*$}ix )
|
||||
|| ( $subject =~ m{\w\s*=~\s*s\(.+\)\(.*\)[gi]*\s*$}ix ) )
|
||||
{
|
||||
$fact_string = $self->get_fact_substitute( $subject, $said->{name}, $said, $realchannel, $realserver);
|
||||
$fact_string =
|
||||
$self->get_fact_substitute( $subject, $said->{name}, $said,
|
||||
$realchannel, $realserver );
|
||||
}
|
||||
elsif ( !$call_only and $subject =~ /\s+$COPULA_RE\s+/ ) {
|
||||
return if $said->{nolearn};
|
||||
|
|
@ -268,7 +282,9 @@ sub sub_command ($self, $said, $pm, $realchannel, $realserver) {
|
|||
$fact_string = "Stored @ret";
|
||||
}
|
||||
else {
|
||||
$fact_string = $self->get_fact( $pm, $said, $subject, $said->{name}, $call_only, $realchannel, $realserver )
|
||||
$fact_string =
|
||||
$self->get_fact( $pm, $said, $subject, $said->{name}, $call_only,
|
||||
$realchannel, $realserver );
|
||||
}
|
||||
|
||||
if ( defined $fact_string ) {
|
||||
|
|
@ -281,9 +297,11 @@ sub sub_command ($self, $said, $pm, $realchannel, $realserver) {
|
|||
|
||||
# Handler code stolen from the old nfacts plugin
|
||||
sub handle ( $self, $said, $pm ) {
|
||||
my $conf = $self->get_conf_for_channel($pm, $said->{server}, $said->{channel});
|
||||
my $conf =
|
||||
$self->get_conf_for_channel( $pm, $said->{server}, $said->{channel} );
|
||||
|
||||
$said->{body} =~ s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?<fact>.*?)\??\s*$/$+{fact}/i;
|
||||
$said->{body} =~
|
||||
s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?<fact>.*?)\??\s*$/$+{fact}/i;
|
||||
|
||||
my $prefix = $conf->{prefix_command};
|
||||
return unless $prefix;
|
||||
|
|
@ -291,8 +309,10 @@ sub handle($self, $said, $pm) {
|
|||
# TODO make this channel configurable and make it work properly to learn shit with colors later.
|
||||
$said->{body} = strip_formatting strip_color $said->{body};
|
||||
|
||||
if ($said->{body} =~ /^\Q$prefix\E(?<fact>[^@]*?)(?:\s@\s*(?<user>\S*)\s*)?$/ ||
|
||||
$said->{body} =~ /^\Q$prefix\E!@(?<user>\S+)\s+(?<fact>.+)$/) {
|
||||
if ( $said->{body} =~
|
||||
/^\Q$prefix\E(?<fact>[^@]*?)(?:\s@\s*(?<user>\S*)\s*)?$/
|
||||
|| $said->{body} =~ /^\Q$prefix\E!@(?<user>\S+)\s+(?<fact>.+)$/ )
|
||||
{
|
||||
my $fact = $+{fact};
|
||||
my $user = $+{user};
|
||||
|
||||
|
|
@ -319,11 +339,11 @@ sub handle($self, $said, $pm) {
|
|||
return;
|
||||
}
|
||||
|
||||
|
||||
sub _clean_subject($subject) {
|
||||
$subject =~ s/^\s+//;
|
||||
$subject =~ s/\s+$//;
|
||||
$subject =~ s/\s+/ /g;
|
||||
|
||||
# $subject =~ s/[^\w\s]//g; #comment out to fix punct in factoids
|
||||
$subject = lc fc $subject;
|
||||
|
||||
|
|
@ -339,7 +359,8 @@ sub _clean_subject_func($subject, $variant) { # for parametrized macros
|
|||
|
||||
( $key, $arg ) = ( $1, $2 );
|
||||
|
||||
} else {
|
||||
}
|
||||
else {
|
||||
$subject =~ /\A\s*(\S+)(?:\s+(.*))?\z/s or return;
|
||||
|
||||
( $key, $arg ) = ( $1, $2 );
|
||||
|
|
@ -362,23 +383,38 @@ sub store_factoid($self, $said) {
|
|||
my ( $subject, $copula, $predicate ) = ( $1, $2, $3 );
|
||||
my $compose_macro = 0;
|
||||
|
||||
return "Insufficient permissions for changing protected factoid [$subject]" if (!$self->_db_check_perm($subject,$said));
|
||||
return "Insufficient permissions for changing protected factoid [$subject]"
|
||||
if ( !$self->_db_check_perm( $subject, $said ) );
|
||||
|
||||
if ( $subject =~ s/^\s*\@?macro\b\s*// ) { $compose_macro = 1; }
|
||||
elsif ( $subject =~ s/^\s*\@?func\b\s*// ) { $compose_macro = 2; }
|
||||
elsif ( $predicate =~ s/^\s*also\s+// ) {
|
||||
my $fact = $self->_db_get_fact( _clean_subject( $subject ), $author, $server, $namespace );
|
||||
my $fact = $self->_db_get_fact( _clean_subject($subject),
|
||||
$author, $server, $namespace );
|
||||
|
||||
$predicate = $fact->{predicate} . " | " . $predicate;
|
||||
}
|
||||
|
||||
return unless
|
||||
$self->_insert_factoid( $author, $subject, $copula, $predicate, $compose_macro, $self->_db_get_protect($subject, $server, $namespace), $aliasserver, $aliasnamespace );
|
||||
return
|
||||
unless $self->_insert_factoid(
|
||||
$author,
|
||||
$subject,
|
||||
$copula,
|
||||
$predicate,
|
||||
$compose_macro,
|
||||
$self->_db_get_protect( $subject, $server, $namespace ),
|
||||
$aliasserver,
|
||||
$aliasnamespace
|
||||
);
|
||||
|
||||
return ( $subject, $copula, $predicate );
|
||||
}
|
||||
|
||||
sub _insert_factoid ($self, $author, $subject, $copula, $predicate, $compose_macro, $protected, $server, $namespace) {
|
||||
sub _insert_factoid (
|
||||
$self, $author, $subject, $copula, $predicate,
|
||||
$compose_macro, $protected, $server, $namespace
|
||||
)
|
||||
{
|
||||
my = @_;
|
||||
my $dbh = $self->dbh;
|
||||
|
||||
|
|
@ -387,7 +423,8 @@ sub _insert_factoid ($self, $author, $subject, $copula, $predicate, $compose_mac
|
|||
my $key;
|
||||
if ( $compose_macro == 2 ) {
|
||||
( $key, my $arg ) = _clean_subject_func( $subject, 1 );
|
||||
warn "*********************** GENERATED [$key] FROM [$subject] and [$arg]\n";
|
||||
warn
|
||||
"*********************** GENERATED [$key] FROM [$subject] and [$arg]\n";
|
||||
|
||||
$arg =~ /\S/
|
||||
and return;
|
||||
|
|
@ -397,7 +434,8 @@ sub _insert_factoid ($self, $author, $subject, $copula, $predicate, $compose_mac
|
|||
}
|
||||
return unless $key =~ /\S/;
|
||||
|
||||
$dbh->do( "INSERT INTO factoid
|
||||
$dbh->do(
|
||||
"INSERT INTO factoid
|
||||
(original_subject,subject,copula,predicate,author,modified_time,metaphone,compose_macro,protected, namespace, server)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?)",
|
||||
undef,
|
||||
|
|
@ -424,18 +462,20 @@ sub get_fact_protect($self, $subject, $name, $said) {
|
|||
warn "===TRYING TO PROTECT [$subject] [$name]\n";
|
||||
|
||||
#XXX check permissions here
|
||||
return "Insufficient permissions for protecting factoid [$subject]" if (!$self->_db_check_perm($subject,$said));
|
||||
return "Insufficient permissions for protecting factoid [$subject]"
|
||||
if ( !$self->_db_check_perm( $subject, $said ) );
|
||||
|
||||
my $fact = $self->_db_get_fact( _clean_subject( $subject ), $name, $server, $namespace );
|
||||
my $fact = $self->_db_get_fact( _clean_subject($subject),
|
||||
$name, $server, $namespace );
|
||||
|
||||
if (defined($fact->{predicate}))
|
||||
{
|
||||
$self->_insert_factoid( $name, $subject, $fact->{copula}, $fact->{predicate}, $fact->{compose_macro}, 1, $aliasserver, $aliasnamespace );
|
||||
if ( defined( $fact->{predicate} ) ) {
|
||||
$self->_insert_factoid( $name, $subject, $fact->{copula},
|
||||
$fact->{predicate}, $fact->{compose_macro},
|
||||
1, $aliasserver, $aliasnamespace );
|
||||
|
||||
return "Protected [$subject]";
|
||||
}
|
||||
else
|
||||
{
|
||||
else {
|
||||
return "Unable to protect nonexisting factoid [$subject]";
|
||||
}
|
||||
}
|
||||
|
|
@ -447,18 +487,20 @@ sub get_fact_unprotect($self, $subject, $name, $said) {
|
|||
warn "===TRYING TO PROTECT [$subject] [$name]\n";
|
||||
|
||||
#XXX check permissions here
|
||||
return "Insufficient permissions for unprotecting factoid [$subject]" if (!$self->_db_check_perm($subject,$said));
|
||||
return "Insufficient permissions for unprotecting factoid [$subject]"
|
||||
if ( !$self->_db_check_perm( $subject, $said ) );
|
||||
|
||||
my $fact = $self->_db_get_fact( _clean_subject( $subject ), $name, $server, $namespace );
|
||||
my $fact = $self->_db_get_fact( _clean_subject($subject),
|
||||
$name, $server, $namespace );
|
||||
|
||||
if (defined($fact->{predicate}))
|
||||
{
|
||||
$self->_insert_factoid( $name, $subject, $fact->{copula}, $fact->{predicate}, $fact->{compose_macro}, 0, $aliasserver, $aliasnamespace );
|
||||
if ( defined( $fact->{predicate} ) ) {
|
||||
$self->_insert_factoid( $name, $subject, $fact->{copula},
|
||||
$fact->{predicate}, $fact->{compose_macro},
|
||||
0, $aliasserver, $aliasnamespace );
|
||||
|
||||
return "Unprotected [$subject]";
|
||||
}
|
||||
else
|
||||
{
|
||||
else {
|
||||
return "Unable to unprotect nonexisting factoid [$subject]";
|
||||
}
|
||||
}
|
||||
|
|
@ -470,19 +512,24 @@ sub get_fact_forget($self, $subject, $name, $said) {
|
|||
warn "===TRYING TO FORGET [$subject] [$name]\n";
|
||||
|
||||
#XXX check permissions here
|
||||
return "Insufficient permissions for forgetting protected factoid [$subject]" if (!$self->_db_check_perm($subject,$said));
|
||||
return
|
||||
"Insufficient permissions for forgetting protected factoid [$subject]"
|
||||
if ( !$self->_db_check_perm( $subject, $said ) );
|
||||
|
||||
$self->_insert_factoid( $name, $subject, "is", " ", 0, $self->_db_get_protect($subject, $server, $namespace), $aliasserver, $aliasnamespace );
|
||||
$self->_insert_factoid( $name, $subject, "is", " ", 0,
|
||||
$self->_db_get_protect( $subject, $server, $namespace ),
|
||||
$aliasserver, $aliasnamespace );
|
||||
|
||||
return "Forgot $subject";
|
||||
}
|
||||
|
||||
sub _fact_literal_format($r) {
|
||||
|
||||
# TODO make this express the parent namespace if present
|
||||
# <server:namespace>
|
||||
($r->{protected}?"P:" : "" ).
|
||||
("","macro ","func ")[$r->{compose_macro}] .
|
||||
"$r->{subject} $r->{copula} $r->{predicate}";
|
||||
( $r->{protected} ? "P:" : "" )
|
||||
. ( "", "macro ", "func " )[ $r->{compose_macro} ]
|
||||
. "$r->{subject} $r->{copula} $r->{predicate}";
|
||||
}
|
||||
|
||||
sub get_fact_revisions ( $self, $subject, $name ) {
|
||||
|
|
@ -511,7 +558,8 @@ sub get_fact_revisions($self, $subject, $name) {
|
|||
sub get_fact_literal ( $self, $subject, $name ) {
|
||||
|
||||
my ( $server, $namespace ) = $self->get_namespace($said);
|
||||
my $fact = $self->_db_get_fact( _clean_subject( $subject ), $name, $server, $namespace );
|
||||
my $fact = $self->_db_get_fact( _clean_subject($subject),
|
||||
$name, $server, $namespace );
|
||||
|
||||
return _fact_literal_format($fact);
|
||||
}
|
||||
|
|
@ -523,21 +571,26 @@ sub _fact_substitute($self, $pred, $match, $subst, $flags) {
|
|||
while ( $pred =~ /$regex/g ) {
|
||||
my $matchedstring = substr( $pred, $-[0], $+[0] - $-[0] );
|
||||
my ( $matchstart, $matchend ) = ( $-[0], $+[0] );
|
||||
my @caps = map {substr($pred, $-[$_], $+[$_] - $-[$_])} 1..$#+;
|
||||
my @caps =
|
||||
map { substr( $pred, $-[$_], $+[$_] - $-[$_] ) } 1 .. $#+;
|
||||
my $realsubst = $subst;
|
||||
$realsubst =~ s/(?<!\\)\$(?:\{(\d+)\}|(\d+))/$caps[$1-1]/eg;
|
||||
$realsubst =~ s/\\(?=\$)//g;
|
||||
|
||||
substr $pred, $matchstart, $matchend - $matchstart, $realsubst;
|
||||
pos $pred = $matchstart+length($realsubst); #set the new position, might have an off by one?
|
||||
pos $pred = $matchstart +
|
||||
length($realsubst)
|
||||
; #set the new position, might have an off by one?
|
||||
}
|
||||
|
||||
return $pred;
|
||||
} else {
|
||||
}
|
||||
else {
|
||||
my $regex = $flags =~ /i/ ? qr/(?i:$match)/i : qr/$match/;
|
||||
|
||||
if ( $pred =~ /$regex/ ) {
|
||||
my @caps = map {substr($pred, $-[$_], $+[$_] - $-[$_])} 1..$#+;
|
||||
my @caps =
|
||||
map { substr( $pred, $-[$_], $+[$_] - $-[$_] ) } 1 .. $#+;
|
||||
my $realsubst = $subst;
|
||||
$realsubst =~ s/(?<!\\)\$(?:\{(\d+)\}|(\d+))/$caps[$1-1]/eg;
|
||||
$realsubst =~ s/\\(?=\$)//g;
|
||||
|
|
@ -555,17 +608,29 @@ sub get_fact_substitute($self, $subject, $name, $said) {
|
|||
my ( $server, $namespace ) = $self->get_namespace($said);
|
||||
|
||||
if (
|
||||
($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) ||
|
||||
($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
|
||||
)
|
||||
|| ( $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 );
|
||||
|
||||
# TODO does this need to be done via the ->get_fact() instead now?
|
||||
my $fact = $self->_db_get_fact( _clean_subject( $subject ), $name, $server, $namespace );
|
||||
my $fact = $self->_db_get_fact( _clean_subject($subject),
|
||||
$name, $server, $namespace );
|
||||
|
||||
if ( $fact && $fact->{predicate} =~ /\S/ )
|
||||
{ #we've got a fact to operate on
|
||||
|
|
@ -575,7 +640,8 @@ sub get_fact_substitute($self, $subject, $name, $said) {
|
|||
my $result;
|
||||
|
||||
#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 ) = @_;
|
||||
|
||||
|
|
@ -584,17 +650,17 @@ sub get_fact_substitute($self, $subject, $name, $said) {
|
|||
|
||||
# TODO why is this calling there?
|
||||
# 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 );
|
||||
|
||||
return $ret;
|
||||
}
|
||||
else
|
||||
{
|
||||
return "Can't use dangerous things in a regex, you naughty user";
|
||||
else {
|
||||
return
|
||||
"Can't use dangerous things in a regex, you naughty user";
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
else {
|
||||
return "Can't substitute on unknown factoid [$subject]";
|
||||
}
|
||||
}
|
||||
|
|
@ -607,7 +673,9 @@ sub get_fact_revert($self, $subject, $name, $said) {
|
|||
my ( $server, $namespace ) = $self->get_namespace($said);
|
||||
|
||||
#XXX check permissions here
|
||||
return "Insufficient permissions for reverting protected factoid [$subject]" if (!$self->_db_check_perm($subject,$said));
|
||||
return
|
||||
"Insufficient permissions for reverting protected factoid [$subject]"
|
||||
if ( !$self->_db_check_perm( $subject, $said ) );
|
||||
|
||||
$subject =~ s/^\s*(\d+)\s*$//
|
||||
or return "Failed to match revision format";
|
||||
|
|
@ -621,12 +689,16 @@ sub get_fact_revert($self, $subject, $name, $said) {
|
|||
$rev_id
|
||||
);
|
||||
|
||||
my $protect = $self->_db_get_protect($fact_rev->{subject}, $server, $namespace);
|
||||
my $protect =
|
||||
$self->_db_get_protect( $fact_rev->{subject}, $server, $namespace );
|
||||
|
||||
return "Bad revision id" unless $fact_rev and $fact_rev->{subject}; # Make sure it's valid..
|
||||
return "Bad revision id"
|
||||
unless $fact_rev and $fact_rev->{subject}; # Make sure it's valid..
|
||||
|
||||
# subject, copula, predicate
|
||||
$self->_insert_factoid( $name, @$fact_rev{qw"subject copula predicate compose_macro"}, $protect, $aliasserver, $aliasnamespace);
|
||||
$self->_insert_factoid( $name,
|
||||
@$fact_rev{qw"subject copula predicate compose_macro"},
|
||||
$protect, $aliasserver, $aliasnamespace );
|
||||
|
||||
return "Reverted $fact_rev->{subject} to revision $rev_id";
|
||||
}
|
||||
|
|
@ -639,18 +711,23 @@ sub get_fact_learn($self, $body, $name, $said, $subject, $predicate) {
|
|||
return if ( $said->{nolearn} );
|
||||
|
||||
$body =~ s/^\s*learn\s+//;
|
||||
($subject, $predicate ) = split /\s+as\s+/, $body, 2 unless ($subject && $predicate);
|
||||
( $subject, $predicate ) = split /\s+as\s+/, $body, 2
|
||||
unless ( $subject && $predicate );
|
||||
|
||||
#XXX check permissions here
|
||||
return "Insufficient permissions for changing protected factoid [$subject]" if (!$self->_db_check_perm($subject,$said));
|
||||
return "Insufficient permissions for changing protected factoid [$subject]"
|
||||
if ( !$self->_db_check_perm( $subject, $said ) );
|
||||
|
||||
#my @ret = $self->store_factoid( $name, $said->{body} );
|
||||
$self->_insert_factoid( $name, $subject, 'is', $predicate, 0 , $self->_db_get_protect($subject), $aliasserver, $aliasnamespace);
|
||||
$self->_insert_factoid( $name, $subject, 'is', $predicate, 0,
|
||||
$self->_db_get_protect($subject),
|
||||
$aliasserver, $aliasnamespace );
|
||||
|
||||
return "Stored $subject as $predicate";
|
||||
}
|
||||
|
||||
sub get_fact_search ( $self, $body, $name ) {
|
||||
|
||||
# TODO replace this with FTS
|
||||
|
||||
my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said);
|
||||
|
|
@ -662,9 +739,9 @@ sub get_fact_search($self, $body, $name) {
|
|||
|
||||
my $results;
|
||||
|
||||
if ($body =~ m|^\s*m?/(.*)/\s*$|)
|
||||
{
|
||||
if ( $body =~ m|^\s*m?/(.*)/\s*$| ) {
|
||||
my $search = $1;
|
||||
|
||||
#XXX: need to also search contents of factoids TODO
|
||||
$results = $self->dbh->selectall_arrayref(
|
||||
"SELECT subject,copula,predicate
|
||||
|
|
@ -675,8 +752,7 @@ sub get_fact_search($self, $body, $name) {
|
|||
$search, $search,
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
else {
|
||||
#XXX: need to also search contents of factoids TODO
|
||||
$results = $self->dbh->selectall_arrayref(
|
||||
"SELECT subject,copula,predicate
|
||||
|
|
@ -691,17 +767,18 @@ sub get_fact_search($self, $body, $name) {
|
|||
if ( $results and @$results ) {
|
||||
my $ret_string;
|
||||
for (@$results) {
|
||||
|
||||
#i want a better string here, i'll probably go with just the subject, XXX TODO
|
||||
$ret_string .= "[" . _fact_literal_format($_) . "]\n" if ($_->{predicate} !~ /^\s*$/);
|
||||
$ret_string .= "[" . _fact_literal_format($_) . "]\n"
|
||||
if ( $_->{predicate} !~ /^\s*$/ );
|
||||
}
|
||||
|
||||
return $ret_string;
|
||||
}
|
||||
else {
|
||||
return "No matches."
|
||||
return "No matches.";
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub get_fact ( $self, $pm, $said, $subject, $name, $call_only ) {
|
||||
|
|
@ -722,8 +799,7 @@ sub _db_check_perm($self, $subj, $said) {
|
|||
#if its not protected no need to check if they are op or root;
|
||||
return 1 if ( !$isprot );
|
||||
|
||||
if ($isprot && ($said->{by_root} || $said->{by_chan_op}))
|
||||
{
|
||||
if ( $isprot && ( $said->{by_root} || $said->{by_chan_op} ) ) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
|
@ -733,12 +809,14 @@ sub _db_check_perm($self, $subj, $said) {
|
|||
|
||||
#get the status of the protection bit
|
||||
sub _db_get_protect ( $self, $subj, $server, $namespace ) {
|
||||
|
||||
# TODO switch to new CTE query
|
||||
|
||||
$subj = _clean_subject( $subj, 1 );
|
||||
|
||||
my $dbh = $self->dbh;
|
||||
my $prot = ($dbh->selectrow_array( "
|
||||
my $prot = (
|
||||
$dbh->selectrow_array( "
|
||||
SELECT protected
|
||||
FROM factoid
|
||||
WHERE original_subject = ?
|
||||
|
|
@ -746,12 +824,12 @@ sub _db_get_protect($self, $subj, $server, $namespace) {
|
|||
",
|
||||
undef,
|
||||
$subj,
|
||||
))[0];
|
||||
)
|
||||
)[0];
|
||||
|
||||
return $prot;
|
||||
}
|
||||
|
||||
|
||||
sub _db_get_fact ( $self, $subj, $func, $namespace, $server ) {
|
||||
|
||||
# TODO write the recursive CTE for this
|
||||
|
|
@ -767,12 +845,10 @@ sub _db_get_fact($self, $subj, $func, $namespace, $server) {
|
|||
$subj,
|
||||
);
|
||||
|
||||
if ($func && (!$fact->{compose_macro}))
|
||||
{
|
||||
if ( $func && ( !$fact->{compose_macro} ) ) {
|
||||
return undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
else {
|
||||
return $fact;
|
||||
}
|
||||
|
||||
|
|
@ -788,6 +864,7 @@ sub basic_get_fact {
|
|||
if ( !$call_only ) {
|
||||
$fact = $self->_db_get_fact( $key, $name );
|
||||
}
|
||||
|
||||
# Attempt to determine if our subject matches a previously defined
|
||||
# 'macro' or 'func' type factoid.
|
||||
# I suspect it won't match two word function names now.
|
||||
|
|
@ -805,14 +882,16 @@ sub basic_get_fact {
|
|||
|
||||
local $said->{macro_arg} = $arg;
|
||||
local $said->{body} = $fact->{predicate};
|
||||
local $said->{addressed} = 1; # Force addressed to circumvent restrictions? May not be needed!
|
||||
local $said->{addressed} = 1
|
||||
; # Force addressed to circumvent restrictions? May not be needed!
|
||||
|
||||
open( my $fh, ">/tmp/wutwut" );
|
||||
print $fh Dumper( $said, $plugin, $pm );
|
||||
|
||||
my $ret = $plugin->command( $said, $pm );
|
||||
use Data::Dumper;
|
||||
print $fh Dumper({key => $key, arg => $arg, fact => $fact, ret => $ret});
|
||||
print $fh Dumper(
|
||||
{ key => $key, arg => $arg, fact => $fact, ret => $ret } );
|
||||
|
||||
# $ret = "die 'fuck me silly';";
|
||||
|
||||
|
|
@ -826,11 +905,13 @@ sub basic_get_fact {
|
|||
}
|
||||
}
|
||||
else {
|
||||
if ($subject =~ /[\?\.\!]$/) #check if some asshole decided to add a ? at the end of the factoid, if so remove it and recurse, this should only be able to recurse N times so it should be fine
|
||||
if ( $subject =~ /[\?\.\!]$/
|
||||
) #check if some asshole decided to add a ? at the end of the factoid, if so remove it and recurse, this should only be able to recurse N times so it should be fine
|
||||
{
|
||||
my $newsubject = $subject;
|
||||
$newsubject =~ s/[\?\.\!]$//;
|
||||
return $self->basic_get_fact($pm, $said, $newsubject, $name, $call_only);
|
||||
return $self->basic_get_fact( $pm, $said, $newsubject, $name,
|
||||
$call_only );
|
||||
}
|
||||
|
||||
my $metaphone = Metaphone( _clean_subject( $subject, 1 ) );
|
||||
|
|
@ -840,7 +921,8 @@ sub basic_get_fact {
|
|||
push @{ $said->{metaphone_matches} }, @$matches;
|
||||
|
||||
if ( ( $matches and @$matches ) && ( !$said->{backdressed} ) ) {
|
||||
return "No factoid found. Did you mean one of these: " . join " ", map "[$_]", @$matches;
|
||||
return "No factoid found. Did you mean one of these: " . join " ",
|
||||
map "[$_]", @$matches;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
|
|
@ -856,14 +938,18 @@ sub _metaphone_matches {
|
|||
#XXX HACK WARNING: not really a hack, but something to document, the inner query here seems to work fine on sqlite, but i suspect on other databases it might need an ORDER BY factoid_id clause to enforce that it picks the last entry in the database
|
||||
my $rows = $dbh->selectall_arrayref(
|
||||
"SELECT f.factoid_id, f.subject, f.predicate, f.metaphone, spellfix1_editdist(f.metaphone, ?) AS score FROM (SELECT max(factoid_id) AS factoid_id FROM factoid GROUP BY original_subject) as subquery JOIN factoid AS f USING (factoid_id) WHERE NOT (f.predicate = ' ' OR f.predicate = '') AND f.predicate IS NOT NULL AND length(f.metaphone) > 1 AND score < 200 ORDER BY score ASC;",
|
||||
undef,
|
||||
$metaphone
|
||||
undef, $metaphone
|
||||
);
|
||||
|
||||
use Text::Levenshtein qw/distance/; # only import it in this scope
|
||||
|
||||
my $threshold = int( max( 4, min( 10, 4 + length($subject) / 7 ) ) );
|
||||
my @sorted = map {$_->[0]} sort {$a->[1] <=> $b->[1]} grep {$_->[1] < $threshold} map {[$_->[1], distance($subject, $_->[1])]} grep {$_->[2] =~ /\S/} @$rows ;
|
||||
my @sorted =
|
||||
map { $_->[0] }
|
||||
sort { $a->[1] <=> $b->[1] }
|
||||
grep { $_->[1] < $threshold }
|
||||
map { [ $_->[1], distance( $subject, $_->[1] ) ] }
|
||||
grep { $_->[2] =~ /\S/ } @$rows;
|
||||
|
||||
return [ grep { $_ } @sorted[ 0 .. 9 ] ];
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue