X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fmodules.pl;h=b5cadd76d24d719a396f9f6caf11cc7c3cdb0cf1;hb=0fbfef3c124ae0abe85dbf5eb4625520f0772487;hp=75b64ba4e64141416fd3996550e4bb24ae301dad;hpb=ca19b985df1627cd66fe320968866fe83f724315;p=infobot.git diff --git a/src/modules.pl b/src/modules.pl index 75b64ba..b5cadd7 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -22,7 +22,6 @@ if ($@) { ### MODULES. %myModules = ( "countdown" => "Countdown.pl", - "allowDNS" => "DNS.pl", "debian" => "Debian.pl", "debianExtra" => "DebianExtra.pl", "dict" => "Dict.pl", @@ -32,6 +31,7 @@ if ($@) { "kernel" => "Kernel.pl", "ircdcc" => "UserDCC.pl", "perlMath" => "Math.pl", + "news" => "News.pl", "quote" => "Quote.pl", "rootwarn" => "RootWarn.pl", "search" => "Search.pl", @@ -45,33 +45,40 @@ if ($@) { "wingate" => "Wingate.pl", "insult" => "insult.pl", "nickometer" => "nickometer.pl", + "babelfish" => "babel.pl", ); -@myModulesLoadNow = ('topic', 'uptime',); -@myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl'); +### THIS IS NOT LOADED ON RELOAD :( +BEGIN { + @myModulesLoadNow = ('topic', 'uptime', 'news', 'rootWarn'); + @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); - &status("Loading CORE modules..."); + &status("Loading ".scalar(@mods)." CORE modules..."); + + foreach (sort @mods) { + my $mod = "$bot_src_dir/$_"; + + eval "require \"$mod\""; + if ($@) { + &ERROR("lCM => $@"); + &shutdown(); + exit 1; + } - while (defined(my $file = readdir DIR)) { - next unless $file =~ /\.pl$/; - next unless $file =~ /^[A-Z]/; - my $mod = "$bot_src_dir/$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 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"; if ($@) { @@ -81,22 +88,30 @@ sub loadDBModules { &showProc(" (DBI // mysql)"); &status(" using MySQL support."); - require "$bot_src_dir/db_mysql.pl"; + $f = "$bot_src_dir/db_mysql.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; } 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)"); + &showProc(" (pgsql)"); - &status(" using PostgreSQL support."); + &status(" using pgsql support."); require "$bot_src_dir/db_pgsql.pl"; + } elsif ($param{'DBType'} =~ /^dbm$/i) { &status(" using Berkeley DBM 1.85/2.0 support."); - require "$bot_src_dir/db_dbm.pl"; + &ERROR("dbm support is broken... if you want it, fix it yourself!"); + &shutdown(); + exit 1; + +# require "$bot_src_dir/db_dbm.pl"; } else { &status("DB support DISABLED."); @@ -105,59 +120,56 @@ sub loadDBModules { } 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/$_"; + + eval "require \"$mod\""; + if ($@) { + &ERROR("lFM: $@"); + exit 1; + } - 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? - require $mod; $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/) { + &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; } - if (!opendir(DIR, "$bot_src_dir/IRC")) { - &ERROR("can't open source directory Factoids: $!"); - exit 1; - } + foreach ( &getPerlFiles("$bot_src_dir/IRC") ) { + my $mod = "$bot_src_dir/IRC/$_"; + + eval "require \"$mod\""; + if ($@) { + &ERROR("lIRCM => $@"); + &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 { @@ -167,25 +179,40 @@ sub loadMyModulesNow { &status("Loading MyModules..."); foreach (@myModulesLoadNow) { $total++; + if (!defined $_) { + &WARN("mMLN: null element."); + next; + } + + if (!&IsParam($_) and !&IsChanConf($_) and !&getChanConfList($_)) { + if (exists $myModules{$_}) { + &status("myModule: $myModules{$_} or $_ (1) not loaded."); + } else { + &DEBUG("myModule: $_ (2) not loaded."); + } - if (!exists $param{$_}) { - &DEBUG("myModule: $myModules{$_} not loaded."); next; } - &loadMyModule($myModules{$_}); + + # weird hack to get rootwarn to work. + # it may break on other cases though, any ideas? + &loadMyModule( $myModules{$_} || $myModules{lc $_} ); $loaded++; } - &status("Module: Loaded/Total [$loaded/$total]"); + &status("Module: Runtime: Loaded/Total [$loaded/$total]"); } ### 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? @@ -209,25 +236,33 @@ sub reloadModule { return; } - my $age = (stat $file)[9]; - return if ($age == $moduleAge{$file}); - - if ($age < $moduleAge{$file}) { - &WARN("rM: we're not gonna downgrade the file. use 'touch'."); - return; - } - if (grep /$mod/, @myModulesReloadNot) { &DEBUG("rM: SHOULD NOT RELOAD $mod!!!"); return; } - my $dc = &Time2String($age - $moduleAge{$file}); - my $ago = &Time2String(time() - $moduleAge{$file}); + my $age = (stat $file)[9]; + + if (!exists $moduleAge{$file}) { + &DEBUG("Looks like $file was not loaded; fixing."); + } else { + return 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; + } + + my $dc = &Time2String($age - $moduleAge{$file}); + my $ago = &Time2String(time() - $moduleAge{$file}); + + &VERB("Module: delta change: $dc",2); + &VERB("Module: ago: $ago",2); + } &status("Module: Loading $mod..."); - &VERB("Module: delta change: $dc",2); - &VERB("Module: ago: $ago",2); delete $INC{$file}; eval "require \"$file\""; # require or use? @@ -283,7 +318,7 @@ sub loadMyModule { $modulename = $tmp; } } - my $modulefile = "$bot_src_dir/Modules/$modulebase"; + $modulefile = "$bot_src_dir/Modules/$modulebase"; # call reloadModule() which checks age of file and reload. if (grep /\/$modulebase$/, keys %INC) { @@ -322,21 +357,50 @@ sub loadMyModule { } } -### this chews 3megs on potato, 300 kB on slink. -$no_syscall = 0; -###eval "require 'sys/syscall.ph'"; -#if ($@) { -# &WARN("sys/syscall.ph has not been installed//generated. gettimeofday -#will use time() instead"); - $no_syscall = 1; -#} -#&showProc(" (syscall)"); +$no_timehires = 0; +eval "use Time::HiRes qw(gettimeofday tv_interval)"; +if ($@) { + &WARN("No Time::HiRes?"); + $no_timehires = 1; +} +&showProc(" (Time::HiRes)"); sub AUTOLOAD { - &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD"); - foreach (@_) { - &status(" => $_"); + if (!defined $AUTOLOAD and defined $::AUTOLOAD) { + &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!"); + } + return unless (defined $AUTOLOAD); + return if ($AUTOLOAD =~ /__/); # internal. + + my $str = join(', ', @_); + &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str)"); + + $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;