X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fmodules.pl;h=2179b9648d62eb2ed4ab259363b4037baa7a58bb;hb=e59135bba96d76f54f9405b297b8ef7e7c22ac9f;hp=ee86c3817fef38e694fb188978b37e1b0c275360;hpb=34f9ccd5a869f040bf4cb6dc12c55aea16cd25bb;p=infobot.git

diff --git a/src/modules.pl b/src/modules.pl
index ee86c38..2179b96 100644
--- a/src/modules.pl
+++ b/src/modules.pl
@@ -5,206 +5,157 @@
 #     Created: 20000624
 #
 
-if (&IsParam("useStrict")) { use strict; }
-use vars qw($AUTOLOAD);
+use strict;
+
+use vars qw($AUTOLOAD $no_timehires $bot_version $bot_release);
 
 ###
 ### REQUIRED MODULES.
 ###
 
-eval "use IO::Socket";
+eval 'use IO::Socket';
 if ($@) {
-    &ERROR("no IO::Socket?");
+    &ERROR('no IO::Socket?');
     exit 1;
 }
-&showProc(" (IO::Socket)");
-
-### MODULES.
-%myModules = (
-	"countdown"	=> "Countdown.pl",
-	"debian"	=> "Debian.pl",
-	"debianExtra"	=> "DebianExtra.pl",
-	"dict"		=> "Dict.pl",
-	"dumpvars"	=> "DumpVars.pl",
-	"factoids"	=> "Factoids.pl",
-	"freshmeat"	=> "Freshmeat.pl",
-	"kernel"	=> "Kernel.pl",
-	"ircdcc"	=> "UserDCC.pl",
-	"perlMath"	=> "Math.pl",
-	"news"		=> "News.pl",
-	"quote"		=> "Quote.pl",
-	"rootwarn"	=> "RootWarn.pl",
-	"search"	=> "Search.pl",
-	"slashdot"	=> "Slashdot3.pl",
-	"topic"		=> "Topic.pl",
-	"units"		=> "Units.pl",
-	"uptime"	=> "Uptime.pl",
-	"userinfo"	=> "UserInfo.pl",
-	"wwwsearch"	=> "W3Search.pl",
-	"whatis"	=> "WhatIs.pl",
-	"wingate"	=> "Wingate.pl",
-	"insult"	=> "insult.pl",
-	"nickometer"	=> "nickometer.pl",
-	"babelfish"	=> "babel.pl",
-);
+&showProc(' (IO::Socket)');
+
 ### THIS IS NOT LOADED ON RELOAD :(
+my @myModulesLoadNow;
+my @myModulesReloadNot;
+
 BEGIN {
-    @myModulesLoadNow	= ('topic', 'uptime', 'news');
-    @myModulesReloadNot	= ('IRC/Irc.pl','IRC/Schedulers.pl');
+    @myModulesLoadNow = (
+        'Topic',     'Uptime',  'News', 'RootWarn',
+        'DumpVars2', 'botmail', 'OnJoin'
+    );
+    @myModulesReloadNot = ( 'IRC/Irc.pl', 'IRC/Schedulers.pl' );
 }
 
 sub loadCoreModules {
-    if (!opendir(DIR, $bot_src_dir)) {
-	&ERROR("can't open source directory $bot_src_dir: $!");
-	exit 1;
-    }
+    my @mods = &getPerlFiles($bot_src_dir);
 
-    my @mods;
-    while (defined(my $file = readdir DIR)) {
-	next unless $file =~ /\.pl$/;
-	next unless $file =~ /^[A-Z]/;
-	push(@mods, $file);
-    }
-    closedir DIR;
-    &status("Loading ".scalar(@mods)." CORE modules...");
+    &status('Loading CORE modules...');
 
-    foreach (sort @mods) {
-	my $mod = "$bot_src_dir/$_";
+    foreach ( sort @mods ) {
+        my $mod = "$bot_src_dir/$_";
 
-	eval "require \"$mod\"";
-	if ($@) {
-	    &ERROR("lCM => $@");
-	    &shutdown();
-	    exit 1;
-	}
+        eval "require \"$mod\"";
+        if ($@) {
+            &ERROR("lCM => $@");
+            &shutdown();
+            exit 1;
+        }
 
-	$moduleAge{$mod} = (stat $mod)[9];
-	&showProc(" ($_)") if (&IsParam("DEBUG"));
+        $moduleAge{$mod} = ( stat $mod )[9];
+        &showProc(" ($_)") if ( &IsParam('DEBUG') );
     }
 }
 
 sub loadDBModules {
-    &status("Loading DB modules...");
-
-    if ($param{'DBType'} =~ /^mysql$/i) {
-	eval "use DBI";
-	if ($@) {
-	    &ERROR("libdbd-mysql-perl is not installed!");
-	    exit 1;
-	}
-	&showProc(" (DBI // mysql)");
-
-	&status("  using MySQL support.");
-	require "$bot_src_dir/db_mysql.pl";
-
-    } elsif ($param{'DBType'} =~ /^pgsql$/i) {
-	eval "use Pg";
-	if ($@) {
-	    &ERROR("libpgperl is not installed!");
-	    exit 1;
-	}
-	&showProc(" (Pg // postgreSQLl)");
-
-	&status("  using PostgreSQL support.");
-	require "$bot_src_dir/db_pgsql.pl";
-    } elsif ($param{'DBType'} =~ /^dbm$/i) {
-
-	&status("  using Berkeley DBM 1.85/2.0 support.");
-	require "$bot_src_dir/db_dbm.pl";
-    } else {
-
-	&status("DB support DISABLED.");
-	return;
+    my $f;
+
+    # TODO: use function to load module.
+
+    if ( $param{'DBType'} =~ /^(mysql|SQLite(2)?|pgsql)$/i ) {
+        eval 'use DBI';
+        if ($@) {
+            &ERROR( 'No support for DBI::' . $param{'DBType'} . ', exiting!' );
+            exit 1;
+        }
+        &status( 'Loading ' . $param{'DBType'} . ' support.' );
+        $f = "$bot_src_dir/dbi.pl";
+        require $f;
+        $moduleAge{$f} = ( stat $f )[9];
+
+        &showProc( ' (DBI::' . $param{'DBType'} . ')' );
+    }
+    else {
+        &WARN('DB support DISABLED.');
+        return;
     }
 }
 
 sub loadFactoidsModules {
-    &status("Loading Factoids modules...");
-
-    if (!&IsParam("factoids")) {
-	&status("Factoid support DISABLED.");
-	return;
+    if ( !&IsParam('factoids') ) {
+        &status('Factoid support DISABLED.');
+        return;
     }
 
-    if (!opendir(DIR, "$bot_src_dir/Factoids")) {
-	&ERROR("can't open source directory Factoids: $!");
-	exit 1;
-    }
+    &status('Loading Factoids modules...');
+
+    foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) {
+        my $mod = "$bot_src_dir/Factoids/$_";
 
-    while (defined(my $file = readdir DIR)) {
-	next unless $file =~ /\.pl$/;
-	next unless $file =~ /^[A-Z]/;
-	my $mod = "$bot_src_dir/Factoids/$file";
-	### TODO: use eval and exit gracefully?
-	eval "require \"$mod\"";
-	if ($@) {
-	    &WARN("lFM: $@");
-	    exit 1;
-	}
-
-	$moduleAge{$mod} = (stat $mod)[9];
-	&showProc(" ($file)") if (&IsParam("DEBUG"));
+        eval "require \"$mod\"";
+        if ($@) {
+            &ERROR("lFM: $@");
+            exit 1;
+        }
+
+        $moduleAge{$mod} = ( stat $mod )[9];
+        &showProc(" ($_)") if ( &IsParam('DEBUG') );
     }
-    closedir DIR;
 }
 
 sub loadIRCModules {
-    &status("Loading IRC modules...");
-    if (&whatInterface() =~ /IRC/) {
-	eval "use Net::IRC";
-	if ($@) {
-	    &ERROR("libnet-irc-perl is not installed!");
-	    exit 1;
-	}
-	&showProc(" (Net::IRC)");
-
-    } else {
-	&status("IRC support DISABLED.");
-	return;
+    my ($interface) = &whatInterface();
+    if ( $interface =~ /IRC/ ) {
+        &status('Loading IRC modules...');
+
+        eval 'use Net::IRC';
+        if ($@) {
+            &ERROR('libnet-irc-perl is not installed!');
+            exit 1;
+        }
+        &showProc(' (Net::IRC)');
     }
+    else {
+        &status('IRC support DISABLED.');
 
-    if (!opendir(DIR, "$bot_src_dir/IRC")) {
-	&ERROR("can't open source directory Factoids: $!");
-	exit 1;
+        # disabling forking. Why?
+        #$param{forking}	= 0;
+        #$param{noSHM}	= 1;
     }
 
-    while (defined(my $file = readdir DIR)) {
-	next unless $file =~ /\.pl$/;
-	next unless $file =~ /^[A-Z]/;
-	my $mod = "$bot_src_dir/IRC/$file";
-	### TODO: use eval and exit gracefully?
-	require $mod;
-	$moduleAge{$mod} = (stat $mod)[9];
-	&showProc(" ($file)") if (&IsParam("DEBUG"));
+    foreach ( &getPerlFiles("$bot_src_dir/$interface") ) {
+        my $mod = "$bot_src_dir/$interface/$_";
+
+        # hrm... use another config option besides DEBUG to display
+        # change in memory usage.
+        &status("Loading Modules \"$mod\"") if ( !&IsParam('DEBUG') );
+        eval "require \"$mod\"";
+        if ($@) {
+            &ERROR("require \"$mod\" => $@");
+            &shutdown();
+            exit 1;
+        }
+
+        $moduleAge{$mod} = ( stat $mod )[9];
+        &showProc(" ($_)") if ( &IsParam('DEBUG') );
     }
-    closedir DIR;
 }
 
 sub loadMyModulesNow {
     my $loaded = 0;
     my $total  = 0;
 
-    &status("Loading MyModules...");
+    &status('Loading MyModules...');
     foreach (@myModulesLoadNow) {
-	$total++;
-	if (!defined $_) {
-	    &WARN("mMLN: null element.");
-	    next;
-	}
-
-	if (!&IsParam($_) and !&IsChanConf($_) and !&getChanConfList($_)) {
-	    &DEBUG("_ => $_");
-	    if (exists $myModules{$_}) {
-		&status("myModule: $myModules{$_} (1) not loaded.");
-	    } else {
-		&DEBUG("myModule: $_ (2) not loaded.");
-	    }
-
-	    next;
-	}
-
-	&loadMyModule($myModules{$_});
-	$loaded++;
+        $total++;
+        if ( !defined $_ ) {
+            &WARN('mMLN: null element.');
+            next;
+        }
+
+        if ( !&IsParam($_) and &IsChanConf($_) <= 0 and !&getChanConfList($_) )
+        {
+            &DEBUG("loadMyModuleNow: $_ (2) not loaded.");
+            next;
+        }
+
+        &loadMyModule($_);
+        $loaded++;
     }
 
     &status("Module: Runtime: Loaded/Total [$loaded/$total]");
@@ -212,163 +163,210 @@ sub loadMyModulesNow {
 
 ### rename to moduleReloadAll?
 sub reloadAllModules {
-###    &status("Module: reloading all.");
-    foreach (map { substr($_,2) } keys %moduleAge) {
-        &reloadModule($_);
+    my $retval = '';
+
+    &VERB( 'Module: reloading all.', 2 );
+
+    # Reload version and save
+    open( VERSION, '<VERSION' );
+    $bot_release = <VERSION> || '(unknown version)';
+    chomp($bot_release);
+    $bot_version = "infobot $bot_release -- $^O";
+    close(VERSION);
+
+    # obscure usage of map and regex :)
+    foreach ( map { s/.*?\/?src/src/; $_ } keys %moduleAge ) {
+        $retval .= &reloadModule($_);
     }
-###    &status("Module: reloading done.");
+
+    &VERB( 'Module: reloading done.', 2 );
+    return $retval;
 }
 
 ### rename to modulesReload?
 sub reloadModule {
-    my ($mod)	= @_;
-    my $file	= (grep /\/$mod/, keys %INC)[0];
+    my ($mod) = @_;
+    my $file = ( grep /\/$mod/, keys %INC )[0];
+    my $retval = '';
 
     # don't reload if it's not our module.
-    if ($mod =~ /::/ or $mod !~ /pl$/) {
-	&VERB("Not reloading $mod.",3);
-	return;
+    if ( $mod =~ /::/ or $mod !~ /pl$/ ) {
+        &VERB( "Not reloading $mod.", 3 );
+        return $retval;
     }
 
-    if (!defined $file) {
-	&WARN("rM: Cannot reload $mod since it was not loaded anyway.");
-	return;
+    if ( !defined $file ) {
+        &WARN("rM: Cannot reload $mod since it was not loaded anyway.");
+        return $retval;
     }
 
-    if (! -f $file) {
-	&ERROR("rM: file '$file' does not exist?");
-	return;
+    if ( !-f $file ) {
+        &ERROR("rM: file '$file' does not exist?");
+        return $retval;
     }
 
-    my $age = (stat $file)[9];
-    return if ($age == $moduleAge{$file});
-
-    if ($age < $moduleAge{$file}) {
-	&WARN("rM: we're not gonna downgrade the file. use 'touch'.");
-	return;
+    if ( grep /$mod/, @myModulesReloadNot ) {
+        &DEBUG("rM: should not reload $mod");
+        return $retval;
     }
 
-    if (grep /$mod/, @myModulesReloadNot) {
-	&DEBUG("rM: SHOULD NOT RELOAD $mod!!!");
-	return;
+    my $age = ( stat $file )[9];
+
+    if ( !exists $moduleAge{$file} ) {
+        &DEBUG("Looks like $file was not loaded; fixing.");
     }
+    else {
+        return $retval if ( $age == $moduleAge{$file} );
+
+        if ( $age < $moduleAge{$file} ) {
+            &WARN("rM: we're not gonna downgrade '$file'; use touch.");
+            &DEBUG("age => $age, mA{$file} => $moduleAge{$file}");
+            return $retval;
+        }
 
-    my $dc  = &Time2String($age   - $moduleAge{$file});
-    my $ago = &Time2String(time() - $moduleAge{$file});
+        my $dc  = &Time2String( $age - $moduleAge{$file} );
+        my $ago = &Time2String( time() - $moduleAge{$file} );
+
+        &VERB( "Module:  delta change: $dc",  2 );
+        &VERB( "Module:           ago: $ago", 2 );
+    }
 
     &status("Module: Loading $mod...");
-    &VERB("Module:  delta change: $dc",2);
-    &VERB("Module:           ago: $ago",2);
 
     delete $INC{$file};
-    eval "require \"$file\"";	# require or use?
+    eval "require \"$file\"";    # require or use?
     if (@$) {
-	&DEBUG("rM: failure: @$");
-    } else {
-	my $basename = $file;
-	$basename =~ s/^.*\///;
-	&status("Module: reloaded $basename");
-	$moduleAge{$file} = $age;
+        &DEBUG("rM: failure: @$ ");
+    }
+    else {
+        my $basename = $file;
+        $basename =~ s/^.*\///;
+        &status("Module: reloaded $basename");
+        $retval = " $basename";
+        $moduleAge{$file} = $age;
     }
+    return $retval;
 }
 
 ###
 ### OPTIONAL MODULES.
 ###
 
-local %perlModulesLoaded  = ();
-local %perlModulesMissing = ();
+my %perlModulesLoaded  = ();
+my %perlModulesMissing = ();
 
 sub loadPerlModule {
-    return 0 if (exists $perlModulesMissing{$_[0]});
-    &reloadModule($_[0]);
-    return 1 if (exists $perlModulesLoaded{$_[0]});
+    return 0 if ( exists $perlModulesMissing{ $_[0] } );
+    &reloadModule( $_[0] );
+    return 1 if ( exists $perlModulesLoaded{ $_[0] } );
 
     eval "use $_[0]";
     if ($@) {
-	&WARN("Module: $_[0] is not installed!");
-	$perlModulesMissing{$_[0]} = 1;
-	return 0;
-    } else {
-	$perlModulesLoaded{$_[0]} = 1;
-	&status("Module: Loaded $_[0] ...");
-	&showProc(" ($_[0])");
-	return 1;
+        &WARN("Module: $_[0] is not installed!");
+        $perlModulesMissing{ $_[0] } = 1;
+        return 0;
+    }
+    else {
+        $perlModulesLoaded{ $_[0] } = 1;
+        &status("Loaded $_[0]");
+        &showProc(" ($_[0])");
+        return 1;
     }
 }
 
 sub loadMyModule {
-    my ($tmp) = @_;
-    if (!defined $tmp) {
-	&WARN("loadMyModule: module is NULL.");
-	return 0; 
+    my ($modulename) = @_;
+    if ( !defined $modulename ) {
+        &WARN('loadMyModule: module is NULL.');
+        return 0;
     }
 
-    my ($modulebase, $modulefile);
-    if (exists $myModules{$tmp}) {
-	($modulename, $modulebase) = ($tmp, $myModules{$tmp});
-    } else {
-	$modulebase = $tmp;
-	if ($tmp = grep /^$modulebase$/, keys %myModules) {
-	    &DEBUG("lMM: lame hack, file => name => $tmp.");
-	    $modulename = $tmp;
-	}
-    }
-    my $modulefile = "$bot_src_dir/Modules/$modulebase";
+    my $modulefile = "$bot_src_dir/Modules/$modulename.pl";
 
     # call reloadModule() which checks age of file and reload.
-    if (grep /\/$modulebase$/, keys %INC) {
-	&reloadModule($modulebase);
-	return 1;	# depend on reloadModule?
+    if ( grep /\/$modulename$/, keys %INC ) {
+        &reloadModule($modulename);
+        return 1;    # depend on reloadModule?
     }
 
-    if (! -f $modulefile) {
-	&ERROR("lMM: module ($modulebase) does not exist.");
-	if ($$ == $bot_pid) {	# parent.
-	    &shutdown() if (defined $shm and defined $dbh);
-	} else {			# child.
-	    &DEBUG("b4 delfork 1");
-	    &delForked($modulebase);
-	}
-
-	exit 1;
+    if ( !-f $modulefile ) {
+        &ERROR("lMM: module ($modulename) does not exist.");
+        if ( $$ == $bot_pid ) {    # parent.
+            &shutdown() if ( defined $shm and defined $dbh );
+        }
+        else {                     # child.
+            &DEBUG('b4 delfork 1');
+            &delForked($modulename);
+        }
+
+        exit 1;
     }
 
     eval "require \"$modulefile\"";
     if ($@) {
-	&ERROR("cannot load my module: $modulebase");
-	if ($bot_pid != $$) {	# child.
-	    &DEBUG("b4 delfork 2");
-	    &delForked($modulebase);
-	    exit 1;
-	}
-
-	return 0;
-    } else {
-	$moduleAge{$modulefile} = (stat $modulefile)[9];
-
-	&status("myModule: Loaded $modulebase ...");
-	&showProc(" ($modulebase)");
-	return 1;
+        &ERROR("cannot load my module: $modulename");
+        if ( $bot_pid != $$ ) {    # child.
+            &DEBUG('b4 delfork 2');
+            &delForked($modulename);
+            exit 1;
+        }
+
+        return 0;
+    }
+    else {
+        $moduleAge{$modulefile} = ( stat $modulefile )[9];
+
+        &status("Loaded $modulename");
+        &showProc(" ($modulename)");
+        return 1;
     }
 }
 
 $no_timehires = 0;
-eval "use Time::HiRes qw(gettimeofday tv_interval)";
+eval 'use Time::HiRes qw(gettimeofday tv_interval)';
 if ($@) {
-    &WARN("No Time::HiRes?");
+    &WARN('No Time::HiRes?');
     $no_timehires = 1;
 }
-&showProc(" (Time::HiRes)");
+&showProc(' (Time::HiRes)');
 
 sub AUTOLOAD {
-    return if ($AUTOLOAD =~ /__/);	# internal.
+    if ( !defined $AUTOLOAD and defined $::AUTOLOAD ) {
+        &DEBUG('AUTOLOAD: hrm.. ::AUTOLOAD defined!');
+    }
+    return unless ( defined $AUTOLOAD );
+    return if ( $AUTOLOAD =~ /__/ );    # internal.
+
+    my $str = join( ', ', @_ );
+    my ( $package, $filename, $line ) = caller;
+    &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD ($str) $filename line $line");
 
-    &ERROR("UNKNOWN FUNCTION CALLED: $AUTOLOAD");
-    foreach (@_) {
-	next unless (defined $_);
-	&status("  => $_");
+    $AUTOLOAD =~ s/^(\S+):://g;
+
+    # hopefully this will work.
+    &DEBUG("Trying to load module $AUTOLOAD...");
+    &loadMyModule($AUTOLOAD);
+}
+
+sub getPerlFiles {
+    my ($dir) = @_;
+
+    if ( !opendir( DIR, $dir ) ) {
+        &ERROR("Cannot open source directory ($dir): $!");
+        exit 1;
+    }
+
+    my @mods;
+    while ( defined( my $file = readdir DIR ) ) {
+        next unless $file =~ /\.pl$/;
+        next unless $file =~ /^[A-Z]/;
+        push( @mods, $file );
     }
+    closedir DIR;
+
+    return reverse sort @mods;
 }
 
 1;
+
+# vim:ts=4:sw=4:expandtab:tw=80