src/modules.pl

   1 #
   2 #  modules.pl: pseudo-Module handler
   3 #      Author: dms
   4 #     Version: v0.2 (20000629)
   5 #     Created: 20000624
   6 #
   7
   8 # use strict;   # TODO
   9
  10 use vars qw($AUTOLOAD);
  11
  12 ###
  13 ### REQUIRED MODULES.
  14 ###
  15
  16 eval "use IO::Socket";
  17 if ($@) {
  18     &ERROR("no IO::Socket?");
  19     exit 1;
  20 }
  21 &showProc(" (IO::Socket)");
  22
  23 ### MODULES.
  24 %myModules = (
  25         "babelfish"     => "babelfish.pl",
  26         "botmail"       => "botmail.pl",
  27         "BZFlag"        => "BZFlag.pl",
  28         "countdown"     => "countdown.pl",
  29         "Debian"        => "Debian.pl",
  30         "DebianExtra"   => "DebianExtra.pl",
  31         "Dict"          => "Dict.pl",
  32         "DumpVars"      => "DumpVars.pl",
  33         "Exchange"      => "Exchange.pl",
  34         "Factoids"      => "Factoids.pl",
  35         "HTTPDtype"     => "HTTPDtype.pl",
  36         "insult"        => "insult.pl",
  37         "UserDCC"       => "UserDCC.pl",
  38         "Kernel"        => "Kernel.pl",
  39         "News"          => "News.pl",
  40         "nickometer"    => "nickometer.pl",
  41         "pager"         => "pager.pl",
  42         "Math"          => "Math.pl",
  43         "Plug"          => "Plug.pl",
  44         "quote"         => "Quote.pl",
  45         "rootwarn"      => "RootWarn.pl",
  46         "rss"           => "Rss.pl",
  47         "search"        => "Search.pl",
  48         "slashdot"      => "Slashdot3.pl",
  49         "symdump"       => "DumpVars2.pl",
  50         "topic"         => "Topic.pl",
  51         "units"         => "Units.pl",
  52         "uptime"        => "Uptime.pl",
  53         "userinfo"      => "UserInfo.pl",
  54         "weather"       => "Weather.pl",
  55         "whatis"        => "WhatIs.pl",
  56         "wikipedia"     => "wikipedia.pl",
  57         "wingate"       => "Wingate.pl",
  58         "wwwsearch"     => "W3Search.pl",
  59         "zfi"           => "zfi.pl",
  60         "zippy"         => "Zippy.pl",
  61         "zsi"           => "zsi.pl",
  62 );
  63 ### THIS IS NOT LOADED ON RELOAD :(
  64 my @myModulesLoadNow;
  65 my @myModulesReloadNot;
  66 BEGIN {
  67     @myModulesLoadNow   = ('topic', 'uptime', 'News', 'rootWarn', 'symdump', 'botmail');
  68     @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl');
  69 }
  70
  71 sub loadCoreModules {
  72     my @mods = &getPerlFiles($bot_src_dir);
  73
  74     &status("Loading CORE modules...");
  75
  76     foreach (sort @mods) {
  77         my $mod = "$bot_src_dir/$_";
  78
  79         eval "require \"$mod\"";
  80         if ($@) {
  81             &ERROR("lCM => $@");
  82             &shutdown();
  83             exit 1;
  84         }
  85
  86         $moduleAge{$mod} = (stat $mod)[9];
  87         &showProc(" ($_)") if (&IsParam("DEBUG"));
  88     }
  89 }
  90
  91 sub loadDBModules {
  92     my $f;
  93     # TODO: use function to load module.
  94
  95     if ($param{'DBType'} =~ /^(mysql|SQLite|pgsql)$/i) {
  96         eval "use DBI";
  97         if ($@) {
  98             &ERROR("No support for DBI::" . $param{'DBType'} . ", exiting!");
  99             exit 1;
 100         }
 101         &status("Loading " . $param{'DBType'} . " support.");
 102         $f = "$bot_src_dir/dbi.pl";
 103         require $f;
 104         $moduleAge{$f} = (stat $f)[9];
 105
 106         &showProc(" (DBI::" . $param{'DBType'} . ")");
 107     } else {
 108         &WARN("DB support DISABLED.");
 109         return;
 110     }
 111 }
 112
 113 sub loadFactoidsModules {
 114     if (!&IsParam("factoids")) {
 115         &status("Factoid support DISABLED.");
 116         return;
 117     }
 118
 119     &status("Loading Factoids modules...");
 120
 121     foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) {
 122         my $mod = "$bot_src_dir/Factoids/$_";
 123
 124         eval "require \"$mod\"";
 125         if ($@) {
 126             &ERROR("lFM: $@");
 127             exit 1;
 128         }
 129
 130         $moduleAge{$mod} = (stat $mod)[9];
 131         &showProc(" ($_)") if (&IsParam("DEBUG"));
 132     }
 133 }
 134
 135 sub loadIRCModules {
 136     my ($interface) = &whatInterface();
 137     if ($interface =~ /IRC/) {
 138         &status("Loading IRC modules...");
 139
 140         eval "use Net::IRC";
 141         if ($@) {
 142             &ERROR("libnet-irc-perl is not installed!");
 143             exit 1;
 144         }
 145         &showProc(" (Net::IRC)");
 146     } else {
 147         &status("IRC support DISABLED.");
 148         # disabling forking. Why?
 149         #$param{forking}        = 0;
 150         #$param{noSHM}  = 1;
 151     }
 152
 153     foreach ( &getPerlFiles("$bot_src_dir/$interface") ) {
 154         my $mod = "$bot_src_dir/$interface/$_";
 155
 156         # hrm... use another config option besides DEBUG to display
 157         # change in memory usage.
 158         &status("Loading Modules \"$mod\"") if (!&IsParam("DEBUG"));
 159         eval "require \"$mod\"";
 160         if ($@) {
 161             &ERROR("require \"$mod\" => $@");
 162             &shutdown();
 163             exit 1;
 164         }
 165
 166         $moduleAge{$mod} = (stat $mod)[9];
 167         &showProc(" ($_)") if (&IsParam("DEBUG"));
 168     }
 169 }
 170
 171 sub loadMyModulesNow {
 172     my $loaded = 0;
 173     my $total  = 0;
 174
 175     &status("Loading MyModules...");
 176     foreach (@myModulesLoadNow) {
 177         $total++;
 178         if (!defined $_) {
 179             &WARN("mMLN: null element.");
 180             next;
 181         }
 182
 183         if (!&IsParam($_) and !&IsChanConf($_) and !&getChanConfList($_)) {
 184             if (exists $myModules{$_}) {
 185                 &status("myModule: $myModules{$_} or $_ (1) not loaded.");
 186             } else {
 187                 &DEBUG("myModule: $_ (2) not loaded.");
 188             }
 189
 190             next;
 191         }
 192
 193         # weird hack to get rootwarn to work.
 194         # it may break on other cases though, any ideas?
 195         &loadMyModule( $myModules{$_} || $myModules{lc $_} );
 196         $loaded++;
 197     }
 198
 199     &status("Module: Runtime: Loaded/Total [$loaded/$total]");
 200 }
 201
 202 ### rename to moduleReloadAll?
 203 sub reloadAllModules {
 204     my $retval = "";
 205
 206     &VERB("Module: reloading all.",2);
 207
 208     # obscure usage of map and regex :)
 209     foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
 210         $retval .= &reloadModule($_);
 211     }
 212
 213     &VERB("Module: reloading done.",2);
 214     return $retval;
 215 }
 216
 217 ### rename to modulesReload?
 218 sub reloadModule {
 219     my ($mod)   = @_;
 220     my $file    = (grep /\/$mod/, keys %INC)[0];
 221     my $retval = "";
 222
 223     # don't reload if it's not our module.
 224     if ($mod =~ /::/ or $mod !~ /pl$/) {
 225         &VERB("Not reloading $mod.",3);
 226         return $retval;
 227     }
 228
 229     if (!defined $file) {
 230         &WARN("rM: Cannot reload $mod since it was not loaded anyway.");
 231         return $retval;
 232     }
 233
 234     if (! -f $file) {
 235         &ERROR("rM: file '$file' does not exist?");
 236         return $retval;
 237     }
 238
 239     if (grep /$mod/, @myModulesReloadNot) {
 240         &DEBUG("rM: should not reload $mod");
 241         return $retval;
 242     }
 243
 244     my $age = (stat $file)[9];
 245
 246     if (!exists $moduleAge{$file}) {
 247         &DEBUG("Looks like $file was not loaded; fixing.");
 248     } else {
 249         return $retval if ($age == $moduleAge{$file});
 250
 251         if ($age < $moduleAge{$file}) {
 252             &WARN("rM: we're not gonna downgrade '$file'; use touch.");
 253             &DEBUG("age => $age");
 254             &DEBUG("mA{$file} => $moduleAge{$file}");
 255             return $retval;
 256         }
 257
 258         my $dc  = &Time2String($age   - $moduleAge{$file});
 259         my $ago = &Time2String(time() - $moduleAge{$file});
 260
 261         &VERB("Module:  delta change: $dc",2);
 262         &VERB("Module:           ago: $ago",2);
 263     }
 264
 265     &status("Module: Loading $mod...");
 266
 267     delete $INC{$file};
 268     eval "require \"$file\"";   # require or use?
 269     if (@$) {
 270         &DEBUG("rM: failure: @$ ");
 271     } else {
 272         my $basename = $file;
 273         $basename =~ s/^.*\///;
 274         &status("Module: reloaded $basename");
 275         $retval = " $basename";
 276         $moduleAge{$file} = $age;
 277     }
 278     return $retval;
 279 }
 280
 281 ###
 282 ### OPTIONAL MODULES.
 283 ###
 284
 285 my %perlModulesLoaded  = ();
 286 my %perlModulesMissing = ();
 287
 288 sub loadPerlModule {
 289     return 0 if (exists $perlModulesMissing{$_[0]});
 290     &reloadModule($_[0]);
 291     return 1 if (exists $perlModulesLoaded{$_[0]});
 292
 293     eval "use $_[0]";
 294     if ($@) {
 295         &WARN("Module: $_[0] is not installed!");
 296         $perlModulesMissing{$_[0]} = 1;
 297         return 0;
 298     } else {
 299         $perlModulesLoaded{$_[0]} = 1;
 300         &status("Loaded $_[0]");
 301         &showProc(" ($_[0])");
 302         return 1;
 303     }
 304 }
 305
 306 sub loadMyModule {
 307     my ($tmp) = @_;
 308     if (!defined $tmp) {
 309         &WARN("loadMyModule: module is NULL.");
 310         return 0;
 311     }
 312
 313     my ($modulename, $modulebase);
 314     if (exists $myModules{$tmp}) {
 315         ($modulename, $modulebase) = ($tmp, $myModules{$tmp});
 316     } else {
 317         $modulebase = $tmp;
 318         if ($tmp = grep /^$modulebase$/, keys %myModules) {
 319             &DEBUG("lMM: lame hack, file => name => $tmp.");
 320             $modulename = $tmp;
 321         }
 322     }
 323     my $modulefile = "$bot_src_dir/Modules/$modulebase";
 324
 325     # call reloadModule() which checks age of file and reload.
 326     if (grep /\/$modulebase$/, keys %INC) {
 327         &reloadModule($modulebase);
 328         return 1;       # depend on reloadModule?
 329     }
 330
 331     if (! -f $modulefile) {
 332         &ERROR("lMM: module ($modulebase) does not exist.");
 333         if ($$ == $bot_pid) {   # parent.
 334             &shutdown() if (defined $shm and defined $dbh);
 335         } else {                        # child.
 336             &DEBUG("b4 delfork 1");
 337             &delForked($modulename);
 338         }
 339
 340         exit 1;
 341     }
 342
 343     eval "require \"$modulefile\"";
 344     if ($@) {
 345         &ERROR("cannot load my module: $modulebase");
 346         if ($bot_pid != $$) {   # child.
 347             &DEBUG("b4 delfork 2");
 348             &delForked($modulename);
 349             exit 1;
 350         }
 351
 352         return 0;
 353     } else {
 354         $moduleAge{$modulefile} = (stat $modulefile)[9];
 355
 356         &status("Loaded $modulebase");
 357         &showProc(" ($modulebase)");
 358         return 1;
 359     }
 360 }
 361
 362 $no_timehires = 0;
 363 eval "use Time::HiRes qw(gettimeofday tv_interval)";
 364 if ($@) {
 365     &WARN("No Time::HiRes?");
 366     $no_timehires = 1;
 367 }
 368 &showProc(" (Time::HiRes)");
 369
 370 sub AUTOLOAD {
 371     if (!defined $AUTOLOAD and defined $::AUTOLOAD) {
 372         &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!");
 373     }
 374     return unless (defined $AUTOLOAD);
 375     return if ($AUTOLOAD =~ /__/);      # internal.
 376
 377     my $str = join(', ', @_);
 378     my ($package, $filename, $line) = caller;
 379     &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line");
 380
 381     $AUTOLOAD =~ s/^(\S+):://g;
 382
 383     if (exists $myModules{lc $AUTOLOAD}) {
 384         # hopefully this will work.
 385         &DEBUG("Trying to load module $AUTOLOAD...");
 386         &loadMyModule(lc $AUTOLOAD);
 387     }
 388 }
 389
 390 sub getPerlFiles {
 391     my($dir) = @_;
 392
 393     if (!opendir(DIR, $dir)) {
 394         &ERROR("Cannot open source directory ($dir): $!");
 395         exit 1;
 396     }
 397
 398     my @mods;
 399     while (defined(my $file = readdir DIR)) {
 400         next unless $file =~ /\.pl$/;
 401         next unless $file =~ /^[A-Z]/;
 402         push(@mods, $file);
 403     }
 404     closedir DIR;
 405
 406     return reverse sort @mods;
 407 }
 408
 409 1;