X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fmodules.pl;h=5a8a20980200687fe7349d4ae162efb57c419270;hb=492eb2c99e1b47c2fb0c729cb9ff196a4081fcd9;hp=43d623e0d0cfd0b7c50df47369b98d58f7fab22c;hpb=66ce4d619091f642e37908c3b0ff56f1dda5ef5a;p=infobot.git diff --git a/src/modules.pl b/src/modules.pl index 43d623e..5a8a209 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -5,7 +5,8 @@ # Created: 20000624 # -if (&IsParam("useStrict")) { use strict; } +# use strict; # TODO + use vars qw($AUTOLOAD); ### @@ -21,17 +22,20 @@ if ($@) { ### MODULES. %myModules = ( + "bzflag" => "BZFlag.pl", "countdown" => "Countdown.pl", "debian" => "Debian.pl", "debianExtra" => "DebianExtra.pl", "dict" => "Dict.pl", "dumpvars" => "DumpVars.pl", + "symdump" => "DumpVars2.pl", + "exchange" => "Exchange.pl", "factoids" => "Factoids.pl", "freshmeat" => "Freshmeat.pl", "kernel" => "Kernel.pl", - "ircdcc" => "UserDCC.pl", "perlMath" => "Math.pl", "news" => "News.pl", + "plug" => "Plug.pl", "quote" => "Quote.pl", "rootwarn" => "RootWarn.pl", "search" => "Search.pl", @@ -39,24 +43,32 @@ if ($@) { "topic" => "Topic.pl", "units" => "Units.pl", "uptime" => "Uptime.pl", + "ircdcc" => "UserDCC.pl", "userinfo" => "UserInfo.pl", + "weather" => "Weather.pl", "wwwsearch" => "W3Search.pl", "whatis" => "WhatIs.pl", "wingate" => "Wingate.pl", + "babelfish" => "babel.pl", "insult" => "insult.pl", "nickometer" => "nickometer.pl", - "babelfish" => "babel.pl", + "zfi" => "zfi.pl", + "zippy" => "Zippy.pl", + "zsi" => "zsi.pl", + "botmail" => "botmail.pl", ); ### THIS IS NOT LOADED ON RELOAD :( +my @myModulesLoadNow; +my @myModulesReloadNot; BEGIN { - @myModulesLoadNow = ('topic', 'uptime', 'news', 'rootWarn'); + @myModulesLoadNow = ('topic', 'uptime', 'news', 'rootWarn', 'symdump', 'botmail'); @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl'); } sub loadCoreModules { my @mods = &getPerlFiles($bot_src_dir); - &status("Loading ".scalar(@mods)." CORE modules..."); + &status("Loading CORE modules..."); foreach (sort @mods) { my $mod = "$bot_src_dir/$_"; @@ -74,9 +86,8 @@ sub loadCoreModules { } sub loadDBModules { - &status("Loading DB modules..."); - - $moduleAge{"$bot_src_dir/modules.pl"} = time(); + my $f; + # todo: use function to load module. if ($param{'DBType'} =~ /^mysql$/i) { eval "use DBI"; @@ -84,35 +95,49 @@ sub loadDBModules { &ERROR("libdbd-mysql-perl is not installed!"); exit 1; } - &showProc(" (DBI // mysql)"); + &status("Loading MySQL support."); + $f = "$bot_src_dir/dbi.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; - &status(" using MySQL support."); - require "$bot_src_dir/db_mysql.pl"; - $moduleAge{"$bot_src_dir/db_mysql.pl"} = time(); + &showProc(" (DBI::mysql)"); } elsif ($param{'DBType'} =~ /^pgsql$/i) { -# eval "use Pg"; eval "use DBI"; if ($@) { &ERROR("libpgperl is not installed!"); exit 1; } - &showProc(" (pgsql)"); + &status("Loading pgsql support."); + $f = "$bot_src_dir/dbi.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; + + &showProc(" (DBI::pgsql)"); + + } elsif ($param{'DBType'} =~ /^sqlite$/i) { + eval "use DBI"; + if ($@) { + &ERROR("libdbd-sqlite-perl is not installed!"); + exit 1; + } + &status("Loading SQLite support."); + $f = "$bot_src_dir/dbi.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; - &status(" using pgsql support."); - require "$bot_src_dir/db_pgsql.pl"; + &showProc(" (DBI::SQLite)"); } elsif ($param{'DBType'} =~ /^dbm$/i) { + &status("Loading dbm support."); + $f = "$bot_src_dir/dbm.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; - &status(" using Berkeley DBM 1.85/2.0 support."); - &ERROR("dbm support is broken... if you want it, fix it yourself!"); - &shutdown(); - exit 1; + &showProc(" (dbm.pl)"); -# require "$bot_src_dir/db_dbm.pl"; } else { - - &status("DB support DISABLED."); + &WARN("DB support DISABLED."); return; } } @@ -140,7 +165,8 @@ sub loadFactoidsModules { } sub loadIRCModules { - if (&whatInterface() =~ /IRC/) { + my ($interface) = &whatInterface(); + if ($interface =~ /IRC/) { &status("Loading IRC modules..."); eval "use Net::IRC"; @@ -149,18 +175,22 @@ sub loadIRCModules { exit 1; } &showProc(" (Net::IRC)"); - } else { &status("IRC support DISABLED."); - return; + # disabling forking. Why? + #$param{forking} = 0; + #$param{noSHM} = 1; } - foreach ( &getPerlFiles("$bot_src_dir/IRC") ) { - my $mod = "$bot_src_dir/IRC/$_"; + foreach ( &getPerlFiles("$bot_src_dir/$interface") ) { + my $mod = "$bot_src_dir/$interface/$_"; + # hrm... use another config option besides DEBUG to display + # change in memory usage. + &status("Loading Modules \"$mod\"") if (!&IsParam("DEBUG")); eval "require \"$mod\""; if ($@) { - &ERROR("lIRCM => $@"); + &ERROR("require \"$mod\" => $@"); &shutdown(); exit 1; } @@ -235,7 +265,7 @@ sub reloadModule { } if (grep /$mod/, @myModulesReloadNot) { - &DEBUG("rM: SHOULD NOT RELOAD $mod!!!"); + &DEBUG("rM: should not reload $mod"); return; } @@ -247,7 +277,9 @@ sub reloadModule { return if ($age == $moduleAge{$file}); if ($age < $moduleAge{$file}) { - &WARN("rM: we're not gonna downgrade the file. use 'touch'."); + &WARN("rM: we're not gonna downgrade '$file'; use touch."); + &DEBUG("age => $age"); + &DEBUG("mA{$file} => $moduleAge{$file}"); return; } @@ -276,8 +308,8 @@ sub reloadModule { ### OPTIONAL MODULES. ### -local %perlModulesLoaded = (); -local %perlModulesMissing = (); +my %perlModulesLoaded = (); +my %perlModulesMissing = (); sub loadPerlModule { return 0 if (exists $perlModulesMissing{$_[0]}); @@ -304,7 +336,7 @@ sub loadMyModule { return 0; } - my ($modulebase, $modulefile); + my ($modulename, $modulebase); if (exists $myModules{$tmp}) { ($modulename, $modulebase) = ($tmp, $myModules{$tmp}); } else { @@ -314,7 +346,7 @@ sub loadMyModule { $modulename = $tmp; } } - $modulefile = "$bot_src_dir/Modules/$modulebase"; + my $modulefile = "$bot_src_dir/Modules/$modulebase"; # call reloadModule() which checks age of file and reload. if (grep /\/$modulebase$/, keys %INC) { @@ -328,7 +360,7 @@ sub loadMyModule { &shutdown() if (defined $shm and defined $dbh); } else { # child. &DEBUG("b4 delfork 1"); - &delForked($modulebase); + &delForked($modulename); } exit 1; @@ -339,7 +371,7 @@ sub loadMyModule { &ERROR("cannot load my module: $modulebase"); if ($bot_pid != $$) { # child. &DEBUG("b4 delfork 2"); - &delForked($modulebase); + &delForked($modulename); exit 1; } @@ -369,7 +401,8 @@ sub AUTOLOAD { return if ($AUTOLOAD =~ /__/); # internal. my $str = join(', ', @_); - &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str)"); + my ($package, $filename, $line) = caller; + &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line"); $AUTOLOAD =~ s/^(\S+):://g; @@ -384,7 +417,7 @@ sub getPerlFiles { my($dir) = @_; if (!opendir(DIR, $dir)) { - &ERROR("cannot open source directory $dir: $!"); + &ERROR("Cannot open source directory ($dir): $!"); exit 1; }