X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fmodules.pl;h=b81d31fef4d0428265cd7ae1fd3fa5511a95d337;hb=e1808cadf169b3811d694a4aa3d2a03ec2eeae84;hp=a4e729b0b336f414b74135783ce594a08ecd0bc9;hpb=26d011c7bd06806267214b31aa16f93d7ed1002f;p=infobot.git

diff --git a/src/modules.pl b/src/modules.pl
index a4e729b..b81d31f 100644
--- a/src/modules.pl
+++ b/src/modules.pl
@@ -5,7 +5,9 @@
 #     Created: 20000624
 #
 
-if (&IsParam("useStrict")) { use strict; }
+use strict;
+
+use vars qw($AUTOLOAD $no_timehires $bot_version $bot_release);
 
 ###
 ### REQUIRED MODULES.
@@ -18,119 +20,83 @@ 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!");
+	    &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")) {
+    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!");
@@ -139,24 +105,27 @@ sub loadIRCModules {
 	&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 {
@@ -166,75 +135,119 @@ 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("Modules: Loaded/Total [$loaded/$total]");
+    &status("Module: Runtime: Loaded/Total [$loaded/$total]");
 }
 
 ### rename to moduleReloadAll?
 sub reloadAllModules {
-    &status("Modules: reloading all.");
-    foreach (map { substr($_,2) } keys %moduleAge) {
-        &reloadModule($_);
+    my $retval = '';
+
+    &VERB("Module: reloading all.",2);
+    
+    # Reload version and save
+    open(VERSION,"<VERSION");
+    $bot_release = <VERSION> || "(unknown version)";
+    chomp($bot_release);
+    $bot_version    = "infobot $bot_release -- $^O";
+    close(VERSION);
+
+    # obscure usage of map and regex :)
+    foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
+	$retval .= &reloadModule($_);
     }
-    &status("Modules: 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 $retval;
+    }
 
     if (!defined $file) {
-###	&DEBUG("rM: mod '$mod' was not found in \%INC.");
-	return;
+	&WARN("rM: Cannot reload $mod since it was not loaded anyway.");
+	return $retval;
     }
 
     if (! -f $file) {
-	&DEBUG("rM: file '$file' does not exist?");
-	return;
+	&ERROR("rM: file '$file' does not exist?");
+	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 (grep /$mod/, @myModulesReloadNot) {
-	&DEBUG("rM: SHOULD NOT RELOAD $mod!!!");
-	return;
+    if (!exists $moduleAge{$file}) {
+	&DEBUG("Looks like $file was not loaded; fixing.");
+    } else {
+	return $retval if ($age == $moduleAge{$file});
+
+	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});
+
+	&VERB("Module:  delta change: $dc",2);
+	&VERB("Module:           ago: $ago",2);
     }
 
     &status("Module: Loading $mod...");
+
     delete $INC{$file};
     eval "require \"$file\"";	# require or use?
     if (@$) {
-	&DEBUG("rM: failure: @$");
+	&DEBUG("rM: failure: @$ ");
     } else {
 	my $basename = $file;
 	$basename =~ s/^.*\///;
-	&status("Modules: reloaded $basename");
+	&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 1 if (exists $perlModulesLoaded{$_[0]});
-
     &reloadModule($_[0]);
+    return 1 if (exists $perlModulesLoaded{$_[0]});
 
     eval "use $_[0]";
     if ($@) {
@@ -243,38 +256,33 @@ 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";
 
-    return 1 if (grep /$modulefile/, keys %INC);
+    # call reloadModule() which checks age of file and reload.
+    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($modulename);
 	}
 
@@ -283,31 +291,66 @@ sub loadMyModule {
 
     eval "require \"$modulefile\"";
     if ($@) {
-	&ERROR("cannot load my module: $modulebase");
-	if ($bot_pid == $$) {	# parent.
-	    &shutdown() if (defined $shm and defined $dbh);
-	} else {			# child.
+	&ERROR("cannot load my module: $modulename");
+	if ($bot_pid != $$) {	# child.
+	    &DEBUG("b4 delfork 2");
 	    &delForked($modulename);
+	    exit 1;
 	}
 
-	exit 1;
+	return 0;
     } 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 {
+    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;