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