2 # Misc.pl: Miscellaneous stuff.
3 # Author: xk <xk@leguin.openprojects.net>
5 # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
8 if (&IsParam("useStrict")) { use strict; }
12 my $file = $infobot_misc_dir."/infobot.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.");
76 if ($no_syscall) { # fallback.
78 } else { # the real thing.
79 my $time = pack("LL", 0);
81 syscall(&SYS_gettimeofday, $time, 0);
82 my @time = unpack("LL",$time);
84 return sprintf("%d.%d", @time);
93 # Usage; &formListReply($rand, $prefix, @list);
95 my($rand, $prefix, @list) = @_;
96 my $total = scalar @list;
97 my $maxshow = $param{'maxListReplyCount'} || 10;
98 my $maxlen = $param{'maxListReplyLength'} || 400;
102 return $prefix ."returned no results." unless ($total);
107 foreach (&makeRandom($total)) {
108 push(@rand, $list[$_]);
109 last if (scalar @rand == $maxshow);
112 } elsif ($total > $maxshow) {
113 &status("formListReply: truncating list.");
115 @list = @list[0..$maxshow-1];
120 $reply = $prefix ."(\002". scalar(@list). "\002 shown";
121 $reply .= "; \002$total\002 total" if ($total != scalar @list);
122 $reply .= "): ". join(" \002;;\002 ",@list) .".";
124 last if (length($reply) < $maxlen and scalar(@list) <= $maxshow);
125 last if (scalar(@list) == 1);
133 ### Intelligence joining of arrays.
134 # Usage: &IJoin(@array);
138 } elsif (scalar @_ == 1) {
141 return join(', ',@{_}[0..$#_-1]) . " and $_[$#_]";
146 # Usage: &Time2String(seconds);
151 return("0s") if ($time !~ /\d+/ or $time <= 0);
153 my $s = int($time) % 60;
154 my $m = int($time / 60) % 60;
155 my $h = int($time / 3600) % 24;
156 my $d = int($time / 86400);
158 $retval .= sprintf(" \002%d\002d", $d) if ($d != 0);
159 $retval .= sprintf(" \002%d\002h", $h) if ($h != 0);
160 $retval .= sprintf(" \002%d\002m", $m) if ($m != 0);
161 $retval .= sprintf(" \002%d\002s", $s) if ($s != 0);
163 return substr($retval, 1);
170 # Usage: &fixFileList(@files);
175 # generate a hash list.
177 if (/^(.*\/)(.*?)$/) {
181 @files = (); # reuse the array.
183 # sort the hash list appropriately.
184 foreach (sort keys %files) {
186 my @keys = sort keys %{$files{$file}};
187 my $i = scalar(@keys);
190 $file .= "\002{\002". join("\002|\002", @keys) ."\002}\002";
201 # Usage: &fixString($str);
203 my ($str, $level) = @_;
205 &WARN("fixString: str == NULL.");
210 s/^\s+//; # remove start whitespaces.
211 s/\s+$//; # remove end whitespaces.
212 s/\s+/ /g; # remove excessive whitespaces.
214 next unless (defined $level);
215 s/[\cA-\c_]//ig # remove control characters.
221 # Usage: &fixPlural($str,$int);
226 $str = "have" if ($int > 1);
227 } elsif ($str eq "is") {
228 $str = "are" if ($int > 1);
229 } elsif ($str eq "was") {
230 $str = "were" if ($int > 1);
231 } elsif ($str eq "this") {
232 $str = "these" if ($int > 1);
233 } elsif ($str =~ /y$/) {
236 $str .= "s"; # eg: "money" => "moneys".
242 $str .= "s" if ($int != 1);
254 sub getRandomLineFromFile {
258 &WARN("gRLfF: file '$file' does not exist.");
262 if (open(IN,$file)) {
265 if (!scalar @lines) {
266 &ERROR("GRLF: nothing loaded?");
270 while (my $line = &getRandom(@lines)) {
273 next if ($line =~ /^\#/);
274 next if ($line =~ /^\s*$/);
279 &WARN("gRLfF: could not open file '$file'.");
284 sub getLineFromFile {
285 my($file,$lineno) = @_;
288 &ERROR("getLineFromFile: file '$file' does not exist.");
292 if (open(IN,$file)) {
296 if ($lineno > scalar @lines) {
297 &ERROR("getLineFromFile: lineno exceeds line count from file.");
301 my $line = $lines[$lineno-1];
305 &ERROR("getLineFromFile: could not open file '$file'.");
310 # Usage: &getRandom(@array);
315 return $array[int(rand(scalar @array))];
318 # Usage: &getRandomInt("30-60");
324 if ($str =~ /^(\d+)$/) {
326 my $fuzzy = int(rand 5);
331 return ($i - $fuzzy)*60;
333 return ($i + $fuzzy)*60;
335 } elsif ($str =~ /^(\d+)-(\d+)$/) {
336 return ($2 - $1)*int(rand $1)*60;
338 return $str; # hope we're safe.
341 &ERROR("getRandomInt: invalid arg '$str'.");
350 my ($left,$right) = @_;
351 return 0 unless defined $right;
352 return 0 unless defined $left;
353 return 1 if ($left =~ /^\Q$right$/i);
357 my $retval = &iseq(@_);
358 return 1 unless ($retval);
362 # Usage: &IsHostMatch($nuh);
367 if ($nuh =~ /^(\S+)!(\S+)@(\S+)/) {
368 $local{'nick'} = lc $1;
369 $local{'user'} = lc $2;
370 $local{'host'} = &makeHostMask(lc $3);
373 if ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) {
374 $this{'nick'} = lc $1;
375 $this{'user'} = lc $2;
376 $this{'host'} = &makeHostMask(lc $3);
378 &WARN("IHM: thisnuh is invalid '$thisnuh'.");
379 return 1 if ($thisnuh eq "");
383 # auth if 1) user and host match 2) user and nick match.
384 # this may change in the future.
386 if ($this{'user'} =~ /^\Q$local{'user'}$/i) {
387 return 2 if ($this{'host'} eq $local{'host'});
388 return 1 if ($this{'nick'} eq $local{'nick'});
394 # Usage: &isStale($file, $age);
396 my ($file, $age) = @_;
398 return 1 unless ( -f $file);
399 return 1 if (time() - (stat($file))[8] > $age*60*60*24);
400 my $delta = time() - (stat($file))[8];
401 my $hage = $age*60*60*24;
402 &DEBUG("isStale: not stale! $delta < $hage ($age) ?");
410 # Usage: &makeHostMask($host);
414 if ($host =~ /^$mask{ip}$/) {
418 my @array = split(/\./, $host);
419 return $host if (scalar @array <= 3);
420 return "*.".join('.',@{array}[1..$#array]);
423 # Usage: &makeRandom(int);
429 if ($max =~ /^\D+$/) {
430 &ERROR("makeRandom: arg ($max) is not integer.");
435 &ERROR("makeRandom: arg ($max) is not positive.");
440 while (scalar keys %done < $max) {
441 my $rand = int(rand $max);
442 next if (exists $done{$rand});
453 return unless (&IsParam("minLengthBeforePrivate"));
454 return if ($force_public_reply);
456 if (length $reply > $param{'minLengthBeforePrivate'}) {
457 &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private.");
458 $msgType = 'private';
466 # Usage: &validExec($string);
470 if ($str =~ /[\'\"\|]/) { # invalid.
477 # Usage: &validFactoid($lhs,$rhs);
483 # allow the following only if they have been made on purpose.
484 if ($rhs ne "" and $rhs !~ /^</) {
485 / \Q$ident$/i and last; # someone said i'm something.
487 /^(it|that|there|what)('s)?(\s+|$)/ and last;
488 /^you('re)?(\s+|$)/ and last;
490 /^(where|who|why|when|how)(\s+|$)/ and last;
491 /^(this|that|these|those|they)(\s+|$)/ and last;
492 /^(every(one|body)|we) / and last;
498 /^add topic / and last; # topic management.
499 /( add$| add |^add )/ and last; # borked teach statement.
500 /^learn / and last; # teach. damn morons.
501 /^tell (\S+) about / and last; # tell.
502 /\=\~/ and last; # substituition.
503 /^\S+ to \S+ \S+/ and last; # babelfish.
511 /\=\>/ and last; # '=>'.
512 /\;\;/ and last; # ';;'.
513 /\|\|/ and last; # '||'.
515 /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed.
517 /\\$/ and last; # forgot shift for '?'.
522 /^because / and last;
524 /^h(is|er) / and last;
531 /^supposedly/ and last;
536 # nasty bug I introduced _somehow_, probably by fixMySQLBug().
540 # weird/special stuff. also old (stock) infobot bugs.
541 $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
544 $rhs =~ /^\Q$lhs /i and last;
545 last if ($rhs =~ /^is /i and / is$/);
553 # Usage: &hasProfanity($string);
560 /dick|dildo/ and last;
561 /shit|turd|crap/ and last;
562 /pussy|[ck]unt/ and last;
563 /wh[0o]re|bitch|slut/ and last;
574 if (&IsParam($param)) {
577 &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
583 my ($label, $code) = @_;
587 &status("double fork detected; not forking.") if ($$ != $infobot_pid);
589 if (&IsParam("forking") and $$ == $infobot_pid) {
590 return 'NOREPLY' unless (&addForked($label));
591 $SIG{CHLD} = 'IGNORE';
592 $pid = eval { fork() }; # catch non-forking OSes and other errors
593 return 'NOREPLY' if $pid; # parent does nothing
594 &status("fork starting for '$label', PID == $$.");
597 if (!&loadMyModule($myModules{$label})) {
598 &DEBUG("Forker: failed?");
603 $code->(); # weird, hey?
605 &WARN("Forker: code not defined!");
608 if (defined $pid) { # child.
610 &status("fork finished for '$label'.");
616 &DEBUG("checkPing() called.");
617 $conn->schedule(60, \&checkPing, "this is a test");
618 $conn->sl("PING $server :".time());
622 return 1 unless (exists $file{PID});
623 return 1 unless ( -f $file{PID});
624 return 1 if (unlink $file{PID});
625 return 0 if ( -f $file{PID});