src/Modules/Topic.pl

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