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