From 9f6fa885f8438f3cf7b13387cd93bb2bee4640b5 Mon Sep 17 00:00:00 2001 From: dms Date: Fri, 2 May 2003 16:32:05 +0000 Subject: [PATCH] - ircTextCounters stuff moved into a separate function. - removed debugging messages here and there - cleaned up a few output messages - added +T for add topic flag. - changed KB to KiB (is that right?) - topic: reformatted from 2whitespace indendation to 4. git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@777 c11ca15a-4712-0410-83d8-924469b57eb5 --- src/CommandStubs.pl | 291 +++++++++++----------- src/DynaConfig.pl | 1 + src/Factoids/Core.pl | 1 + src/IRC/Irc.pl | 1 - src/IRC/IrcHelpers.pl | 4 +- src/IRC/IrcHooks.pl | 43 ++-- src/IRC/Schedulers.pl | 2 +- src/Modules/Topic.pl | 552 ++++++++++++++++++++++++------------------ src/core.pl | 16 +- src/dbi.pl | 1 - src/modules.pl | 4 +- 11 files changed, 500 insertions(+), 416 deletions(-) diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl index cc0a3fb..0a37f7c 100644 --- a/src/CommandStubs.pl +++ b/src/CommandStubs.pl @@ -309,105 +309,8 @@ sub Modules { $itc = &getChanConf("ircTextCounters"); $itc = &findChanConf("ircTextCounters") unless ($itc); if ($itc) { - $itc =~ s/([^\w\s])/\\$1/g; - my $z = join '|', split ' ', $itc; - - if ($msgType eq "privmsg" and $message =~ / ($mask{chan})$/) { - &DEBUG("ircTC: privmsg detected; chan = $1"); - $chan = $1; - } - - if ($message =~ /^_stats(\s+(\S+))$/i) { - &textstats_main($2); - return; - } - - if ($message =~ /^($z)stats(\s+(\S+))?$/i) { - my $type = $1; - my $arg = $3; - - # even more uglier with channel/time arguments. - my $c = $chan; -# my $c = $chan || "PRIVATE"; - my $where = "type=".&sqlQuote($type); - $where .= " AND channel=".&sqlQuote($c) if (defined $c); - &DEBUG("not using chan arg") if (!defined $c); - my $sum = (&sqlRawReturn("SELECT SUM(counter) FROM stats" - ." WHERE ".$where ))[0]; - - if (!defined $arg or $arg =~ /^\s*$/) { - # this is way fucking ugly. - - # TODO convert $where to hash - my %hash = &sqlSelectColHash("stats", "nick,counter", - { }, - $where." ORDER BY counter DESC LIMIT 3", 1 - ); - my $i; - my @top; - - # unfortunately we have to sort it again! - my $tp = 0; - foreach $i (sort { $b <=> $a } keys %hash) { - foreach (keys %{ $hash{$i} }) { - my $p = sprintf("%.01f", 100*$i/$sum); - $tp += $p; - push(@top, "\002$_\002 -- $i ($p%)"); - } - } - my $topstr = ""; - &DEBUG("*stats: tp => $tp"); - if (scalar @top) { - $topstr = ". Top ".scalar(@top).": ".join(', ', @top); - } - - if (defined $sum) { - &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); - } else { - &pSReply("zero counter for \037$type\037."); - } - } else { - # TODO convert $where to hash and use a sqlSelect - my $x = (&sqlRawReturn("SELECT SUM(counter) FROM stats". - " WHERE $where AND nick=".&sqlQuote($arg) ))[0]; - - if (!defined $x) { # !defined. - &pSReply("$arg has not said $type yet."); - return; - } - - # defined. - # TODO convert $where to hash - my @array = &sqlSelect("stats", "nick", undef, - $where." ORDER BY counter", 1 - ); - my $good = 0; - my $i = 0; - for($i=0; $ischedule(3, \&verstats_flush() ); } +sub do_text_counters { + my ($itc) = @_; + $itc =~ s/([^\w\s])/\\$1/g; + my $z = join '|', split ' ', $itc; + + if ($msgType eq "privmsg" and $message =~ / ($mask{chan})$/) { + &DEBUG("ircTC: privmsg detected; chan = $1"); + $chan = $1; + } + + if ($message =~ /^_stats(\s+(\S+))$/i) { + &textstats_main($2); + return; + } + + my ($type,$arg); + if ($message =~ /^($z)stats(\s+(\S+))?$/i) { + $type = $1; + $arg = $3; + } else { + return; + } + + # even more uglier with channel/time arguments. + my $c = $chan; +# my $c = $chan || "PRIVATE"; + my $where = "type=".&sqlQuote($type); + if (defined $c) { + &DEBUG("c => $c"); + $where .= " AND channel=".&sqlQuote($c) if (defined $c); + } else { + &DEBUG("not using chan arg"); + } + + my $sum = (&sqlRawReturn("SELECT SUM(counter) FROM stats" + ." WHERE ".$where ))[0]; + + if (!defined $arg or $arg =~ /^\s*$/) { + # this is way fucking ugly. + + # TODO convert $where to hash + my %hash = &sqlSelectColHash("stats", "nick,counter", + { }, + $where." ORDER BY counter DESC LIMIT 3", 1 + ); + my $i; + my @top; + + # unfortunately we have to sort it again! + my $tp = 0; + foreach $i (sort { $b <=> $a } keys %hash) { + foreach (keys %{ $hash{$i} }) { + my $p = sprintf("%.01f", 100*$i/$sum); + $tp += $p; + push(@top, "\002$_\002 -- $i ($p%)"); + } + } + my $topstr = ""; + if (scalar @top) { + $topstr = ". Top ".scalar(@top).": ".join(', ', @top); + } + + if (defined $sum) { + &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); + } else { + &pSReply("zero counter for \037$type\037."); + } + } else { + # TODO convert $where to hash and use a sqlSelect + my $x = (&sqlRawReturn("SELECT SUM(counter) FROM stats". + " WHERE $where AND nick=".&sqlQuote($arg) ))[0]; + + if (!defined $x) { # !defined. + &pSReply("$arg has not said $type yet."); + return; + } + + # defined. + # TODO convert $where to hash + my @array = &sqlSelect("stats", "nick", undef, + $where." ORDER BY counter", 1 + ); + my $good = 0; + my $i = 0; + for ($i=0; $i $tp"); if (scalar @top) { $topstr = ". Top ".scalar(@top).": ".join(', ', @top); } @@ -948,53 +959,55 @@ sub textstats_main { } else { &pSReply("zero counter for \037$type\037."); } - } else { - # TODO add nick to where_href - my %hash = &sqlSelectColHash("stats", "type,counter", - $where_href, " AND nick=".&sqlQuote($arg) - ); - # this is totally fucked... needs to be fixed... and cleaned up. - my $total; - my $good; - my $ii; - my $x; - foreach (keys %hash) { - &DEBUG("_stats: hash{$_} => $hash{$_}"); - # ranking. - # TODO convert $where to hash - my @array = &sqlSelect("stats", "nick", undef, - $where." ORDER BY counter", 1); - $good = 0; - $ii = 0; - for(my $i=0; $i $i, good => $good, total => $total"); - $x .= " ".$total."blah blah"; + # TODO add nick to where_href + my %hash = &sqlSelectColHash("stats", "type,counter", + $where_href, " AND nick=".&sqlQuote($arg) + ); + # this is totally fucked... needs to be fixed... and cleaned up. + my $total; + my $good; + my $ii; + my $x; + + foreach (keys %hash) { + &DEBUG("_stats: hash{$_} => $hash{$_}"); + # ranking. + # TODO convert $where to hash + my @array = &sqlSelect("stats", "nick", undef, + $where." ORDER BY counter", 1); + $good = 0; + $ii = 0; + for(my $i=0; $i $i, good => $good, total => $total"); + $x .= " ".$total."blah blah"; + } - if (!defined $x) { # !defined. - &pSReply("$arg has not said $type yet."); - return; - } +# return; - my $xtra = ""; - if ($total and $good) { - my $pct = sprintf("%.01f", 100*(1+$total-$ii)/$total); - $xtra = ", ranked $ii\002/\002$total (percentile: \002$pct\002 %)"; - } + if (!defined $x) { # !defined. + &pSReply("$arg has not said $type yet."); + return; + } - my $pct1 = sprintf("%.01f", 100*$x/$sum); - &pSReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra"); + my $xtra = ""; + if ($total and $good) { + my $pct = sprintf("%.01f", 100*(1+$total-$ii)/$total); + $xtra = ", ranked $ii\002/\002$total (percentile: \002$pct\002 %)"; } + + my $pct1 = sprintf("%.01f", 100*$x/$sum); + &pSReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra"); } sub nullski { my ($arg) = @_; return unless (defined $arg); diff --git a/src/DynaConfig.pl b/src/DynaConfig.pl index 88b0dcb..96ec689 100644 --- a/src/DynaConfig.pl +++ b/src/DynaConfig.pl @@ -848,6 +848,7 @@ my @regFlagsUser = ( "O", # dynamic ops (as on channel). (automatic +o) "A", # bot administration over /msg # default is only via DCC CHAT + "T", # add topics. ); 1; diff --git a/src/Factoids/Core.pl b/src/Factoids/Core.pl index fde06aa..26c732b 100644 --- a/src/Factoids/Core.pl +++ b/src/Factoids/Core.pl @@ -155,6 +155,7 @@ sub FactoidStuff { return; } + # todo: squeeze 3 getFactInfo calls into one? my $author = &getFactInfo($faqtoid, "created_by"); my $count = &getFactInfo($faqtoid, "requested_count") || 0; # don't delete if requested $limit times diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl index a73a51a..7bd925a 100644 --- a/src/IRC/Irc.pl +++ b/src/IRC/Irc.pl @@ -775,7 +775,6 @@ sub clearChanVars { } sub clearIRCVars { - &DEBUG("clearIRCVars() called!"); undef %channels; undef %floodjoin; diff --git a/src/IRC/IrcHelpers.pl b/src/IRC/IrcHelpers.pl index 18ff34a..fd26338 100644 --- a/src/IRC/IrcHelpers.pl +++ b/src/IRC/IrcHelpers.pl @@ -6,8 +6,6 @@ # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 # -# use strict; # TODO - ####################################################################### ####### IRC HOOK HELPERS IRC HOOK HELPERS IRC HOOK HELPERS ######## ####################################################################### @@ -292,7 +290,7 @@ sub chanLimitVerify { } if (!defined $l) { - &DEBUG("running chanlimitCheck from chanLimitVerify; FIXME! (chan = $chan)"); + &DEBUG("$chan: running chanlimitCheck from chanLimitVerify."); &chanlimitCheck(); return; } diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl index 87c5f90..e8eb962 100644 --- a/src/IRC/IrcHooks.pl +++ b/src/IRC/IrcHooks.pl @@ -5,8 +5,6 @@ # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 # -# use strict; # TODO - # GENERIC. TO COPY. sub on_generic { my ($self, $event) = @_; @@ -869,33 +867,36 @@ sub on_public { $userstats{lc $nick}{'Time'} = time(); } - # would this slow things down? - if ($_ = &getChanConf("ircTextCounters")) { - my $time = time(); - - foreach (split /[\s]+/) { - my $x = $_; + # cache it. + my $time = time(); + if (!$cache{ircTextCounters}) { + &DEBUG("caching ircTextCounters for first time."); + my @str = split(/\s+/, &getChanConf("ircTextCounters")); + for (@str) { $_ = quotemeta($_); } + $cache{ircTextCounters} = join('|', @str); + } - # either full word or ends with a space, etc... - next unless ($msg =~ /^\Q$x\E[\$\s!.]/i); + my $str = $cache{ircTextCounters}; + if ($str && $msg =~ /^($str)[\s!\.]?$/i) { + my $x = $1; - &VERB("textcounters: $x matched for $who",2); - my $c = $chan || "PRIVATE"; + &VERB("textcounters: $x matched for $who",2); + my $c = $chan || "PRIVATE"; - my ($v,$t) = &sqlSelect("stats", "counter,time", { + # better to do "counter=counter+1". + # but that will avoid time check. + my ($v,$t) = &sqlSelect("stats", "counter,time", { nick => $who, type => $x, channel => $c, - } ); - $v++; - - # don't allow ppl to cheat the stats :-) - next unless (defined $t); - next unless ($time - $t > 10); + } ); + $v++; + # don't allow ppl to cheat the stats :-) + if (defined $t && $time - $t > 60) { &sqlReplace("stats", { - nick => $who, - type => $x, + nick => $who, + type => $x, channel => $c, time => $time, counter => $v, diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index 5ef67f8..84b8da5 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -417,7 +417,7 @@ sub chanlimitCheck { delete $cache{warn}{chanlimit}{$chan}; if (!defined $limit) { - &status("chanlimit: setting for first time or from netsplit, for $chan"); + &status("chanlimit: $chan: setting for first time or from netsplit."); } if (exists $cache{chanlimitChange}{$chan}) { diff --git a/src/Modules/Topic.pl b/src/Modules/Topic.pl index 2778fee..6fccc44 100644 --- a/src/Modules/Topic.pl +++ b/src/Modules/Topic.pl @@ -7,7 +7,8 @@ use strict; use vars qw(%topiccmp %topic %channels %orig); -use vars qw($who $chan $conn $uh $ident); +use vars qw($who $chan $conn $uh $ident $topicUpdate); +# use cache{topicUpdate}? ############################### ##### INTERNAL FUNCTIONS @@ -16,164 +17,142 @@ use vars qw($who $chan $conn $uh $ident); ### # Usage: &topicDecipher(chan); sub topicDecipher { - my $chan = shift; - my @results; + my ($chan) = @_; + my @results; - if (!exists $topic{$chan}{'Current'}) { - return; - } + return if (!exists $topic{$chan}); + return if (!exists $topic{$chan}{'Current'}); - foreach (split /\|\|/, $topic{$chan}{'Current'}) { - s/^\s+//; - s/\s+$//; + foreach (split /\|\|/, $topic{$chan}{'Current'}) { + s/^\s+//; + s/\s+$//; - # very nice fix to solve the null subtopic problem. - ### if nick contains a space, treat topic as ownerless. - if (/^\(.*?\)$/) { - next unless ($1 =~ /\s/); - } + # very nice fix to solve the null subtopic problem. + # if nick contains a space, treat topic as ownerless. + if (/^\(.*?\)$/) { + next unless ($1 =~ /\s/); + } - my $subtopic = $_; - my $owner = "Unknown"; - if (/(.*)\s+\((.*?)\)$/) { - $subtopic = $1; - $owner = $2; - } + my $subtopic = $_; + my $owner = "Unknown"; - if (grep /^\Q$subtopic\E\|\|\Q$owner\E$/, @results) { - &status("Topic: we have found a dupe in the topic, not adding."); - next; - } + if (/(.*)\s+\((.*?)\)$/) { + $subtopic = $1; + $owner = $2; + } + + if (grep /^\Q$subtopic\E\|\|\Q$owner\E$/, @results) { + &status("Topic: we have found a dupe in the topic, not adding."); + next; + } - push(@results, "$subtopic||$owner"); - } + push(@results, "$subtopic||$owner"); + } - return @results; + return @results; } ### # Usage: &topicCipher(@topics); sub topicCipher { - if (!@_) { - &WARN("topicCipher: topic is NULL for $chan."); - return; - } - - my $result; - foreach (@_) { - my ($subtopic, $setby) = split /\|\|/; + if (!@_) { + &WARN("topicCipher: topic is NULL for $chan."); + return; + } - $result .= " || $subtopic"; - next if ($setby eq "" or $setby =~ /unknown/i); + my @topic; + foreach (@_) { + my ($subtopic, $setby) = split /\|\|/; - $result .= " (" . $setby . ")"; - } + if ($setby =~ /(unknown|)$/i) { + push(@topic, $subtopic); + } else { + push(@topic, "$subtopic ($setby)"); + } + } - return substr($result, 4); + return join(' || ', @topic); } ### # Usage: &topicNew($chan, $topic, $updateMsg, $topicUpdate); sub topicNew { - my ($chan, $topic, $updateMsg, $topicUpdate) = @_; - my $maxlen = 470; - - if ($channels{$chan}{t} and !$channels{$chan}{o}{$ident}) { - &msg($who, "error: cannot change topic without ops. (channel is +t) :("); - return 0; - } - - if (defined $topiccmp{$chan} and $topiccmp{$chan} eq $topic) { - &msg($who, "warning: action had no effect on topic; no change required."); - return 0; - } - - # bail out if the new topic is too long. - my $newlen = length($chan.$topic); - if ($newlen > $maxlen) { - &msg($who, "new topic will be too long. ($newlen > $maxlen)"); - return 0; - } - - $topic{$chan}{'Current'} = $topic; - - # notification that the topic was altered. - if (!$topicUpdate) { # for cached changes with '-'. - &msg($who, "okay"); + my ($chan, $topic, $updateMsg, $topicUpdate) = @_; + my $maxlen = 470; + + if ($channels{$chan}{t} and !$channels{$chan}{o}{$ident}) { + &msg($who, "error: cannot change topic without ops. (channel is +t) :("); + return 0; + } + + if (defined $topiccmp{$chan} and $topiccmp{$chan} eq $topic) { + &msg($who, "warning: action had no effect on topic; no change required."); + return 0; + } + + # bail out if the new topic is too long. + my $newlen = length($chan.$topic); + if ($newlen > $maxlen) { + &msg($who, "new topic will be too long. ($newlen > $maxlen)"); + return 0; + } + + $topic{$chan}{'Current'} = $topic; + + # notification that the topic was altered. + if (!$topicUpdate) { # for cached changes with '-'. + &msg($who, "okay"); + return 1; + } + + if ($updateMsg ne "") { + &msg($who, $updateMsg); + } + + $topic{$chan}{'Last'} = $topic; + $topic{$chan}{'Who'} = $orig{who}."!".$uh; + $topic{$chan}{'Time'} = time(); + + $conn->topic($chan, $topic); + &topicAddHistory($chan,$topic); + return 1; - } - - if ($updateMsg ne "") { - &msg($who, $updateMsg); - } - - $topic{$chan}{'Last'} = $topic; - $topic{$chan}{'Who'} = $orig{who}."!".$uh; - $topic{$chan}{'Time'} = time(); - $conn->topic($chan, $topic); - &topicAddHistory($chan,$topic); - return 1; } ### # Usage: &topicAddHistory($chan,$topic); sub topicAddHistory { - my ($chan, $topic) = @_; - my $dupe = 0; + my ($chan, $topic) = @_; + my $dupe = 0; - return 1 if ($topic eq ""); # required fix. + return 1 if ($topic eq ""); # required fix. - foreach (@{ $topic{$chan}{'History'} }) { - next if ($_ ne "" and $_ ne $topic); - # checking length is required. + foreach (@{ $topic{$chan}{'History'} }) { + next if ($_ ne "" and $_ ne $topic); + # checking length is required. - $dupe++; - last; - } + # slightly weird to put a return statement in a loop. + return 1; + } - return 1 if $dupe; + # WTF IS THIS FOR? - my @topics = @{ $topic{$chan}{'History'} }; - unshift(@topics, $topic); - pop(@topics) while (scalar @topics > 6); - $topic{$chan}{'History'} = \@topics; + my @topics = @{ $topic{$chan}{'History'} }; + unshift(@topics, $topic); + pop(@topics) while (scalar @topics > 6); + $topic{$chan}{'History'} = \@topics; - return $dupe; + return $dupe; } ############################### ##### HELPER FUNCTIONS ############################### -### TODO. -# sub topicNew { -# sub topicDelete { -# sub topicList { -# sub topicModify { -# sub topicMove { -# sub topicShuffle { -# sub topicHistory { -# sub topicRestore { -# sub topicRehash { -# sub topicHelp { - -############################### -##### MAIN -############################### - -### -# Usage: &Topic($cmd, $args); -sub Topic { - my ($chan, $cmd, $args) = @_; - my $topicUpdate = 1; +# cmd: add. +sub do_add { + my ($chan, $args) = @_; - if ($cmd =~ /^-(\S+)/) { - $topicUpdate = 0; - $cmd = $1; - } - - if ($cmd =~ /^(add)$/i) { - ### CMD: ADD: if ($args eq "") { &help("topic add"); return; @@ -185,16 +164,26 @@ sub Topic { return; } + if (!&hasFlag("T")) { + &msg($who, "you do not have enough flags to add topics"); + return; + } + my @prev = &topicDecipher($chan); my $new = "$args ($orig{who})"; $topic{$chan}{'What'} = "Added '$args'."; + if (scalar @prev) { - $new = &topicCipher(@prev, sprintf("%s||%s", $args, $who)); + my $str = sprintf("%s||%s", $args, $who); + $new = &topicCipher(@prev, $str); } + &topicNew($chan, $new, "", $topicUpdate); +} - } elsif ($cmd =~ /^(del|delete|rm|remove|kill|purge)$/i) { - ### CMD: DEL: +# cmd: delete. +sub do_delete { + my ($chan, $args) = @_; my @subtopics = &topicDecipher($chan); my $topiccount = scalar @subtopics; @@ -208,21 +197,23 @@ sub Topic { return; } - $args = ",".$args.","; - $args =~ s/\s+//g; - $args =~ s/(first|1st)/1/i; - $args =~ s/last/$topiccount/i; - $args =~ s/,-(\d+)/,1-$1/; - $args =~ s/(\d+)-,/,$1-$topiccount/; + for ($args) { + $_ = sprintf(",%s,", $args); + s/\s+//g; + s/(first|1st)/1/i; + s/last/$topiccount/i; + s/,-(\d+)/,1-$1/; + s/(\d+)-,/,$1-$topiccount/; + } if ($args !~ /[\,\-\d]/) { &msg($who, "error: Invalid argument ($args)."); return; } + my @delete; foreach (split ",", $args) { next if ($_ eq ""); - my @delete; # change to hash list instead of array? if (/^(\d+)-(\d+)$/) { @@ -238,21 +229,25 @@ sub Topic { } $topic{$chan}{'What'} = "Deleted ".join("/",@delete); + } + - foreach (@delete) { - if ($_ > $topiccount || $_ < 1) { + foreach (@delete) { + if ($_ > $topiccount || $_ < 1) { &msg($who, "error: argument out of range. (max: $topiccount)"); return; - } - # skip if already deleted. - # only checked if x-y range is given. - next unless (defined($subtopics[$_-1])); - - my ($subtopic,$whoby) = split('\|\|', $subtopics[$_-1]); - $whoby = "unknown" if ($whoby eq ""); - &msg($who, "Deleting topic: $subtopic ($whoby)"); - undef $subtopics[$_-1]; } + + # skip if already deleted. + # only checked if x-y range is given. + next unless (defined($subtopics[$_-1])); + + my ($subtopic,$whoby) = split('\|\|', $subtopics[$_-1]); + + $whoby = "unknown" if ($whoby eq ""); + + &msg($who, "Deleting topic: $subtopic ($whoby)"); + undef $subtopics[$_-1]; } my @newtopics; @@ -262,10 +257,13 @@ sub Topic { } &topicNew($chan, &topicCipher(@newtopics), "", $topicUpdate); +} + +# cmd: list +sub do_list { + my ($chan, $args) = @_; + my @topics = &topicDecipher($chan); - } elsif ($cmd =~ /^list$/i) { - ### CMD: LIST: - my @topics = &topicDecipher($chan); if (!scalar @topics) { &msg($who, "No topics for \002$chan\002."); return; @@ -278,14 +276,21 @@ sub Topic { foreach (@topics) { my ($subtopic, $setby) = split /\|\|/; - &msg($who, sprintf(" %d. \002[\002%-10s\002]\002 %s", - $i, $setby, $subtopic)); + my $str = sprintf(" %d. [%-10s] %s", $i, $setby, $subtopic); + # is there a better way of doing this? + $str =~ s/ (\[)/ \002$1/g; + $str =~ s/ (\])/ \002$1/g; + + &msg($who, $str); $i++; } + &msg($who, "End of Topics."); +} - } elsif ($cmd =~ /^(mod|modify|change|alter)$/i) { - ### CMD: MOD: +# cmd: modify. +sub do_modify { + my ($chan, $args) = @_; if ($args eq "") { &help("topic mod"); @@ -304,107 +309,115 @@ sub Topic { my ($delim, $op, $np, $flags) = ($1,$2,$3,$4); if ($flags !~ /^(g)?$/) { - &msg($who, "error: Invalid flags to regex."); - return; + &msg($who, "error: Invalid flags to regex."); + return; } my $topic = $topic{$chan}{'Current'}; ### TODO: use m### to make code safe! if (($flags eq "g" and $topic =~ s/\Q$op\E/$np/g) || - ($flags eq "" and $topic =~ s/\Q$op\E/$np/)) { + ($flags eq "" and $topic =~ s/\Q$op\E/$np/) + ) { - $_ = "Modifying topic with sar s/$op/$np/."; - &topicNew($chan, $topic, $_, $topicUpdate); + $_ = "Modifying topic with sar s/$op/$np/."; + &topicNew($chan, $topic, $_, $topicUpdate); } else { - &msg($who, "warning: regex not found in topic."); + &msg($who, "warning: regex not found in topic."); } + return; } &msg($who, "error: Invalid regex. Try s/1/2/, s#3#4#..."); +} - } elsif ($cmd =~ /^(mv|move)$/i) { - ### CMD: MV: +# cmd: move. +sub do_move { + my ($chan, $args) = @_; if ($args eq "") { &help("topic mv"); return; } + my ($from, $action, $to); + # better way of doing this? if ($args =~ /^(first|last|\d+)\s+(before|after|swap)\s+(first|last|\d+)$/i) { - my ($from, $action, $to) = ($1,$2,$3); - my @subtopics = &topicDecipher($chan); - my @newtopics; - my $topiccount = scalar @subtopics; - - if ($topiccount == 1) { - &msg($who, "error: impossible to move the only subtopic, dumbass."); - return; - } + ($from, $action, $to) = ($1,$2,$3); + } else { + &msg($who, "Invalid arguments."); + return; + } - # Is there an easier way to do this? - $from =~ s/first/1/i; - $to =~ s/first/1/i; - $from =~ s/last/$topiccount/i; - $to =~ s/last/$topiccount/i; + my @subtopics = &topicDecipher($chan); + my @newtopics; + my $topiccount = scalar @subtopics; - if ($from > $topiccount || $to > $topiccount || $from < 1 || $to < 1) { - &msg($who, "error: or is out of range."); - return; - } + if ($topiccount == 1) { + &msg($who, "error: impossible to move the only subtopic, dumbass."); + return; + } - if ($from == $to) { - &msg($who, "error: and are the same."); - return; - } + # Is there an easier way to do this? + $from =~ s/first/1/i; + $to =~ s/first/1/i; + $from =~ s/last/$topiccount/i; + $to =~ s/last/$topiccount/i; - $topic{$chan}{'What'} = "Move $from to $to"; + if ($from > $topiccount || $to > $topiccount || $from < 1 || $to < 1) { + &msg($who, "error: or is out of range."); + return; + } - if ($action =~ /^(swap)$/i) { - my $tmp = $subtopics[$to - 1]; - $subtopics[$to - 1] = $subtopics[$from - 1]; - $subtopics[$from - 1] = $tmp; + if ($from == $to) { + &msg($who, "error: and are the same."); + return; + } - $_ = "Swapped #\002$from\002 with #\002$to\002."; - &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate); - return; - } + $topic{$chan}{'What'} = "Move $from to $to"; - # action != swap: - # Is there a better way to do this? guess not. - my $i = 1; - my $subtopic = $subtopics[$from - 1]; - foreach (@subtopics) { - my $j = $i*2 - 1; - $newtopics[$j] = $_ if ($i != $from); - $i++; - } + if ($action =~ /^(swap)$/i) { + my $tmp = $subtopics[$to - 1]; + $subtopics[$to - 1] = $subtopics[$from - 1]; + $subtopics[$from - 1] = $tmp; - if ($action =~ /^(before|b4)$/i) { - $newtopics[$to*2-2] = $subtopic; - } else { - # action =~ /after/. - $newtopics[$to*2] = $subtopic; - } + $_ = "Swapped #\002$from\002 with #\002$to\002."; + &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate); + return; + } - undef @subtopics; # lets reuse this array. - foreach (@newtopics) { - next if (!defined $_ or $_ eq ""); - push(@subtopics, $_); - } + # action != swap: + # Is there a better way to do this? guess not. + my $i = 1; + my $subtopic = $subtopics[$from - 1]; + foreach (@subtopics) { + my $j = $i*2 - 1; + $newtopics[$j] = $_ if ($i != $from); + $i++; + } - $_ = "Moved #\002$from\002 $action #\002$to\002."; - &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate); + if ($action =~ /^(before|b4)$/i) { + $newtopics[$to*2-2] = $subtopic; + } else { + # action =~ /after/. + $newtopics[$to*2] = $subtopic; + } - return; + undef @subtopics; # lets reuse this array. + foreach (@newtopics) { + next if (!defined $_ or $_ eq ""); + push(@subtopics, $_); } - &msg($who, "Invalid arguments."); + $_ = "Moved #\002$from\002 $action #\002$to\002."; + &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate); +} - } elsif ($cmd =~ /^shuffle$/i) { - ### CMD: SHUFFLE: - my @subtopics = &topicDecipher($chan); +# cmd: shuffle. +sub do_shuffle { + my ($chan, $args) = @_; + my @subtopics = &topicDecipher($chan); my @newtopics; $topic{$chan}{'What'} = "shuffled"; @@ -415,9 +428,12 @@ sub Topic { $_ = "Shuffling the bag of lollies."; &topicNew($chan, &topicCipher(@newtopics), $_, $topicUpdate); +} + +# cmd: history. +sub do_history { + my ($chan, $args) = @_; - } elsif ($cmd =~ /^(history)$/i) { - ### CMD: HISTORY: if (!scalar @{ $topic{$chan}{'History'} }) { &msg($who, "Sorry, no topics in history list."); return; @@ -431,10 +447,14 @@ sub Topic { # To prevent excess floods. sleep 1 if (length($topic) > 160); } + &msg($who, "End of list."); +} + +# cmd: restore. +sub do_restore { + my ($chan, $args) = @_; - } elsif ($cmd =~ /^restore$/i) { - ### CMD: RESTORE: if ($args eq "") { &help("topic restore"); return; @@ -451,28 +471,33 @@ sub Topic { $args = 1; } - if ($args =~ /\d+/) { - if ($args > $#{ $topic{$chan}{'History'} } || $args < 1) { - &msg($who, "error: argument is out of range."); - return; - } - - $_ = "Changing topic according to request."; - &topicNew($chan, ${ $topic{$chan}{'History'} }[$args-1], $_, $topicUpdate); + if ($args !~ /\d+/) { + &msg($who, "error: argument is not positive integer."); + return; + } + if ($args > $#{ $topic{$chan}{'History'} } || $args < 1) { + &msg($who, "error: argument is out of range."); return; } - &msg($who, "error: argument is not positive integer."); + $_ = "Changing topic according to request."; + &topicNew($chan, ${ $topic{$chan}{'History'} }[$args-1], $_, $topicUpdate); +} + +# cmd: rehash. +sub do_rehash { + my ($chan) = @_; - } elsif ($cmd =~ /^rehash$/i) { - ### CMD: REHASH. $_ = "Rehashing topic..."; $topic{$chan}{'What'} = "Rehash"; &topicNew($chan, $topic{$chan}{'Current'}, $_, 1); +} + +# cmd: info. +sub do_info { + my ($chan) = @_; - } elsif ($cmd =~ /^info$/i) { - ### CMD: INFO. my $reply = "no topic info."; if (exists $topic{$chan}{'Who'} and exists $topic{$chan}{'Time'}) { $reply = "topic on \002$chan\002 was last set by ". @@ -484,18 +509,65 @@ sub Topic { } &performStrictReply($reply); - } else { - ### CMD: HELP: - if ($cmd ne "" and $cmd !~ /^help/i) { - &msg($who, "Invalid command [$cmd]."); - &msg($who, "Try 'help topic'."); - return; +} + +############################### +##### MAIN +############################### + +### +# Usage: &Topic($cmd, $args); +sub Topic { + my ($chan, $cmd, $args) = @_; + my $topicUpdate = 1; + + if ($cmd =~ /^-(\S+)/) { + $topicUpdate = 0; + $cmd = $1; } - &help("topic"); - } + if ($cmd =~ /^(add)$/i) { + &do_add($chan, $args); + + } elsif ($cmd =~ /^(del|delete|rm|remove|kill|purge)$/i) { + &do_delete($chan, $args); + + } elsif ($cmd =~ /^list$/i) { + &do_list($chan, $args); + + } elsif ($cmd =~ /^(mod|modify|change|alter)$/i) { + &do_modify($chan, $args); + + } elsif ($cmd =~ /^(mv|move)$/i) { + &do_move($chan, $args); + + } elsif ($cmd =~ /^shuffle$/i) { + &do_shuffle($chan, $args); + + } elsif ($cmd =~ /^(history)$/i) { + &do_history($chan, $args); + + } elsif ($cmd =~ /^restore$/i) { + &do_restore($chan, $args); - return; + } elsif ($cmd =~ /^rehash$/i) { + &do_rehash($chan); + + } elsif ($cmd =~ /^info$/i) { + &do_info($chan); + + } else { + ### CMD: HELP: + if ($cmd ne "" and $cmd !~ /^help/i) { + &msg($who, "Invalid command [$cmd]."); + &msg($who, "Try 'help topic'."); + return; + } + + &help("topic"); + } + + return; } 1; diff --git a/src/core.pl b/src/core.pl index 9bcaccd..f7d989b 100644 --- a/src/core.pl +++ b/src/core.pl @@ -100,7 +100,7 @@ sub doExit { &status("--- Start of quit."); $ident ||= "blootbot"; # lame hack. - &status("Memory Usage: $memusage kB"); + &status("Memory Usage: $memusage KiB"); &closePID(); &closeStats(); @@ -321,7 +321,7 @@ sub getChanConfDefault { if (exists $param{$what}) { if (!exists $cache{config}{$what}) { - &status("Config ($chan): backward-compatible option: found param{$what} ($param{$what}) instead"); + &status("config ($chan): backward-compatible option: found param{$what} ($param{$what}) instead"); $cache{config}{$what} = 1; } @@ -331,7 +331,7 @@ sub getChanConfDefault { return $val if (defined $val); $param{$what} = $default; - &status("Config ($chan): auto-setting param{$what} = $default"); + &status("config ($chan): auto-setting param{$what} = $default"); $cache{config}{$what} = 1; return $default; } @@ -394,13 +394,13 @@ sub showProc { if ($delta == 0) { return; } elsif ($delta > 500) { - $str = "MEM:$prefix increased by $delta kB. (total: $memusage kB)"; + $str = "MEM:$prefix increased by $delta KiB. (total: $memusage KiB)"; } elsif ($delta > 0) { - $str = "MEM:$prefix increased by $delta kB"; + $str = "MEM:$prefix increased by $delta KiB"; } else { # delta < 0. $delta = -$delta; # never knew RSS could decrease, probably Size can't? - $str = "MEM:$prefix decreased by $delta kB."; + $str = "MEM:$prefix decreased by $delta KiB."; } &status($str); @@ -440,7 +440,7 @@ sub setup { $param{tempDir} =~ s#\~/#$ENV{HOME}/#; - &status("Initial memory usage: $memusage kB"); + &status("Initial memory usage: $memusage KiB"); &status("-------------------------------------------------------"); } @@ -476,7 +476,7 @@ sub setupConfig { sub startup { if (&IsParam("DEBUG")) { &status("enabling debug diagnostics."); - ### I thought disabling this reduced memory usage by 1000 kB. + ### I thought disabling this reduced memory usage by 1000 KiB. use diagnostics; } diff --git a/src/dbi.pl b/src/dbi.pl index 8efc2f1..0166880 100644 --- a/src/dbi.pl +++ b/src/dbi.pl @@ -500,7 +500,6 @@ sub hashref2array { sub countKeys { my ($table, $col) = @_; $col ||= "*"; - &DEBUG("&countKeys($table, $col);"); return (&sqlRawReturn("SELECT count($col) FROM $table"))[0]; } diff --git a/src/modules.pl b/src/modules.pl index 7c5832b..62c8e1d 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -287,7 +287,7 @@ sub loadPerlModule { return 0; } else { $perlModulesLoaded{$_[0]} = 1; - &status("Module: Loaded $_[0] ..."); + &status("Loaded $_[0]"); &showProc(" ($_[0])"); return 1; } @@ -343,7 +343,7 @@ sub loadMyModule { } else { $moduleAge{$modulefile} = (stat $modulefile)[9]; - &status("myModule: Loaded $modulebase ..."); + &status("Loaded $modulebase"); &showProc(" ($modulebase)"); return 1; } -- 2.39.2