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