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