2 # modules.pl: pseudo-Module handler
4 # Version: v0.2 (20000629)
10 use vars qw($AUTOLOAD);
16 eval "use IO::Socket";
18 &ERROR("no IO::Socket?");
21 &showProc(" (IO::Socket)");
25 "bzflag" => "BZFlag.pl",
26 "countdown" => "Countdown.pl",
27 "debian" => "Debian.pl",
28 "debianExtra" => "DebianExtra.pl",
30 "dumpvars" => "DumpVars.pl",
31 "symdump" => "DumpVars2.pl",
32 "exchange" => "Exchange.pl",
33 "factoids" => "Factoids.pl",
34 "freshmeat" => "Freshmeat.pl",
35 "kernel" => "Kernel.pl",
36 "perlMath" => "Math.pl",
39 "quote" => "Quote.pl",
40 "rootwarn" => "RootWarn.pl",
41 "search" => "Search.pl",
42 "slashdot" => "Slashdot3.pl",
43 "topic" => "Topic.pl",
44 "units" => "Units.pl",
45 "uptime" => "Uptime.pl",
46 "ircdcc" => "UserDCC.pl",
47 "userinfo" => "UserInfo.pl",
48 "weather" => "Weather.pl",
49 "wwwsearch" => "W3Search.pl",
50 "whatis" => "WhatIs.pl",
51 "wingate" => "Wingate.pl",
52 "babelfish" => "babel.pl",
53 "insult" => "insult.pl",
54 "nickometer" => "nickometer.pl",
56 "zippy" => "Zippy.pl",
58 "botmail" => "botmail.pl",
60 ### THIS IS NOT LOADED ON RELOAD :(
62 my @myModulesReloadNot;
64 @myModulesLoadNow = ('topic', 'uptime', 'news', 'rootWarn', 'symdump');
65 @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl');
69 my @mods = &getPerlFiles($bot_src_dir);
71 &status("Loading CORE modules...");
73 foreach (sort @mods) {
74 my $mod = "$bot_src_dir/$_";
76 eval "require \"$mod\"";
83 $moduleAge{$mod} = (stat $mod)[9];
84 &showProc(" ($_)") if (&IsParam("DEBUG"));
90 # todo: use function to load module.
92 if ($param{'DBType'} =~ /^mysql$/i) {
95 &ERROR("libdbd-mysql-perl is not installed!");
98 &status("Loading MySQL support.");
99 $f = "$bot_src_dir/dbi.pl";
101 $moduleAge{$f} = (stat $f)[9];
103 &showProc(" (DBI::mysql)");
105 } elsif ($param{'DBType'} =~ /^pgsql$/i) {
108 &ERROR("libpgperl is not installed!");
111 &status("Loading pgsql support.");
112 $f = "$bot_src_dir/dbi.pl";
114 $moduleAge{$f} = (stat $f)[9];
116 &showProc(" (DBI::pgsql)");
118 } elsif ($param{'DBType'} =~ /^sqlite$/i) {
121 &ERROR("libdbd-sqlite-perl is not installed!");
124 &status("Loading SQLite support.");
125 $f = "$bot_src_dir/dbi.pl";
127 $moduleAge{$f} = (stat $f)[9];
129 &showProc(" (DBI::SQLite)");
131 } elsif ($param{'DBType'} =~ /^dbm$/i) {
132 &status("Loading dbm support.");
133 $f = "$bot_src_dir/dbm.pl";
135 $moduleAge{$f} = (stat $f)[9];
137 &showProc(" (dbm.pl)");
140 &WARN("DB support DISABLED.");
145 sub loadFactoidsModules {
146 if (!&IsParam("factoids")) {
147 &status("Factoid support DISABLED.");
151 &status("Loading Factoids modules...");
153 foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) {
154 my $mod = "$bot_src_dir/Factoids/$_";
156 eval "require \"$mod\"";
162 $moduleAge{$mod} = (stat $mod)[9];
163 &showProc(" ($_)") if (&IsParam("DEBUG"));
168 my ($interface) = &whatInterface();
169 if ($interface =~ /IRC/) {
170 &status("Loading IRC modules...");
174 &ERROR("libnet-irc-perl is not installed!");
177 &showProc(" (Net::IRC)");
179 &status("IRC support DISABLED.");
180 # disabling forking. Why?
181 #$param{forking} = 0;
185 foreach ( &getPerlFiles("$bot_src_dir/$interface") ) {
186 my $mod = "$bot_src_dir/$interface/$_";
188 # hrm... use another config option besides DEBUG to display
189 # change in memory usage.
190 &status("Loading Modules \"$mod\"") if (!&IsParam("DEBUG"));
191 eval "require \"$mod\"";
193 &ERROR("require \"$mod\" => $@");
198 $moduleAge{$mod} = (stat $mod)[9];
199 &showProc(" ($_)") if (&IsParam("DEBUG"));
203 sub loadMyModulesNow {
207 &status("Loading MyModules...");
208 foreach (@myModulesLoadNow) {
211 &WARN("mMLN: null element.");
215 if (!&IsParam($_) and !&IsChanConf($_) and !&getChanConfList($_)) {
216 if (exists $myModules{$_}) {
217 &status("myModule: $myModules{$_} or $_ (1) not loaded.");
219 &DEBUG("myModule: $_ (2) not loaded.");
225 # weird hack to get rootwarn to work.
226 # it may break on other cases though, any ideas?
227 &loadMyModule( $myModules{$_} || $myModules{lc $_} );
231 &status("Module: Runtime: Loaded/Total [$loaded/$total]");
234 ### rename to moduleReloadAll?
235 sub reloadAllModules {
236 &VERB("Module: reloading all.",2);
238 # obscure usage of map and regex :)
239 foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
243 &VERB("Module: reloading done.",2);
246 ### rename to modulesReload?
249 my $file = (grep /\/$mod/, keys %INC)[0];
251 # don't reload if it's not our module.
252 if ($mod =~ /::/ or $mod !~ /pl$/) {
253 &VERB("Not reloading $mod.",3);
257 if (!defined $file) {
258 &WARN("rM: Cannot reload $mod since it was not loaded anyway.");
263 &ERROR("rM: file '$file' does not exist?");
267 if (grep /$mod/, @myModulesReloadNot) {
268 &DEBUG("rM: should not reload $mod");
272 my $age = (stat $file)[9];
274 if (!exists $moduleAge{$file}) {
275 &DEBUG("Looks like $file was not loaded; fixing.");
277 return if ($age == $moduleAge{$file});
279 if ($age < $moduleAge{$file}) {
280 &WARN("rM: we're not gonna downgrade '$file'; use touch.");
281 &DEBUG("age => $age");
282 &DEBUG("mA{$file} => $moduleAge{$file}");
286 my $dc = &Time2String($age - $moduleAge{$file});
287 my $ago = &Time2String(time() - $moduleAge{$file});
289 &VERB("Module: delta change: $dc",2);
290 &VERB("Module: ago: $ago",2);
293 &status("Module: Loading $mod...");
296 eval "require \"$file\""; # require or use?
298 &DEBUG("rM: failure: @$");
300 my $basename = $file;
301 $basename =~ s/^.*\///;
302 &status("Module: reloaded $basename");
303 $moduleAge{$file} = $age;
308 ### OPTIONAL MODULES.
311 my %perlModulesLoaded = ();
312 my %perlModulesMissing = ();
315 return 0 if (exists $perlModulesMissing{$_[0]});
316 &reloadModule($_[0]);
317 return 1 if (exists $perlModulesLoaded{$_[0]});
321 &WARN("Module: $_[0] is not installed!");
322 $perlModulesMissing{$_[0]} = 1;
325 $perlModulesLoaded{$_[0]} = 1;
326 &status("Module: Loaded $_[0] ...");
327 &showProc(" ($_[0])");
335 &WARN("loadMyModule: module is NULL.");
339 my ($modulename, $modulebase);
340 if (exists $myModules{$tmp}) {
341 ($modulename, $modulebase) = ($tmp, $myModules{$tmp});
344 if ($tmp = grep /^$modulebase$/, keys %myModules) {
345 &DEBUG("lMM: lame hack, file => name => $tmp.");
349 my $modulefile = "$bot_src_dir/Modules/$modulebase";
351 # call reloadModule() which checks age of file and reload.
352 if (grep /\/$modulebase$/, keys %INC) {
353 &reloadModule($modulebase);
354 return 1; # depend on reloadModule?
357 if (! -f $modulefile) {
358 &ERROR("lMM: module ($modulebase) does not exist.");
359 if ($$ == $bot_pid) { # parent.
360 &shutdown() if (defined $shm and defined $dbh);
362 &DEBUG("b4 delfork 1");
363 &delForked($modulename);
369 eval "require \"$modulefile\"";
371 &ERROR("cannot load my module: $modulebase");
372 if ($bot_pid != $$) { # child.
373 &DEBUG("b4 delfork 2");
374 &delForked($modulename);
380 $moduleAge{$modulefile} = (stat $modulefile)[9];
382 &status("myModule: Loaded $modulebase ...");
383 &showProc(" ($modulebase)");
389 eval "use Time::HiRes qw(gettimeofday tv_interval)";
391 &WARN("No Time::HiRes?");
394 &showProc(" (Time::HiRes)");
397 if (!defined $AUTOLOAD and defined $::AUTOLOAD) {
398 &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!");
400 return unless (defined $AUTOLOAD);
401 return if ($AUTOLOAD =~ /__/); # internal.
403 my $str = join(', ', @_);
404 my ($package, $filename, $line) = caller;
405 &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line");
407 $AUTOLOAD =~ s/^(\S+):://g;
409 if (exists $myModules{lc $AUTOLOAD}) {
410 # hopefully this will work.
411 &DEBUG("Trying to load module $AUTOLOAD...");
412 &loadMyModule(lc $AUTOLOAD);
419 if (!opendir(DIR, $dir)) {
420 &ERROR("Cannot open source directory ($dir): $!");
425 while (defined(my $file = readdir DIR)) {
426 next unless $file =~ /\.pl$/;
427 next unless $file =~ /^[A-Z]/;
432 return reverse sort @mods;