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