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