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