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