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