2 # Misc.pl: Miscellaneous stuff.
5 # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
8 if (&IsParam("useStrict")) { use strict; }
12 my $file = $bot_misc_dir."/blootbot.help";
15 if (!open(FILE, $file)) {
16 &ERROR("FAILED loadHelp ($file): $!");
20 while (defined(my $help = <FILE>)) {
21 $help =~ s/^[\# ].*//;
24 my ($key, $val) = split(/:/, $help, 2);
27 $val =~ s/^D:/\002 Desc\002:/;
28 $val =~ s/^E:/\002Example\002:/;
29 $val =~ s/^N:/\002 NOTE\002:/;
30 $val =~ s/^U:/\002 Usage\002:/;
35 $help{$key} = "" if (!exists $help{$key});
36 $help{$key} .= $val."\n";
40 if (!defined $topic) {
41 &msg($who, $help{'main'});
45 my $count = scalar(keys %help);
47 foreach (sort keys %help) {
49 $reply = scalar(@array) ." topics: ".
50 join("\002,\002 ", @array);
53 if (length $reply > 400 or $count == $i) {
62 $topic = &fixString(lc $topic);
64 if (exists $help{$topic}) {
65 foreach (split /\n/, $help{$topic}) {
69 &msg($who, "no help on $topic. Use 'help' without arguments.");
78 ### TODO: gotta hate an if statement.
87 if ($no_syscall) { # fallback.
89 } else { # the real thing.
90 my $time = pack("LL", 0);
92 syscall(&SYS_gettimeofday, $time, 0);
93 my @time = unpack("LL",$time);
95 return sprintf("%d.%d", @time);
104 # Usage; &formListReply($rand, $prefix, @list);
106 my($rand, $prefix, @list) = @_;
107 my $total = scalar @list;
108 my $maxshow = $param{'maxListReplyCount'} || 10;
109 my $maxlen = $param{'maxListReplyLength'} || 400;
113 return $prefix ."returned no results." unless ($total);
118 foreach (&makeRandom($total)) {
119 push(@rand, $list[$_]);
120 last if (scalar @rand == $maxshow);
123 } elsif ($total > $maxshow) {
124 &status("formListReply: truncating list.");
126 @list = @list[0..$maxshow-1];
131 $reply = $prefix ."(\002". scalar(@list). "\002 shown";
132 $reply .= "; \002$total\002 total" if ($total != scalar @list);
133 $reply .= "): ". join(" \002;;\002 ",@list) .".";
135 last if (length($reply) < $maxlen and scalar(@list) <= $maxshow);
136 last if (scalar(@list) == 1);
144 ### Intelligence joining of arrays.
145 # Usage: &IJoin(@array);
149 } elsif (scalar @_ == 1) {
152 return join(', ',@{_}[0..$#_-1]) . " and $_[$#_]";
157 # Usage: &Time2String(seconds);
162 return("0s") if ($time !~ /\d+/ or $time <= 0);
164 my $s = int($time) % 60;
165 my $m = int($time / 60) % 60;
166 my $h = int($time / 3600) % 24;
167 my $d = int($time / 86400);
169 $retval .= sprintf(" \002%d\002d", $d) if ($d != 0);
170 $retval .= sprintf(" \002%d\002h", $h) if ($h != 0);
171 $retval .= sprintf(" \002%d\002m", $m) if ($m != 0);
172 $retval .= sprintf(" \002%d\002s", $s) if ($s != 0);
174 return substr($retval, 1);
181 # Usage: &fixFileList(@files);
186 # generate a hash list.
188 if (/^(.*\/)(.*?)$/) {
192 @files = (); # reuse the array.
194 # sort the hash list appropriately.
195 foreach (sort keys %files) {
197 my @keys = sort keys %{$files{$file}};
198 my $i = scalar(@keys);
201 $file .= "\002{\002". join("\002|\002", @keys) ."\002}\002";
212 # Usage: &fixString($str);
214 my ($str, $level) = @_;
216 &WARN("fixString: str == NULL.");
221 s/^\s+//; # remove start whitespaces.
222 s/\s+$//; # remove end whitespaces.
223 s/\s+/ /g; # remove excessive whitespaces.
225 next unless (defined $level);
226 s/[\cA-\c_]//ig # remove control characters.
232 # Usage: &fixPlural($str,$int);
237 $str = "have" if ($int > 1);
238 } elsif ($str eq "is") {
239 $str = "are" if ($int > 1);
240 } elsif ($str eq "was") {
241 $str = "were" if ($int > 1);
242 } elsif ($str eq "this") {
243 $str = "these" if ($int > 1);
244 } elsif ($str =~ /y$/) {
247 $str .= "s"; # eg: "money" => "moneys".
253 $str .= "s" if ($int != 1);
265 sub getRandomLineFromFile {
269 &WARN("gRLfF: file '$file' does not exist.");
273 if (open(IN,$file)) {
276 if (!scalar @lines) {
277 &ERROR("GRLF: nothing loaded?");
281 while (my $line = &getRandom(@lines)) {
284 next if ($line =~ /^\#/);
285 next if ($line =~ /^\s*$/);
290 &WARN("gRLfF: could not open file '$file'.");
295 sub getLineFromFile {
296 my($file,$lineno) = @_;
299 &ERROR("getLineFromFile: file '$file' does not exist.");
303 if (open(IN,$file)) {
307 if ($lineno > scalar @lines) {
308 &ERROR("getLineFromFile: lineno exceeds line count from file.");
312 my $line = $lines[$lineno-1];
316 &ERROR("getLineFromFile: could not open file '$file'.");
321 # Usage: &getRandom(@array);
326 return $array[int(rand(scalar @array))];
329 # Usage: &getRandomInt("30-60");
335 if ($str =~ /^(\d+)$/) {
337 my $fuzzy = int(rand 5);
342 return ($i - $fuzzy)*60;
344 return ($i + $fuzzy)*60;
346 } elsif ($str =~ /^(\d+)-(\d+)$/) {
347 return ($2 - $1)*int(rand $1)*60;
349 return $str; # hope we're safe.
352 &ERROR("getRandomInt: invalid arg '$str'.");
361 my ($left,$right) = @_;
362 return 0 unless defined $right;
363 return 0 unless defined $left;
364 return 1 if ($left =~ /^\Q$right$/i);
368 my $retval = &iseq(@_);
369 return 1 unless ($retval);
373 # Usage: &IsHostMatch($nuh);
378 if ($nuh =~ /^(\S+)!(\S+)@(\S+)/) {
379 $local{'nick'} = lc $1;
380 $local{'user'} = lc $2;
381 $local{'host'} = &makeHostMask(lc $3);
384 if ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) {
385 $this{'nick'} = lc $1;
386 $this{'user'} = lc $2;
387 $this{'host'} = &makeHostMask(lc $3);
389 &WARN("IHM: thisnuh is invalid '$thisnuh'.");
390 return 1 if ($thisnuh eq "");
394 # auth if 1) user and host match 2) user and nick match.
395 # this may change in the future.
397 if ($this{'user'} =~ /^\Q$local{'user'}$/i) {
398 return 2 if ($this{'host'} eq $local{'host'});
399 return 1 if ($this{'nick'} eq $local{'nick'});
405 # Usage: &isStale($file, $age);
407 my ($file, $age) = @_;
409 return 1 unless ( -f $file);
410 return 1 if (time() - (stat($file))[8] > $age*60*60*24);
411 my $delta = time() - (stat($file))[8];
412 my $hage = $age*60*60*24;
413 &DEBUG("isStale: not stale! $delta < $hage ($age) ?");
421 # Usage: &makeHostMask($host);
425 if ($host =~ /^$mask{ip}$/) {
429 my @array = split(/\./, $host);
430 return $host if (scalar @array <= 3);
431 return "*.".join('.',@{array}[1..$#array]);
434 # Usage: &makeRandom(int);
440 if ($max =~ /^\D+$/) {
441 &ERROR("makeRandom: arg ($max) is not integer.");
446 &ERROR("makeRandom: arg ($max) is not positive.");
451 while (scalar keys %done < $max) {
452 my $rand = int(rand $max);
453 next if (exists $done{$rand});
464 return unless (&IsParam("minLengthBeforePrivate"));
465 return if ($force_public_reply);
467 if (length $reply > $param{'minLengthBeforePrivate'}) {
468 &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private.");
469 $msgType = 'private';
477 # Usage: &validExec($string);
481 if ($str =~ /[\'\"\|]/) { # invalid.
488 # Usage: &validFactoid($lhs,$rhs);
494 # allow the following only if they have been made on purpose.
495 if ($rhs ne "" and $rhs !~ /^</) {
496 / \Q$ident$/i and last; # someone said i'm something.
498 /^(it|that|there|what)('s)?(\s+|$)/ and last;
499 /^you('re)?(\s+|$)/ and last;
501 /^(where|who|why|when|how)(\s+|$)/ and last;
502 /^(this|that|these|those|they)(\s+|$)/ and last;
503 /^(every(one|body)|we) / and last;
509 /^add topic / and last; # topic management.
510 /( add$| add |^add )/ and last; # borked teach statement.
511 /^learn / and last; # teach. damn morons.
512 /^tell (\S+) about / and last; # tell.
513 /\=\~/ and last; # substituition.
514 /^\S+ to \S+ \S+/ and last; # babelfish.
522 /\=\>/ and last; # '=>'.
523 /\;\;/ and last; # ';;'.
524 /\|\|/ and last; # '||'.
526 /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed.
528 /\\$/ and last; # forgot shift for '?'.
533 /^because / and last;
535 /^h(is|er) / and last;
542 /^supposedly/ and last;
547 # nasty bug I introduced _somehow_, probably by fixMySQLBug().
551 # weird/special stuff. also old (stock) blootbot bugs.
552 $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
555 $rhs =~ /^\Q$lhs /i and last;
556 last if ($rhs =~ /^is /i and / is$/);
564 # Usage: &hasProfanity($string);
571 /dick|dildo/ and last;
572 /shit|turd|crap/ and last;
573 /pussy|[ck]unt/ and last;
574 /wh[0o]re|bitch|slut/ and last;
585 if (&IsParam($param)) {
588 &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
594 my ($label, $code) = @_;
598 &status("double fork detected; not forking.") if ($$ != $bot_pid);
600 if (&IsParam("forking") and $$ == $bot_pid) {
601 return $noreply unless (&addForked($label));
602 $SIG{CHLD} = 'IGNORE';
603 $pid = eval { fork() }; # catch non-forking OSes and other errors
604 return $noreply if $pid; # parent does nothing
605 &status("fork starting for '$label', PID == $$.");
608 if (!&loadMyModule($myModules{$label})) {
609 &DEBUG("Forker: failed?");
614 $code->(); # weird, hey?
616 &WARN("Forker: code not defined!");
619 if (defined $pid) { # child.
621 &status("fork finished for '$label'.");
627 &DEBUG("checkPing() called.");
628 $conn->schedule(60, \&checkPing, "this is a test");
629 $conn->sl("PING $server :".time());
633 return 1 unless (exists $file{PID});
634 return 1 unless ( -f $file{PID});
635 return 1 if (unlink $file{PID});
636 return 0 if ( -f $file{PID});