From 38525a9b4c0407c3c02ef9c7ef9a37072d24b1ea Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Sun, 6 Sep 2020 20:57:02 -0700 Subject: [PATCH] More tidy --- .gitignore | 2 + perltidy.cmd | 1 + plugins/factoids.pm | 579 ++++++++++++++++++-------------------------- 3 files changed, 245 insertions(+), 337 deletions(-) create mode 100644 perltidy.cmd diff --git a/.gitignore b/.gitignore index 82ec254..ad9a357 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,5 @@ jail.ext4 var/asn.db langs/ *.swp +*.LOG +*.bak diff --git a/perltidy.cmd b/perltidy.cmd new file mode 100644 index 0000000..22615eb --- /dev/null +++ b/perltidy.cmd @@ -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 diff --git a/plugins/factoids.pm b/plugins/factoids.pm index 26ce535..35b3bab 100644 --- a/plugins/factoids.pm +++ b/plugins/factoids.pm @@ -15,8 +15,8 @@ use Encode qw/decode/; use Data::Dumper; use List::Util qw/min max/; -open( my $fh, "<", "etc/factoid_db_keys" ) or die $!; -my ( $dbname, $dbuser, $dbpass ) = <$fh>; +open(my $fh, "<", "etc/factoid_db_keys") or die $!; +my ($dbname, $dbuser, $dbpass) = <$fh>; close($fh); chomp $dbname; @@ -35,17 +35,13 @@ 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! + # "" => \&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, "relearn" => \&get_fact_learn, @@ -74,23 +70,22 @@ sub new($class) { } sub dbh($self) { - if ( $self->{dbh} and $self->{dbh}->ping ) { + if ($self->{dbh} and $self->{dbh}->ping) { return $self->{dbh}; } 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); return $dbh; } -sub get_conf_for_channel ( $self, $pm, $server, $channel ) { +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 ) }; + my $gc = sub {$pm->plugin_conf($_[0], $server, $channel)}; # Load factoids if it exists, otherwise grab the old nfacts setup my $conf = $gc->("factoids"); @@ -100,43 +95,42 @@ sub get_conf_for_channel ( $self, $pm, $server, $channel ) { # This must go away instead # TODO sub __get_namespaced_factoid { - my ( $self, $pm, $body, $said, $forcechan, $forceserver ) = @_; + my ($self, $pm, $body, $said, $forcechan, $forceserver) = @_; 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 + 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 $channel = $forcechan // $channel; $server = $forceserver // $server; return $body if $channel eq '*irc_msg' or $channel eq '##NULL'; - if ( $body =~ /^(?:\s*(?$commands_re|macro)\s+)?(?.*)$/ ) { + if ($body =~ /^(?:\s*(?$commands_re|macro)\s+)?(?.*)$/) { #my ($command, $body); - ( $command, $body ) = @+{qw/command body/}; + ($command, $body) = @+{qw/command body/}; } - open( my $fh, ">/tmp/notwut" ); + open(my $fh, ">/tmp/notwut"); print $fh "NAMESPACE: [ $channel , $server ]"; - my $conf = $self->get_conf_for_channel( $pm, $said->{server}, $channel ); + my $conf = $self->get_conf_for_channel($pm, $said->{server}, $channel); print $fh Dumper($conf); my $realserver = $conf->{serverspace} // $server; my $realchannel = $conf->{chanspace} // $channel; - print $fh Dumper( $realserver, $realchannel ); + print $fh Dumper($realserver, $realchannel); - return ( $realserver, $realchannel, $body ); + return ($realserver, $realchannel, $body); } # TODO remove this sub __namespace_filter { - my ( $self, $body, $enabled ) = @_; + my ($self, $body, $enabled) = @_; return $body =~ s|$fsep[^$fsep]*?$fsep[^$fsep]*?$fsep(\S+)|$1|rg if $enabled; @@ -145,29 +139,29 @@ sub __namespace_filter { # TODO update this to use the new table layout once it's ready sub postload { - my ( $self, $pm ) = @_; + my ($self, $pm) = @_; -# my $sql = "CREATE TABLE factoid ( -# factoid_id INTEGER PRIMARY KEY AUTOINCREMENT, -# original_subject VARCHAR(100), -# subject VARCHAR(100), -# copula VARCHAR(25), -# predicate TEXT, -# author VARCHAR(100), -# modified_time INTEGER, -# metaphone TEXT, -# compose_macro CHAR(1) DEFAULT '0', -# protected BOOLEAN DEFAULT '0' -# ); -# CREATE INDEX factoid_subject_idx ON factoid(subject); -# CREATE INDEX factoid_original_subject_idx ON factoid(original_subject_idx); -# "; # Stupid lack of timestamp fields -# -# $pm->create_table( $self->dbh, "factoid", $sql ); -# -# delete $self->{dbh}; # UGLY HAX GO. -# Basically we delete the dbh we cached so we don't fork -# with one active + # my $sql = "CREATE TABLE factoid ( + # factoid_id INTEGER PRIMARY KEY AUTOINCREMENT, + # original_subject VARCHAR(100), + # subject VARCHAR(100), + # copula VARCHAR(25), + # predicate TEXT, + # author VARCHAR(100), + # modified_time INTEGER, + # metaphone TEXT, + # compose_macro CHAR(1) DEFAULT '0', + # protected BOOLEAN DEFAULT '0' + # ); + # CREATE INDEX factoid_subject_idx ON factoid(subject); + # CREATE INDEX factoid_original_subject_idx ON factoid(original_subject_idx); + # "; # Stupid lack of timestamp fields + # + # $pm->create_table( $self->dbh, "factoid", $sql ); + # + # delete $self->{dbh}; # UGLY HAX GO. + # Basically we delete the dbh we cached so we don't fork + # with one active } # This whole code is a mess. @@ -176,75 +170,69 @@ sub postload { # if it's a retrieve command such as "foo" or if it's a retrieve sub- # command such as "forget foo" # Need to add "what is foo?" support... -sub command ( $self, $_said, $pm ) { +sub command ($self, $_said, $pm) { my $said = +{ $_said->%* }; my $conf = - $self->get_conf_for_channel( $pm, $said->{server}, $said->{channel} ); + $self->get_conf_for_channel($pm, $said->{server}, $said->{channel}); - open( my $fh, ">/tmp/wut" ); + open(my $fh, ">/tmp/wut"); print $fh "COMMAND INCOMING\n"; print $fh Dumper($conf); print $fh Dumper($said); my $response; #namespaced factoids have no fallback - my ( $realchannel, $realserver ); + my ($realchannel, $realserver); # I want to rework this TODO - if ( $conf->{namespaced} || $said->{channel} eq '*irc_msg' ) { + if ($conf->{namespaced} || $said->{channel} eq '*irc_msg') { # Parse body here my $body = $said->{body}; $said->{channel} = "##NULL" if $said->{channel} eq '*irc_msg'; - if ( $body =~ /^(?$commands_re)\s+(?.*)$/ ) { - my ( $command, $fact ) = @+{qw/command fact/}; + if ($body =~ /^(?$commands_re)\s+(?.*)$/) { + my ($command, $fact) = @+{qw/command fact/}; print $fh "Got command $command :: $fact\n"; # handle a channel prefix on everything - if ( $fact =~ /^\s*(?#\S+)\s+(?.*)$/ ) { + if ($fact =~ /^\s*(?#\S+)\s+(?.*)$/) { $said->{channel} = $+{channel}; $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*(?#\S+)\s+(?.*)$/ ) { + if ($body =~ /^\s*(?#\S+)\s+(?.*)$/) { $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} ); + $fact_out = $self->namespace_filter($fact_out, $conf->{filtersep}); - return ( $handled, $fact_out ); + return ($handled, $fact_out); } -sub sub_command ( $self, $said, $pm, $realchannel, $realserver ) { +sub sub_command ($self, $said, $pm, $realchannel, $realserver) { return unless $said->{body} =~ /\S/; #Try to prevent "false positives" my $call_only = $said->{command_match} eq "call"; @@ -256,62 +244,51 @@ 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+// ) { + 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. + #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 ) - || ( $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 ) ) + $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)) { - $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 ); + my @ret = $self->store_factoid($said, $realchannel, $realserver); $fact_string = "Failed to store $said->{body}" unless @ret; - $fact_string = "@ret" if ( $ret[0] =~ /^insuff/i ); + $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 { + if (defined $fact_string) { + return ('handled', $fact_string); + } 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} ); +sub handle ($self, $said, $pm) { + 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+(?.*?)\??\s*$/$+{fact}/i; + $said->{body} =~ s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?.*?)\??\s*$/$+{fact}/i; my $prefix = $conf->{prefix_command}; return unless $prefix; -# TODO make this channel configurable and make it work properly to learn shit with colors later. + # 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(?[^@]*?)(?:\s@\s*(?\S*)\s*)?$/ - || $said->{body} =~ /^\Q$prefix\E!@(?\S+)\s+(?.+)$/ ) + if ( $said->{body} =~ /^\Q$prefix\E(?[^@]*?)(?:\s@\s*(?\S*)\s*)?$/ + || $said->{body} =~ /^\Q$prefix\E!@(?\S+)\s+(?.+)$/) { my $fact = $+{fact}; my $user = $+{user}; @@ -319,8 +296,8 @@ s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?.*?)\??\s*$/$+{fact my $newsaid = +{ $said->%* }; $newsaid->{body} = $fact; - if ( $fact =~ /^\s*(?#\S+)\s+(?.*)$/ ) { - my ( $fact, $channel ) = @+{qw/fact channel/}; + if ($fact =~ /^\s*(?#\S+)\s+(?.*)$/) { + my ($fact, $channel) = @+{qw/fact channel/}; $newsaid->{body} = $fact; $newsaid->{channel} = $channel; } @@ -328,11 +305,11 @@ s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?.*?)\??\s*$/$+{fact $newsaid->{addressed} = 1; $newsaid->{nolearn} = 1; - my ( $s, $r ) = $self->command( $newsaid, $pm ); + my ($s, $r) = $self->command($newsaid, $pm); if ($s) { $r = "$user: $r" if $user; $r = "\0" . $r; - return ( $r, 'handled' ); + return ($r, 'handled'); } } @@ -351,85 +328,68 @@ sub _clean_subject($subject) { } # TODO document this better -sub _clean_subject_func ( $subject, $variant ) { # for parametrized macros - my ( $key, $arg ); +sub _clean_subject_func ($subject, $variant) { # for parametrized macros + my ($key, $arg); if ($variant) { $subject =~ /\A\s*(\S+(?:\s+\S+)?)(?:\s+(.*))?\z/s or return; - ( $key, $arg ) = ( $1, $2 ); + ($key, $arg) = ($1, $2); - } - else { + } else { $subject =~ /\A\s*(\S+)(?:\s+(.*))?\z/s or return; - ( $key, $arg ) = ( $1, $2 ); + ($key, $arg) = ($1, $2); } return $key, $arg; } -sub store_factoid ( $self, $said ) { - my ( $self, $said ) = @_; +sub store_factoid ($self, $said) { + my ($self, $said) = @_; # alias namespace is the current alias we assign factoids to # server and namespace is the server and channel we're looking up for - my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($said); + my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said); + my ($server, $namespace) = $self->get_namespace($said); - my ( $author, $body ) = ( $said->{name}, $said->{body} ); + my ($author, $body) = ($said->{name}, $said->{body}); return unless $body =~ /^(?:no[, ])?\s*(.+?)\s+($COPULA_RE)\s+(.+)$/s; - my ( $subject, $copula, $predicate ) = ( $1, $2, $3 ); + 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 ) ); + 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 ); + 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); $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 ); + 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; warn "Attempting to insert factoid: type $compose_macro"; my $key; - if ( $compose_macro == 2 ) { - ( $key, my $arg ) = _clean_subject_func( $subject, 1 ); - warn -"*********************** GENERATED [$key] FROM [$subject] and [$arg]\n"; + if ($compose_macro == 2) { + ($key, my $arg) = _clean_subject_func($subject, 1); + warn "*********************** GENERATED [$key] FROM [$subject] and [$arg]\n"; $arg =~ /\S/ and return; - } - else { + } else { $key = _clean_subject($subject); } return unless $key =~ /\S/; @@ -455,70 +415,59 @@ sub _insert_factoid ( return 1; } -sub get_fact_protect ( $self, $subject, $name, $said ) { - my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($said); +sub get_fact_protect ($self, $subject, $name, $said) { + my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said); + my ($server, $namespace) = $self->get_namespace($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 ) ); + 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]"; } } -sub get_fact_unprotect ( $self, $subject, $name, $said ) { - my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($said); +sub get_fact_unprotect ($self, $subject, $name, $said) { + my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said); + my ($server, $namespace) = $self->get_namespace($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 ) ); + 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]"; } } -sub get_fact_forget ( $self, $subject, $name, $said ) { - my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($said); +sub get_fact_forget ($self, $subject, $name, $said) { + my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said); + my ($server, $namespace) = $self->get_namespace($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"; } @@ -527,19 +476,17 @@ sub _fact_literal_format($r) { # TODO make this express the parent namespace if present # - ( $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 ) { +sub get_fact_revisions ($self, $subject, $name) { my $dbh = $self->dbh; - my ( $server, $namespace ) = $self->get_namespace($said); + my ($server, $namespace) = $self->get_namespace($said); # TODO this query needs to be rewritten my $revisions = $dbh->selectall_arrayref( -"SELECT factoid_id, subject, copula, predicate, author, compose_macro, protected + "SELECT factoid_id, subject, copula, predicate, author, compose_macro, protected FROM factoid WHERE original_subject = ? ORDER BY modified_time DESC @@ -548,49 +495,43 @@ 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; } -sub get_fact_literal ( $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 ($server, $namespace) = $self->get_namespace($said); + my $fact = $self->_db_get_fact(_clean_subject($subject), $name, $server, $namespace); return _fact_literal_format($fact); } -sub _fact_substitute ( $self, $pred, $match, $subst, $flags ) { - if ( $flags =~ /g/ ) { +sub _fact_substitute ($self, $pred, $match, $subst, $flags) { + if ($flags =~ /g/) { my $regex = $flags =~ /i/ ? qr/(?i:$match)/i : qr/$match/; - while ( $pred =~ /$regex/g ) { - my $matchedstring = substr( $pred, $-[0], $+[0] - $-[0] ); - my ( $matchstart, $matchend ) = ( $-[0], $+[0] ); + while ($pred =~ /$regex/g) { + my $matchedstring = substr($pred, $-[0], $+[0] - $-[0]); + my ($matchstart, $matchend) = ($-[0], $+[0]); my @caps = - map { substr( $pred, $-[$_], $+[$_] - $-[$_] ) } 1 .. $#+; + map {substr($pred, $-[$_], $+[$_] - $-[$_])} 1 .. $#+; my $realsubst = $subst; $realsubst =~ s/(?get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($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 ); + 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,32 +574,27 @@ 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]"; } } } -sub get_fact_revert ( $self, $subject, $name, $said ) { +sub get_fact_revert ($self, $subject, $name, $said) { my $dbh = $self->dbh; - my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($said); + my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($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"; @@ -689,49 +608,44 @@ 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"; } -sub get_fact_learn ( $self, $body, $name, $said, $subject, $predicate ) { +sub get_fact_learn ($self, $body, $name, $said, $subject, $predicate) { - my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($said); + my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said); + my ($server, $namespace) = $self->get_namespace($said); - return if ( $said->{nolearn} ); + 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 ) ); + 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 ) { +sub get_fact_search ($self, $body, $name) { # TODO replace this with FTS - my ( $aliasserver, $aliasnamespace ) = $self->get_alias_namespace($said); - my ( $server, $namespace ) = $self->get_namespace($said); + my ($aliasserver, $aliasnamespace) = $self->get_alias_namespace($said); + my ($server, $namespace) = $self->get_namespace($said); $body =~ s/^\s*for\s*//; #remove the for from searches @@ -739,7 +653,7 @@ 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 @@ -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 @@ -764,42 +678,41 @@ sub get_fact_search ( $self, $body, $name ) { ); } - if ( $results and @$results ) { + 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 + #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*$/ ); + if ($_->{predicate} !~ /^\s*$/); } return $ret_string; - } - else { + } else { return "No matches."; } } -sub get_fact ( $self, $pm, $said, $subject, $name, $call_only ) { - return $self->basic_get_fact( $pm, $said, $subject, $name, $call_only ); +sub get_fact ($self, $pm, $said, $subject, $name, $call_only) { + return $self->basic_get_fact($pm, $said, $subject, $name, $call_only); } -sub _db_check_perm ( $self, $subj, $said ) { - my ( $server, $namespace ) = $self->get_namespace($said); +sub _db_check_perm ($self, $subj, $said) { + my ($server, $namespace) = $self->get_namespace($said); - my $isprot = $self->_db_get_protect( $subj, $server, $namespace ); + my $isprot = $self->_db_get_protect($subj, $server, $namespace); warn "Checking permissions of [$subj] for [$said->{name}]"; warn Dumper($said); #always refuse to change factoids if not in one of my channels - return 0 if ( !$said->{in_my_chan} ); + return 0 if (!$said->{in_my_chan}); #if its not protected no need to check if they are op or root; - return 1 if ( !$isprot ); + return 1 if (!$isprot); - if ( $isprot && ( $said->{by_root} || $said->{by_chan_op} ) ) { + if ($isprot && ($said->{by_root} || $said->{by_chan_op})) { return 1; } @@ -808,15 +721,15 @@ sub _db_check_perm ( $self, $subj, $said ) { } #get the status of the protection bit -sub _db_get_protect ( $self, $subj, $server, $namespace ) { +sub _db_get_protect ($self, $subj, $server, $namespace) { # TODO switch to new CTE query - $subj = _clean_subject( $subj, 1 ); + $subj = _clean_subject($subj, 1); my $dbh = $self->dbh; my $prot = ( - $dbh->selectrow_array( " + $dbh->selectrow_array(" SELECT protected FROM factoid WHERE original_subject = ? @@ -830,12 +743,12 @@ sub _db_get_protect ( $self, $subj, $server, $namespace ) { return $prot; } -sub _db_get_fact ( $self, $subj, $func, $namespace, $server ) { +sub _db_get_fact ($self, $subj, $func, $namespace, $server) { # TODO write the recursive CTE for this my $dbh = $self->dbh; - my $fact = $dbh->selectrow_hashref( " + my $fact = $dbh->selectrow_hashref(" SELECT factoid_id, subject, copula, predicate, author, modified_time, compose_macro, protected, original_subject FROM factoid WHERE original_subject = ? @@ -845,93 +758,85 @@ 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; } } sub basic_get_fact { - my ( $self, $pm, $said, $subject, $name, $call_only ) = @_; + my ($self, $pm, $said, $subject, $name, $call_only) = @_; # open(my $fh, ">>/tmp/facts"); - my ( $fact, $key, $arg ); + my ($fact, $key, $arg); $key = _clean_subject($subject); - if ( !$call_only ) { - $fact = $self->_db_get_fact( $key, $name ); + 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. - for my $variant ( 0, 1 ) { - if ( !$fact ) { - ( $key, $arg ) = _clean_subject_func( $subject, $variant ); - $fact = $self->_db_get_fact( $key, $name, 1 ); + for my $variant (0, 1) { + if (!$fact) { + ($key, $arg) = _clean_subject_func($subject, $variant); + $fact = $self->_db_get_fact($key, $name, 1); } } - if ( $fact->{predicate} =~ /\S/ ) { - if ( $fact->{compose_macro} ) { - my $plugin = $pm->get_plugin( "compose", $said ); + if ($fact->{predicate} =~ /\S/) { + if ($fact->{compose_macro}) { + my $plugin = $pm->get_plugin("compose", $said); 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 ); + open(my $fh, ">/tmp/wutwut"); + print $fh Dumper($said, $plugin, $pm); - my $ret = $plugin->command( $said, $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';"; # $ret = unpack("H*", decode('utf8',$ret)); - $ret = "\x00$ret" if ( $key eq "tell" ); + $ret = "\x00$ret" if ($key eq "tell"); return $ret; - } - else { + } else { return "$fact->{predicate}"; } - } - 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 + } 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 ) ); + my $metaphone = Metaphone(_clean_subject($subject, 1)); - my $matches = $self->_metaphone_matches( $metaphone, $subject ); + my $matches = $self->_metaphone_matches($metaphone, $subject); 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 { + if (($matches and @$matches) && (!$said->{backdressed})) { + return "No factoid found. Did you mean one of these: " . join " ", map "[$_]", @$matches; + } else { return; } } } sub _metaphone_matches { - my ( $self, $metaphone, $subject ) = @_; + my ($self, $metaphone, $subject) = @_; my $dbh = $self->dbh; # TODO this needs to be rewritten to do an edit distance based on the metaphone columns, rather than a direct comparison @@ -943,15 +848,15 @@ sub _metaphone_matches { use Text::Levenshtein qw/distance/; # only import it in this scope - my $threshold = int( max( 4, min( 10, 4 + length($subject) / 7 ) ) ); + 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; + map {$_->[0]} + sort {$a->[1] <=> $b->[1]} + grep {$_->[1] < $threshold} + map {[$_->[1], distance($subject, $_->[1])]} + grep {$_->[2] =~ /\S/} @$rows; - return [ grep { $_ } @sorted[ 0 .. 9 ] ]; + return [grep {$_} @sorted[0 .. 9]]; } no warnings 'void';