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