);
### THIS IS NOT LOADED ON RELOAD :(
BEGIN {
- @myModulesLoadNow = ('topic', 'uptime', 'news');
+ @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);
- my @mods;
- while (defined(my $file = readdir DIR)) {
- next unless $file =~ /\.pl$/;
- next unless $file =~ /^[A-Z]/;
- push(@mods, $file);
- }
- closedir DIR;
&status("Loading ".scalar(@mods)." CORE modules...");
foreach (sort @mods) {
sub loadDBModules {
&status("Loading DB modules...");
+ $moduleAge{"$bot_src_dir/modules.pl"} = time();
+
if ($param{'DBType'} =~ /^mysql$/i) {
eval "use DBI";
if ($@) {
&status(" using MySQL support.");
require "$bot_src_dir/db_mysql.pl";
+ $moduleAge{"$bot_src_dir/db_mysql.pl"} = time();
} elsif ($param{'DBType'} =~ /^pgsql$/i) {
eval "use Pg";
} 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... you want it, you fix it!");
+ &shutdown();
+ exit 1;
+
+# require "$bot_src_dir/db_dbm.pl";
} else {
&status("DB support DISABLED.");
}
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/$_";
- 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?
eval "require \"$mod\"";
if ($@) {
- &WARN("lFM: $@");
+ &ERROR("lFM: $@");
exit 1;
}
$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!");
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 {
}
if (!&IsParam($_) and !&IsChanConf($_) and !&getChanConfList($_)) {
- &DEBUG("_ => $_");
if (exists $myModules{$_}) {
- &status("myModule: $myModules{$_} (1) not loaded.");
+ &status("myModule: $myModules{$_} or $_ (1) not loaded.");
} else {
&DEBUG("myModule: $_ (2) 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++;
}
### 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?
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 the file. use 'touch'.");
+ 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?
$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) {
sub AUTOLOAD {
return if ($AUTOLOAD =~ /__/); # internal.
- &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD");
- foreach (@_) {
- next unless (defined $_);
- &status(" => $_");
+ 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;
projects / infobot.git / blobdiff