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 @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
  65         ### TODO: use eval and exit gracefully?
  66         eval "require \"$mod\"";
  67         if ($@) {
  68             &ERROR("lCM => $@");
  69             &shutdown();
  70             exit 1;
  71         }
  72
  73         $moduleAge{$mod} = (stat $mod)[9];
  74         &showProc(" ($file)") if (&IsParam("DEBUG"));
  75     }
  76     closedir DIR;
  77 }
  78
  79 sub loadDBModules {
  80     &status("Loading DB modules...");
  81
  82     if ($param{'DBType'} =~ /^mysql$/i) {
  83         eval "use DBI";
  84         if ($@) {
  85             &ERROR("libdbd-mysql-perl is not installed!");
  86             exit 1;
  87         }
  88         &showProc(" (DBI // mysql)");
  89
  90         &status("  using MySQL support.");
  91         require "$bot_src_dir/db_mysql.pl";
  92
  93     } elsif ($param{'DBType'} =~ /^pgsql$/i) {
  94         eval "use Pg";
  95         if ($@) {
  96             &ERROR("libpgperl is not installed!");
  97             exit 1;
  98         }
  99         &showProc(" (Pg // postgreSQLl)");
 100
 101         &status("  using PostgreSQL support.");
 102         require "$bot_src_dir/db_pgsql.pl";
 103     } elsif ($param{'DBType'} =~ /^dbm$/i) {
 104
 105         &status("  using Berkeley DBM 1.85/2.0 support.");
 106         require "$bot_src_dir/db_dbm.pl";
 107     } else {
 108
 109         &status("DB support DISABLED.");
 110         return;
 111     }
 112 }
 113
 114 sub loadFactoidsModules {
 115     &status("Loading Factoids modules...");
 116
 117     if (!&IsParam("factoids")) {
 118         &status("Factoid support DISABLED.");
 119         return;
 120     }
 121
 122     if (!opendir(DIR, "$bot_src_dir/Factoids")) {
 123         &ERROR("can't open source directory Factoids: $!");
 124         exit 1;
 125     }
 126
 127     while (defined(my $file = readdir DIR)) {
 128         next unless $file =~ /\.pl$/;
 129         next unless $file =~ /^[A-Z]/;
 130         my $mod = "$bot_src_dir/Factoids/$file";
 131         ### TODO: use eval and exit gracefully?
 132         eval "require \"$mod\"";
 133         if ($@) {
 134             &WARN("lFM: $@");
 135             exit 1;
 136         }
 137
 138         $moduleAge{$mod} = (stat $mod)[9];
 139         &showProc(" ($file)") if (&IsParam("DEBUG"));
 140     }
 141     closedir DIR;
 142 }
 143
 144 sub loadIRCModules {
 145     &status("Loading IRC modules...");
 146     if (&whatInterface() =~ /IRC/) {
 147         eval "use Net::IRC";
 148         if ($@) {
 149             &ERROR("libnet-irc-perl is not installed!");
 150             exit 1;
 151         }
 152         &showProc(" (Net::IRC)");
 153
 154     } else {
 155         &status("IRC support DISABLED.");
 156         return;
 157     }
 158
 159     if (!opendir(DIR, "$bot_src_dir/IRC")) {
 160         &ERROR("can't open source directory Factoids: $!");
 161         exit 1;
 162     }
 163
 164     while (defined(my $file = readdir DIR)) {
 165         next unless $file =~ /\.pl$/;
 166         next unless $file =~ /^[A-Z]/;
 167         my $mod = "$bot_src_dir/IRC/$file";
 168         ### TODO: use eval and exit gracefully?
 169         require $mod;
 170         $moduleAge{$mod} = (stat $mod)[9];
 171         &showProc(" ($file)") if (&IsParam("DEBUG"));
 172     }
 173     closedir DIR;
 174 }
 175
 176 sub loadMyModulesNow {
 177     my $loaded = 0;
 178     my $total  = 0;
 179
 180     &status("Loading MyModules...");
 181     foreach (@myModulesLoadNow) {
 182         $total++;
 183         if (!defined $_) {
 184             &WARN("mMLN: null element.");
 185             next;
 186         }
 187
 188         if (!&IsParam($_) and !&IsChanConf($_)) {
 189             if (exists $myModules{$_}) {
 190                 &DEBUG("myModule: $myModules{$_} (1) not loaded.");
 191             } else {
 192                 &DEBUG("myModule: $_ (2) not loaded.");
 193             }
 194
 195             next;
 196         }
 197
 198         &loadMyModule($myModules{$_});
 199         $loaded++;
 200     }
 201
 202     &status("Module: Loaded/Total [$loaded/$total]");
 203 }
 204
 205 ### rename to moduleReloadAll?
 206 sub reloadAllModules {
 207 ###    &status("Module: reloading all.");
 208     foreach (map { substr($_,2) } keys %moduleAge) {
 209         &reloadModule($_);
 210     }
 211 ###    &status("Module: reloading done.");
 212 }
 213
 214 ### rename to modulesReload?
 215 sub reloadModule {
 216     my ($mod)   = @_;
 217     my $file    = (grep /\/$mod/, keys %INC)[0];
 218
 219     # don't reload if it's not our module.
 220     if ($mod =~ /::/ or $mod !~ /pl$/) {
 221         &VERB("Not reloading $mod.",3);
 222         return;
 223     }
 224
 225     if (!defined $file) {
 226         &WARN("rM: Cannot reload $mod since it was not loaded anyway.");
 227         return;
 228     }
 229
 230     if (! -f $file) {
 231         &ERROR("rM: file '$file' does not exist?");
 232         return;
 233     }
 234
 235     my $age = (stat $file)[9];
 236     return if ($age == $moduleAge{$file});
 237
 238     if ($age < $moduleAge{$file}) {
 239         &WARN("rM: we're not gonna downgrade the file. use 'touch'.");
 240         return;
 241     }
 242
 243     if (grep /$mod/, @myModulesReloadNot) {
 244         &DEBUG("rM: SHOULD NOT RELOAD $mod!!!");
 245         return;
 246     }
 247
 248     my $dc  = &Time2String($age   - $moduleAge{$file});
 249     my $ago = &Time2String(time() - $moduleAge{$file});
 250
 251     &status("Module: Loading $mod...");
 252     &VERB("Module:  delta change: $dc",2);
 253     &VERB("Module:           ago: $ago",2);
 254
 255     delete $INC{$file};
 256     eval "require \"$file\"";   # require or use?
 257     if (@$) {
 258         &DEBUG("rM: failure: @$");
 259     } else {
 260         my $basename = $file;
 261         $basename =~ s/^.*\///;
 262         &status("Module: reloaded $basename");
 263         $moduleAge{$file} = $age;
 264     }
 265 }
 266
 267 ###
 268 ### OPTIONAL MODULES.
 269 ###
 270
 271 local %perlModulesLoaded  = ();
 272 local %perlModulesMissing = ();
 273
 274 sub loadPerlModule {
 275     return 0 if (exists $perlModulesMissing{$_[0]});
 276     &reloadModule($_[0]);
 277     return 1 if (exists $perlModulesLoaded{$_[0]});
 278
 279     eval "use $_[0]";
 280     if ($@) {
 281         &WARN("Module: $_[0] is not installed!");
 282         $perlModulesMissing{$_[0]} = 1;
 283         return 0;
 284     } else {
 285         $perlModulesLoaded{$_[0]} = 1;
 286         &status("Module: Loaded $_[0] ...");
 287         &showProc(" ($_[0])");
 288         return 1;
 289     }
 290 }
 291
 292 sub loadMyModule {
 293     my ($tmp) = @_;
 294     if (!defined $tmp) {
 295         &WARN("loadMyModule: module is NULL.");
 296         return 0;
 297     }
 298
 299     my ($modulebase, $modulefile);
 300     if (exists $myModules{$tmp}) {
 301         ($modulename, $modulebase) = ($tmp, $myModules{$tmp});
 302     } else {
 303         $modulebase = $tmp;
 304         if ($tmp = grep /^$modulebase$/, keys %myModules) {
 305             &DEBUG("lMM: lame hack, file => name => $tmp.");
 306             $modulename = $tmp;
 307         }
 308     }
 309     my $modulefile = "$bot_src_dir/Modules/$modulebase";
 310
 311     # call reloadModule() which checks age of file and reload.
 312     if (grep /\/$modulebase$/, keys %INC) {
 313         &reloadModule($modulebase);
 314         return 1;       # depend on reloadModule?
 315     }
 316
 317     if (! -f $modulefile) {
 318         &ERROR("lMM: module ($modulebase) does not exist.");
 319         if ($$ == $bot_pid) {   # parent.
 320             &shutdown() if (defined $shm and defined $dbh);
 321         } else {                        # child.
 322             &DEBUG("b4 delfork 1");
 323             &delForked($modulebase);
 324         }
 325
 326         exit 1;
 327     }
 328
 329     eval "require \"$modulefile\"";
 330     if ($@) {
 331         &ERROR("cannot load my module: $modulebase");
 332         if ($bot_pid != $$) {   # child.
 333             &DEBUG("b4 delfork 2");
 334             &delForked($modulebase);
 335             exit 1;
 336         }
 337
 338         return 0;
 339     } else {
 340         $moduleAge{$modulefile} = (stat $modulefile)[9];
 341
 342         &status("myModule: Loaded $modulebase ...");
 343         &showProc(" ($modulebase)");
 344         return 1;
 345     }
 346 }
 347
 348 $no_timehires = 0;
 349 eval "use Time::HiRes qw(gettimeofday tv_interval)";
 350 if ($@) {
 351     &WARN("No Time::HiRes?");
 352     $no_timehires = 1;
 353 }
 354 &showProc(" (Time::HiRes)");
 355
 356 sub AUTOLOAD {
 357     return if ($AUTOLOAD =~ /__/);      # internal.
 358
 359     &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD");
 360     foreach (@_) {
 361         next unless (defined $_);
 362         &status("  => $_");
 363     }
 364 }
 365
 366 1;