X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fmodules.pl;h=bcbd3282a50665e8c1cfd1d80a21d5cc93b22557;hb=2fe7b3f4c44843313576e45ac0ceee8d2fcdab3d;hp=0cbfd9f5e72abdd00c1a1a5ab65818ede2199ab6;hpb=d5e397a3f5090bc881987adc3f2418fdf007252c;p=infobot.git diff --git a/src/modules.pl b/src/modules.pl index 0cbfd9f..bcbd328 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -5,8 +5,9 @@ # Created: 20000624 # -if (&IsParam("useStrict")) { use strict; } -use vars qw($AUTOLOAD); +use strict; + +use vars qw($AUTOLOAD $no_timehires); ### ### REQUIRED MODULES. @@ -19,146 +20,112 @@ if ($@) { } &showProc(" (IO::Socket)"); -### MODULES. -%myModules = ( - "countdown" => "Countdown.pl", - "allowDNS" => "DNS.pl", - "debian" => "Debian.pl", - "debianExtra" => "DebianExtra.pl", - "dict" => "Dict.pl", - "dumpvars" => "DumpVars.pl", - "factoids" => "Factoids.pl", - "freshmeat" => "Freshmeat.pl", - "kernel" => "Kernel.pl", - "ircdcc" => "UserDCC.pl", - "perlMath" => "Math.pl", - "quote" => "Quote.pl", - "rootwarn" => "RootWarn.pl", - "search" => "Search.pl", - "slashdot" => "Slashdot3.pl", - "topic" => "Topic.pl", - "units" => "Units.pl", - "uptime" => "Uptime.pl", - "userinfo" => "UserInfo.pl", - "wwwsearch" => "W3Search.pl", - "whatis" => "WhatIs.pl", - "wingate" => "Wingate.pl", - "insult" => "insult.pl", - "nickometer" => "nickometer.pl", -); -@myModulesLoadNow = ('topic', 'uptime',); -@myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl'); +### THIS IS NOT LOADED ON RELOAD :( +my @myModulesLoadNow; +my @myModulesReloadNot; +BEGIN { + @myModulesLoadNow = ('Topic', 'Uptime', 'News', 'RootWarn', 'DumpVars2', 'botmail', 'OnJoin'); + @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..."); - 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; + foreach (sort @mods) { + my $mod = "$bot_src_dir/$_"; + + eval "require \"$mod\""; + if ($@) { + &ERROR("lCM => $@"); + &shutdown(); + exit 1; + } + $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($file)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam("DEBUG")); } - closedir DIR; } sub loadDBModules { - &status("Loading DB modules..."); + my $f; + # 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!"); - exit 1; - } - &showProc(" (DBI // mysql)"); - - &status(" using MySQL support."); - require "$bot_src_dir/db_mysql.pl"; - - } elsif ($param{'DBType'} =~ /^pgsql$/i) { - eval "use Pg"; - if ($@) { - &ERROR("libpgperl is not installed!"); + &ERROR("No support for DBI::" . $param{'DBType'} . ", exiting!"); exit 1; } - &showProc(" (Pg // postgreSQLl)"); + &status("Loading " . $param{'DBType'} . " support."); + $f = "$bot_src_dir/dbi.pl"; + require $f; + $moduleAge{$f} = (stat $f)[9]; - &status(" using PostgreSQL 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"; + &showProc(" (DBI::" . $param{'DBType'} . ")"); } else { - - &status("DB support DISABLED."); + &WARN("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/$_"; + + 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/) { + 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. Why? + #$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/$_"; + + # 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("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 { @@ -168,86 +135,107 @@ sub loadMyModulesNow { &status("Loading MyModules..."); foreach (@myModulesLoadNow) { $total++; + if (!defined $_) { + &WARN("mMLN: null element."); + next; + } - if (!exists $param{$_}) { - &DEBUG("myModule: $myModules{$_} not loaded."); + if (!&IsParam($_) and &IsChanConf($_) <= 0 and !&getChanConfList($_)) { + &DEBUG("loadMyModuleNow: $_ (2) not loaded."); next; } - &loadMyModule($myModules{$_}); + + &loadMyModule($_); $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) { - &reloadModule($_); + my $retval = ""; + + &VERB("Module: reloading all.",2); + + # obscure usage of map and regex :) + foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) { + $retval .= &reloadModule($_); } -### &status("Module: reloading done."); + + &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 $retval; } 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 (!exists $moduleAge{$file}) { + &DEBUG("Looks like $file was not loaded; fixing."); + } else { + return $retval if ($age == $moduleAge{$file}); - if (grep /$mod/, @myModulesReloadNot) { - &DEBUG("rM: SHOULD NOT RELOAD $mod!!!"); - return; - } + if ($age < $moduleAge{$file}) { + &WARN("rM: we're not gonna downgrade '$file'; use touch."); + &DEBUG("age => $age, mA{$file} => $moduleAge{$file}"); + return $retval; + } + + my $dc = &Time2String($age - $moduleAge{$file}); + my $ago = &Time2String(time() - $moduleAge{$file}); - 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? if (@$) { - &DEBUG("rM: failure: @$"); + &DEBUG("rM: failure: @$ "); } else { my $basename = $file; $basename =~ s/^.*\///; &status("Module: reloaded $basename"); + $retval = " $basename"; $moduleAge{$file} = $age; } + return $retval; } ### ### OPTIONAL MODULES. ### -local %perlModulesLoaded = (); -local %perlModulesMissing = (); +my %perlModulesLoaded = (); +my %perlModulesMissing = (); sub loadPerlModule { return 0 if (exists $perlModulesMissing{$_[0]}); @@ -261,44 +249,34 @@ 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 ($modulebase, $modulefile); - 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. &DEBUG("b4 delfork 1"); - &delForked($modulebase); + &delForked($modulename); } exit 1; @@ -306,10 +284,10 @@ 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($modulebase); + &delForked($modulename); exit 1; } @@ -317,28 +295,55 @@ sub loadMyModule { } else { $moduleAge{$modulefile} = (stat $modulefile)[9]; - &status("myModule: Loaded $modulebase ..."); - &showProc(" ($modulebase)"); + &status("Loaded $modulename"); + &showProc(" ($modulename)"); return 1; } } -### 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 (@_) { - next unless (defined $_); - &status(" => $_"); + if (!defined $AUTOLOAD and defined $::AUTOLOAD) { + &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!"); + } + return unless (defined $AUTOLOAD); + return if ($AUTOLOAD =~ /__/); # internal. + + my $str = join(', ', @_); + my ($package, $filename, $line) = caller; + &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line"); + + $AUTOLOAD =~ s/^(\S+):://g; + + # 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; } + + 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;