]> git.donarmstrong.com Git - infobot.git/blob - src/IRC/Schedulers.pl
- typo for already-run check. should work now.
[infobot.git] / src / IRC / Schedulers.pl
1 #
2 # ProcessExtra.pl: Extensions to Process.pl
3 #          Author: dms
4 #         Version: v0.5 (20010124)
5 #         Created: 20000117
6 #
7
8 if (&IsParam("useStrict")) { use strict; }
9
10 use POSIX qw(strftime);
11 use vars qw(%sched);
12
13 #
14 # is there a point in ScheduleChecked()?
15 # not yet... not unless we run setupSchedulers more than once.
16 #
17
18 sub setupSchedulers {
19     &VERB("Starting schedulers...",2);
20
21     # ONCE OFF.
22
23     # REPETITIVE.
24     &uptimeCycle(1);
25     &randomQuote(2);
26     &randomFactoid(2);
27     &randomFreshmeat(2);
28     &logCycle(1);
29     &chanlimitCheck(1);
30     &netsplitCheck(1);  # mandatory
31     &floodCycle(1);     # mandatory
32     &seenFlush(1);
33     &leakCheck(1);      # mandatory
34     &ignoreCheck(1);    # mandatory
35     &seenFlushOld(1);
36     &ircCheck(1);       # mandatory
37     &miscCheck(1);      # mandatory
38     &shmFlush(1);       # mandatory
39     &slashdotCycle(2);
40     &freshmeatCycle(2);
41     &kernelCycle(2);
42     &wingateWriteFile(1);
43     &factoidCheck(1);
44
45 #    my $count = map { exists $sched{$_}{TIME} } keys %sched;
46     my $count   = 0;
47     foreach (keys %sched) {
48         next unless (exists $sched{$_}{TIME});
49         $count++;
50     }
51
52     &status("Schedulers: $count will be running.");
53 ###    &scheduleList();
54 }
55
56 sub ScheduleThis {
57     my ($interval, $codename, @args) = @_;
58     my $waittime = &getRandomInt($interval);
59
60     if (!defined $waittime) {
61         &WARN("interval == waittime == UNDEF for $codename.");
62         return;
63     }
64
65     if (exists $sched{$codename}{RUNNING}) {
66         &WARN("Sched for $codename already exists.");
67         return;
68     }
69
70     &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
71     my $retval = $conn->schedule($waittime, \&$codename, @args);
72     $sched{$codename}{LABEL}    = $retval;
73     $sched{$codename}{TIME}     = time()+$waittime;
74     $sched{$codename}{RUNNING}  = 1;
75 }
76
77 sub ScheduleChecked {
78     my ($codename) = shift;
79
80     # what the hell is this for?
81     if (exists $sched{$codename}{RUNNING}) {
82 ###     &DEBUG("SC: Removed $codename.");
83         delete $sched{$codename}{RUNNING};
84     } else {
85 ###     &WARN("sched $codename already removed.");
86     }
87 }
88
89 ####
90 #### LET THE FUN BEGIN.
91 ####
92
93 sub randomQuote {
94     my $interval = $param{'randomQuoteInterval'} || 60;
95     &ScheduleThis($interval, "randomQuote") if (@_);
96     &ScheduleChecked("randomQuote");
97     return if ($_[0] eq "2");   # defer.
98
99     my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.randtext");
100     if (!defined $line) {
101         &ERROR("random Quote: weird error?");
102         return;
103     }
104
105     foreach ( &ChanConfList("randomQuote") ) {
106         next unless (&validChan($_));   # ???
107
108         &status("sending random Quote to $_.");
109         &action($_, "Ponders: ".$line);
110     }
111     ### TODO: if there were no channels, don't reschedule until channel
112     ###         configuration is modified.
113 }
114
115 sub randomFactoid {
116     my ($key,$val);
117     my $error = 0;
118
119     my $interval = $param{'randomFactoidInterval'} || 60; # FIXME.
120     &ScheduleThis($interval, "randomFactoid") if (@_);
121     &ScheduleChecked("randomFactoid");
122     return if ($_[0] eq "2");   # defer.
123
124     while (1) {
125         ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
126 ###     $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
127         last if ($val !~ /^</);
128         $error++;
129         if ($error == 5) {
130             &ERROR("rF: tried 5 times but failed.");
131             return;
132         }
133     }
134
135     foreach ( &ChanConfList("randomFactoid") ) {
136         next unless (&validChan($_));   # ???
137
138         &status("sending random Factoid to $_.");
139         &action($_, "Thinks: \037$key\037 is $val");
140         ### FIXME: Use &getReply() on above to format factoid properly?
141         $good++;
142     }
143 }
144
145 sub randomFreshmeat {
146     my $interval = $param{'randomFresheatInterval'} || 60;
147     &ScheduleThis($interval, "randomFreshmeat") if (@_);
148     &ScheduleChecked("randomFreshmeat");
149     return if ($_[0] eq "2");   # defer.
150
151     my @chans = &ChanConfList("randomFreshmeat");
152     return unless (scalar @chans);
153
154     &Forker("freshmeat", sub {
155         my $retval = &Freshmeat::randPackage();
156
157         foreach (@chans) {
158             next unless (&validChan($_));       # ???
159
160             &status("sending random Freshmeat to $_.");
161             &say($_, $line);
162         }
163     } );
164 }
165
166 sub logCycle {
167     if (@_) {
168         &ScheduleThis(60, "logCycle");
169         &ScheduleChecked("logCycle");
170         return if ($_[0] eq "2");       # defer.
171     }
172
173     return unless (defined fileno LOG);
174     return unless (&IsParam("logfile"));
175     return unless (&IsParam("maxLogSize"));
176
177     ### check if current size is too large.
178     if ( -s $file{log} > $param{'maxLogSize'}) {
179         my $date = sprintf("%04d%02d%02d", (localtime)[5,4,3]);
180         $file{log} = $param{'logfile'} ."-". $date;
181         &status("cycling log file.");
182
183         if ( -e $file{log}) {
184             my $i = 1;
185             my $newlog;
186             while () {
187                 $newlog = $file{log}."-".$i;
188                 last if (! -e $newlog);
189                 $i++;
190             }
191             $file{log} = $newlog;
192         }
193
194         &closeLog();
195         system("/bin/mv '$param{'logfile'}' '$file{log}'");
196         &compress($file{log});
197         &openLog();
198         &status("cycling log file.");
199     }
200
201     ### check if all the logs exceed size.
202     my $logdir = "$bot_base_dir/log/";
203     if (opendir(LOGS, $logdir)) {
204         my $tsize = 0;
205         my (%age, %size);
206
207         while (defined($_ = readdir LOGS)) {
208             my $logfile         = "$logdir/$_";
209
210             next unless ( -f $logfile);
211             my $size            = -s $logfile;
212             my $age             = (stat $logfile)[9];
213
214             $age{$age}          = $logfile;
215             $size{$logfile}     = $size;
216
217             $tsize              += $size;
218         }
219         closedir LOGS;
220
221         my $delete      = 0;
222         while ($tsize > $param{'maxLogSize'}) {
223             &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
224             my $oldest  = (sort {$a <=> $b} keys %age)[0];
225             &status("LOG: unlinking $age{$oldest}.");
226             unlink $age{$oldest};
227             $tsize      -= $oldest;
228             $delete++;
229         }
230
231         ### TODO: add how many b,kb,mb removed?
232         &status("LOG: removed $delete logs.") if ($delete);
233     } else {
234         &WARN("could not open dir $logdir");
235     }
236
237 }
238
239 sub seenFlushOld {
240     if (@_) {
241         &ScheduleThis(1440, "seenFlushOld");
242         &ScheduleChecked("seenFlushOld");
243         return if ($_[0] eq "2");       # defer.
244     }
245
246     # is this global-only?
247     return unless (&IsChanConf("seen") > 0);
248     return unless (&IsChanConf("seenFlushInterval") > 0);
249
250     my $max_time = ($chanconf{_default}{'seenMaxDays'} || 30)
251                                 *60*60*24; # global.
252     my $delete   = 0;
253
254     if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
255         my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
256         my $sth = $dbh->prepare($query);
257         $sth->execute;
258
259         while (my @row = $sth->fetchrow_array) {
260             my ($nick,$time) = @row;
261
262             &dbDel("seen","nick",$nick);
263             $delete++;
264         }
265         $sth->finish;
266     } elsif ($param{'DBType'} =~ /^dbm/i) {
267         my $time = time();
268
269         foreach (keys %seen) {
270             my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
271             next unless ($delta_time > $max_time);
272
273             &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
274             delete $seen{$_};
275             $delete++;
276         }
277     } else {
278         &FIXME("seenFlushOld: for PG/NO-DB.");
279     }
280     &VERB("SEEN deleted $delete seen entries.",2);
281
282 }
283
284 sub chanlimitCheck {
285     if (@_) {
286         my $interval = &getChanConf("chanlimitcheckInterval") || 10;
287         &ScheduleThis($interval, "chanlimitCheck");
288         &ScheduleChecked("chanlimitCheck");
289         return if ($_[0] eq "2");
290     }
291
292     foreach ( &ChanConfList("chanlimitcheck") ) {
293         next unless (&validChan($_));   # ???
294
295         my $limitplus   = &getChanConf("chanlimitcheckPlus",$_) || 5;
296         my $newlimit    = scalar(keys %{$channels{$_}{''}}) + $limitplus;
297         my $limit       = $channels{$_}{'l'};
298
299         if (scalar keys %{$channels{$_}{''}} > $limit) {
300             &status("LIMIT: set too low!!! FIXME");
301             ### run NAMES again and flush it.
302         }
303
304         next unless (!defined $limit or $limit != $newlimit);
305
306         if (!exists $channels{$_}{'o'}{$ident}) {
307             &ERROR("chanlimitcheck: dont have ops on $_.");
308             next;
309         }
310         &rawout("MODE $_ +l $newlimit");
311     }
312
313 }
314
315 sub netsplitCheck {
316     my ($s1,$s2);
317
318     if (@_) {
319         &ScheduleThis(30, "netsplitCheck");
320         &ScheduleChecked("netsplitCheck");
321         return if ($_[0] eq "2");
322     }
323
324     foreach $s1 (keys %netsplitservers) {
325         foreach $s2 (keys %{$netsplitservers{$s1}}) {
326             if (time() - $netsplitservers{$s1}{$s2} > 3600) {
327                 &status("netsplit between $s1 and $s2 appears to be stale.");
328                 delete $netsplitservers{$s1}{$s2};
329             }
330         }
331     }
332
333     # %netsplit hash checker.
334     foreach (keys %netsplit) {
335         if (&IsNickInAnyChan($_)) {
336             &DEBUG("netsplitC: $_ is in some chan; removing from netsplit list.");
337             delete $netsplit{$_};
338         }
339         next unless (time() - $netsplit{$_} > 60*60*2); # 2 hours.
340         next if (&IsNickInAnyChan($_));
341
342         &DEBUG("netsplitC: $_ didn't come back from netsplit in 2 hours; removing from netsplit list.");
343         delete $netsplit{$_};
344     }
345 }
346
347 sub floodCycle {
348     my $delete   = 0;
349     my $who;
350
351     if (@_) {
352         &ScheduleThis(60, "floodCycle");        # minutes.
353         &ScheduleChecked("floodCycle");
354         return if ($_[0] eq "2");
355     }
356
357     my $time    = time();
358     foreach $who (keys %flood) {
359         foreach (keys %{$flood{$who}}) {
360             if (!exists $flood{$who}{$_}) {
361 # or !defined $flood{$who}{$_}) {
362                 &WARN("flood{$who}{$_} undefined?");
363                 next;
364             }
365
366             if ($time - $flood{$who}{$_} > $interval) {
367                 delete $flood{$who}{$_};
368                 $delete++;
369             }
370         }
371     }
372     &VERB("floodCycle: deleted $delete items.",2);
373
374 }
375
376 sub seenFlush {
377     my %stats;
378     my $nick;
379     my $flushed         = 0;
380     $stats{'count_old'} = &countKeys("seen");
381     $stats{'new'}       = 0;
382     $stats{'old'}       = 0;
383
384     if (@_) {
385         my $interval = $param{'seenFlushInterval'} || 60;
386         &ScheduleThis($interval, "seenFlush");
387         &ScheduleChecked("seenFlush");
388         return if ($_[0] eq "2");
389     }
390
391     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
392         foreach $nick (keys %seencache) {
393             my $exists = &dbGet("seen","nick", $nick, "nick");
394
395             if (defined $exists and $exists) {
396                 &dbUpdate("seen", "nick", $nick, (
397                         "time" => $seencache{$nick}{'time'},
398                         "host" => $seencache{$nick}{'host'},
399                         "channel" => $seencache{$nick}{'chan'},
400                         "message" => $seencache{$nick}{'msg'},
401                 ) );
402                 $stats{'old'}++;
403             } else {
404                 my $retval = &dbInsert("seen", $nick, (
405                         "nick" => $seencache{$nick}{'nick'},
406                         "time" => $seencache{$nick}{'time'},
407                         "host" => $seencache{$nick}{'host'},
408                         "channel" => $seencache{$nick}{'chan'},
409                         "message" => $seencache{$nick}{'msg'},
410                 ) );
411                 $stats{'new'}++;
412
413                 ### TODO: put bad nick into a list and don't do it again!
414                 &FIXME("Should never happen! (nick => $nick)") if !$retval;
415             }
416
417             delete $seencache{$nick};
418             $flushed++;
419         }
420
421     } elsif ($param{'DBType'} =~ /^dbm/i) {
422
423         foreach $nick (keys %seencache) {
424             my $retval = &dbInsert("seen", $nick, (
425                 "nick" => $seencache{$nick}{'nick'},
426                 "time" => $seencache{$nick}{'time'},
427                 "host" => $seencache{$nick}{'host'},
428                 "channel" => $seencache{$nick}{'chan'},
429                 "message" => $seencache{$nick}{'msg'},
430             ) );
431
432             ### TODO: put bad nick into a list and don't do it again!
433             &FIXME("Should never happen! (nick => $nick)") if !$retval;
434
435             delete $seencache{$nick};
436             $flushed++;
437         }
438     } else {
439         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
440     }
441
442     &status("Flushed $flushed seen entries.")           if ($flushed);
443     &VERB(sprintf("  new seen: %03.01f%% (%d/%d)",
444         $stats{'new'}*100/$stats{'count_old'},
445         $stats{'new'}, $stats{'count_old'} ), 2)        if ($stats{'new'});
446     &VERB(sprintf("  now seen: %3.1f%% (%d/%d)",
447         $stats{'old'}*100/&countKeys("seen"),
448         $stats{'old'}, &countKeys("seen") ), 2)         if ($stats{'old'});
449
450     &WARN("scalar keys seenflush != 0!")        if (scalar keys %seenflush);
451
452 }
453
454 sub leakCheck {
455     my ($blah1,$blah2);
456     my $count = 0;
457
458     if (@_) {
459         &ScheduleThis(60, "leakCheck");
460         &ScheduleChecked("leakCheck");
461         return if ($_[0] eq "2");
462     }
463
464     # flood.
465     foreach $blah1 (keys %flood) {
466         foreach $blah2 (keys %{$flood{$blah1}}) {
467             $count += scalar(keys %{$flood{$blah1}{$blah2}});
468         }
469     }
470     &VERB("\%flood has $count total keys.",2);
471
472     my $chan;
473     foreach $chan (grep /[A-Z]/, keys %channels) {
474         &DEBUG("leak: chan => '$chan'.");
475         my ($i,$j);
476         foreach $i (keys %{$channels{$chan}}) {
477             foreach (keys %{$channels{$chan}{$i}}) {
478                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
479             }
480         }
481     }
482 }
483
484 sub ignoreCheck {
485     my $time    = time();
486     my $count   = 0;
487
488     foreach (keys %ignore) {
489         my $chan = $_;
490
491         foreach (keys %{ $ignore{$chan} }) {
492             my @array = $ignore{$chan}{$_};
493
494             foreach (@array) {
495                 &DEBUG("  => $_");
496             }
497
498             next;
499             next unless ($time > $ignore{$_});
500
501             delete $ignore{$chan}{$_};
502             &status("ignore: $_/$chan has expired.");
503             $count++;
504         }
505     }
506     &VERB("ignore: $count items deleted.",2);
507
508     &ScheduleThis(60, "ignoreCheck") if (@_);
509 }
510
511 sub ircCheck {
512     my @array = grep !/^_default$/, keys %chanconf;
513     my $iconf = scalar(@array);
514     my $inow  = scalar(keys %channels);
515     if ($iconf > 2 and $inow * 2 <= $iconf) {
516         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
517     }
518
519     if (!$conn->connected and time - $msgtime > 3600) {
520         &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
521         $msgtime = time();      # just in case.
522         &ircloop();
523     }
524
525     if ($ident !~ /^\Q$param{ircNick}\E$/) {
526         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
527     }
528
529     &joinNextChan();
530         # if scalar @joinnext => join more channels
531         # else check for chanserv.
532
533     if (grep /^\s*$/, keys %channels) {
534         &WARN("we have a NULL chan in hash channels? removing!");
535         delete $channels{''};
536         &status("channels now:");
537         foreach (keys %channels) {
538             &status("  $_");
539         }
540     }
541
542     ### USER FILE.
543     if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) {
544         &writeUserFile();
545         $wtime_userfile = time();
546     }
547     ### CHAN FILE.
548     if ($utime_chanfile > $wtime_chanfile and time() - $wtime_chanfile > 3600) {
549         &writeChanFile();
550         $wtime_chanfile = time();
551     }
552
553     &ScheduleThis(240, "ircCheck") if (@_);
554 }
555
556 sub miscCheck {
557     &ScheduleThis(240, "miscCheck") if (@_);
558
559     # SHM check.
560     my @ipcs;
561     if ( -x "/usr/bin/ipcs") {
562         @ipcs = `/usr/bin/ipcs`;
563     } else {
564         &WARN("ircCheck: no 'ipcs' binary.");
565         return;
566     }
567
568     # shmid stale remove.
569     foreach (@ipcs) {
570         chop;
571
572         # key, shmid, owner, perms, bytes, nattch
573         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
574
575         my ($shmid, $size) = ($2,$5);
576         next unless ($shmid != $shm and $size == 2000);
577
578 ###     &status("SHM: nuking shmid $shmid");
579 ###     system("/usr/bin/ipcrm shm $shmid >/dev/null");
580     }
581
582     ### check modules if they've been modified. might be evil.
583     &reloadAllModules();
584 }
585
586 sub shmFlush {
587     if (@_) {
588         &ScheduleThis(5, "shmFlush");
589         &ScheduleChecked("shmFlush");
590         return if ($_[0] eq "2");
591     }
592
593     my $shmmsg = &shmRead($shm);
594     $shmmsg =~ s/\0//g;         # remove padded \0's.
595
596     return if ($$ != $::bot_pid); # fork protection.
597
598     foreach (split '\|\|', $shmmsg) {
599         &VERB("shm: Processing '$_'.",2);
600
601         if (/^DCC SEND (\S+) (\S+)$/) {
602             my ($nick,$file) = ($1,$2);
603             if (exists $dcc{'SEND'}{$who}) {
604                 &msg($nick,"DCC already active.");
605             } else {
606                 &DEBUG("shm: dcc sending $2 to $1.");
607                 $conn->new_send($1,$2);
608                 $dcc{'SEND'}{$who} = time();
609             }
610         } elsif (/^SET FORKPID (\S+) (\S+)/) {
611             $forked{$1}{PID} = $2;
612         } elsif (/^DELETE FORK (\S+)$/) {
613             delete $forked{$1};
614         } elsif (/^EVAL (.*)$/) {
615             &DEBUG("evaling '$1'.");
616             eval $1;
617         } else {
618             &DEBUG("shm: unknown msg. ($_)");
619         }
620     }
621
622     &shmWrite($shm,"") if ($shmmsg ne "");
623 }
624
625 ### this is semi-scheduled
626 sub getNickInUse {
627     if ($ident eq $param{'ircNick'}) {
628         &status("okay, got my nick back.");
629         return;
630     }
631
632     &status("Trying to get my nick back.");
633     &nick($param{'ircNick'});
634
635     &ScheduleThis(5, "getNickInUse") if (@_);
636 }
637
638 sub uptimeCycle {
639     &uptimeWriteFile();
640
641     &ScheduleThis(60, "uptimeCycle") if (@_);
642 }
643
644 sub slashdotCycle {
645     &ScheduleThis(60, "slashdotCycle") if (@_);
646     &ScheduleChecked("slashdotCycle");
647     return if ($_[0] eq "2");
648
649     my @chans = &ChanConfList("slashdotAnnounce");
650     return unless (scalar @chans);
651
652     &Forker("slashdot", sub {
653         my @data = &Slashdot::slashdotAnnounce();
654
655         foreach (@chans) {
656             next unless (&::validChan($_));
657
658             &::status("sending slashdot update to $_.");
659             my $c = $_;
660             foreach (@data) {
661                 &notice($c, "Slashdot: $_");
662             }
663         }
664     } );
665 }
666
667 sub freshmeatCycle {
668     &ScheduleThis(60, "freshmeatCycle") if (@_);
669     &ScheduleChecked("freshmeatCycle");
670     return if ($_[0] eq "2");
671
672     my @chans = &ChanConfList("freshmeatAnnounce");
673     return unless (scalar @chans);
674
675     &Forker("freshmeat", sub {
676         my $data = &Freshmeat::freshmeatAnnounce();
677
678         foreach (@chans) {
679             next unless (&::validChan($_));
680
681             &::status("sending freshmeat update to $_.");
682             &msg($_, $data);
683         }
684     } );
685 }
686
687 sub kernelCycle {
688     &ScheduleThis(240, "kernelCycle") if (@_);
689     &ScheduleChecked("kernelCycle");
690     return if ($_[0] eq "2");
691
692     my @chans = &ChanConfList("kernelAnnounce");
693     return unless (scalar @chans);
694
695     &Forker("kernel", sub {
696         my @data = &Kernel::kernelAnnounce();
697
698         foreach (@chans) {
699             next unless (&::validChan($_));
700
701             &::status("sending kernel update to $_.");
702             my $c = $_;
703             foreach (@data) {
704                 &notice($c, "Kernel: $_");
705             }
706         }
707     } );
708 }
709
710 sub wingateCheck {
711     return unless &IsParam("wingate");
712     return unless ($param{'wingate'} =~ /^(.*\s+)?$chan(\s+.*)?$/i);
713
714     ### FILE CACHE OF OFFENDING WINGATES.
715     foreach (grep /^$host$/, @wingateBad) {
716         &status("Wingate: RUNNING ON $host BY $who");
717         &ban("*!*\@$host", "") if &IsParam("wingateBan");
718
719         next unless (&IsParam("wingateKick"));
720         &kick($who, "", $param{'wingateKick'})
721     }
722
723     ### RUN CACHE OF TRIED WINGATES.
724     if (grep /^$host$/, @wingateCache) {
725         push(@wingateNow, $host);       # per run.
726         push(@wingateCache, $host);     # cache per run.
727     } else {
728         &DEBUG("Already scanned $host. good.");
729     }
730
731     my $interval = $param{'wingateInterval'} || 60;     # seconds.
732     return if (defined $forked{'wingate'});
733     return if (time() - $wingaterun <= $interval);
734     return unless (scalar(keys %wingateToDo));
735
736     $wingaterun = time();
737
738     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
739     undef @wingateNow;
740 }
741
742 ### TODO.
743 sub wingateWriteFile {
744     return unless (scalar @wingateCache);
745
746     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
747     if ($bot_pid != $$) {
748         &DEBUG("wingateWriteFile: Reorganising!");
749
750         open(IN, $file);
751         while (<IN>) {
752             chop;
753             push(@wingateNow, $_);
754         }
755         close IN;
756
757         # very lame hack.
758         my %hash = map { $_ => 1 } @wingateNow;
759         @wingateNow = sort keys %hash;
760     }
761
762     &DEBUG("wingateWF: writing...");
763     open(OUT, ">$file");
764     foreach (@wingateNow) {
765         print OUT "$_\n";
766     }
767     close OUT;
768
769     &ScheduleThis(60, "wingateWriteFile") if (@_);
770 }
771
772 sub factoidCheck {
773     my @list = &searchTable("factoids", "factoid_key", "factoid_key", " #DEL#");
774     my $stale = ($param{'factoidDeleteDelay'} || 7)*60*60*24;
775
776     foreach (@list) {
777         my $age = &getFactInfo($_, "modified_time");    
778         next unless (time() - $age > $stale);
779
780         my $fix = $_;
781         $fix =~ s/ #DEL#$//g;
782         &VERB("safedel: Removing $fix for good.",2);
783         &delFactoid($_);
784     }
785
786     &ScheduleThis(1440, "factoidCheck") if (@_);
787 }
788
789 sub dccStatus {
790     my $time = strftime("%H:%M", localtime(time()) );
791
792     return unless (scalar keys %{ $DCC{CHAT} });
793
794     foreach (keys %channels) {
795         &DCCBroadcast("[$time] $_: $users members ($chops chops), $bans bans","+o");
796     }
797
798     &ScheduleThis(10, "dccStatus") if (@_);
799 }
800
801 sub schedulerSTUB {
802
803     &ScheduleThis(TIME_IN_MINUTES, "FUNCTION") if (@_);
804 }
805
806 sub scheduleList {
807     ###
808     # custom:
809     #   a - time == now.
810     #   b - weird time.
811     ###
812
813     &DEBUG("sched:");
814     foreach (keys %{ $irc->{_queue} }) {
815         my $q = $_;
816
817         my $sched;
818         foreach (keys %sched) {
819             next unless ($q eq $sched{$_});
820             $sched = $_;
821             last;
822         }
823
824         my $time = $irc->{_queue}->{$q}->[0] - time();
825
826         if (defined $sched) {
827             &DEBUG("   $sched($q): ".&Time2String($time) );
828         } else {
829             &DEBUG("   NULL($q): ".&Time2String($time) );
830         }
831     }
832
833     &DEBUG("end of sList.");
834 }
835
836 sub getChanConfDefault {
837     my($what, $chan, $default) = @_;
838
839     if (exists $param{$what}) {
840         return $param{$what};
841     }
842
843     my $val = &getChanConf($what, $chan);
844     if (defined $val) {
845         return $val;
846     }
847     &DEBUG("returning default $default for $what");
848     ### TODO: set some vars?
849     return $default;
850 }
851
852 1;