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