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