X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fmodules.pl;h=9d54aa1204f1dfbcc171a50177b4ac10ea08a8f7;hb=b24caafaad5c48b4895f31132251c33fcae6b81f;hp=30c5a40c8d9d2d2113ab89e7d0f159ec9bf4e5c4;hpb=79ddec2f34e07300f6fdb0803b56746b8399c0f4;p=infobot.git diff --git a/src/modules.pl b/src/modules.pl index 30c5a40..9d54aa1 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -5,7 +5,7 @@ # Created: 20000624 # -if (&IsParam("useStrict")) { use strict; } +#use strict; use vars qw($AUTOLOAD); ### @@ -21,17 +21,19 @@ if ($@) { ### MODULES. %myModules = ( + "bzflag" => "BZFlag.pl", "countdown" => "Countdown.pl", "debian" => "Debian.pl", "debianExtra" => "DebianExtra.pl", "dict" => "Dict.pl", "dumpvars" => "DumpVars.pl", + "symdump" => "DumpVars2.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,33 +41,28 @@ if ($@) { "topic" => "Topic.pl", "units" => "Units.pl", "uptime" => "Uptime.pl", + "ircdcc" => "UserDCC.pl", "userinfo" => "UserInfo.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", + "zsi" => "zsi.pl", ); ### THIS IS NOT LOADED ON RELOAD :( +my @myModulesLoadNow; +my @myModulesReloadNot; BEGIN { - @myModulesLoadNow = ('topic', 'uptime', 'news'); + @myModulesLoadNow = ('topic', 'uptime', 'news', 'rootWarn', 'symdump'); @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl'); } sub loadCoreModules { - if (!opendir(DIR, $bot_src_dir)) { - &ERROR("can't open source directory $bot_src_dir: $!"); - exit 1; - } + my @mods = &getPerlFiles($bot_src_dir); - my @mods; - while (defined(my $file = readdir DIR)) { - next unless $file =~ /\.pl$/; - next unless $file =~ /^[A-Z]/; - push(@mods, $file); - } - closedir DIR; &status("Loading ".scalar(@mods)." CORE modules..."); foreach (sort @mods) { @@ -84,7 +81,8 @@ sub loadCoreModules { } sub loadDBModules { - &status("Loading DB modules..."); + my $f = "$bot_src_dir/modules.pl"; + $moduleAge{$f} = (stat $f)[9]; if ($param{'DBType'} =~ /^mysql$/i) { eval "use DBI"; @@ -92,92 +90,87 @@ sub loadDBModules { &ERROR("libdbd-mysql-perl is not installed!"); exit 1; } + &status("Loading MySQL support."); + $f = "$bot_src_dir/db_mysql.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; &showProc(" (DBI // mysql)"); - - &status(" using MySQL support."); - require "$bot_src_dir/db_mysql.pl"; - } elsif ($param{'DBType'} =~ /^pgsql$/i) { - eval "use Pg"; +# eval "use Pg"; + eval "use DBI"; if ($@) { &ERROR("libpgperl is not installed!"); exit 1; } - &showProc(" (Pg // postgreSQLl)"); - - &status(" using PostgreSQL support."); + &status("Loading pgsql support."); require "$bot_src_dir/db_pgsql.pl"; + &showProc(" (pgsql)"); } elsif ($param{'DBType'} =~ /^dbm$/i) { - - &status(" using Berkeley DBM 1.85/2.0 support."); - require "$bot_src_dir/db_dbm.pl"; + &status("Loading Berkeley DBM support."); + $f = "$bot_src_dir/db_dbm.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; + &showProc(" $bot_src_dir/db_dbm.pl"); } else { - &status("DB support DISABLED."); return; } } sub loadFactoidsModules { - &status("Loading Factoids modules..."); - if (!&IsParam("factoids")) { &status("Factoid support DISABLED."); return; } - if (!opendir(DIR, "$bot_src_dir/Factoids")) { - &ERROR("can't open source directory Factoids: $!"); - exit 1; - } + &status("Loading Factoids modules..."); + + foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) { + my $mod = "$bot_src_dir/Factoids/$_"; - while (defined(my $file = readdir DIR)) { - next unless $file =~ /\.pl$/; - next unless $file =~ /^[A-Z]/; - my $mod = "$bot_src_dir/Factoids/$file"; - ### TODO: use eval and exit gracefully? eval "require \"$mod\""; if ($@) { - &WARN("lFM: $@"); + &ERROR("lFM: $@"); exit 1; } $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($file)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam("DEBUG")); } - closedir DIR; } sub loadIRCModules { - &status("Loading IRC modules..."); - if (&whatInterface() =~ /IRC/) { + my ($interface) = &whatInterface(); + if ($interface =~ /IRC/) { + &status("Loading IRC modules..."); + eval "use Net::IRC"; if ($@) { &ERROR("libnet-irc-perl is not installed!"); exit 1; } &showProc(" (Net::IRC)"); - } else { &status("IRC support DISABLED."); - return; + # disabling forking. + $param{forking} = 0; + $param{noSHM} = 1; } - if (!opendir(DIR, "$bot_src_dir/IRC")) { - &ERROR("can't open source directory Factoids: $!"); - exit 1; - } + foreach ( &getPerlFiles("$bot_src_dir/$interface") ) { + my $mod = "$bot_src_dir/$interface/$_"; + + &status("Loading Modules \"$mod\""); + eval "require \"$mod\""; + if ($@) { + &ERROR("require \"$mod\" => $@"); + &shutdown(); + exit 1; + } - while (defined(my $file = readdir DIR)) { - next unless $file =~ /\.pl$/; - next unless $file =~ /^[A-Z]/; - my $mod = "$bot_src_dir/IRC/$file"; - ### TODO: use eval and exit gracefully? - require $mod; $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($file)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam("DEBUG")); } - closedir DIR; } sub loadMyModulesNow { @@ -202,7 +195,9 @@ sub loadMyModulesNow { next; } - &loadMyModule($myModules{$_}); + # weird hack to get rootwarn to work. + # it may break on other cases though, any ideas? + &loadMyModule( $myModules{$_} || $myModules{lc $_} ); $loaded++; } @@ -211,11 +206,14 @@ sub loadMyModulesNow { ### rename to moduleReloadAll? sub reloadAllModules { -### &status("Module: reloading all."); - foreach (map { substr($_,2) } keys %moduleAge) { + &VERB("Module: reloading all.",2); + + # obscure usage of map and regex :) + foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) { &reloadModule($_); } -### &status("Module: reloading done."); + + &VERB("Module: reloading done.",2); } ### rename to modulesReload? @@ -240,7 +238,7 @@ sub reloadModule { } if (grep /$mod/, @myModulesReloadNot) { - &DEBUG("rM: SHOULD NOT RELOAD $mod!!!"); + &DEBUG("rM: should not reload $mod"); return; } @@ -252,7 +250,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; } @@ -281,8 +281,8 @@ sub reloadModule { ### OPTIONAL MODULES. ### -local %perlModulesLoaded = (); -local %perlModulesMissing = (); +my %perlModulesLoaded = (); +my %perlModulesMissing = (); sub loadPerlModule { return 0 if (exists $perlModulesMissing{$_[0]}); @@ -309,7 +309,7 @@ sub loadMyModule { return 0; } - my ($modulebase, $modulefile); + my ($modulename, $modulebase); if (exists $myModules{$tmp}) { ($modulename, $modulebase) = ($tmp, $myModules{$tmp}); } else { @@ -367,13 +367,42 @@ if ($@) { &showProc(" (Time::HiRes)"); sub AUTOLOAD { + if (!defined $AUTOLOAD and defined $::AUTOLOAD) { + &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!"); + } + return unless (defined $AUTOLOAD); return if ($AUTOLOAD =~ /__/); # internal. - &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD"); - foreach (@_) { - next unless (defined $_); - &status(" => $_"); + my $str = join(', ', @_); + my ($package, $filename, $line) = caller; + &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line"); + + $AUTOLOAD =~ s/^(\S+):://g; + + if (exists $myModules{lc $AUTOLOAD}) { + # hopefully this will work. + &DEBUG("Trying to load module $AUTOLOAD..."); + &loadMyModule(lc $AUTOLOAD); + } +} + +sub getPerlFiles { + my($dir) = @_; + + if (!opendir(DIR, $dir)) { + &ERROR("Cannot open source directory ($dir): $!"); + exit 1; } + + my @mods; + while (defined(my $file = readdir DIR)) { + next unless $file =~ /\.pl$/; + next unless $file =~ /^[A-Z]/; + push(@mods, $file); + } + closedir DIR; + + return reverse sort @mods; } 1;