2 # Misc.pl: Miscellaneous stuff.
4 # Version: v0.1 (20010906)
10 use vars qw(%param %cache %lang %cmdstats %bots);
11 use vars qw($message $who $addressed $chan $h $nuh $ident $msgType
12 $correction_plausable);
14 # Usage: &validFactoid($lhs,$rhs);
16 my ( $lhs, $rhs ) = @_;
21 # allow the following only if they have been made on purpose.
22 if ( $rhs ne '' and $rhs !~ /^</ ) {
23 / \Q$ident\E$/i and last; # someone said i'm something.
25 /^(it|that|there|what)('s)?(\s+|$)/ and last;
26 /^you('re)?(\s+|$)/ and last;
28 /^(where|who|why|when|how)(\s+|$)/ and last;
29 /^(this|that|these|those|they)(\s+|$)/ and last;
30 /^(every(one|body)|we) / and last;
36 /^add topic / and last; # topic management.
37 /( add$| add |^add )/ and last; # borked teach statement.
38 /^learn / and last; # teach. damn morons.
39 /^tell (\S+) about / and last; # tell.
40 /\=\~/ and last; # substituition.
42 /^\=/ and last; # botnick = heh is.
43 /wants you to know/ and last;
48 ( /^'/ and /'$/ ) and last;
49 ( /^"/ and /"$/ ) and last;
52 /\=\>/ and last; # '=>'.
53 /\;\;/ and last; # ';;'.
54 /\|\|/ and last; # '||'.
56 /^\Q$ident\E[\'\,\: ]/ and last; # dupe addressed.
58 /\\$/ and last; # forgot shift for '?'.
66 /^h(is|er) / and last;
74 /^supposedly/ and last;
79 # nasty bug I introduced _somehow_, probably by fixMySQLBug().
83 # weird/special stuff. also old infobot bugs.
84 $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
87 $rhs =~ /^\Q$lhs\E /i and last;
88 last if ( $rhs =~ /^is /i and / is$/ );
99 if ( $msgType =~ /private/ and $message =~ s/^:INFOBOT:// ) {
101 &status("infobot <$nuh> identified") unless $bots{$nuh};
107 if ( $message =~ /^QUERY (<.*?>) (.*)/ ) { # query.
108 my ( $target, $item ) = ( $1, $2 );
111 &status(":INFOBOT:QUERY $who: $message");
113 if ( $_ = &getFactoid($item) ) {
114 &msg( $who, ":INFOBOT:REPLY $target $item =is=> $_" );
117 return 'INFOBOT QUERY';
119 elsif ( $message =~ /^REPLY <(.*?)> (.*)/ ) { # reply.
120 my ( $target, $item ) = ( $1, $2 );
122 &status(":INFOBOT:REPLY $who: $message");
124 my ( $lhs, $mhs, $rhs ) = $item =~ /^(.*?) =(.*?)=> (.*)/;
126 if ( $param{'acceptUrl'} !~ /REQUIRE/
127 or $rhs =~ /(http|ftp|mailto|telnet|file):/ )
129 &msg( $target, "$who knew: $lhs $mhs $rhs" );
132 $rhs = "<REPLY> are" if ( $mhs eq 'are' );
133 &setFactInfo( $lhs, 'factoid_value', $rhs );
136 return 'INFOBOT REPLY';
139 &ERROR(":INFOBOT:UNKNOWN $who: $message");
140 return 'INFOBOT UNKNOWN';
145 if ( $message =~ s/^forget\s+//i ) {
146 return 'forget: no addr' unless ($addressed);
148 my $faqtoid = $message;
149 if ( $faqtoid eq '' ) {
154 $faqtoid =~ tr/A-Z/a-z/;
155 my $result = &getFactoid($faqtoid);
157 # if it doesn't exist, well... it doesn't!
158 if ( !defined $result ) {
159 &performReply("i didn't have anything called '$faqtoid' to forget");
163 # TODO: squeeze 3 getFactInfo calls into one?
164 my $author = &getFactInfo( $faqtoid, 'created_by' );
165 my $count = &getFactInfo( $faqtoid, 'requested_count' ) || 0;
167 # don't delete if requested $limit times
169 &getChanConfDefault( 'factoidPreventForgetLimit', 100, $chan );
171 # don't delete if older than $limitage seconds (modified by requests below)
172 my $limitage = &getChanConfDefault( 'factoidPreventForgetLimitTime',
173 7 * 24 * 60 * 60, $chan );
174 my $t = &getFactInfo( $faqtoid, 'created_time' ) || 0;
175 my $age = time() - $t;
177 # lets scale limitage from 1 (nearly 0) to $limit (full time).
178 $limitage = $limitage * ( $count + 1 ) / $limit if ( $count < $limit );
181 my $isau = ( defined $author and &IsHostMatch($author) == 2 ) ? 1 : 0;
182 my $isop = ( &IsFlag('o') eq 'o' ) ? 1 : 0;
184 if ( IsFlag('r') ne 'r' && !$isop ) {
185 &msg( $who, "you don't have access to remove factoids" );
189 return 'locked factoid' if ( &IsLocked($faqtoid) == 1 );
192 ### lets go do some checking.
195 # factoidPreventForgetLimitTime:
196 if ( !( $isop or $isau ) and $age / ( 60 * 60 * 24 ) > $limitage ) {
198 "cannot remove factoid '$faqtoid', too old. ("
199 . $age / ( 60 * 60 * 24 )
200 . ">$limitage) use 'no,' instead" );
204 # factoidPreventForgetLimit:
205 if ( !( $isop or $isau ) and $limit and $count > $limit ) {
207 "will not delete '$faqtoid', count > limit ($count > $limit) use 'no, ' instead."
212 # this may eat some memory.
213 # prevent deletion if other factoids redirect to it.
214 # TODO: use hash instead of array.
216 if ( &getChanConf('factoidPreventForgetRedirect') ) {
217 &status("Factoids/Core: forget: checking for redirect factoids");
219 &searchTable( 'factoids', 'factoid_key', 'factoid_value',
226 my $v = &getFactInfo( $f, 'factoid_value' );
227 my $fsafe = quotemeta($faqtoid);
228 next unless ( $v =~ /^<REPLY> ?see( also)? $fsafe\.?$/i );
230 &DEBUG("Factoids/Core: match! ($f || $faqtoid)");
235 # TODO: warn for op aswell, but allow force delete.
236 if ( !$isop and $match ) {
238 "uhm, other (redirection) factoids depend on this one." );
243 if ( !$isop and &IsHostMatch($author) != 2 ) {
244 $cache{forget}{$h}++;
247 if ( $cache{forget}{$h} > 3 ) {
248 &msg( $who, "Stop abusing forget!" );
252 # TODO: make forget limit configurable.
253 # TODO: make forget ignore time configurable.
254 if ( $cache{forget}{$h} > 5 ) {
256 &makeHostMask($nuh), '*',
260 &msg( $who, "forget: Ignoring you for abuse!" );
266 if ( &IsParam('factoidDeleteDelay')
267 or &IsChanConf('factoidDeleteDelay') > 0 )
269 if ( !( $isop or $isau ) and $faqtoid =~ / #DEL#$/ ) {
270 &msg( $who, "cannot delete it ($faqtoid)." );
274 &status( "forgot (safe delete): '$faqtoid' - " . scalar(gmtime) );
275 ### TODO: check if the 'backup' exists and overwrite it
276 my $check = &getFactoid("$faqtoid #DEL#");
278 if ( !defined $check or $check =~ /^\s*$/ ) {
279 if ( $faqtoid !~ / #DEL#$/ ) {
280 my $new = $faqtoid . " #DEL#";
282 my $backup = &getFactoid($new);
284 &DEBUG("forget: not overwriting backup: $faqtoid");
287 &status("forget: backing up '$faqtoid'");
288 &setFactInfo( $faqtoid, 'factoid_key', $new );
289 &setFactInfo( $new, 'modified_by', $who );
290 &setFactInfo( $new, 'modified_time', time() );
295 &status("forget: not backing up $faqtoid.");
300 &status("forget: not overwriting backup!");
304 &status("forget: <$who> '$faqtoid' =is=> '$result'");
305 &delFactoid($faqtoid);
307 &performReply("i forgot $faqtoid");
314 # factoid unforget/undelete.
315 if ( $message =~ s/^un(forget|delete)\s+//i ) {
316 return 'unforget: no addr' unless ($addressed);
319 $i++ if ( &IsParam('factoidDeleteDelay') );
320 $i++ if ( &IsChanConf('factoidDeleteDelay') > 0 );
323 "safe delete has been disable so what is there to undelete?");
327 my $faqtoid = $message;
328 if ( $faqtoid eq '' ) {
333 $faqtoid =~ tr/A-Z/a-z/;
334 my $result = &getFactoid( $faqtoid . " #DEL#" );
335 my $check = &getFactoid($faqtoid);
337 if ( defined $check ) {
339 "cannot undeleted '$faqtoid' because it already exists!");
343 if ( !defined $result ) {
344 &performReply("that factoid was not backedup :/");
348 &setFactInfo( $faqtoid . " #DEL#", 'factoid_key', $faqtoid );
350 # &setFactInfo($faqtoid, 'modified_by', '');
351 # &setFactInfo($faqtoid, 'modified_time', 0);
353 $check = &getFactoid($faqtoid);
355 # TODO: check if $faqtoid." #DEL#" exists?
356 if ( defined $check ) {
357 &performReply("Successfully recovered '$faqtoid'. Have fun now.");
358 $count{'Undelete'}++;
361 &performReply("did not recover '$faqtoid'. What happened?");
368 if ( $message =~ /^((un)?lock)(\s+(.*))?\s*?$/i ) {
369 return 'lock: no addr 2' unless ($addressed);
371 my $function = lc $1;
374 if ( $faqtoid eq '' ) {
379 if ( &getFactoid($faqtoid) eq '' ) {
380 &msg( $who, "factoid \002$faqtoid\002 does not exist" );
384 if ( $function eq 'lock' ) {
386 # strongly requested by #debian on 19991028. -xk
387 if ( 1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag('o') ne 'o' ) {
389 "sorry, locking cannot be used since it can be abused unneccesarily."
392 "Replace 1 with 0 in Process.pl#~324 for locking support.");
399 &CmdUnLock($faqtoid);
406 if ( $message =~ s/^rename(\s+|$)// ) {
407 return 'rename: no addr' unless ($addressed);
409 if ( $message eq '' ) {
414 if ( $message =~ /^'(.*)'\s+'(.*)'$/ ) {
415 my ( $from, $to ) = ( lc $1, lc $2 );
417 my $result = &getFactoid($from);
418 if ( !defined $result ) {
420 "i didn't have anything called '$from' to rename");
424 # author == nick!user@host
426 my $author = &getFactInfo( $from, 'created_by' );
430 # Can they even modify factoids?
431 if ( &IsFlag('m') ne 'm'
432 and &IsFlag('M') ne 'M'
433 and &IsFlag('o') ne 'o' )
435 &performReply("You do not have permission to modify factoids");
438 # If they have +M but they didnt create the factoid
440 elsif ( &IsFlag('M') eq 'M'
441 and $who !~ /^\Q$created_by\E$/i
442 and &IsFlag('m') ne 'm'
443 and &IsFlag('o') ne 'o' )
445 &performReply("factoid '$from' is not yours to modify.");
449 # Else they have permission, so continue
451 if ( $_ = &getFactoid($to) ) {
452 &performReply("destination factoid already exists.");
456 &setFactInfo( $from, 'factoid_key', $to );
458 &status("rename: <$who> '$from' is now '$to'");
459 &performReply("i renamed '$from' to '$to'");
462 &msg( $who, "error: wrong format. ask me about 'help rename'." );
468 # factoid substitution. (X =~ s/A/B/FLAG)
469 if ( $message =~ m|^(.*?)\s+=~\s+s([/,#])(.+?)\2(.*?)\2([a-z]*);?\s*$| ) {
470 my ( $faqtoid, $delim, $op, $np, $flags ) = ( lc $1, $2, $3, $4, $5 );
471 return 'subst: no addr' unless ($addressed);
474 if ( $np =~ /$delim/ ) {
476 "looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'."
482 if ( my $result = &getFactoid($faqtoid) ) {
483 return 'subst: locked' if ( &IsLocked($faqtoid) == 1 );
485 my $faqauth = &getFactInfo( $faqtoid, 'created_by' );
487 if ( ( $flags eq 'g' && $result =~ s/\Q$op/$np/gi )
488 || $result =~ s/\Q$op/$np/i )
490 my $author = $faqauth;
494 # Can they even modify factoids?
495 if ( &IsFlag('m') ne 'm'
496 and &IsFlag('M') ne 'M'
497 and &IsFlag('o') ne 'o' )
500 "You do not have permission to modify factoids");
503 # If they have +M but they didnt create the factoid
505 elsif ( &IsFlag('M') eq 'M'
506 and $who !~ /^\Q$created_by\E$/i
507 and &IsFlag('m') ne 'm'
508 and &IsFlag('o') ne 'o' )
510 &performReply("factoid '$faqtoid' is not yours to modify.");
515 if ( length $result > $param{'maxDataSize'} ) {
516 &performReply("that's too long");
521 if ( length $result == 0 ) {
523 "factoid would be empty. Use forget instead.");
528 if ( ( length $result ) * 2 < length $was
529 and &IsFlag('o') ne 'o'
530 and &IsHostMatch($faqauth) != 2 )
532 &performReply("too drastic change of factoid.");
535 &setFactInfo( $faqtoid, 'factoid_value', $result );
536 &status("update: '$faqtoid' =is=> '$result'; was '$was'");
540 &performReply("that doesn't contain '$op'");
544 &performReply("i didn't have anything called '$faqtoid' to modify");
550 # Fix up $message for question.
551 my $question = $message;
557 s/^whois //i; # Must match ^, else factoids with "whois" anywhere break
559 s/^what is (a|an)?//i;
561 s/^where can i (find|get|download)//i;
565 # clear the string of useless words.
566 s/^(stupid )?q(uestion)?:\s+//i;
567 s/^(does )?(any|ne)(1|one|body) know //i;
569 s/^[uh]+m*[,\.]* +//i;
573 s/^(gee|boy|golly|gosh)([, ]+)//i;
574 s/^(well|and|but|or|yes)([, ]+)//i;
576 s/^o+[hk]+(a+y+)?([,. ]+)//i;
577 s/^g(eez|osh|olly)([,. ]+)//i;
578 s/^w(ow|hee|o+ho+)([,. ]+)//i;
579 s/^heya?,?( folks)?([,. ]+)//i;
582 if ( $addressed and $message =~ s/^no([, ]+)(\Q$ident\E\,+)?\s*//i ) {
583 $correction_plausible = 1;
585 "correction is plausible, initial negative and nick deleted ($&)")
586 if ( $param{VERBOSITY} );
589 $correction_plausible = 0;
592 my $result = &doQuestion($question);
593 if ( !defined $result or $result eq $noreply ) {
594 return 'result from doQ undef.';
597 if ( defined $result and $result !~ /^0?$/ ) { # question.
598 &status("question: <$who> $message");
599 $count{'Question'}++;
601 elsif ( &IsChanConf('Math') > 0 and $addressed ) { # perl math.
602 &loadMyModule('Math');
603 my $newresult = &perlMath();
605 if ( defined $newresult and $newresult ne '' ) {
606 $cmdstats{'Maths'}++;
607 $result = $newresult;
608 &status("math: <$who> $message => $result");
612 if ( $result !~ /^0?$/ ) {
613 &performStrictReply($result);
617 # why would a friendly bot get passed here?
618 if ( &IsParam('friendlyBots') ) {
620 if ( grep lc($_) eq lc($who),
621 split( /\s+/, $param{'friendlyBots'} ) );
625 if ( !defined &doStatement($message) ) {
629 return unless ( $addressed and !$addrchar );
631 if ( length $message > 64 ) {
632 &status("unparseable-moron: $message");
634 # &performReply( &getRandom(keys %{ $lang{'moron'} }) );
637 &performReply( "You are moron \002#" . $count{'Moron'} . "\002" );
641 &status("unparseable: $message");
642 &performReply( &getRandom( keys %{ $lang{'dunno'} } ) );
648 # vim:ts=4:sw=4:expandtab:tw=80