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 $bot_version $bot_release);
  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     # Reload version and save
 162     open(VERSION,"<VERSION");
 163     $bot_release = <VERSION> || "(unknown version)";
 164     chomp($bot_release);
 165     $bot_version    = "infobot $bot_release -- $^O";
 166     close(VERSION);
 167
 168     # obscure usage of map and regex :)
 169     foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
 170         $retval .= &reloadModule($_);
 171     }
 172
 173     &VERB("Module: reloading done.",2);
 174     return $retval;
 175 }
 176
 177 ### rename to modulesReload?
 178 sub reloadModule {
 179     my ($mod)   = @_;
 180     my $file    = (grep /\/$mod/, keys %INC)[0];
 181     my $retval = '';
 182
 183     # don't reload if it's not our module.
 184     if ($mod =~ /::/ or $mod !~ /pl$/) {
 185         &VERB("Not reloading $mod.",3);
 186         return $retval;
 187     }
 188
 189     if (!defined $file) {
 190         &WARN("rM: Cannot reload $mod since it was not loaded anyway.");
 191         return $retval;
 192     }
 193
 194     if (! -f $file) {
 195         &ERROR("rM: file '$file' does not exist?");
 196         return $retval;
 197     }
 198
 199     if (grep /$mod/, @myModulesReloadNot) {
 200         &DEBUG("rM: should not reload $mod");
 201         return $retval;
 202     }
 203
 204     my $age = (stat $file)[9];
 205
 206     if (!exists $moduleAge{$file}) {
 207         &DEBUG("Looks like $file was not loaded; fixing.");
 208     } else {
 209         return $retval if ($age == $moduleAge{$file});
 210
 211         if ($age < $moduleAge{$file}) {
 212             &WARN("rM: we're not gonna downgrade '$file'; use touch.");
 213             &DEBUG("age => $age, mA{$file} => $moduleAge{$file}");
 214             return $retval;
 215         }
 216
 217         my $dc  = &Time2String($age   - $moduleAge{$file});
 218         my $ago = &Time2String(time() - $moduleAge{$file});
 219
 220         &VERB("Module:  delta change: $dc",2);
 221         &VERB("Module:           ago: $ago",2);
 222     }
 223
 224     &status("Module: Loading $mod...");
 225
 226     delete $INC{$file};
 227     eval "require \"$file\"";   # require or use?
 228     if (@$) {
 229         &DEBUG("rM: failure: @$ ");
 230     } else {
 231         my $basename = $file;
 232         $basename =~ s/^.*\///;
 233         &status("Module: reloaded $basename");
 234         $retval = " $basename";
 235         $moduleAge{$file} = $age;
 236     }
 237     return $retval;
 238 }
 239
 240 ###
 241 ### OPTIONAL MODULES.
 242 ###
 243
 244 my %perlModulesLoaded  = ();
 245 my %perlModulesMissing = ();
 246
 247 sub loadPerlModule {
 248     return 0 if (exists $perlModulesMissing{$_[0]});
 249     &reloadModule($_[0]);
 250     return 1 if (exists $perlModulesLoaded{$_[0]});
 251
 252     eval "use $_[0]";
 253     if ($@) {
 254         &WARN("Module: $_[0] is not installed!");
 255         $perlModulesMissing{$_[0]} = 1;
 256         return 0;
 257     } else {
 258         $perlModulesLoaded{$_[0]} = 1;
 259         &status("Loaded $_[0]");
 260         &showProc(" ($_[0])");
 261         return 1;
 262     }
 263 }
 264
 265 sub loadMyModule {
 266     my ($modulename) = @_;
 267     if (!defined $modulename) {
 268         &WARN("loadMyModule: module is NULL.");
 269         return 0;
 270     }
 271
 272     my $modulefile = "$bot_src_dir/Modules/$modulename.pl";
 273
 274     # call reloadModule() which checks age of file and reload.
 275     if (grep /\/$modulename$/, keys %INC) {
 276         &reloadModule($modulename);
 277         return 1;       # depend on reloadModule?
 278     }
 279
 280     if (! -f $modulefile) {
 281         &ERROR("lMM: module ($modulename) does not exist.");
 282         if ($$ == $bot_pid) {   # parent.
 283             &shutdown() if (defined $shm and defined $dbh);
 284         } else {                        # child.
 285             &DEBUG("b4 delfork 1");
 286             &delForked($modulename);
 287         }
 288
 289         exit 1;
 290     }
 291
 292     eval "require \"$modulefile\"";
 293     if ($@) {
 294         &ERROR("cannot load my module: $modulename");
 295         if ($bot_pid != $$) {   # child.
 296             &DEBUG("b4 delfork 2");
 297             &delForked($modulename);
 298             exit 1;
 299         }
 300
 301         return 0;
 302     } else {
 303         $moduleAge{$modulefile} = (stat $modulefile)[9];
 304
 305         &status("Loaded $modulename");
 306         &showProc(" ($modulename)");
 307         return 1;
 308     }
 309 }
 310
 311 $no_timehires = 0;
 312 eval "use Time::HiRes qw(gettimeofday tv_interval)";
 313 if ($@) {
 314     &WARN("No Time::HiRes?");
 315     $no_timehires = 1;
 316 }
 317 &showProc(" (Time::HiRes)");
 318
 319 sub AUTOLOAD {
 320     if (!defined $AUTOLOAD and defined $::AUTOLOAD) {
 321         &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!");
 322     }
 323     return unless (defined $AUTOLOAD);
 324     return if ($AUTOLOAD =~ /__/);      # internal.
 325
 326     my $str = join(', ', @_);
 327     my ($package, $filename, $line) = caller;
 328     &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line");
 329
 330     $AUTOLOAD =~ s/^(\S+):://g;
 331
 332     # hopefully this will work.
 333     &DEBUG("Trying to load module $AUTOLOAD...");
 334     &loadMyModule($AUTOLOAD);
 335 }
 336
 337 sub getPerlFiles {
 338     my($dir) = @_;
 339
 340     if (!opendir(DIR, $dir)) {
 341         &ERROR("Cannot open source directory ($dir): $!");
 342         exit 1;
 343     }
 344
 345     my @mods;
 346     while (defined(my $file = readdir DIR)) {
 347         next unless $file =~ /\.pl$/;
 348         next unless $file =~ /^[A-Z]/;
 349         push(@mods, $file);
 350     }
 351     closedir DIR;
 352
 353     return reverse sort @mods;
 354 }
 355
 356 1;
 357
 358 # vim:ts=4:sw=4:expandtab:tw=80