# Created: 20000624
#
-if (&IsParam("useStrict")) { use strict; }
+# use strict; # TODO
+
use vars qw($AUTOLOAD);
###
### MODULES.
%myModules = (
+ "bzflag" => "BZFlag.pl",
"countdown" => "Countdown.pl",
- "allowDNS" => "DNS.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",
"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",
+ "httpdtype" => "HTTPDtype.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', 'symdump', 'botmail');
+ @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|pgsql)$/i) {
eval "use DBI";
if ($@) {
- &ERROR("libdbd-mysql-perl is not installed!");
+ &ERROR("No support for DBI::" . $param{'DBType'} . ", exiting!");
exit 1;
}
- &showProc(" (DBI // mysql)");
+ &status("Loading " . $param{'DBType'} . " 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";
-
- } elsif ($param{'DBType'} =~ /^pgsql$/i) {
- eval "use Pg";
- if ($@) {
- &ERROR("libpgperl is not installed!");
- exit 1;
- }
- &showProc(" (Pg // postgreSQLl)");
-
- &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 {
&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) {
- &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");
+ &DEBUG("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]});
return 0;
} else {
$perlModulesLoaded{$_[0]} = 1;
- &status("Module: Loaded $_[0] ...");
+ &status("Loaded $_[0]");
&showProc(" ($_[0])");
return 1;
}
my ($tmp) = @_;
if (!defined $tmp) {
&WARN("loadMyModule: module is NULL.");
- return 0;
+ return 0;
}
- my ($modulebase, $modulefile);
+ my ($modulename, $modulebase);
if (exists $myModules{$tmp}) {
($modulename, $modulebase) = ($tmp, $myModules{$tmp});
} else {
&shutdown() if (defined $shm and defined $dbh);
} else { # child.
&DEBUG("b4 delfork 1");
- &delForked($modulebase);
+ &delForked($modulename);
}
exit 1;
&ERROR("cannot load my module: $modulebase");
if ($bot_pid != $$) { # child.
&DEBUG("b4 delfork 2");
- &delForked($modulebase);
+ &delForked($modulename);
exit 1;
}
} else {
$moduleAge{$modulefile} = (stat $modulefile)[9];
- &status("myModule: Loaded $modulebase ...");
+ &status("Loaded $modulebase");
&showProc(" ($modulebase)");
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;
+
+ 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;
projects / infobot.git / blobdiff