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