blootbot/src/modules.pl

   1 #
   2 #  modules.pl: pseudo-Module handler
   3 #      Author: dms
   4 #     Version: v0.2 (20000629)
   5 #     Created: 20000624
   6 #
   7
   8 if (&IsParam("useStrict")) { 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         "countdown"     => "Countdown.pl",
  25         "debian"        => "Debian.pl",
  26         "debianExtra"   => "DebianExtra.pl",
  27         "dict"          => "Dict.pl",
  28         "dumpvars"      => "DumpVars.pl",
  29         "factoids"      => "Factoids.pl",
  30         "freshmeat"     => "Freshmeat.pl",
  31         "kernel"        => "Kernel.pl",
  32         "ircdcc"        => "UserDCC.pl",
  33         "perlMath"      => "Math.pl",
  34         "quote"         => "Quote.pl",
  35         "rootwarn"      => "RootWarn.pl",
  36         "search"        => "Search.pl",
  37         "slashdot"      => "Slashdot3.pl",
  38         "topic"         => "Topic.pl",
  39         "units"         => "Units.pl",
  40         "uptime"        => "Uptime.pl",
  41         "userinfo"      => "UserInfo.pl",
  42         "wwwsearch"     => "W3Search.pl",
  43         "whatis"        => "WhatIs.pl",
  44         "wingate"       => "Wingate.pl",
  45         "insult"        => "insult.pl",
  46         "nickometer"    => "nickometer.pl",
  47         "babelfish"     => "babel.pl",
  48 );
  49 BEGIN {
  50     @myModulesLoadNow   = ('topic', 'uptime',);
  51     @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl');
  52 }
  53
  54 sub loadCoreModules {
  55     if (!opendir(DIR, $bot_src_dir)) {
  56         &ERROR("can't open source directory $bot_src_dir: $!");
  57         exit 1;
  58     }
  59
  60     &status("Loading CORE modules...");
  61
  62     while (defined(my $file = readdir DIR)) {
  63         next unless $file =~ /\.pl$/;
  64         next unless $file =~ /^[A-Z]/;
  65         my $mod = "$bot_src_dir/$file";
  66
  67         ### TODO: use eval and exit gracefully?
  68         eval "require \"$mod\"";
  69         if ($@) {
  70             &ERROR("lCM => $@");
  71             &shutdown();
  72             exit 1;
  73         }
  74
  75         $moduleAge{$mod} = (stat $mod)[9];
  76         &showProc(" ($file)") if (&IsParam("DEBUG"));
  77     }
  78     closedir DIR;
  79 }
  80
  81 sub loadDBModules {
  82     &status("Loading DB modules...");
  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         &showProc(" (DBI // mysql)");
  91
  92         &status("  using MySQL support.");
  93         require "$bot_src_dir/db_mysql.pl";
  94
  95     } elsif ($param{'DBType'} =~ /^pgsql$/i) {
  96         eval "use Pg";
  97         if ($@) {
  98             &ERROR("libpgperl is not installed!");
  99             exit 1;
 100         }
 101         &showProc(" (Pg // postgreSQLl)");
 102
 103         &status("  using PostgreSQL support.");
 104         require "$bot_src_dir/db_pgsql.pl";
 105     } elsif ($param{'DBType'} =~ /^dbm$/i) {
 106
 107         &status("  using Berkeley DBM 1.85/2.0 support.");
 108         require "$bot_src_dir/db_dbm.pl";
 109     } else {
 110
 111         &status("DB support DISABLED.");
 112         return;
 113     }
 114 }
 115
 116 sub loadFactoidsModules {
 117     &status("Loading Factoids modules...");
 118
 119     if (!&IsParam("factoids")) {
 120         &status("Factoid support DISABLED.");
 121         return;
 122     }
 123
 124     if (!opendir(DIR, "$bot_src_dir/Factoids")) {
 125         &ERROR("can't open source directory Factoids: $!");
 126         exit 1;
 127     }
 128
 129     while (defined(my $file = readdir DIR)) {
 130         next unless $file =~ /\.pl$/;
 131         next unless $file =~ /^[A-Z]/;
 132         my $mod = "$bot_src_dir/Factoids/$file";
 133         ### TODO: use eval and exit gracefully?
 134         eval "require \"$mod\"";
 135         if ($@) {
 136             &WARN("lFM: $@");
 137             exit 1;
 138         }
 139
 140         $moduleAge{$mod} = (stat $mod)[9];
 141         &showProc(" ($file)") if (&IsParam("DEBUG"));
 142     }
 143     closedir DIR;
 144 }
 145
 146 sub loadIRCModules {
 147     &status("Loading IRC modules...");
 148     if (&whatInterface() =~ /IRC/) {
 149         eval "use Net::IRC";
 150         if ($@) {
 151             &ERROR("libnet-irc-perl is not installed!");
 152             exit 1;
 153         }
 154         &showProc(" (Net::IRC)");
 155
 156     } else {
 157         &status("IRC support DISABLED.");
 158         return;
 159     }
 160
 161     if (!opendir(DIR, "$bot_src_dir/IRC")) {
 162         &ERROR("can't open source directory Factoids: $!");
 163         exit 1;
 164     }
 165
 166     while (defined(my $file = readdir DIR)) {
 167         next unless $file =~ /\.pl$/;
 168         next unless $file =~ /^[A-Z]/;
 169         my $mod = "$bot_src_dir/IRC/$file";
 170         ### TODO: use eval and exit gracefully?
 171         require $mod;
 172         $moduleAge{$mod} = (stat $mod)[9];
 173         &showProc(" ($file)") if (&IsParam("DEBUG"));
 174     }
 175     closedir DIR;
 176 }
 177
 178 sub loadMyModulesNow {
 179     my $loaded = 0;
 180     my $total  = 0;
 181
 182     &status("Loading MyModules...");
 183     foreach (@myModulesLoadNow) {
 184         $total++;
 185         if (!defined $_) {
 186             &WARN("mMLN: null element.");
 187             next;
 188         }
 189
 190         if (!&IsParam($_) and !&IsChanConf($_)) {
 191             if (exists $myModules{$_}) {
 192                 &status("myModule: $myModules{$_} (1) not loaded.");
 193             } else {
 194                 &DEBUG("myModule: $_ (2) not loaded.");
 195             }
 196
 197             next;
 198         }
 199
 200         &loadMyModule($myModules{$_});
 201         $loaded++;
 202     }
 203
 204     &status("Module: Loaded/Total [$loaded/$total]");
 205 }
 206
 207 ### rename to moduleReloadAll?
 208 sub reloadAllModules {
 209 ###    &status("Module: reloading all.");
 210     foreach (map { substr($_,2) } keys %moduleAge) {
 211         &reloadModule($_);
 212     }
 213 ###    &status("Module: reloading done.");
 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     my $age = (stat $file)[9];
 238     return if ($age == $moduleAge{$file});
 239
 240     if ($age < $moduleAge{$file}) {
 241         &WARN("rM: we're not gonna downgrade the file. use 'touch'.");
 242         return;
 243     }
 244
 245     if (grep /$mod/, @myModulesReloadNot) {
 246         &DEBUG("rM: SHOULD NOT RELOAD $mod!!!");
 247         return;
 248     }
 249
 250     my $dc  = &Time2String($age   - $moduleAge{$file});
 251     my $ago = &Time2String(time() - $moduleAge{$file});
 252
 253     &status("Module: Loading $mod...");
 254     &VERB("Module:  delta change: $dc",2);
 255     &VERB("Module:           ago: $ago",2);
 256
 257     delete $INC{$file};
 258     eval "require \"$file\"";   # require or use?
 259     if (@$) {
 260         &DEBUG("rM: failure: @$");
 261     } else {
 262         my $basename = $file;
 263         $basename =~ s/^.*\///;
 264         &status("Module: reloaded $basename");
 265         $moduleAge{$file} = $age;
 266     }
 267 }
 268
 269 ###
 270 ### OPTIONAL MODULES.
 271 ###
 272
 273 local %perlModulesLoaded  = ();
 274 local %perlModulesMissing = ();
 275
 276 sub loadPerlModule {
 277     return 0 if (exists $perlModulesMissing{$_[0]});
 278     &reloadModule($_[0]);
 279     return 1 if (exists $perlModulesLoaded{$_[0]});
 280
 281     eval "use $_[0]";
 282     if ($@) {
 283         &WARN("Module: $_[0] is not installed!");
 284         $perlModulesMissing{$_[0]} = 1;
 285         return 0;
 286     } else {
 287         $perlModulesLoaded{$_[0]} = 1;
 288         &status("Module: Loaded $_[0] ...");
 289         &showProc(" ($_[0])");
 290         return 1;
 291     }
 292 }
 293
 294 sub loadMyModule {
 295     my ($tmp) = @_;
 296     if (!defined $tmp) {
 297         &WARN("loadMyModule: module is NULL.");
 298         return 0;
 299     }
 300
 301     my ($modulebase, $modulefile);
 302     if (exists $myModules{$tmp}) {
 303         ($modulename, $modulebase) = ($tmp, $myModules{$tmp});
 304     } else {
 305         $modulebase = $tmp;
 306         if ($tmp = grep /^$modulebase$/, keys %myModules) {
 307             &DEBUG("lMM: lame hack, file => name => $tmp.");
 308             $modulename = $tmp;
 309         }
 310     }
 311     my $modulefile = "$bot_src_dir/Modules/$modulebase";
 312
 313     # call reloadModule() which checks age of file and reload.
 314     if (grep /\/$modulebase$/, keys %INC) {
 315         &reloadModule($modulebase);
 316         return 1;       # depend on reloadModule?
 317     }
 318
 319     if (! -f $modulefile) {
 320         &ERROR("lMM: module ($modulebase) does not exist.");
 321         if ($$ == $bot_pid) {   # parent.
 322             &shutdown() if (defined $shm and defined $dbh);
 323         } else {                        # child.
 324             &DEBUG("b4 delfork 1");
 325             &delForked($modulebase);
 326         }
 327
 328         exit 1;
 329     }
 330
 331     eval "require \"$modulefile\"";
 332     if ($@) {
 333         &ERROR("cannot load my module: $modulebase");
 334         if ($bot_pid != $$) {   # child.
 335             &DEBUG("b4 delfork 2");
 336             &delForked($modulebase);
 337             exit 1;
 338         }
 339
 340         return 0;
 341     } else {
 342         $moduleAge{$modulefile} = (stat $modulefile)[9];
 343
 344         &status("myModule: Loaded $modulebase ...");
 345         &showProc(" ($modulebase)");
 346         return 1;
 347     }
 348 }
 349
 350 $no_timehires = 0;
 351 eval "use Time::HiRes qw(gettimeofday tv_interval)";
 352 if ($@) {
 353     &WARN("No Time::HiRes?");
 354     $no_timehires = 1;
 355 }
 356 &showProc(" (Time::HiRes)");
 357
 358 sub AUTOLOAD {
 359     return if ($AUTOLOAD =~ /__/);      # internal.
 360
 361     &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD");
 362     foreach (@_) {
 363         next unless (defined $_);
 364         &status("  => $_");
 365     }
 366 }
 367
 368 1;