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