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