$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; $i<scalar @array; $i++) {
- next unless ($array[0] =~ /^\Q$who\E$/);
- $good++;
- last;
- }
- $i++;
-
- my $total = scalar(@array);
- my $xtra = "";
- if ($total and $good) {
- my $pct = sprintf("%.01f", 100*(1+$total-$i)/$total);
- $xtra = ", ranked $i\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");
- }
-
- return;
- }
-
- if ($@) {
- &DEBUG("regex failed: $@");
- return;
- }
+ &do_text_counters($itc);
+ return;
}
# list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET
my $reply;
### TODO: multi channel support. may require &IsNick() to return
### all channels or something.
+
my @chans = &getNickInChans($seen[0]);
if (scalar @chans) {
$reply = "$seen[0] is currently on";
$conn->schedule(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<scalar @array; $i++) {
+ next unless ($array[0] =~ /^\Q$who\E$/);
+ $good++;
+ last;
+ }
+ $i++;
+
+ my $total = scalar(@array);
+ my $xtra = "";
+ if ($total and $good) {
+ my $pct = sprintf("%.01f", 100*(1+$total-$i)/$total);
+ $xtra = ", ranked $i\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");
+ }
+
+ if ($@) {
+ &DEBUG("regex failed: $@");
+ return;
+ }
+}
+
sub textstats_main {
my($arg) = @_;
}
my $topstr = "";
- &DEBUG("*stats: tp => $tp");
if (scalar @top) {
$topstr = ". Top ".scalar(@top).": ".join(', ', @top);
}
} 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<scalar @array; $i++) {
- next unless ($array[0] =~ /^\Q$who\E$/);
- $good++;
- last;
- }
- $ii++;
+ return;
+ }
- $total = scalar(@array);
- &DEBUG(" 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<scalar @array; $i++) {
+ next unless ($array[0] =~ /^\Q$who\E$/);
+ $good++;
+ last;
}
+ $ii++;
- return;
+ $total = scalar(@array);
+ &DEBUG(" 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);
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
###
# 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;
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;
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+)$/) {
}
$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;
}
&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;
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");
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: <from> or <to> 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: <from> and <to> 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: <from> or <to> 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: <from> and <to> 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";
$_ = "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;
# 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;
$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 ".
}
&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;
projects / infobot.git / commitdiff