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