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