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