X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=blootbot%2Fsrc%2Fmodules.pl;h=1da1e1ecc7524ccad427ac204c03bdaf271d7904;hb=16c36ddd8e8e1f0c2e6add8e2ddc52005f5e7198;hp=babaec00891db7a143de7e227d07cb47176661f7;hpb=b9996d6838fad355adf849957a5183b50fc7536f;p=infobot.git diff --git a/blootbot/src/modules.pl b/blootbot/src/modules.pl index babaec0..1da1e1e 100644 --- a/blootbot/src/modules.pl +++ b/blootbot/src/modules.pl @@ -5,9 +5,9 @@ # Created: 20000624 # -# use strict; # TODO +use strict; -use vars qw($AUTOLOAD); +use vars qw($AUTOLOAD $no_timehires); ### ### REQUIRED MODULES. @@ -20,48 +20,11 @@ if ($@) { } &showProc(" (IO::Socket)"); -### 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", - "perlMath" => "Math.pl", - "news" => "News.pl", - "plug" => "Plug.pl", - "quote" => "Quote.pl", - "rootwarn" => "RootWarn.pl", - "search" => "Search.pl", - "slashdot" => "Slashdot3.pl", - "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", - "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', 'symdump'); + @myModulesLoadNow = ('Topic', 'Uptime', 'News', 'RootWarn', 'DumpVars2', 'botmail', 'OnJoin'); @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl'); } @@ -81,62 +44,26 @@ sub loadCoreModules { } $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($_)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam('DEBUG')); } } sub loadDBModules { my $f; - # todo: use function to load module. + # TODO: use function to load module. - if ($param{'DBType'} =~ /^mysql$/i) { + if ($param{'DBType'} =~ /^(mysql|SQLite(2)?|pgsql)$/i) { eval "use DBI"; if ($@) { - &ERROR("libdbd-mysql-perl is not installed!"); + &ERROR("No support for DBI::" . $param{'DBType'} . ", exiting!"); exit 1; } - &status("Loading MySQL support."); + &status("Loading " . $param{'DBType'} . " support."); $f = "$bot_src_dir/dbi.pl"; require $f; $moduleAge{$f} = (stat $f)[9]; - &showProc(" (DBI::mysql)"); - - } elsif ($param{'DBType'} =~ /^pgsql$/i) { - eval "use DBI"; - if ($@) { - &ERROR("libpgperl is not installed!"); - exit 1; - } - &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"; - $f = "$bot_src_dir/db_sqlite.pl"; - require $f; - $moduleAge{$f} = (stat $f)[9]; - - &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]; - - &showProc(" (dbm.pl)"); - + &showProc(" (DBI::" . $param{'DBType'} . ")"); } else { &WARN("DB support DISABLED."); return; @@ -144,7 +71,7 @@ sub loadDBModules { } sub loadFactoidsModules { - if (!&IsParam("factoids")) { + if (!&IsParam('factoids')) { &status("Factoid support DISABLED."); return; } @@ -161,7 +88,7 @@ sub loadFactoidsModules { } $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($_)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam('DEBUG')); } } @@ -188,16 +115,16 @@ sub loadIRCModules { # hrm... use another config option besides DEBUG to display # change in memory usage. - &status("Loading Modules \"$mod\"") if (!&IsParam("DEBUG")); + &status("Loading Modules \"$mod\"") if (!&IsParam('DEBUG')); eval "require \"$mod\""; if ($@) { &ERROR("require \"$mod\" => $@"); &shutdown(); exit 1; - } + } $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($_)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam('DEBUG')); } } @@ -213,19 +140,12 @@ sub loadMyModulesNow { next; } - if (!&IsParam($_) and !&IsChanConf($_) and !&getChanConfList($_)) { - if (exists $myModules{$_}) { - &status("myModule: $myModules{$_} or $_ (1) not loaded."); - } else { - &DEBUG("myModule: $_ (2) not loaded."); - } - + if (!&IsParam($_) and &IsChanConf($_) <= 0 and !&getChanConfList($_)) { + &DEBUG("loadMyModuleNow: $_ (2) not loaded."); next; } - # weird hack to get rootwarn to work. - # it may break on other cases though, any ideas? - &loadMyModule( $myModules{$_} || $myModules{lc $_} ); + &loadMyModule($_); $loaded++; } @@ -234,40 +154,44 @@ sub loadMyModulesNow { ### rename to moduleReloadAll? sub reloadAllModules { + my $retval = ''; + &VERB("Module: reloading all.",2); # obscure usage of map and regex :) foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) { - &reloadModule($_); + $retval .= &reloadModule($_); } &VERB("Module: reloading done.",2); + return $retval; } ### rename to modulesReload? sub reloadModule { my ($mod) = @_; my $file = (grep /\/$mod/, keys %INC)[0]; + my $retval = ''; # don't reload if it's not our module. if ($mod =~ /::/ or $mod !~ /pl$/) { &VERB("Not reloading $mod.",3); - return; + return $retval; } if (!defined $file) { &WARN("rM: Cannot reload $mod since it was not loaded anyway."); - return; + return $retval; } if (! -f $file) { &ERROR("rM: file '$file' does not exist?"); - return; + return $retval; } if (grep /$mod/, @myModulesReloadNot) { &DEBUG("rM: should not reload $mod"); - return; + return $retval; } my $age = (stat $file)[9]; @@ -275,13 +199,12 @@ sub reloadModule { if (!exists $moduleAge{$file}) { &DEBUG("Looks like $file was not loaded; fixing."); } else { - return if ($age == $moduleAge{$file}); + return $retval if ($age == $moduleAge{$file}); if ($age < $moduleAge{$file}) { &WARN("rM: we're not gonna downgrade '$file'; use touch."); - &DEBUG("age => $age"); - &DEBUG("mA{$file} => $moduleAge{$file}"); - return; + &DEBUG("age => $age, mA{$file} => $moduleAge{$file}"); + return $retval; } my $dc = &Time2String($age - $moduleAge{$file}); @@ -296,13 +219,15 @@ sub reloadModule { delete $INC{$file}; eval "require \"$file\""; # require or use? if (@$) { - &DEBUG("rM: failure: @$"); + &DEBUG("rM: failure: @$ "); } else { my $basename = $file; $basename =~ s/^.*\///; &status("Module: reloaded $basename"); + $retval = " $basename"; $moduleAge{$file} = $age; } + return $retval; } ### @@ -324,39 +249,29 @@ sub loadPerlModule { return 0; } else { $perlModulesLoaded{$_[0]} = 1; - &status("Module: Loaded $_[0] ..."); + &status("Loaded $_[0]"); &showProc(" ($_[0])"); return 1; } } sub loadMyModule { - my ($tmp) = @_; - if (!defined $tmp) { + my ($modulename) = @_; + if (!defined $modulename) { &WARN("loadMyModule: module is NULL."); - return 0; + return 0; } - my ($modulename, $modulebase); - if (exists $myModules{$tmp}) { - ($modulename, $modulebase) = ($tmp, $myModules{$tmp}); - } else { - $modulebase = $tmp; - if ($tmp = grep /^$modulebase$/, keys %myModules) { - &DEBUG("lMM: lame hack, file => name => $tmp."); - $modulename = $tmp; - } - } - my $modulefile = "$bot_src_dir/Modules/$modulebase"; + my $modulefile = "$bot_src_dir/Modules/$modulename.pl"; # call reloadModule() which checks age of file and reload. - if (grep /\/$modulebase$/, keys %INC) { - &reloadModule($modulebase); + if (grep /\/$modulename$/, keys %INC) { + &reloadModule($modulename); return 1; # depend on reloadModule? } if (! -f $modulefile) { - &ERROR("lMM: module ($modulebase) does not exist."); + &ERROR("lMM: module ($modulename) does not exist."); if ($$ == $bot_pid) { # parent. &shutdown() if (defined $shm and defined $dbh); } else { # child. @@ -369,7 +284,7 @@ sub loadMyModule { eval "require \"$modulefile\""; if ($@) { - &ERROR("cannot load my module: $modulebase"); + &ERROR("cannot load my module: $modulename"); if ($bot_pid != $$) { # child. &DEBUG("b4 delfork 2"); &delForked($modulename); @@ -380,8 +295,8 @@ sub loadMyModule { } else { $moduleAge{$modulefile} = (stat $modulefile)[9]; - &status("myModule: Loaded $modulebase ..."); - &showProc(" ($modulebase)"); + &status("Loaded $modulename"); + &showProc(" ($modulename)"); return 1; } } @@ -407,19 +322,17 @@ sub AUTOLOAD { $AUTOLOAD =~ s/^(\S+):://g; - if (exists $myModules{lc $AUTOLOAD}) { - # hopefully this will work. - &DEBUG("Trying to load module $AUTOLOAD..."); - &loadMyModule(lc $AUTOLOAD); - } + # hopefully this will work. + &DEBUG("Trying to load module $AUTOLOAD..."); + &loadMyModule($AUTOLOAD); } sub getPerlFiles { my($dir) = @_; if (!opendir(DIR, $dir)) { - &ERROR("Cannot open source directory ($dir): $!"); - exit 1; + &ERROR("Cannot open source directory ($dir): $!"); + exit 1; } my @mods;