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
  10 ###
  11 ### REQUIRED MODULES.
  12 ###
  13
  14 eval "use IO::Socket";
  15 if ($@) {
  16     &ERROR("no IO::Socket?");
  17     exit 1;
  18 }
  19 &showProc(" (IO::Socket)");
  20
  21 ### MODULES.
  22 %myModules = (
  23         "countdown"     => "Countdown.pl",
  24         "allowDNS"      => "DNS.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 );
  48 @myModulesLoadNow       = ('topic', 'uptime',);
  49 @myModulesReloadNot     = ('IRC/Irc.pl','IRC/Schedulers.pl');
  50
  51 sub loadCoreModules {
  52     if (!opendir(DIR, $bot_src_dir)) {
  53         &ERROR("can't open source directory $bot_src_dir: $!");
  54         exit 1;
  55     }
  56
  57     &status("Loading CORE modules...");
  58
  59     while (defined(my $file = readdir DIR)) {
  60         next unless $file =~ /\.pl$/;
  61         next unless $file =~ /^[A-Z]/;
  62         my $mod = "$bot_src_dir/$file";
  63         ### TODO: use eval and exit gracefully?
  64         require $mod;
  65         $moduleAge{$mod} = (stat $mod)[9];
  66         &showProc(" ($file)") if (&IsParam("DEBUG"));
  67     }
  68     closedir DIR;
  69 }
  70
  71 sub loadDBModules {
  72     &status("Loading DB modules...");
  73
  74     if ($param{'DBType'} =~ /^mysql$/i) {
  75         eval "use DBI";
  76         if ($@) {
  77             &ERROR("libdbd-mysql-perl is not installed!");
  78             exit 1;
  79         }
  80         &showProc(" (DBI // mysql)");
  81
  82         &status("  using MySQL support.");
  83         require "$bot_src_dir/db_mysql.pl";
  84
  85     } elsif ($param{'DBType'} =~ /^pgsql$/i) {
  86         eval "use Pg";
  87         if ($@) {
  88             &ERROR("libpgperl is not installed!");
  89             exit 1;
  90         }
  91         &showProc(" (Pg // postgreSQLl)");
  92
  93         &status("  using PostgreSQL support.");
  94         require "$bot_src_dir/db_pgsql.pl";
  95     } elsif ($param{'DBType'} =~ /^dbm$/i) {
  96
  97         &status("  using Berkeley DBM 1.85/2.0 support.");
  98         require "$bot_src_dir/db_dbm.pl";
  99     } else {
 100
 101         &status("DB support DISABLED.");
 102         return;
 103     }
 104 }
 105
 106 sub loadFactoidsModules {
 107     &status("Loading Factoids modules...");
 108
 109     if (!&IsParam("factoids")) {
 110         &status("Factoid support DISABLED.");
 111         return;
 112     }
 113
 114     if (!opendir(DIR, "$bot_src_dir/Factoids")) {
 115         &ERROR("can't open source directory Factoids: $!");
 116         exit 1;
 117     }
 118
 119     while (defined(my $file = readdir DIR)) {
 120         next unless $file =~ /\.pl$/;
 121         next unless $file =~ /^[A-Z]/;
 122         my $mod = "$bot_src_dir/Factoids/$file";
 123         ### TODO: use eval and exit gracefully?
 124         require $mod;
 125         $moduleAge{$mod} = (stat $mod)[9];
 126         &showProc(" ($file)") if (&IsParam("DEBUG"));
 127     }
 128     closedir DIR;
 129 }
 130
 131 sub loadIRCModules {
 132     &status("Loading IRC modules...");
 133     if (&whatInterface() =~ /IRC/) {
 134         eval "use Net::IRC";
 135         if ($@) {
 136             &ERROR("libnet-irc-perl is not installed!");
 137             exit 1;
 138         }
 139         &showProc(" (Net::IRC)");
 140     } else {
 141         &status("IRC support DISABLED.");
 142         return;
 143     }
 144
 145     if (!opendir(DIR, "$bot_src_dir/IRC")) {
 146         &ERROR("can't open source directory Factoids: $!");
 147         exit 1;
 148     }
 149
 150     while (defined(my $file = readdir DIR)) {
 151         next unless $file =~ /\.pl$/;
 152         next unless $file =~ /^[A-Z]/;
 153         my $mod = "$bot_src_dir/IRC/$file";
 154         ### TODO: use eval and exit gracefully?
 155         require $mod;
 156         $moduleAge{$mod} = (stat $mod)[9];
 157         &showProc(" ($file)") if (&IsParam("DEBUG"));
 158     }
 159     closedir DIR;
 160 }
 161
 162 sub loadMyModulesNow {
 163     my $loaded = 0;
 164     my $total  = 0;
 165
 166     &status("Loading MyModules...");
 167     foreach (@myModulesLoadNow) {
 168         $total++;
 169
 170         if (!exists $param{$_}) {
 171             &DEBUG("myModule: $myModules{$_} not loaded.");
 172             next;
 173         }
 174         &loadMyModule($myModules{$_});
 175         $loaded++;
 176     }
 177
 178     &status("Module: Loaded/Total [$loaded/$total]");
 179 }
 180
 181 ### rename to moduleReloadAll?
 182 sub reloadAllModules {
 183 ###    &status("Module: reloading all.");
 184     foreach (map { substr($_,2) } keys %moduleAge) {
 185         &reloadModule($_);
 186     }
 187 ###    &status("Module: reloading done.");
 188 }
 189
 190 ### rename to modulesReload?
 191 sub reloadModule {
 192     my ($mod)   = @_;
 193     my $file    = (grep /\/$mod/, keys %INC)[0];
 194
 195     if (!defined $file) {
 196         &WARN("rM: Cannot reload $mod since it was not loaded anyway.");
 197         return;
 198     }
 199
 200     if (! -f $file) {
 201         &ERROR("rM: file '$file' does not exist?");
 202         return;
 203     }
 204
 205     my $age = (stat $file)[9];
 206     return if ($age == $moduleAge{$file});
 207
 208     if ($age < $moduleAge{$file}) {
 209         &WARN("rM: we're not gonna downgrade the file. use 'touch'.");
 210         return;
 211     }
 212
 213     if (grep /$mod/, @myModulesReloadNot) {
 214         &DEBUG("rM: SHOULD NOT RELOAD $mod!!!");
 215         return;
 216     }
 217
 218     my $dc  = &Time2String($age   - $moduleAge{$file});
 219     my $ago = &Time2String(time() - $moduleAge{$file});
 220
 221     &status("Module: Loading $mod...");
 222     &VERB("Module:  delta change: $dc",2);
 223     &VERB("Module:           ago: $ago",2);
 224
 225     delete $INC{$file};
 226     eval "require \"$file\"";   # require or use?
 227     if (@$) {
 228         &DEBUG("rM: failure: @$");
 229     } else {
 230         my $basename = $file;
 231         $basename =~ s/^.*\///;
 232         &status("Module: reloaded $basename");
 233         $moduleAge{$file} = $age;
 234     }
 235 }
 236
 237 ###
 238 ### OPTIONAL MODULES.
 239 ###
 240
 241 local %perlModulesLoaded  = ();
 242 local %perlModulesMissing = ();
 243
 244 sub loadPerlModule {
 245     return 0 if (exists $perlModulesMissing{$_[0]});
 246     &reloadModule($_[0]);
 247     return 1 if (exists $perlModulesLoaded{$_[0]});
 248
 249     eval "use $_[0]";
 250     if ($@) {
 251         &WARN("Module: $_[0] is not installed!");
 252         $perlModulesMissing{$_[0]} = 1;
 253         return 0;
 254     } else {
 255         $perlModulesLoaded{$_[0]} = 1;
 256         &status("Module: Loaded $_[0] ...");
 257         &showProc(" ($_[0])");
 258         return 1;
 259     }
 260 }
 261
 262 sub loadMyModule {
 263     my ($tmp) = @_;
 264     if (!defined $tmp) {
 265         &WARN("loadMyModule: module is NULL.");
 266         return 0;
 267     }
 268
 269     my ($modulebase, $modulefile);
 270     if (exists $myModules{$tmp}) {
 271         ($modulename, $modulebase) = ($tmp, $myModules{$tmp});
 272     } else {
 273         $modulebase = $tmp;
 274         if ($tmp = grep /^$modulebase$/, keys %myModules) {
 275             &DEBUG("lMM: lame hack, file => name => $tmp.");
 276             $modulename = $tmp;
 277         }
 278     }
 279     my $modulefile = "$bot_src_dir/Modules/$modulebase";
 280
 281     # call reloadModule() which checks age of file and reload.
 282     if (grep /\/$modulebase$/, keys %INC) {
 283         &reloadModule($modulebase);
 284         return;
 285     }
 286
 287     if (! -f $modulefile) {
 288         &ERROR("lMM: module ($modulebase) does not exist.");
 289         if ($$ == $bot_pid) {   # parent.
 290             &shutdown() if (defined $shm and defined $dbh);
 291         } else {                        # child.
 292             &delForked($modulename);
 293         }
 294
 295         exit 1;
 296     }
 297
 298     eval "require \"$modulefile\"";
 299     if ($@) {
 300         &ERROR("cannot load my module: $modulebase");
 301         if ($bot_pid == $$) {   # parent.
 302             &shutdown() if (defined $shm and defined $dbh);
 303         } else {                        # child.
 304             &delForked($modulename);
 305         }
 306
 307         exit 1;
 308     } else {
 309         $moduleAge{$modulefile} = (stat $modulefile)[9];
 310
 311         &status("myModule: Loaded $modulebase ...");
 312         &showProc(" ($modulebase)");
 313         return 1;
 314     }
 315 }
 316
 317 ### this chews 3megs on potato, 300 kB on slink.
 318 $no_syscall = 0;
 319 ###eval "require 'sys/syscall.ph'";
 320 #if ($@) {
 321 #    &WARN("sys/syscall.ph has not been installed//generated. gettimeofday
 322 #will use time() instead");
 323     $no_syscall = 1;
 324 #}
 325 #&showProc(" (syscall)");
 326
 327 1;