src/modules.pl

   1 #
   2 #  modules.pl: pseudo-Module handler
   3 #      Author: dms
   4 #     Version: v0.2 (20000629)
   5 #     Created: 20000624
   6 #
   7
   8 use strict;
   9
  10 use vars qw($AUTOLOAD $no_timehires);
  11
  12 ###
  13 ### REQUIRED MODULES.
  14 ###
  15
  16 eval "use IO::Socket";
  17 if ($@) {
  18     &ERROR("no IO::Socket?");
  19     exit 1;
  20 }
  21 &showProc(" (IO::Socket)");
  22
  23 ### THIS IS NOT LOADED ON RELOAD :(
  24 my @myModulesLoadNow;
  25 my @myModulesReloadNot;
  26 BEGIN {
  27     @myModulesLoadNow   = ('Topic', 'Uptime', 'News', 'RootWarn', 'DumpVars2', 'botmail', 'OnJoin');
  28     @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl');
  29 }
  30
  31 sub loadCoreModules {
  32     my @mods = &getPerlFiles($bot_src_dir);
  33
  34     &status("Loading CORE modules...");
  35
  36     foreach (sort @mods) {
  37         my $mod = "$bot_src_dir/$_";
  38
  39         eval "require \"$mod\"";
  40         if ($@) {
  41             &ERROR("lCM => $@");
  42             &shutdown();
  43             exit 1;
  44         }
  45
  46         $moduleAge{$mod} = (stat $mod)[9];
  47         &showProc(" ($_)") if (&IsParam('DEBUG'));
  48     }
  49 }
  50
  51 sub loadDBModules {
  52     my $f;
  53     # TODO: use function to load module.
  54
  55     if ($param{'DBType'} =~ /^(mysql|SQLite(2)?|pgsql)$/i) {
  56         eval "use DBI";
  57         if ($@) {
  58             &ERROR("No support for DBI::" . $param{'DBType'} . ", exiting!");
  59             exit 1;
  60         }
  61         &status("Loading " . $param{'DBType'} . " support.");
  62         $f = "$bot_src_dir/dbi.pl";
  63         require $f;
  64         $moduleAge{$f} = (stat $f)[9];
  65
  66         &showProc(" (DBI::" . $param{'DBType'} . ")");
  67     } else {
  68         &WARN("DB support DISABLED.");
  69         return;
  70     }
  71 }
  72
  73 sub loadFactoidsModules {
  74     if (!&IsParam('factoids')) {
  75         &status("Factoid support DISABLED.");
  76         return;
  77     }
  78
  79     &status("Loading Factoids modules...");
  80
  81     foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) {
  82         my $mod = "$bot_src_dir/Factoids/$_";
  83
  84         eval "require \"$mod\"";
  85         if ($@) {
  86             &ERROR("lFM: $@");
  87             exit 1;
  88         }
  89
  90         $moduleAge{$mod} = (stat $mod)[9];
  91         &showProc(" ($_)") if (&IsParam('DEBUG'));
  92     }
  93 }
  94
  95 sub loadIRCModules {
  96     my ($interface) = &whatInterface();
  97     if ($interface =~ /IRC/) {
  98         &status("Loading IRC modules...");
  99
 100         eval "use Net::IRC";
 101         if ($@) {
 102             &ERROR("libnet-irc-perl is not installed!");
 103             exit 1;
 104         }
 105         &showProc(" (Net::IRC)");
 106     } else {
 107         &status("IRC support DISABLED.");
 108         # disabling forking. Why?
 109         #$param{forking}        = 0;
 110         #$param{noSHM}  = 1;
 111     }
 112
 113     foreach ( &getPerlFiles("$bot_src_dir/$interface") ) {
 114         my $mod = "$bot_src_dir/$interface/$_";
 115
 116         # hrm... use another config option besides DEBUG to display
 117         # change in memory usage.
 118         &status("Loading Modules \"$mod\"") if (!&IsParam('DEBUG'));
 119         eval "require \"$mod\"";
 120         if ($@) {
 121             &ERROR("require \"$mod\" => $@");
 122             &shutdown();
 123             exit 1;
 124         }
 125
 126         $moduleAge{$mod} = (stat $mod)[9];
 127         &showProc(" ($_)") if (&IsParam('DEBUG'));
 128     }
 129 }
 130
 131 sub loadMyModulesNow {
 132     my $loaded = 0;
 133     my $total  = 0;
 134
 135     &status("Loading MyModules...");
 136     foreach (@myModulesLoadNow) {
 137         $total++;
 138         if (!defined $_) {
 139             &WARN("mMLN: null element.");
 140             next;
 141         }
 142
 143         if (!&IsParam($_) and &IsChanConf($_) <= 0 and !&getChanConfList($_)) {
 144             &DEBUG("loadMyModuleNow: $_ (2) not loaded.");
 145             next;
 146         }
 147
 148         &loadMyModule($_);
 149         $loaded++;
 150     }
 151
 152     &status("Module: Runtime: Loaded/Total [$loaded/$total]");
 153 }
 154
 155 ### rename to moduleReloadAll?
 156 sub reloadAllModules {
 157     my $retval = '';
 158
 159     &VERB("Module: reloading all.",2);
 160
 161     # obscure usage of map and regex :)
 162     foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
 163         $retval .= &reloadModule($_);
 164     }
 165
 166     &VERB("Module: reloading done.",2);
 167     return $retval;
 168 }
 169
 170 ### rename to modulesReload?
 171 sub reloadModule {
 172     my ($mod)   = @_;
 173     my $file    = (grep /\/$mod/, keys %INC)[0];
 174     my $retval = '';
 175
 176     # don't reload if it's not our module.
 177     if ($mod =~ /::/ or $mod !~ /pl$/) {
 178         &VERB("Not reloading $mod.",3);
 179         return $retval;
 180     }
 181
 182     if (!defined $file) {
 183         &WARN("rM: Cannot reload $mod since it was not loaded anyway.");
 184         return $retval;
 185     }
 186
 187     if (! -f $file) {
 188         &ERROR("rM: file '$file' does not exist?");
 189         return $retval;
 190     }
 191
 192     if (grep /$mod/, @myModulesReloadNot) {
 193         &DEBUG("rM: should not reload $mod");
 194         return $retval;
 195     }
 196
 197     my $age = (stat $file)[9];
 198
 199     if (!exists $moduleAge{$file}) {
 200         &DEBUG("Looks like $file was not loaded; fixing.");
 201     } else {
 202         return $retval if ($age == $moduleAge{$file});
 203
 204         if ($age < $moduleAge{$file}) {
 205             &WARN("rM: we're not gonna downgrade '$file'; use touch.");
 206             &DEBUG("age => $age, mA{$file} => $moduleAge{$file}");
 207             return $retval;
 208         }
 209
 210         my $dc  = &Time2String($age   - $moduleAge{$file});
 211         my $ago = &Time2String(time() - $moduleAge{$file});
 212
 213         &VERB("Module:  delta change: $dc",2);
 214         &VERB("Module:           ago: $ago",2);
 215     }
 216
 217     &status("Module: Loading $mod...");
 218
 219     delete $INC{$file};
 220     eval "require \"$file\"";   # require or use?
 221     if (@$) {
 222         &DEBUG("rM: failure: @$ ");
 223     } else {
 224         my $basename = $file;
 225         $basename =~ s/^.*\///;
 226         &status("Module: reloaded $basename");
 227         $retval = " $basename";
 228         $moduleAge{$file} = $age;
 229     }
 230     return $retval;
 231 }
 232
 233 ###
 234 ### OPTIONAL MODULES.
 235 ###
 236
 237 my %perlModulesLoaded  = ();
 238 my %perlModulesMissing = ();
 239
 240 sub loadPerlModule {
 241     return 0 if (exists $perlModulesMissing{$_[0]});
 242     &reloadModule($_[0]);
 243     return 1 if (exists $perlModulesLoaded{$_[0]});
 244
 245     eval "use $_[0]";
 246     if ($@) {
 247         &WARN("Module: $_[0] is not installed!");
 248         $perlModulesMissing{$_[0]} = 1;
 249         return 0;
 250     } else {
 251         $perlModulesLoaded{$_[0]} = 1;
 252         &status("Loaded $_[0]");
 253         &showProc(" ($_[0])");
 254         return 1;
 255     }
 256 }
 257
 258 sub loadMyModule {
 259     my ($modulename) = @_;
 260     if (!defined $modulename) {
 261         &WARN("loadMyModule: module is NULL.");
 262         return 0;
 263     }
 264
 265     my $modulefile = "$bot_src_dir/Modules/$modulename.pl";
 266
 267     # call reloadModule() which checks age of file and reload.
 268     if (grep /\/$modulename$/, keys %INC) {
 269         &reloadModule($modulename);
 270         return 1;       # depend on reloadModule?
 271     }
 272
 273     if (! -f $modulefile) {
 274         &ERROR("lMM: module ($modulename) does not exist.");
 275         if ($$ == $bot_pid) {   # parent.
 276             &shutdown() if (defined $shm and defined $dbh);
 277         } else {                        # child.
 278             &DEBUG("b4 delfork 1");
 279             &delForked($modulename);
 280         }
 281
 282         exit 1;
 283     }
 284
 285     eval "require \"$modulefile\"";
 286     if ($@) {
 287         &ERROR("cannot load my module: $modulename");
 288         if ($bot_pid != $$) {   # child.
 289             &DEBUG("b4 delfork 2");
 290             &delForked($modulename);
 291             exit 1;
 292         }
 293
 294         return 0;
 295     } else {
 296         $moduleAge{$modulefile} = (stat $modulefile)[9];
 297
 298         &status("Loaded $modulename");
 299         &showProc(" ($modulename)");
 300         return 1;
 301     }
 302 }
 303
 304 $no_timehires = 0;
 305 eval "use Time::HiRes qw(gettimeofday tv_interval)";
 306 if ($@) {
 307     &WARN("No Time::HiRes?");
 308     $no_timehires = 1;
 309 }
 310 &showProc(" (Time::HiRes)");
 311
 312 sub AUTOLOAD {
 313     if (!defined $AUTOLOAD and defined $::AUTOLOAD) {
 314         &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!");
 315     }
 316     return unless (defined $AUTOLOAD);
 317     return if ($AUTOLOAD =~ /__/);      # internal.
 318
 319     my $str = join(', ', @_);
 320     my ($package, $filename, $line) = caller;
 321     &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line");
 322
 323     $AUTOLOAD =~ s/^(\S+):://g;
 324
 325     # hopefully this will work.
 326     &DEBUG("Trying to load module $AUTOLOAD...");
 327     &loadMyModule($AUTOLOAD);
 328 }
 329
 330 sub getPerlFiles {
 331     my($dir) = @_;
 332
 333     if (!opendir(DIR, $dir)) {
 334         &ERROR("Cannot open source directory ($dir): $!");
 335         exit 1;
 336     }
 337
 338     my @mods;
 339     while (defined(my $file = readdir DIR)) {
 340         next unless $file =~ /\.pl$/;
 341         next unless $file =~ /^[A-Z]/;
 342         push(@mods, $file);
 343     }
 344     closedir DIR;
 345
 346     return reverse sort @mods;
 347 }
 348
 349 1;