src/Modules/Topic.pl

   1 #
   2 # Topic.pl: Advanced topic management (maxtopiclen>=512)
   3 #   Author: dms
   4 #  Version: v0.8 (19990919).
   5 #  Created: 19990720
   6 #
   7
   8 use strict;
   9 use vars qw(%topiccmp %topic %channels %cache %orig);
  10 use vars qw($who $chan $conn $uh $ident);
  11
  12 ###############################
  13 ##### INTERNAL FUNCTIONS
  14 ###############################
  15
  16 ###
  17 # Usage: &topicDecipher(chan);
  18 sub topicDecipher {
  19     my ($chan) = @_;
  20     my @results;
  21
  22     return if (!exists $topic{$chan});
  23     return if (!exists $topic{$chan}{'Current'});
  24
  25     foreach (split /\|\|/, $topic{$chan}{'Current'}) {
  26         s/^\s+//;
  27         s/\s+$//;
  28
  29         # very nice fix to solve the null subtopic problem.
  30         # if nick contains a space, treat topic as ownerless.
  31         if (/^\(.*?\)$/) {
  32             next unless ($1 =~ /\s/);
  33         }
  34
  35         my $subtopic    = $_;
  36         my $owner       = "Unknown";
  37
  38         if (/(.*)\s+\((.*?)\)$/) {
  39             $subtopic   = $1;
  40             $owner      = $2;
  41         }
  42
  43         if (grep /^\Q$subtopic\E\|\|\Q$owner\E$/, @results) {
  44             &status("Topic: we have found a dupe ($subtopic) in the topic, not adding.");
  45             next;
  46         }
  47
  48         push(@results, "$subtopic||$owner");
  49     }
  50
  51     return @results;
  52 }
  53
  54 ###
  55 # Usage: &topicCipher(@topics);
  56 sub topicCipher {
  57     return if (!@_);
  58
  59     my @topic;
  60     foreach (@_) {
  61         my ($subtopic, $setby) = split /\|\|/;
  62
  63         if ($setby =~ /^(unknown|)$/i) {
  64             push(@topic, $subtopic);
  65         # If topicAuthor is on then show it in topic, otherwise just topic -- troubled
  66         } elsif ($param{'topicAuthor'} eq "1") {
  67             push(@topic, "$subtopic ($setby)");
  68         } else {
  69             push(@topic, "$subtopic");
  70         }
  71     }
  72
  73     return join(' || ', @topic);
  74 }
  75
  76 ###
  77 # Usage: &topicNew($chan, $topic, $updateMsg);
  78 sub topicNew {
  79     my ($chan, $topic, $updateMsg) = @_;
  80     my $maxlen = 470;
  81
  82     if ($channels{$chan}{t} and !$channels{$chan}{o}{$ident}) {
  83         &msg($who, "error: cannot change topic without ops. (channel is +t) :(");
  84         return 0;
  85     }
  86
  87     if (defined $topiccmp{$chan} and $topiccmp{$chan} eq $topic) {
  88         &msg($who, "warning: action had no effect on topic; no change required.");
  89         return 0;
  90     }
  91
  92     # bail out if the new topic is too long.
  93     my $newlen = length($chan.$topic);
  94     if ($newlen > $maxlen) {
  95         &msg($who, "new topic will be too long. ($newlen > $maxlen)");
  96         return 0;
  97     }
  98
  99     $topic{$chan}{'Current'} = $topic;
 100
 101     if ($cache{topicNotUpdate}{$chan}) {
 102         &msg($who, "done. 'flush' to finalize changes.");
 103         delete $cache{topicNotUpdate}{$chan};
 104         return 1;
 105     }
 106
 107     if (defined $updateMsg && $updateMsg ne "") {
 108         &msg($who, $updateMsg);
 109     }
 110
 111     $topic{$chan}{'Last'} = $topic;
 112     $topic{$chan}{'Who'}  = $orig{who}."!".$uh;
 113     $topic{$chan}{'Time'} = time();
 114
 115     if ($topic) {
 116         $conn->topic($chan, $topic);
 117         &topicAddHistory($chan, $topic);
 118     } else {
 119         $conn->topic($chan, " ");
 120     }
 121
 122     return 1;
 123 }
 124
 125 ###
 126 # Usage: &topicAddHistory($chan,$topic);
 127 sub topicAddHistory {
 128     my ($chan, $topic)  = @_;
 129     my $dupe            = 0;
 130
 131     return 1 if ($topic eq "");                 # required fix.
 132
 133     foreach (@{ $topic{$chan}{'History'} }) {
 134         next if ($_ ne "" and $_ ne $topic);
 135         # checking length is required.
 136
 137         # slightly weird to put a return statement in a loop.
 138         return 1;
 139     }
 140
 141     # WTF IS THIS FOR?
 142
 143     my @topics = @{ $topic{$chan}{'History'} };
 144     unshift(@topics, $topic);
 145     pop(@topics) while (scalar @topics > 6);
 146     $topic{$chan}{'History'} = \@topics;
 147
 148     return $dupe;
 149 }
 150
 151 ###############################
 152 ##### HELPER FUNCTIONS
 153 ###############################
 154
 155 # cmd: add.
 156 sub do_add {
 157     my ($chan, $args) = @_;
 158
 159     if ($args eq "") {
 160         &help("topic add");
 161         return;
 162     }
 163
 164     # heh, joeyh. 19990819. -xk
 165     if ($who =~ /\|\|/) {
 166         &msg($who, "error: you have an invalid nick, loser!");
 167         return;
 168     }
 169
 170     return if ($channels{$chan}{t} and !&hasFlag("T"));
 171
 172     my @prev = &topicDecipher($chan);
 173     my $new  = "$args ($orig{who})";
 174     $topic{$chan}{'What'} = "Added '$args'.";
 175
 176     if (scalar @prev) {
 177         my $str = sprintf("%s||%s", $args, $who);
 178         $new = &topicCipher(@prev, $str);
 179     }
 180
 181     &topicNew($chan, $new, "");
 182 }
 183
 184 # cmd: delete.
 185 sub do_delete {
 186     my ($chan, $args)   = @_;
 187     my @subtopics       = &topicDecipher($chan);
 188     my $topiccount      = scalar @subtopics;
 189
 190     if ($topiccount == 0) {
 191         &msg($who, "No topic set.");
 192         return;
 193     }
 194
 195     if ($args eq "") {
 196         &help("topic del");
 197         return;
 198     }
 199
 200     for ($args) {
 201         $_ = sprintf(",%s,", $args);
 202         s/\s+//g;
 203         s/(first|1st)/1/i;
 204         s/last/$topiccount/i;
 205         s/,-(\d+)/,1-$1/;
 206         s/(\d+)-,/,$1-$topiccount/;
 207     }
 208
 209     if ($args !~ /[\,\-\d]/) {
 210         &msg($who, "error: Invalid argument ($args).");
 211         return;
 212     }
 213
 214     my @delete;
 215     foreach (split ",", $args) {
 216         next if ($_ eq "");
 217
 218         # change to hash list instead of array?
 219         if (/^(\d+)-(\d+)$/) {
 220             my ($from,$to) = ($1,$2);
 221             ($from,$to) = ($2,$1)       if ($from > $to);
 222
 223             push(@delete, $1..$2);
 224         } elsif (/^(\d+)$/) {
 225             push(@delete, $1);
 226         } else {
 227             &msg($who, "error: Invalid sub-argument ($_).");
 228             return;
 229         }
 230
 231         $topic{$chan}{'What'} = "Deleted ".join("/",@delete);
 232     }
 233
 234     foreach (@delete) {
 235         if ($_ > $topiccount || $_ < 1) {
 236             &msg($who, "error: argument out of range. (max: $topiccount)");
 237             return;
 238         }
 239
 240         # skip if already deleted.
 241         # only checked if x-y range is given.
 242         next unless (defined($subtopics[$_-1]));
 243
 244         my ($subtopic,$whoby) = split('\|\|', $subtopics[$_-1]);
 245
 246         $whoby = "unknown" if ($whoby eq "");
 247
 248         &msg($who, "Deleting topic: $subtopic ($whoby)");
 249         undef $subtopics[$_-1];
 250     }
 251
 252     my @newtopics;
 253     foreach (@subtopics) {
 254         next unless (defined $_);
 255         push(@newtopics, $_);
 256     }
 257
 258     &topicNew($chan, &topicCipher(@newtopics), "");
 259 }
 260
 261 # cmd: list
 262 sub do_list {
 263     my ($chan, $args) = @_;
 264     my @topics = &topicDecipher($chan);
 265
 266     if (!scalar @topics) {
 267         &msg($who, "No topics for \002$chan\002.");
 268         return;
 269     }
 270
 271     &msg($who, "Topics for \002$chan\002:");
 272     &msg($who, "No  \002[\002  Set by  \002]\002 Topic");
 273
 274     my $i = 1;
 275     foreach (@topics) {
 276         my ($subtopic, $setby) = split /\|\|/;
 277
 278         my $str = sprintf(" %d. [%-10s] %s", $i, $setby, $subtopic);
 279         # is there a better way of doing this?
 280         $str =~ s/ (\[)/ \002$1/g;
 281         $str =~ s/ (\])/ \002$1/g;
 282
 283         &msg($who, $str);
 284         $i++;
 285     }
 286
 287     &msg($who, "End of Topics.");
 288 }
 289
 290 # cmd: modify.
 291 sub do_modify {
 292     my ($chan, $args) = @_;
 293
 294     if ($args eq "") {
 295         &help("topic mod");
 296         return;
 297     }
 298
 299     # a warning message instead of halting. we kind of trust the user now.
 300     if ($args =~ /\|\|/) {
 301         &msg($who, "warning: adding double pipes manually == evil. be warned.");
 302     }
 303
 304     $topic{$chan}{'What'} = "SAR $args";
 305
 306     # SAR patch. mu++
 307     if ($args =~ m|^\s*s([/,#])(.+?)\1(.*?)\1([a-z]*);?\s*$|) {
 308         my ($delim, $op, $np, $flags) = ($1,$2,$3,$4);
 309
 310         if ($flags !~ /^(g)?$/) {
 311             &msg($who, "error: Invalid flags to regex.");
 312             return;
 313         }
 314
 315         my $topic = $topic{$chan}{'Current'};
 316
 317         ### TODO: use m### to make code safe!
 318         if (($flags eq "g" and $topic =~ s/\Q$op\E/$np/g) ||
 319             ($flags eq ""  and $topic =~ s/\Q$op\E/$np/)
 320         ) {
 321
 322             $_ = "Modifying topic with sar s/$op/$np/.";
 323             &topicNew($chan, $topic, $_);
 324         } else {
 325             &msg($who, "warning: regex not found in topic.");
 326         }
 327
 328         return;
 329     }
 330
 331     &msg($who, "error: Invalid regex. Try s/1/2/, s#3#4#...");
 332 }
 333
 334 # cmd: move.
 335 sub do_move {
 336     my ($chan, $args) = @_;
 337
 338     if ($args eq "") {
 339         &help("topic mv");
 340         return;
 341     }
 342
 343     my ($from, $action, $to);
 344     # better way of doing this?
 345     if ($args =~ /^(first|last|\d+)\s+(before|after|swap)\s+(first|last|\d+)$/i) {
 346         ($from, $action, $to) = ($1,$2,$3);
 347     } else {
 348         &msg($who, "Invalid arguments.");
 349         return;
 350     }
 351
 352     my @subtopics  = &topicDecipher($chan);
 353     my @newtopics;
 354     my $topiccount = scalar @subtopics;
 355
 356     if ($topiccount == 1) {
 357         &msg($who, "error: impossible to move the only subtopic, dumbass.");
 358         return;
 359     }
 360
 361     # Is there an easier way to do this?
 362     $from =~ s/first/1/i;
 363     $to   =~ s/first/1/i;
 364     $from =~ s/last/$topiccount/i;
 365     $to   =~ s/last/$topiccount/i;
 366
 367     if ($from > $topiccount || $to > $topiccount || $from < 1 || $to < 1) {
 368         &msg($who, "error: <from> or <to> is out of range.");
 369         return;
 370     }
 371
 372     if ($from == $to) {
 373         &msg($who, "error: <from> and <to> are the same.");
 374         return;
 375     }
 376
 377     $topic{$chan}{'What'} = "Move $from to $to";
 378
 379     if ($action =~ /^(swap)$/i) {
 380         my $tmp                 = $subtopics[$to   - 1];
 381         $subtopics[$to   - 1]   = $subtopics[$from - 1];
 382         $subtopics[$from - 1]   = $tmp;
 383
 384         $_ = "Swapped #\002$from\002 with #\002$to\002.";
 385         &topicNew($chan, &topicCipher(@subtopics), $_);
 386         return;
 387     }
 388
 389     # action != swap:
 390     # Is there a better way to do this? guess not.
 391     my $i               = 1;
 392     my $subtopic        = $subtopics[$from - 1];
 393     foreach (@subtopics) {
 394         my $j = $i*2 - 1;
 395         $newtopics[$j] = $_ if ($i != $from);
 396         $i++;
 397     }
 398
 399     if ($action =~ /^(before|b4)$/i) {
 400         $newtopics[$to*2-2] = $subtopic;
 401     } else {
 402         # action =~ /after/.
 403         $newtopics[$to*2] = $subtopic;
 404     }
 405
 406     undef @subtopics;                   # lets reuse this array.
 407     foreach (@newtopics) {
 408         next if (!defined $_ or $_ eq "");
 409         push(@subtopics, $_);
 410     }
 411
 412     $_ = "Moved #\002$from\002 $action #\002$to\002.";
 413     &topicNew($chan, &topicCipher(@subtopics), $_);
 414 }
 415
 416 # cmd: shuffle.
 417 sub do_shuffle {
 418     my ($chan, $args)   = @_;
 419     my @subtopics       = &topicDecipher($chan);
 420     my @newtopics;
 421
 422     $topic{$chan}{'What'} = "shuffled";
 423
 424     foreach (&makeRandom(scalar @subtopics)) {
 425         push(@newtopics, $subtopics[$_]);
 426     }
 427
 428     $_ = "Shuffling the bag of lollies.";
 429     &topicNew($chan, &topicCipher(@newtopics), $_);
 430 }
 431
 432 # cmd: history.
 433 sub do_history {
 434     my ($chan, $args) = @_;
 435
 436     if (!scalar @{ $topic{$chan}{'History'} }) {
 437         &msg($who, "Sorry, no topics in history list.");
 438         return;
 439     }
 440
 441     &msg($who, "History of topics on \002$chan\002:");
 442     for (1 .. scalar @{ $topic{$chan}{'History'} }) {
 443         my $topic = ${ $topic{$chan}{'History'} }[$_-1];
 444         &msg($who, "  #\002$_\002: $topic");
 445
 446         # To prevent excess floods.
 447         sleep 1 if (length($topic) > 160);
 448     }
 449
 450     &msg($who, "End of list.");
 451 }
 452
 453 # cmd: restore.
 454 sub do_restore {
 455     my ($chan, $args) = @_;
 456
 457     if ($args eq "") {
 458         &help("topic restore");
 459         return;
 460     }
 461
 462     $topic{$chan}{'What'} = "Restore topic $args";
 463
 464     # following needs to be verified.
 465     if ($args =~ /^last$/i) {
 466         if (${ $topic{$chan}{'History'} }[0] eq $topic{$chan}{'Current'}) {
 467             &msg($who,"error: cannot restore last topic because it's mine.");
 468             return;
 469         }
 470         $args = 1;
 471     }
 472
 473     if ($args !~ /\d+/) {
 474         &msg($who, "error: argument is not positive integer.");
 475         return;
 476     }
 477
 478     if ($args > $#{ $topic{$chan}{'History'} } || $args < 1) {
 479         &msg($who, "error: argument is out of range.");
 480         return;
 481     }
 482
 483     $_ = "Changing topic according to request.";
 484     &topicNew($chan, ${ $topic{$chan}{'History'} }[$args-1], $_);
 485 }
 486
 487 # cmd: rehash.
 488 sub do_rehash {
 489     my ($chan) = @_;
 490
 491     $_ = "Rehashing topic...";
 492     $topic{$chan}{'What'} = "Rehash";
 493     &topicNew($chan, $topic{$chan}{'Current'}, $_, 1);
 494 }
 495
 496 # cmd: info.
 497 sub do_info {
 498     my ($chan) = @_;
 499
 500     my $reply = "no topic info.";
 501     if (exists $topic{$chan}{'Who'} and exists $topic{$chan}{'Time'}) {
 502         $reply = "topic on \002$chan\002 was last set by ".
 503                 $topic{$chan}{'Who'}. ".  This was done ".
 504                 &Time2String(time() - $topic{$chan}{'Time'}) ." ago".
 505                 ".  Length: ".length($topic{$chan}{'Current'});
 506         my $change = $topic{$chan}{'What'};
 507         $reply .= ".  Change => $change" if (defined $change);
 508     }
 509
 510     &performStrictReply($reply);
 511 }
 512
 513 ###############################
 514 ##### MAIN
 515 ###############################
 516
 517 ###
 518 # Usage: &Topic($cmd, $args);
 519 sub Topic {
 520     my ($chan, $cmd, $args) = @_;
 521
 522     if ($cmd =~ /^-(\S+)/) {
 523         $cache{topicNotUpdate}{$chan} = 1;
 524         $cmd = $1;
 525     }
 526
 527     if ($cmd =~ /^(add)$/i) {
 528         &do_add($chan, $args);
 529
 530     } elsif ($cmd =~ /^(del|delete|rm|remove|kill|purge)$/i) {
 531         &do_delete($chan, $args);
 532
 533     } elsif ($cmd =~ /^list$/i) {
 534         &do_list($chan, $args);
 535
 536     } elsif ($cmd =~ /^(mod|modify|change|alter)$/i) {
 537         &do_modify($chan, $args);
 538
 539     } elsif ($cmd =~ /^(mv|move)$/i) {
 540         &do_move($chan, $args);
 541
 542     } elsif ($cmd =~ /^shuffle$/i) {
 543         &do_shuffle($chan, $args);
 544
 545     } elsif ($cmd =~ /^(history)$/i) {
 546         &do_history($chan, $args);
 547
 548     } elsif ($cmd =~ /^restore$/i) {
 549         &do_restore($chan, $args);
 550
 551     } elsif ($cmd =~ /^(flush|rehash)$/i) {
 552         &do_rehash($chan);
 553
 554     } elsif ($cmd =~ /^info$/i) {
 555         &do_info($chan);
 556
 557     } else {
 558         ### HELP:
 559         if ($cmd ne "" and $cmd !~ /^help/i) {
 560             &msg($who, "Invalid command [$cmd].");
 561             &msg($who, "Try 'help topic'.");
 562             return;
 563         }
 564
 565         &help("topic");
 566     }
 567
 568     return;
 569 }
 570
 571 1;