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