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);
  10 no strict "refs";               ### FIXME!!!
  11
  12 ###############################
  13 ##### INTERNAL FUNCTIONS
  14 ###############################
  15
  16 ###
  17 # Usage: &topicDecipher(chan);
  18 sub topicDecipher {
  19   my $chan      = shift;
  20   my @results;
  21
  22   if (!exists $topic{$chan}{'Current'}) {
  23     return;
  24   }
  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     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 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   if (!@_) {
  58     &DEBUG("topicCipher: topic is NULL.");
  59     return;
  60   }
  61
  62   my $result;
  63   foreach (@_) {
  64     my ($subtopic, $setby) = split /\|\|/;
  65
  66     $result .= " || $subtopic";
  67     next if ($setby eq "" or $setby =~ /unknown/i);
  68
  69     $result .= " (" . $setby . ")";
  70   }
  71
  72   return substr($result, 4);
  73 }
  74
  75 ###
  76 # Usage: &topicNew($chan, $topic, $updateMsg, $topicUpdate);
  77 sub topicNew {
  78   my ($chan, $topic, $updateMsg, $topicUpdate) = @_;
  79   my $maxlen = 470;
  80
  81   if ($channels{$chan}{t} and !$channels{$chan}{o}{$ident}) {
  82     &msg($who, "error: cannot change topic without ops. (channel is +t) :(");
  83     return 0;
  84   }
  85
  86   if (defined $topiccmp{$chan} and $topiccmp{$chan} eq $topic) {
  87     &msg($who, "warning: action had no effect on topic; no change required.");
  88     return 0;
  89   }
  90
  91   # bail out if the new topic is too long.
  92   my $newlen = length($chan.$topic);
  93   if ($newlen > $maxlen) {
  94     &msg($who, "new topic will be too long. ($newlen > $maxlen)");
  95     return 0;
  96   }
  97
  98   $topic{$chan}{'Current'} = $topic;
  99
 100   # notification that the topic was altered.
 101   if (!$topicUpdate) {          # for cached changes with '-'.
 102     &performReply("okay");
 103     return 1;
 104   }
 105
 106   if ($updateMsg ne "") {
 107     &msg($who, $updateMsg);
 108   }
 109
 110   $topic{$chan}{'Last'} = $topic;
 111   $topic{$chan}{'Who'}  = $orig{who}."!".$uh;
 112   $topic{$chan}{'Time'} = time();
 113   rawout("TOPIC $chan :$topic");
 114   &topicAddHistory($chan,$topic);
 115   return 1;
 116 }
 117
 118 ###
 119 # Usage: &topicAddHistory($chan,$topic);
 120 sub topicAddHistory {
 121   my ($chan, $topic)    = @_;
 122   my $dupe              = 0;
 123
 124   return 1 if ($topic eq "");                   # required fix.
 125
 126   foreach (@{ $topic{$chan}{'History'} }) {
 127     next        if ($_ ne "" and $_ ne $topic);
 128     # checking length is required.
 129
 130     $dupe++;
 131     last;
 132   }
 133
 134   return 1      if $dupe;
 135
 136   my @topics = @{ $topic{$chan}{'History'} };
 137   unshift(@topics, $topic);
 138   pop(@topics) while (scalar @topics > 6);
 139   $topic{$chan}{'History'} = \@topics;
 140
 141   return $dupe;
 142 }
 143
 144 ###############################
 145 ##### HELPER FUNCTIONS
 146 ###############################
 147
 148 ### TODO.
 149 # sub topicNew {
 150 # sub topicDelete {
 151 # sub topicList {
 152 # sub topicModify {
 153 # sub topicMove {
 154 # sub topicShuffle {
 155 # sub topicHistory {
 156 # sub topicRestore {
 157 # sub topicRehash {
 158 # sub topicHelp {
 159
 160 ###############################
 161 ##### MAIN
 162 ###############################
 163
 164 ###
 165 # Usage: &Topic($cmd, $args);
 166 sub Topic {
 167   my ($chan, $cmd, $args) = @_;
 168   my $topicUpdate = 1;
 169
 170   if ($cmd =~ /^-(\S+)/) {
 171     $topicUpdate = 0;
 172     $cmd = $1;
 173   }
 174
 175   if ($cmd =~ /^(add)$/i) {
 176     ### CMD: ADD:
 177     if ($args eq "") {
 178         &help("topic add");
 179         return $noreply;
 180     }
 181
 182     # heh, joeyh. 19990819. -xk
 183     if ($who =~ /\|\|/) {
 184         &msg($who, "error: you have an invalid nick, loser!");
 185         return $noreply;
 186     }
 187
 188     my @prev = &topicDecipher($chan);
 189     my $new  = "$args ($orig{who})";
 190     $topic{$chan}{'What'} = "Added '$args'.";
 191     if (scalar @prev) {
 192       $new = &topicCipher(@prev, sprintf("%s||%s", $args, $who));
 193     }
 194     &topicNew($chan, $new, "", $topicUpdate);
 195
 196   } elsif ($cmd =~ /^(del|delete|rm|remove|kill|purge)$/i) {
 197     ### CMD: DEL:
 198     my @subtopics       = &topicDecipher($chan);
 199     my $topiccount      = scalar @subtopics;
 200
 201     if ($topiccount == 0) {
 202         &msg($who, "No topic set.");
 203         return $noreply;
 204     }
 205
 206     if ($args eq "") {
 207         &help("topic del");
 208         return $noreply;
 209     }
 210
 211     $args =  ",".$args.",";
 212     $args =~ s/\s+//g;
 213     $args =~ s/(first|1st)/1/i;
 214     $args =~ s/last/$topiccount/i;
 215     $args =~ s/,-(\d+)/,1-$1/;
 216     $args =~ s/(\d+)-,/,$1-$topiccount/;
 217
 218     if ($args !~ /[\,\-\d]/) {
 219         &msg($who, "error: Invalid argument ($args).");
 220         return $noreply;
 221     }
 222
 223     foreach (split ",", $args) {
 224         next if ($_ eq "");
 225         my @delete;
 226
 227         # change to hash list instead of array?
 228         if (/^(\d+)-(\d+)$/) {
 229             my ($from,$to) = ($1,$2);
 230             ($from,$to) = ($2,$1)       if ($from > $to);
 231
 232             push(@delete, $1..$2);
 233         } elsif (/^(\d+)$/) {
 234             push(@delete, $1);
 235         } else {
 236             &msg($who, "error: Invalid sub-argument ($_).");
 237             return $noreply;
 238         }
 239
 240         $topic{$chan}{'What'} = "Deleted ".join("/",@delete);
 241
 242         foreach (@delete) {
 243           if ($_ > $topiccount || $_ < 1) {
 244             &msg($who, "error: argument out of range. (max: $topiccount)");
 245             return $noreply;
 246           }
 247           # skip if already deleted.
 248           # only checked if x-y range is given.
 249           next unless (defined($subtopics[$_-1]));
 250
 251           my ($subtopic,$whoby) = split('\|\|', $subtopics[$_-1]);
 252           $whoby                = "unknown"     if ($whoby eq "");
 253           &msg($who, "Deleting topic: $subtopic ($whoby)");
 254           undef $subtopics[$_-1];
 255         }
 256     }
 257
 258     my @newtopics;
 259     foreach (@subtopics) {
 260         next unless (defined $_);
 261         push(@newtopics, $_);
 262     }
 263
 264     &topicNew($chan, &topicCipher(@newtopics), "", $topicUpdate);
 265
 266   } elsif ($cmd =~ /^list$/i) {
 267     ### CMD: LIST:
 268     my @topics  = &topicDecipher($chan);
 269     if (!scalar @topics) {
 270         &msg($who, "No topics for \002$chan\002.");
 271         return $noreply;
 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         &msg($who, sprintf(" %d. \002[\002%-10s\002]\002 %s",
 282                                 $i, $setby, $subtopic));
 283         $i++;
 284     }
 285     &msg($who, "End of Topics.");
 286
 287   } elsif ($cmd =~ /^(mod|modify|change|alter)$/i) {
 288     ### CMD: MOD:
 289
 290     if ($args eq "") {
 291         &help("topic mod");
 292         return $noreply;
 293     }
 294
 295     # a warning message instead of halting. we kind of trust the user now.
 296     if ($args =~ /\|\|/) {
 297         &msg($who, "warning: adding double pipes manually == evil. be warned.");
 298     }
 299
 300     $topic{$chan}{'What'} = "SAR $args";
 301
 302     # SAR patch. mu++
 303     if ($args =~ m|^\s*s([/,#])(.+?)\1(.*?)\1([a-z]*);?\s*$|) {
 304         my ($delim, $op, $np, $flags) = ($1,quotemeta $2,$3,$4);
 305
 306         if ($flags !~ /^(g)?$/) {
 307           &msg($who, "error: Invalid flags to regex.");
 308           return $noreply;
 309         }
 310
 311         my $topic = $topic{$chan}{'Current'};
 312
 313         if (($flags eq "g" and $topic =~ s/$op/$np/g) ||
 314             ($flags eq ""  and $topic =~ s/$op/$np/)) {
 315
 316           $_ = "Modifying topic with sar s/$op/$np/.";
 317           &topicNew($chan, $topic, $_, $topicUpdate);
 318         } else {
 319           &msg($who, "warning: regex not found in topic.");
 320         }
 321         return $noreply;
 322     }
 323
 324     &msg($who, "error: Invalid regex. Try s/1/2/, s#3#4#...");
 325
 326   } elsif ($cmd =~ /^(mv|move)$/i) {
 327     ### CMD: MV:
 328
 329     if ($args eq "") {
 330         &help("topic mv");
 331         return $noreply;
 332     }
 333
 334     if ($args =~ /^(first|last|\d+)\s+(before|after|swap)\s+(first|last|\d+)$/i) {
 335         my ($from, $action, $to) = ($1,$2,$3);
 336         my @subtopics  = &topicDecipher($chan);
 337         my @newtopics;
 338         my $topiccount = scalar @subtopics;
 339
 340         if ($topiccount == 1) {
 341           &msg($who, "error: impossible to move the only subtopic, dumbass.");
 342           return $noreply;
 343         }
 344
 345         # Is there an easier way to do this?
 346         $from =~ s/first/1/i;
 347         $to   =~ s/first/1/i;
 348         $from =~ s/last/$topiccount/i;
 349         $to   =~ s/last/$topiccount/i;
 350
 351         if ($from > $topiccount || $to > $topiccount || $from < 1 || $to < 1) {
 352           &msg($who, "error: <from> or <to> is out of range.");
 353           return $noreply;
 354         }
 355
 356         if ($from == $to) {
 357           &msg($who, "error: <from> and <to> are the same.");
 358           return $noreply;
 359         }
 360
 361         $topic{$chan}{'What'} = "Move $from to $to";
 362
 363         if ($action =~ /^(swap)$/i) {
 364           my $tmp                       = $subtopics[$to   - 1];
 365           $subtopics[$to   - 1]         = $subtopics[$from - 1];
 366           $subtopics[$from - 1]         = $tmp;
 367
 368           $_ = "Swapped #\002$from\002 with #\002$to\002.";
 369           &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
 370           return $noreply;
 371         }
 372
 373         # action != swap:
 374         # Is there a better way to do this? guess not.
 375         my $i           = 1;
 376         my $subtopic    = $subtopics[$from - 1];
 377         foreach (@subtopics) {
 378           my $j = $i*2 - 1;
 379           $newtopics[$j] = $_   if ($i != $from);
 380           $i++;
 381         }
 382
 383         if ($action =~ /^(before|b4)$/i) {
 384             $newtopics[$to*2-2] = $subtopic;
 385         } else {
 386             # action =~ /after/.
 387             $newtopics[$to*2] = $subtopic;
 388         }
 389
 390         undef @subtopics;                       # lets reuse this array.
 391         foreach (@newtopics) {
 392           next if ($_ eq "");
 393           push(@subtopics, $_);
 394         }
 395
 396         $_ = "Moved #\002$from\002 $action #\002$to\002.";
 397         &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
 398
 399         return $noreply;
 400     }
 401
 402     &msg($who, "Invalid arguments.");
 403
 404   } elsif ($cmd =~ /^shuffle$/i) {
 405     ### CMD: SHUFFLE:
 406     my @subtopics  = &topicDecipher($chan);
 407     my @newtopics;
 408
 409     $topic{$chan}{'What'} = "shuffled";
 410
 411     foreach (&makeRandom(scalar @subtopics)) {
 412         push(@newtopics, $subtopics[$_]);
 413     }
 414
 415     $_ = "Shuffling the bag of lollies.";
 416     &topicNew($chan, &topicCipher(@newtopics), $_, $topicUpdate);
 417
 418   } elsif ($cmd =~ /^(history)$/i) {
 419     ### CMD: HISTORY:
 420     if (!scalar @{$topic{$chan}{'History'}}) {
 421         &msg($who, "Sorry, no topics in history list.");
 422         return $noreply;
 423     }
 424
 425     &msg($who, "History of topics on \002$chan\002:");
 426     for (1 .. scalar @{$topic{$chan}{'History'}}) {
 427         my $topic = ${$topic{$chan}{'History'}}[$_-1];
 428         &msg($who, "  #\002$_\002: $topic");
 429
 430         # To prevent excess floods.
 431         sleep 1 if (length($topic) > 160);
 432     }
 433     &msg($who, "End of list.");
 434
 435   } elsif ($cmd =~ /^restore$/i) {
 436     ### CMD: RESTORE:
 437     if ($args eq "") {
 438         &help("topic restore");
 439         return $noreply;
 440     }
 441
 442     $topic{$chan}{'What'} = "Restore topic $args";
 443
 444     # following needs to be verified.
 445     if ($args =~ /^last$/i) {
 446         if (${$topic{$chan}{'History'}}[0] eq $topic{$chan}{'Current'}) {
 447             &msg($who,"error: cannot restore last topic because it's mine.");
 448             return $noreply;
 449         }
 450         $args = 1;
 451     }
 452
 453     if ($args =~ /\d+/) {
 454         if ($args > $#{$topic{$chan}{'History'}} || $args < 1) {
 455             &msg($who, "error: argument is out of range.");
 456             return $noreply;
 457         }
 458
 459         $_ = "Changing topic according to request.";
 460         &topicNew($chan, ${$topic{$chan}{'History'}}[$args-1], $_, $topicUpdate);
 461
 462         return $noreply;
 463     }
 464
 465     &msg($who, "error: argument is not positive integer.");
 466
 467   } elsif ($cmd =~ /^rehash$/i) {
 468     ### CMD: REHASH.
 469     $_ = "Rehashing topic...";
 470     $topic{$chan}{'What'} = "Rehash";
 471     &topicNew($chan, $topic{$chan}{'Current'}, $_, 1);
 472
 473   } elsif ($cmd =~ /^info$/i) {
 474     ### CMD: INFO.
 475     my $reply = "no topic info.";
 476     if (exists $topic{$chan}{'Who'} and exists $topic{$chan}{'Time'}) {
 477         $reply = "topic on \002$chan\002 was last set by ".
 478                 $topic{$chan}{'Who'}. ".  This was done ".
 479                 &Time2String(time() - $topic{$chan}{'Time'}) ." ago".
 480                 ".  Length: ".length($topic{$chan}{'Current'});
 481         my $change = $topic{$chan}{'What'};
 482         $reply .= ".  Change => $change" if (defined $change);
 483     }
 484
 485     &performStrictReply($reply);
 486   } else {
 487     ### CMD: HELP:
 488     if ($cmd ne "" and $cmd !~ /^help/i) {
 489         &msg($who, "Invalid command [$cmd].");
 490         &msg($who, "Try 'help topic'.");
 491         return $noreply;
 492     }
 493
 494     &help("topic");
 495   }
 496
 497   return $noreply;
 498 }
 499
 500 1;