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