1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 10:35:41 -04:00

More tidy

This commit is contained in:
Ryan Voots 2020-09-06 20:57:02 -07:00
parent 0ed7f4a51c
commit 38525a9b4c
3 changed files with 245 additions and 337 deletions

2
.gitignore vendored
View file

@ -13,3 +13,5 @@ jail.ext4
var/asn.db
langs/
*.swp
*.LOG
*.bak

1
perltidy.cmd Normal file
View file

@ -0,0 +1 @@
perltidy -g -ce -i=4 -b -l=180 -conv -pt=2 -sbt=2 -bt=1 -bbt=2 -tso -nsfs plugins/factoids.pm

View file

@ -35,11 +35,7 @@ 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.
@ -79,8 +75,7 @@ sub dbh($self) {
}
my $dbh = $self->{dbh} =
DBI->connect( "dbi:Pg:dbname=$dbname", $dbuser, $dbpass,
{ RaiseError => 1, PrintError => 0 } );
DBI->connect("dbi:Pg:dbname=$dbname", $dbuser, $dbpass, { RaiseError => 1, PrintError => 0 });
# DBD::SQLite::BundledExtensions->load_spellfix($dbh);
@ -104,8 +99,7 @@ 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;
@ -209,35 +203,29 @@ 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});
@ -261,18 +249,14 @@ sub sub_command ( $self, $said, $pm, $realchannel, $realserver ) {
#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);
}
elsif (( $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 );
}
elsif ( !$call_only and $subject =~ /\s+$COPULA_RE\s+/ ) {
$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};
my @ret = $self->store_factoid($said, $realchannel, $realserver);
@ -280,28 +264,22 @@ sub sub_command ( $self, $said, $pm, $realchannel, $realserver ) {
$fact_string = "@ret" if ($ret[0] =~ /^insuff/i);
$fact_string = "Stored @ret";
}
else {
$fact_string =
$self->get_fact( $pm, $said, $subject, $said->{name}, $call_only,
$realchannel, $realserver );
} else {
$fact_string = $self->get_fact($pm, $said, $subject, $said->{name}, $call_only, $realchannel, $realserver);
}
if (defined $fact_string) {
return ('handled', $fact_string);
}
else {
} else {
return;
}
}
# 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;
@ -309,8 +287,7 @@ s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?<fact>.*?)\??\s*$/$+{fact
# 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*)?$/
if ( $said->{body} =~ /^\Q$prefix\E(?<fact>[^@]*?)(?:\s@\s*(?<user>\S*)\s*)?$/
|| $said->{body} =~ /^\Q$prefix\E!@(?<user>\S+)\s+(?<fact>.+)$/)
{
my $fact = $+{fact};
@ -359,8 +336,7 @@ 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);
@ -389,32 +365,18 @@ sub store_factoid ( $self, $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
);
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;
@ -423,13 +385,11 @@ sub _insert_factoid (
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;
}
else {
} else {
$key = _clean_subject($subject);
}
return unless $key =~ /\S/;
@ -465,17 +425,13 @@ sub get_fact_protect ( $self, $subject, $name, $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 );
$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]";
}
}
@ -490,17 +446,13 @@ sub get_fact_unprotect ( $self, $subject, $name, $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 );
$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]";
}
}
@ -512,13 +464,10 @@ 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]"
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";
}
@ -527,9 +476,7 @@ 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) {
@ -548,9 +495,7 @@ sub get_fact_revisions ( $self, $subject, $name ) {
_clean_subject($subject),
);
my $ret_string = join " ", map {
"[$_->{factoid_id} by $_->{author}: " . _fact_literal_format($_) . "]";
} @$revisions;
my $ret_string = join " ", map {"[$_->{factoid_id} by $_->{author}: " . _fact_literal_format($_) . "]";} @$revisions;
return $ret_string;
}
@ -558,8 +503,7 @@ 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);
}
@ -578,14 +522,11 @@ sub _fact_substitute ( $self, $pred, $match, $subst, $flags ) {
$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/) {
@ -607,41 +548,24 @@ sub get_fact_substitute ( $self, $subject, $name, $said ) {
my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($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
)
)
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))
{
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
if ( $match !~ /(?:\(\?\??\{)/ )
{ #ok, match has checked out to be "safe", this will likely be extended later
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};
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 ) = @_;
@ -650,17 +574,13 @@ m{^(?:\s*substitute)?\s*(.*?)\s*=~\s*s <([^>]+ ) > <([^>]*? ) >([gi]*)\s*$}ix
# 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]";
}
}
@ -673,8 +593,7 @@ 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]"
return "Insufficient permissions for reverting protected factoid [$subject]"
if (!$self->_db_check_perm($subject, $said));
$subject =~ s/^\s*(\d+)\s*$//
@ -689,16 +608,13 @@ 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..
# 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";
}
@ -719,9 +635,7 @@ sub get_fact_learn ( $self, $body, $name, $said, $subject, $predicate ) {
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";
}
@ -751,8 +665,8 @@ sub get_fact_search ( $self, $body, $name ) {
{ Slice => {} },
$search, $search,
);
}
else {
} else {
#XXX: need to also search contents of factoids TODO
$results = $self->dbh->selectall_arrayref(
"SELECT subject,copula,predicate
@ -774,8 +688,7 @@ sub get_fact_search ( $self, $body, $name ) {
}
return $ret_string;
}
else {
} else {
return "No matches.";
}
@ -847,8 +760,7 @@ sub _db_get_fact ( $self, $subj, $func, $namespace, $server ) {
if ($func && (!$fact->{compose_macro})) {
return undef;
}
else {
} else {
return $fact;
}
@ -882,16 +794,14 @@ 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';";
@ -899,19 +809,16 @@ sub basic_get_fact {
$ret = "\x00$ret" if ($key eq "tell");
return $ret;
}
else {
} else {
return "$fact->{predicate}";
}
}
else {
} 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
{
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));
@ -921,10 +828,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;
}
else {
return "No factoid found. Did you mean one of these: " . join " ", map "[$_]", @$matches;
} else {
return;
}
}