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