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