ws

[infobot.git] / src / modules.pl

diff --git a/src/modules.pl b/src/modules.pl
index acacb4c517581af915bf541d4a5320c9de2e840e..7de063a38d22f412a991e8926d387c041171cb03 100644 (file)
--- a/src/modules.pl
+++ b/src/modules.pl
@@ -5,7 +5,8 @@
 #     Created: 20000624
 #
 
-#use strict;
+# use strict;  # TODO
+
 use vars qw($AUTOLOAD);
 
 ###
@@ -28,8 +29,8 @@ if ($@) {
        "dict"          => "Dict.pl",
        "dumpvars"      => "DumpVars.pl",
        "symdump"       => "DumpVars2.pl",
+       "exchange"      => "Exchange.pl",
        "factoids"      => "Factoids.pl",
-       "freshmeat"     => "Freshmeat.pl",
        "kernel"        => "Kernel.pl",
        "perlMath"      => "Math.pl",
        "news"          => "News.pl",
@@ -53,19 +54,21 @@ if ($@) {
        "zfi"           => "zfi.pl",
        "zippy"         => "Zippy.pl",
        "zsi"           => "zsi.pl",
+       "botmail"       => "botmail.pl",
+       "httpdtype"     => "HTTPDtype.pl",
 );
 ### THIS IS NOT LOADED ON RELOAD :(
 my @myModulesLoadNow;
 my @myModulesReloadNot;
 BEGIN {
-    @myModulesLoadNow  = ('topic', 'uptime', 'news', 'rootWarn', 'symdump');
+    @myModulesLoadNow  = ('topic', 'uptime', 'news', 'rootWarn', 'symdump', 'botmail');
     @myModulesReloadNot        = ('IRC/Irc.pl','IRC/Schedulers.pl');
 }
 
 sub loadCoreModules {
     my @mods = &getPerlFiles($bot_src_dir);
 
-    &status("Loading ".scalar(@mods)." CORE modules...");
+    &status("Loading CORE modules...");
 
     foreach (sort @mods) {
        my $mod = "$bot_src_dir/$_";
@@ -83,38 +86,23 @@ sub loadCoreModules {
 }
 
 sub loadDBModules {
-    my $f = "$bot_src_dir/modules.pl";
-    $moduleAge{$f} = (stat $f)[9];
+    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;
        }
-       &status("Loading MySQL support.");
-       $f = "$bot_src_dir/db_mysql.pl";
-       require $f;
-       $moduleAge{$f} = (stat $f)[9];
-       &showProc(" (DBI // mysql)");
-    } elsif ($param{'DBType'} =~ /^pgsql$/i) {
-#      eval "use Pg";
-       eval "use DBI";
-       if ($@) {
-           &ERROR("libpgperl is not installed!");
-           exit 1;
-       }
-       &status("Loading pgsql support.");
-       require "$bot_src_dir/db_pgsql.pl";
-       &showProc(" (pgsql)");
-    } elsif ($param{'DBType'} =~ /^sqlite$|^dbm$/i) {
        &status("Loading " . $param{'DBType'} . " support.");
-       $f="$bot_src_dir/db_" . $param{'DBType'} . ".pl";
-       $moduleAge{$f} = (stat $f)[9];
+       $f = "$bot_src_dir/dbi.pl";
        require $f;
-       &showProc(" $bot_src_dir/db_" . $param{'DBType'} . ".pl");
+       $moduleAge{$f} = (stat $f)[9];
+
+       &showProc(" (DBI::" . $param{'DBType'} . ")");
     } else {
-       &status("DB support DISABLED.");
+       &WARN("DB support DISABLED.");
        return;
     }
 }
@@ -154,9 +142,9 @@ sub loadIRCModules {
        &showProc(" (Net::IRC)");
     } else {
        &status("IRC support DISABLED.");
-       # disabling forking.
-       $param{forking} = 0;
-       $param{noSHM}   = 1;
+       # disabling forking. Why?
+       #$param{forking}        = 0;
+       #$param{noSHM}  = 1;
     }
 
     foreach ( &getPerlFiles("$bot_src_dir/$interface") ) {
@@ -170,7 +158,7 @@ sub loadIRCModules {
            &ERROR("require \"$mod\" => $@");
            &shutdown();
            exit 1;
-        }
+       }
 
        $moduleAge{$mod} = (stat $mod)[9];
        &showProc(" ($_)") if (&IsParam("DEBUG"));
@@ -210,40 +198,44 @@ sub loadMyModulesNow {
 
 ### rename to moduleReloadAll?
 sub reloadAllModules {
+    my $retval = "";
+
     &VERB("Module: reloading all.",2);
 
     # obscure usage of map and regex :)
     foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
-        &reloadModule($_);
+       $retval .= &reloadModule($_);
     }
 
     &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;
+       return $retval;
     }
 
     my $age = (stat $file)[9];
@@ -251,13 +243,13 @@ sub reloadModule {
     if (!exists $moduleAge{$file}) {
        &DEBUG("Looks like $file was not loaded; fixing.");
     } else {
-       return if ($age == $moduleAge{$file});
+       return $retval 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;
+           return $retval;
        }
 
        my $dc  = &Time2String($age   - $moduleAge{$file});
@@ -272,13 +264,15 @@ sub reloadModule {
     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;
 }
 
 ###
@@ -300,7 +294,7 @@ sub loadPerlModule {
        return 0;
     } else {
        $perlModulesLoaded{$_[0]} = 1;
-       &status("Module: Loaded $_[0] ...");
+       &status("Loaded $_[0]");
        &showProc(" ($_[0])");
        return 1;
     }
@@ -310,7 +304,7 @@ sub loadMyModule {
     my ($tmp) = @_;
     if (!defined $tmp) {
        &WARN("loadMyModule: module is NULL.");
-       return 0; 
+       return 0;
     }
 
     my ($modulename, $modulebase);
@@ -356,7 +350,7 @@ sub loadMyModule {
     } else {
        $moduleAge{$modulefile} = (stat $modulefile)[9];
 
-       &status("myModule: Loaded $modulebase ...");
+       &status("Loaded $modulebase");
        &showProc(" ($modulebase)");
        return 1;
     }
@@ -394,8 +388,8 @@ sub getPerlFiles {
     my($dir) = @_;
 
     if (!opendir(DIR, $dir)) {
-        &ERROR("Cannot open source directory ($dir): $!");
-        exit 1;
+       &ERROR("Cannot open source directory ($dir): $!");
+       exit 1;
     }
 
     my @mods;