Updated.

* Added hook on_whoreply.
* PRIVMSGs and NOTICEs that would cause a >512 bytes resulting message are now divided into multiple messages.
* Renamed botnick to botinfo.

.gitignore

@@ -1,3 +1,6 @@
-*.conf
+auto.conf
 build/*
 *.swp
+autodoc/*
+*.db
+var/*

NEWS

@@ -0,0 +1,43 @@
+8""""8                  
+8    8 e   e eeeee eeeee
+8eeee8 8   8   8   8  88
+88   8 8e  8   8e  8   8
+88   8 88  8   88  8   8
+88   8 88ee8   88  8eee8
+
+          3.0
+
+The future of IRC bots is here! Xelhua gives to you, Auto 3.0, a new version of
+the popular Auto IRC bot.
+
+In this alpha10 release, we have added:
+
+* German translation for AUR command help.
+* German translation for Bitly command help.
+* German translation for Calc command help.
+* German translation for Dictionary command help.
+* German translation for EightBall command help.
+* German translation for Eval command help.
+* German translation for FML command help.
+* German translation for Greet command help.
+* Aliases now work in PM's to the bot too.
+
+Bug fixes:
+
+* Fixed parsing of host masks with a / in them.
+* Security exploit (causes fatal error) in the HELP command.
+* Security exploit (wide characters) in plaintext socket management.
+
+Incompatibilities:
+
+None
+
+We thank you for choosing Auto. Please remember that he is coming to late
+development stages soon, and testers are needed! But we hope we've piqued
+your interest, as Auto's upcoming module repository will allow modules to be
+created by anyone and uploaded there for everyone to use.
+
+Auto's goal is to create an efficient, stable and highly customizable IRC bot
+in Perl. To offer an alternative to other platforms.
+
+Enjoy Auto 3.0.0 Alpha 10!

README

@@ -38,7 +38,8 @@ Contributors - Non-developers who contribute to the project greatly.
 
 3. HOW TO INSTALL
 
-Installation documentation is at: http://wiki.xelhua.org/index.php/Auto:Install
+Installation documentation is at: 
+http://wiki.xelhua.org/index.php/Auto:Installation_guide
 
 
 4. HOW TO UPGRADE

README.md

@@ -42,7 +42,7 @@ greatly.
 
 ## 3. HOW TO INSTALL
 
-Installation documentation can be found [here](http://wiki.xelhua.org/index.php/Auto:Install).
+Installation documentation can be found [here](http://wiki.xelhua.org/index.php/Auto:Installation_guide).
 
 
 ## 4. HOW TO UPGRADE

auto

@@ -5,53 +5,49 @@
 # Written in sh because the user may not have Perl...to run Auto....
 
 PID=bin/auto.pid
-MODS="Mouse Class::Unload"
-EMODS="MIME::Base64 XML::Simple"
+MODS="Class::Unload DBI"
 
 if [ "$1" = "start" ] ; then
-	if [ -e $PID ]; then
-		if [ "$2" = "force" ]; then    
-		    echo "Starting Auto. . ."
-		    bin/auto
-		    sleep 2
-		    if [ ! -r $PID ]; then
-		    	echo "Possible failed startup... check Auto logs for more information."
-		    fi
+    if [ -e $PID ]; then
+    	if [ "$2" = "force" ]; then  
+    	    echo "Starting Auto. . ."
+    	    bin/auto
+    	    sleep 2
+    	    if [ ! -r $PID ]; then
+    	    	echo "Possible failed startup... check Auto logs for more information."
+    	    fi
         else
             echo "Auto appears to be running already. Run ./auto start force to start anyway."
         fi
-	else
-		echo "Starting Auto. . ."
-		bin/auto
-		sleep 2
-		if [ ! -r $PID ]; then
-			echo "Possible failed startup... check Auto logs for more information"
-		fi
-	fi
+    else
+    	echo "Starting Auto. . ."
+    	bin/auto
+    	sleep 2
+    	if [ ! -r $PID ]; then
+    		echo "Possible failed startup... check Auto logs for more information"
+    	fi
+    fi
 
 elif [ "$1" = "stop" ]; then
-	echo "Stopping Auto. . ."
-	kill -TERM `cat $PID`
+    echo "Stopping Auto. . ."
+    kill -TERM `cat $PID`
 
 elif [ "$1" = "rehash" ]; then
-	echo "Rehashing Auto. . ."
-	kill -HUP `cat $PID`
+    echo "Rehashing Auto. . ."
+    kill -HUP `cat $PID`
 
 elif [ "$1" = "status" ]; then
-	if [ -e $PID ]; then
-		echo "Status: Auto appears to be running."
-	else
-		echo "Status: Auto appears to not be running."
-	fi
+    if [ -e $PID ]; then
+    	echo "Status: Auto appears to be running."
+    else
+    	echo "Status: Auto appears to not be running."
+    fi
 
 elif [ "$1" = "getmodules" ]; then
-	cpan -i $MODS
-
-elif [ "$1" = "getextras" ]; then
-	cpan -i $EMODS
+    cpan -i $MODS
 
 else
-	echo "Usage: auto (start|stop|rehash|status|getmodules|getextras)"
+    echo "Usage: auto (start|stop|rehash|status|getmodules)"
 fi
 
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

auto.bat

@@ -0,0 +1,45 @@
+:: auto.bat - Launcher for Microsoft Windows.
+:: Copyright (C) 2010-2011 Xelhua Development Group, et al.
+:: Released under the terms stated in doc/LICENSE.
+:: Clone of `auto`, since Windows likes Batch, not sh.
+
+@echo off
+
+set pidfile=bin/auto.pid
+
+if "%1" == "" goto errparams
+if "%1" == "start" goto start
+if "%1" == "status" goto status
+else goto errparams
+
+:errparams
+echo.
+echo Usage: auto.bat (start|status) [force]
+:end
+
+:start
+echo.
+if exist "%pidfile" (
+    if "%2" == "force" (
+        echo Starting Auto. . .
+        perl bin/auto
+    )
+    else (
+        echo Auto appears to be running already. Run `auto.bat start force` to start anyway.
+    )
+)
+else (
+    echo Starting Auto. . .
+    perl bin/auto
+)
+:end
+
+:status
+echo.
+if exist "%pidfile" (
+    echo Status: Auto appears to be running.
+)
+else (
+    echo Status: Auto appears to not be running.
+)
+:end

bin/auto

@@ -7,84 +7,131 @@ package Auto;
 use 5.010_000;
 use strict;
 use warnings;
-no feature qw(say state);
+no feature qw(state);
 use POSIX;
-use locale;
 use English qw(-no_match_vars);
 use Sys::Hostname;
 use IO::Socket;
 use IO::Select;
+use Getopt::Long;
 use DBI;
-use DBD::SQLite;
 use Class::Unload;
 use FindBin qw($Bin);
 our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::ProhibitPackageVars)
+our (%bin, $UPREFIX);
 BEGIN {
-    unshift @INC, "$Bin/../lib";
+    $bin{cwd} = getcwd;
+    if (!-e "$Bin/../build/syswide") {
+        # Must be a custom PREFIX install.
+        $bin{etc} = "$bin{cwd}/etc";
+        $bin{var} = "$bin{cwd}/var";
+        if (!-e "$Bin/lib/Lib/Auto.pm") {
+            # Must be a system wide install.
+            $bin{lib} = "$Bin/../lib/autobot/3.0.0";    
+            $bin{bld} = "$bin{lib}/build";
+            $bin{lng} = "$bin{lib}/lang";
+            $bin{mod} = "$bin{lib}/modules";
+        }
+        else {
+            # Or not.
+            $bin{lib} = "$Bin/../lib";
+            $bin{bld} = "$Bin/../build";
+            $bin{lng} = "$Bin/../lang";
+            $bin{mod} = "$Bin/../modules";
+        }
+        $UPREFIX = 1;
+    }
+    else {
+        # Must be a standard install.
+        $bin{etc} = "$Bin/../etc";
+        $bin{var} = "$Bin/../var";
+        $bin{lib} = "$Bin/../lib";
+        $bin{bld} = "$Bin/../build";
+        $bin{lng} = "$Bin/../lang";
+        $bin{mod} = "$Bin/../modules";
+        $UPREFIX = 0;
+    }
+
+    unshift @INC, $bin{lib};
+
+    if (-d "$Bin/../.git") {
+        open my $gitfh, '<', "$Bin/../.git/refs/heads/indev";
+        our $VERGITREV = substr readline $gitfh, 0, 7;
+        close $gitfh;
+    }
 
     # Set version information.
     use constant { ## no critic qw(ValuesAndExpressions::ProhibitConstantPragma)
-	    NAME   => 'Auto IRC Bot',
-	    VER    => 3,
-	    SVER   => 0,
-	    REV    => 0,
-	    RSTAGE => 'd',
-        GR     => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7
+        NAME   => 'Auto IRC Bot',
+        VER    => 3,
+        SVER   => 0,
+        REV    => 0,
+        RSTAGE => 'd',
     };
 }
 use Lib::Auto;
 use API::Std qw(conf_get err);
-use API::Log qw(println alog dbug);
+use API::Log qw(alog dbug);
 #use DB::Flatfile;
 use Parser::Config;
 use Parser::Lang;
-use Parser::IRC;
+use Proto::IRC;
+use State::IRC;
 use Core::IRC;
+use Core::IRC::Users;
 use Core::Cmd;
 
-our $VERSION = 3.0.0;
+our $VERSION = 3.000000;
 local $PROGRAM_NAME = 'auto';
 
 # Check for build files.
-if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") {
-	println 'Missing build file(s). Please build Auto before running it.' and exit;
+if (!-e "$bin{bld}/os" or !-e "$bin{bld}/perl" or !-e "$bin{bld}/time" or !-e "$bin{bld}/ver") {
+    say 'Missing build file(s). Please build Auto before running it.' and exit;
 }
 
 # Check build OS.
-open my $BFOS, '<', "$Bin/../build/os" or println 'Cannot start: Broken build.' and exit;
+open my $BFOS, '<', "$bin{bld}/os" or say 'Cannot start: Broken build.' and exit;
 my @BFOS = <$BFOS>;
-close $BFOS or println 'Cannot start: Broken build.' and exit;
+close $BFOS or say 'Cannot start: Broken build.' and exit;
 if ($BFOS[0] ne $OSNAME."\n") {
-	println 'Cannot start: Broken build.' and exit;
+    say 'Cannot start: Broken build.' and exit;
 }
 undef @BFOS;
 
 # Check build features.
 our $ENFEAT;
-open my $BFFEAT, '<', "$Bin/../build/feat" or println 'Cannot start: Broken build.' and exit;
+open my $BFFEAT, '<', "$bin{bld}/feat" or say 'Cannot start: Broken build.' and exit;
 my @BFFEAT = <$BFFEAT>;
-close $BFFEAT or println 'Cannot start: Broken build.' and exit;
+close $BFFEAT or say 'Cannot start: Broken build.' and exit;
 $ENFEAT = substr $BFFEAT[0], 0, length($BFFEAT[0]) - 1;
 undef @BFFEAT;
 
 # Check build Perl version.
-open my $BFPERL, '<', "$Bin/../build/perl" or println 'Cannot start: Broken build.' and exit;
+open my $BFPERL, '<', "$bin{bld}/perl" or say 'Cannot start: Broken build.' and exit;
 my @BFPERL = <$BFPERL>;
-close $BFPERL or println 'Cannot start: Broken build.' and exit;
+close $BFPERL or say 'Cannot start: Broken build.' and exit;
 if ($BFPERL[0] ne $]."\n") {
-	println 'Cannot start: Broken build.' and exit;
+    say 'Cannot start: Broken build.' and exit;
 }
 undef @BFPERL;
 
 # Check build Auto version.
-open my $BFVER, '<', "$Bin/../build/ver" or println 'Cannot start: Broken build.' and exit;
+open my $BFVER, '<', "$bin{bld}/ver" or say 'Cannot start: Broken build.' and exit;
 my @BFVER = <$BFVER>;
-close $BFVER or println 'Cannot start: Broken build.' and exit;
+close $BFVER or say 'Cannot start: Broken build.' and exit;
 if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
-	println 'Cannot start: Broken build.' and exit;
+    say 'Cannot start: Broken build.' and exit;
 }
 undef @BFVER;
 
+# Check build path setup.
+our $SYSWIDE;
+open my $BFPATH, '<', "$bin{bld}/syswide" or say 'Cannot start: Broken build.' and exit;
+my @BFPATH = <$BFPATH>;
+close $BFPATH or say 'Cannot start: Broken build.' and exit;
+if ($BFPATH[0] eq "1\n") { $SYSWIDE = 1 }
+else { $SYSWIDE = 0 }
+
 # Set signal handlers.
 local $SIG{TERM}       = \&Lib::Auto::signal_term;
 local $SIG{INT}        = \&Lib::Auto::signal_int;
@@ -95,9 +142,62 @@ API::Std::event_add('on_sigterm');
 API::Std::event_add('on_sigint');
 API::Std::event_add('on_sighup');
 
+# Get arguments.
+our ($DEBUG, $NUC);
+my ($opt_help, $opt_version, $USECONFIG);
+GetOptions(
+    'nuc'        => \$NUC,
+    'config|c=s' => \$USECONFIG,
+    'h|help'     => \$opt_help,
+    'debug|d'    => \$DEBUG,
+    'version|v'  => \$opt_version,
+);
+
+# If we were passed -h, print help.
+if ($opt_help) {
+    print <<"HELP";
+
+Usage: $PROGRAM_NAME [options]
+    --help, -h     Prints this help.
+    --version, -v  Prints the version of this Auto.
+    --debug, -d    Runs Auto in debug mode. Debug mode will print out debug
+                   messages, including IRC raw data, to screen. This will also
+                   stop Auto from forking into the background.
+
+    --config=FILENAME, -c  Uses etc/FILENAME for the configuration file.
+
+HELP
+    exit 1;
+}
+
+# If we were passed -v, print version.
+if ($opt_version) {
+    say q{};
+    say NAME.' version '.VER.', subversion '.SVER.', revision '.REV.' ('.VER.q{.}.SVER.q{.}.REV.RSTAGE.').';
+    print <<'VERINFO';
+
+Copyright (C) 2010-2011, Xelhua Development Group. All rights reserved.
+
+Auto is released under the licensing terms of the New (3-Clause) BSD License,
+which may be found in doc/LICENSE.
+
+For documentation, you might refer to README, doc/*, and the Xelhua Wiki at
+http://wiki.xelhua.org. Documentation for modules is stored in Man Page and
+HTML form in autodoc/.
+
+For support, visit the Xelhua Forums at http://forums.xelhua.org, or drop by
+the official IRC chatroom at irc.xelhua.org #xelhua. Please report bugs and
+request new features at http://rm.xelhua.org.
+
+VERINFO
+    exit 1;
+}
+
+undef $opt_help;
+undef $opt_version;
 
 # Print startup message.
-println <<'EOF';
+say <<'EOF';
 8""""8                  
 8    8 e   e eeeee eeeee
 8eeee8 8   8   8   8  88
@@ -105,74 +205,128 @@ println <<'EOF';
 88   8 88  8   88  8   8
 88   8 88ee8   88  8eee8
 EOF
-println '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
+say '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
 
 our ($APID, %TIMERS);
 
-# Get arguments.
-our $DEBUG = 0;
-our $NUC = 0;
-if (defined $ARGV[0]) {
-	foreach (@ARGV) {
-		given ($_) {
-            when ('-d') { $DEBUG = 1; }
-            when ('-nuc') { $NUC = 1; }
-        }
-    }
-}
-
 # Check for updates.
 Lib::Auto::checkver();
 
 # Include IPv6 if Auto was built for it.
-if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6; }
+if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6 }
 # Include SSL if Auto was built for it.
-if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; }
+if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL }
 
 # Parse configuration file.
-println '* Parsing configuration file auto.conf...';
-our $CONF = Parser::Config->new('auto.conf') or err(1, 'Failed to parse configuration file!', 1);
+my $configfile = 'auto.conf';
+if ($USECONFIG) { $configfile = $USECONFIG }
+say "* Parsing configuration file $configfile...";
+our $CONF = Parser::Config->new($configfile) or err(1, 'Failed to parse configuration file!', 1);
 our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
-println ' Success';
+say ' Success';
+undef $configfile;
+undef $USECONFIG;
 
 if (conf_get('die')) {
-	if ((conf_get('die'))[0][0] == 1) {
-		println '!!! You didn\'t read the whole config.';
-		println '!!! Insert new user then try again.';
-		exit;
-	}
+    if ((conf_get('die'))[0][0] == 1) {
+        say '!!! You didn\'t read the whole config.';
+        say '!!! Insert new user then try again.';
+        exit;
+    }
 }
 
 # Check for required configuration values.
-my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit);
+my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
 foreach my $REQCVAL (@REQCVALS) {
-	if (!conf_get($REQCVAL)) {
-		my $err = 2;
-		if ($REQCVAL eq 'expire_logs') {
-			$err = 1;
-		}
-		err($err, "Missing required configuration value: $REQCVAL", 1);
-	}
+    if (!conf_get($REQCVAL)) {
+        my $err = 2;
+        if ($REQCVAL eq 'expire_logs') {
+            $err = 1;
+        }
+        err($err, "Missing required configuration value: $REQCVAL", 1);
+    }
 }
 undef @REQCVALS;
 
 # Parse translations.
-println '* Parsing translation files...';
+say '* Parsing translation files...';
 our $LOCALE = (conf_get('locale'))[0][0];
 my @lang = split m/[_]/, $LOCALE;
 Parser::Lang::parse($lang[0]) or err(2, 'Failed to parse translation files!', 1);
 undef @lang;
-println ' Success';
+say ' Success';
 
 # Expire old logs.
 API::Log::expire_logs();
 
 # Connect to database.
-if (!-e "$Bin/../etc/auto.db") {
-    system "touch $Bin/../etc/auto.db";
-    system "chmod a+x $Bin/../etc/auto.db";
+our $DB;
+given (lc((conf_get('database:format'))[0][0])) {
+    when ('sqlite') {
+        # SQLite.
+        if ($ENFEAT !~ /sqlite/) { err(2, 'Auto not built with SQLite support. Aborting.', 1) }
+        if (!conf_get('database:filename')) { err(2, 'Missing required configuration value database:filename. Aborting.', 1) }
+
+        # Import DBD::SQLite.
+        require DBD::SQLite;
+
+        if (!-e "$bin{etc}/".(conf_get('database:filename'))[0][0]) {
+            # Create <database:filename> if it's missing.
+            open my $dbfh, '>', "$bin{etc}/".(conf_get('database:filename'))[0][0];
+            close $dbfh;
+            chmod 0755, "$bin{etc}/".(conf_get('database:filename'))[0][0];
+        }
+        # Connect to database.
+        $DB = DBI->connect("dbi:SQLite:dbname=$bin{etc}/".(conf_get('database:filename'))[0][0]) or err(2, 'Failed to connect to database!', 1);
+    }
+    when ('mysql') {
+        # MySQL.
+        if ($ENFEAT !~ /mysql/) { err(2, 'Auto not built with MySQL support. Aborting.', 1) }
+        my @reqcval = qw(database:host database:name database:username database:password);
+        foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
+        undef @reqcval;
+
+        # Import DBD::mysql.
+        require DBD::mysql;
+
+        # Connect to database.
+        if (conf_get('database:port')) {
+            # If we were given a port, connect with it.
+            $DB = DBI->connect('DBI:mysql:database='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0].';port='.(conf_get('database:port'))[0][0],
+                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);;
+        }
+        else {
+            # If not, connect without specifying a port.
+            $DB = DBI->connect('DBI:mysql:database='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0],
+                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);;
+        }
+    }
+    when ('pgsql') {
+        # PostgreSQL.
+        if ($ENFEAT !~ /pgsql/) { err(2, 'Auto not built with PostgreSQL support. Aborting.', 1) }
+        my @reqcval = qw(database:name database:host database:username database:password);
+        foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
+        undef @reqcval;
+
+        # Import DBD::Pg.
+        require DBD::Pg;
+
+        # Connect to database.
+        if (conf_get('database:port')) {
+            # If a specific port was given, use it.
+            $DB = DBI->connect('dbi:Pg:db='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0].';port='.(conf_get('database:port'))[0][0],
+                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);
+        }
+        else {
+            # We were not given a port, connect using PGPORT (usually 5432)
+            $DB = DBI->connect('dbi:Pg:db='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0],
+                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);
+        }
+    }
+    # Unknown database format.
+    default { err(2, 'Unknown database format \''.lc((conf_get('database:format'))[0][0]).'\'. Aborting.', 1) }
 }
-our $DB = DBI->connect("dbi:SQLite:dbname=$Bin/../etc/auto.db", q{}, q{});
+
 
 # Ratelimit timer.
 Core::IRC::clear_usercmd_timer();
@@ -181,71 +335,80 @@ Core::IRC::clear_usercmd_timer();
 our (%PRIVILEGES);
 # If there are any privsets.
 if (conf_get('privset')) {
-	# Get them.
-	my %tcprivs = conf_get('privset');
+    # Get them.
+    my %tcprivs = conf_get('privset');
 
     foreach my $tckpriv (keys %tcprivs) {
-		# For each privset, get the inner values.
-		my %mcprivs = conf_get("privset:$tckpriv");
+        # For each privset, get the inner values.
+        my %mcprivs = conf_get("privset:$tckpriv");
 
         # Iterate through them.
-		foreach my $mckpriv (keys %mcprivs) {
-			# Switch statement for the values.
-			given ($mckpriv) {
-				# If it's 'priv', save it as a privilege.
-				when ('priv') {
-					if (defined $PRIVILEGES{$tckpriv}) {
-						# If this privset exists, push to it.
-						push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
-					}
-					else {
-						# Otherwise, create it.
-						@{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
-					}
-				}
-				# If it's 'inherit', inherit the privileges of another privset.
-				when ('inherit') {
-					# If the privset we're inheriting exists, continue.
-					if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
-						# Iterate through each privilege.
-						foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
-							# And save them to the privset inheriting them
-							if (defined $PRIVILEGES{$tckpriv}) {
-								# If this privset exists, push to it.
-								push @{ $PRIVILEGES{$tckpriv} }, $_;
-							}
-							else {
-								# Otherwise, create it.
-								@{ $PRIVILEGES{$tckpriv} } = ($_);
-							}
-						}
-					}
-				}
-			}
-		}
-	}
+        foreach my $mckpriv (keys %mcprivs) {
+            # Switch statement for the values.
+            given ($mckpriv) {
+                # If it's 'priv', save it as a privilege.
+                when ('priv') {
+                    if (defined $PRIVILEGES{$tckpriv}) {
+                        # If this privset exists, push to it.
+                        push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
+                    }
+                    else {
+                        # Otherwise, create it.
+                        @{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
+                    }
+                }
+                # If it's 'inherit', inherit the privileges of another privset.
+                when ('inherit') {
+                    # If the privset we're inheriting exists, continue.
+                    if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
+                        # Iterate through each privilege.
+                        foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
+                            # And save them to the privset inheriting them
+                            if (defined $PRIVILEGES{$tckpriv}) {
+                                # If this privset exists, push to it.
+                                push @{ $PRIVILEGES{$tckpriv} }, $_;
+                            }
+                            else {
+                                # Otherwise, create it.
+                                @{ $PRIVILEGES{$tckpriv} } = ($_);
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
 }
 
 # Successful startup.
 our $STARTTIME = time;
-println '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
+say '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
 alog 'Auto successfully started.';
 
+# If we're on Windows, disable forking.
+if ($OSNAME =~ /win/i) {
+    if (!$DEBUG) {
+        say '!!! Forking unavailable (OS is Microsoft Windows), continuing in debug mode.';
+        $DEBUG = 1;
+    }
+}
+
 # Fork into the background if not in debug mode.
 if (!$DEBUG) {
-    println '*** Becoming a daemon...';
+    say '*** Becoming a daemon...';
     open STDIN, '<', '/dev/null' or err(2, "Can't read /dev/null: $ERRNO", 1);
     open STDOUT, '>>', '/dev/null' or err(2, "Can't write to /dev/null: $ERRNO", 1);
     open STDERR, '>>', '/dev/null' or err(2, "Can't write to /dev/null: $ERRNO", 1);
     $APID = fork;
     if ($APID != 0) {
         alog '* Successfully forked into the background. Process ID: '.$APID;
-        if (!-e "$Bin/auto.pid") {
-			system "touch $Bin/auto.pid";
-		}
-		open my $FPID, '>', "$Bin/auto.pid" or exit;
-		print {$FPID} "$APID\n" or exit;
-		close $FPID or exit;
+        # Figure out where to throw auto.pid.
+        my $pidfile;
+        if ($UPREFIX) { $pidfile = "$bin{cwd}/auto.pid" }
+        else { $pidfile = "$Bin/auto.pid" }
+        open my $FPID, '>', $pidfile or exit;
+        print {$FPID} "$APID\n" or exit;
+        close $FPID or exit;
         exit;
     }
     POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1);
@@ -256,14 +419,20 @@ else {
 
 # Events.
 API::Std::event_add('on_preconnect');
+# CAP.
+my %tcsvrs = conf_get('server');
+foreach my $svr (keys %tcsvrs) {
+    $Proto::IRC::cap{$svr} = 'multi-prefix';
+}
+undef %tcsvrs;
 
 # Load modules.
 if (conf_get('module')) {
-	alog '* Loading modules...';
-	dbug '* Loading modules...';
-	foreach (@{ (conf_get('module'))[0] }) {
-		mod_load($_);
-	}
+    alog '* Loading modules...';
+    dbug '* Loading modules...';
+    foreach (@{ (conf_get('module'))[0] }) {
+        mod_load($_);
+    }
 }
 
 ## Create sockets.
@@ -274,153 +443,103 @@ my %cservers = conf_get('server');
 # Set the socket hash and select instance.
 our (%SOCKET, $SELECT);
 $SELECT = IO::Select->new();
-my $it = 0;
 # Iterate through each configured server.
 foreach my $cskey (keys %cservers) {
-    # Prepare socket data.
-    my %conndata = (
-		Proto => 'tcp',
-    	LocalAddr => $cservers{$cskey}{'bind'}[0],
-		PeerAddr  => $cservers{$cskey}{'host'}[0],
-		PeerPort  => $cservers{$cskey}{'port'}[0],
-        Timeout   => 20,
-    );
-	# Set IPv6/SSL data.
-    my $use6 = 0;
-    my $usessl = 0;
-    if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
-    if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
-
-    # CertFP.
-    if ($usessl) {
-        if (defined $cservers{$cskey}{'certfp'}[0]) {
-            if ($cservers{$cskey}{'certfp'}[0] eq 1) {
-                $conndata{'SSL_use_cert'} = 1;
-                if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
-                    $conndata{'SSL_cert_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
-                }
-                if (defined $cservers{$cskey}{'certfp_key'}[0]) {
-                    $conndata{'SSL_key_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
-                }
-                if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
-                    $conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
-                }
-            }
-        }
-    }
-
-    # Create the socket.
-    if ($use6) {
-	    $SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
-        err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-        and delete $SOCKET{$cskey} and next;
-    }
-    else {
-        if ($usessl) {
-	        $SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
-            err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-            and delete $SOCKET{$cskey} and next;
-        }
-        else {
-	        $SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
-            err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-            and delete $SOCKET{$cskey} and next;
-        }
-    }
-
-    # Send PASS if we have one.
-	if (defined $cservers{$cskey}{'pass'}[0]) {
-		socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
-			err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-			and next;
-	}
-	API::Std::event_run('on_preconnect', $cskey);
-	# Send NICK/USER.
-	API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
-	socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
-		err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-		and next;
-	# Add to select.
-	$SELECT->add($SOCKET{$cskey});
-	# Success!
-	alog '** Successfully connected to server: '.$cskey;
-	dbug '** Successfully connected to server: '.$cskey;
-	$it = 1;
+    Lib::Auto::ircsock(\%{$cservers{$cskey}}, $cskey);
 }
 
 # Success!
-if ($it) {
-	alog '** Success: Connected to server(s).';
-	dbug '** Success: Connected to server(s).';
+if (keys %SOCKET) {
+    alog '** Success: Connected to server(s).';
+    dbug '** Success: Connected to server(s).';
 }
 else {
-	err(2, 'No server connections.', 1);
+    err(2, 'No IRC connections -- Exiting program.', 1);
 }
-undef $it;
 
 # Create core commands.
 API::Std::cmd_add('MODLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLOAD, \&Core::Cmd::cmd_modload);
 API::Std::cmd_add('MODUNLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODUNLOAD, \&Core::Cmd::cmd_modunload);
 API::Std::cmd_add('MODRELOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODRELOAD, \&Core::Cmd::cmd_modreload);
+API::Std::cmd_add('MODLIST', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLIST, \&Core::Cmd::cmd_modlist);
 API::Std::cmd_add('SHUTDOWN', 2, 'cmd.shutdown', \%Core::Cmd::HELP_SHUTDOWN, \&Core::Cmd::cmd_shutdown);
 API::Std::cmd_add('RESTART', 2, 'cmd.restart', \%Core::Cmd::HELP_RESTART, \&Core::Cmd::cmd_restart);
 API::Std::cmd_add('REHASH', 2, 'cmd.rehash', \%Core::Cmd::HELP_REHASH, \&Core::Cmd::cmd_rehash);
 API::Std::cmd_add('HELP', 2, 0, \%Core::Cmd::HELP_HELP, \&Core::Cmd::cmd_help);
+# Aliases, if any.
+if (conf_get('aliases:alias')) {
+    my $aliases = (conf_get('aliases:alias'))[0];
+    foreach (@{$aliases}) {
+        if ($_ =~ m/\s/xsm) {
+            my @data = split /\s/xsm, $_;
+            API::Std::cmd_alias($data[0], join ' ', @data[1..$#data]);
+        }
+    }
+}
 
 # Infinite while loop.
 while (1) {
-	# Timer check.
-	foreach my $tk (keys %TIMERS) {
-		if ($TIMERS{$tk}{time} <= time) {
-			&{ $TIMERS{$tk}{sub} }();
-			if ($TIMERS{$tk}{type} == 1) {
-				# If it's type 1, delete from memory.
-				delete $TIMERS{$tk};
-			}
-			elsif ($TIMERS{$tk}{type} == 2) {
-				# If it's type 2, reset timer.
-				$TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
-			}
-			else {
-				# This should never happen.
-				delete $TIMERS{$tk};
-			}
-		}
-	}
-	# Socket check.
-	foreach my $sock ($SELECT->can_read(1)) {
-		# Figure out what network is sending us data.
-		my $sockid;
-		foreach (keys %SOCKET) {
-			if ($SOCKET{$_} eq $sock) { $sockid = $_; }
-		}
-		# Read the data.
-		my $idata;
-		sysread $sock, $idata, POSIX::BUFSIZ, 0;
+    # Timer check.
+    foreach my $tk (keys %TIMERS) {
+        if ($TIMERS{$tk}{time} <= time) {
+            &{ $TIMERS{$tk}{sub} }();
+            if ($TIMERS{$tk}{type} == 1) {
+                # If it's type 1, delete from memory.
+                delete $TIMERS{$tk};
+            }
+            elsif ($TIMERS{$tk}{type} == 2) {
+                # If it's type 2, reset timer.
+                $TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
+            }
+            else {
+                # This should never happen.
+                delete $TIMERS{$tk};
+            }
+        }
+    }
+    # Socket check.
+    foreach my $sock ($SELECT->can_read(1)) {
+        # Figure out what network is sending us data.
+        my $sockid;
+        foreach (keys %SOCKET) {
+            if ($SOCKET{$_} eq $sock) { $sockid = $_ }
+        }
+        # Read the data.
+        my $idata;
+        sysread $sock, $idata, POSIX::BUFSIZ, 0;
 
-		# Check for the data.
-		if (!defined $idata || length($idata) == 0) {
-			# Got EOF, close socket
-			err(2, "Lost connection to $sockid!", 0);
-			$SELECT->remove($sock);
+        # Check for the data.
+        if (!defined $idata || length($idata) == 0) {
+            # Got EOF, close socket
+            err(2, "Lost connection to $sockid!", 0);
+            $SELECT->remove($sock);
             delete $SOCKET{$sockid};
+            API::Std::event_run('on_disconnect', $sockid);
+            if (!keys %SOCKET) {
+                # No more connections, stop the program.
+                API::Std::event_run('on_shutdown');
+                dbug '* No more IRC connections, shutting down.';
+                alog '* No more IRC connections, shutting down.';
+                sleep 1;
+                exit;
+            }
             next;
-		}
+        }
 
         # Read the buffer.
-		my $data .= $idata;
-		while ($data =~ s/(.*\n)//) {
-			my $line = $1;
+        my $data .= $idata;
+        while ($data =~ s/(.*\n)//) {
+            my $line = $1;
 
             # Remove the newlines.
-			chomp $line;
-			# Debug.
-			dbug $sockid.' >> '.$line;
+            chomp $line;
+            # Debug.
+            dbug $sockid.' >> '.$line;
 
             # Parse data.
-			Parser::IRC::ircparse($sockid, $line);
-		}
-	}
+            Proto::IRC::ircparse($sockid, $line);
+        }
+    }
 }
 
 ###############
@@ -428,30 +547,29 @@ while (1) {
 ###############
 
 # Send data to socket.
-sub socksnd
-{
-	my ($svr, $data) = @_;
+sub socksnd {
+    my ($svr, $data) = @_;
 
     if (defined $SOCKET{$svr}) {
-		syswrite $SOCKET{$svr}, $data."\n", POSIX::BUFSIZ, 0;
-		dbug "$svr << $data";
-		return 1;
-	}
-	else {
-		return 0;
-	}
+        syswrite $SOCKET{$svr}, "$data\r\n", POSIX::BUFSIZ, 0;
+        dbug "$svr << $data";
+        return 1;
+    }
+    else {
+        return;
+    }
 }
 
 # Load a module.
 sub mod_load {
     my ($module) = @_;
 
-    if (-e "$Bin/../modules/$module.pm") {
-        do "$Bin/../modules/$module.pm" and return 1;
+    if (-e "$bin{mod}/$module.pm") {
+        do "$bin{mod}/$module.pm" and return 1;
     }
     else {
-        if (-e "$Bin/../modules/$module/main.pm") {
-            do "$Bin/../modules/$module/main.pm" and return 1;
+        if (-e "$bin{mod}/$module/main.pm") {
+            do "$bin{mod}/$module/main.pm" and return 1;
         }
     }
 
@@ -466,4 +584,4 @@ sub mod_load {
     return;
 }
 
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

bin/buildmod

@@ -8,10 +8,45 @@ use strict;
 use warnings;
 use English qw(-no_match_vars);
 use FindBin qw($Bin);
+use Cwd;
+use Pod::Html;
+use Pod::Man;
 our $Bin = $Bin;
-
 our $VERSION = 1.00;
 
+my ($UPREFIX, %bin);
+$bin{cwd} = getcwd;
+if (!-e "$Bin/../build/syswide") {
+    # Must be a custom PREFIX install.
+    $bin{etc} = "$bin{cwd}/etc";
+    $bin{var} = "$bin{cwd}/var";
+    if (!-e "$Bin/lib/Lib/Auto.pm") {
+        # Must be a system wide install.
+        $bin{lib} = "$Bin/../lib/autobot/3.0.0";    
+        $bin{bld} = "$bin{lib}/build";
+        $bin{lng} = "$bin{lib}/lang";
+        $bin{mod} = "$bin{lib}/modules";
+    }
+    else {
+        # Or not.
+        $bin{lib} = "$Bin/../lib";
+        $bin{bld} = "$Bin/../build";
+        $bin{lng} = "$Bin/../lang";
+        $bin{mod} = "$Bin/../modules";
+    }
+    $UPREFIX = 1;
+}
+else {
+    # Must be a standard install.
+    $bin{etc} = "$Bin/../etc";
+    $bin{var} = "$Bin/../var";
+    $bin{lib} = "$Bin/../lib";
+    $bin{bld} = "$Bin/../build";
+    $bin{lng} = "$Bin/../lang";
+    $bin{mod} = "$Bin/../modules";
+    $UPREFIX = 0;
+}
+
 # Get module parameter.
 if (!defined $ARGV[0]) {
     say 'Not enough parameters. Usage: buildmod <module>';
@@ -22,13 +57,13 @@ my $module = $ARGV[0];
 # Set full path.
 my $type = 0;
 my $modulep;
-if (-e "$Bin/../modules/$module.pm") {
-    $modulep = "$Bin/../modules/$module.pm";
+if (-e "$bin{mod}/$module.pm") {
+    $modulep = "$bin{mod}/$module.pm";
     $type = 1;
 }
 else {
-    if (-e "$Bin/../modules/$module/Buildfile") {
-        $modulep = "$Bin/../modules/$module/Buildfile";
+    if (-e "$bin{mod}/$module/Buildfile") {
+        $modulep = "$bin{mod}/$module/Buildfile";
         $type = 2;
     }
     else {
@@ -93,22 +128,65 @@ foreach (@pars) {
             foreach my $cpanmod (@vals) {
                 $res = eval('require '.$cpanmod.'; 1;');
                 say '    '.$cpanmod.': '.(($res) ? 'Found' : 'Not Found');
-                if (!$res) { $die = 1; }
+                if (!$res) { $die = 1 }
             }
             print $RS;
             
-            if ($die) { say 'Failed to build '.$module.'.'; exit; }
+            if ($die) { say 'Failed to build '.$module.'.'; exit }
         }
         when ('perl') {
             print 'Checking Perl version..... '.$PERL_VERSION.' - ';
-            if ($] < $val) { $die = 1; }
+            if ($] < $val) { $die = 1 }
             say (($die) ? 'Not OK' : 'OK');
-            print $RS;
-            if ($die) { say 'Failed to build '.$module.'.'; exit; }
+            if ($die) { say 'Failed to build '.$module.'.'; exit }
         }
     }
 }
 
+# Generate documentation.
+my $got_end = 0;
+open my $FMPH, '<', $modulep;
+my @MPBUF = <$FMPH>;
+close $FMPH;
+
+say 'Generating documentation.....';
+my $podbuf;
+foreach my $line (@MPBUF) {
+    if (!defined $line) { $line = ' ' }
+    $line =~ s/(\r|\n)//g;
+
+    if ($line eq '__END__') {
+        $got_end = 1;
+    }
+
+    if ($got_end and $line ne '__END__' and $line !~ m/^# vim:/sm) {
+        $podbuf .= $line."\n";
+    }
+}
+
+# Create the autodoc/ dir if it doesn't exist.
+my $docdir;
+if ($UPREFIX) {
+    $docdir = "$ENV{HOME}/autodoc";
+    if (!-d "$ENV{HOME}/autodoc") { mkdir "$ENV{HOME}/autodoc" }
+}
+else {
+    $docdir = "$Bin/../autodoc";
+    if (!-d "$Bin/../autodoc") { mkdir "$Bin/../autodoc" }
+}
+
+# Save to POD file in autodoc/
+open my $FMPNH, '>', "$docdir/$module.pod";
+print {$FMPNH} $podbuf;
+close $FMPNH;
+
+# Create HTML.
+pod2html("--infile=$docdir/$module.pod", "--outfile=$docdir/$module.html");
+# Create *roff.
+my $manifier = Pod::Man->new();
+$manifier->parse_from_file("$docdir/$module.pod", "$docdir/$module.1");
+
+print $RS;
 say 'Done.';
 
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

bin/critic

@@ -58,4 +58,4 @@ foreach (@violations) {
 }
 say "$count violations in $ARGV[0].";
 
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

bin/genssl

@@ -9,8 +9,42 @@ use 5.010_000;
 use strict;
 use warnings;
 use FindBin qw($Bin);
+use Cwd;
 our $VERSION = 1.00;
-my $bin = $Bin;
+my $Bin = $Bin;
+
+my ($UPREFIX, %bin);
+$bin{cwd} = getcwd;
+if (!-e "$Bin/../build/syswide") {
+    # Must be a custom PREFIX install.
+    $bin{etc} = "$bin{cwd}/etc";
+    $bin{var} = "$bin{cwd}/var";
+    if (!-e "$Bin/lib/Lib/Auto.pm") {
+        # Must be a system wide install.
+        $bin{lib} = "$Bin/../lib/autobot/3.0.0";    
+        $bin{bld} = "$bin{lib}/build";
+        $bin{lng} = "$bin{lib}/lang";
+        $bin{mod} = "$bin{lib}/modules";
+    }
+    else {
+        # Or not.
+        $bin{lib} = "$Bin/../lib";
+        $bin{bld} = "$Bin/../build";
+        $bin{lng} = "$Bin/../lang";
+        $bin{mod} = "$Bin/../modules";
+    }
+    $UPREFIX = 1;
+}
+else {
+    # Must be a standard install.
+    $bin{etc} = "$Bin/../etc";
+    $bin{var} = "$Bin/../var";
+    $bin{lib} = "$Bin/../lib";
+    $bin{bld} = "$Bin/../build";
+    $bin{lng} = "$Bin/../lang";
+    $bin{mod} = "$Bin/../modules";
+    $UPREFIX = 0;
+}
 
 # Get the name of the network this cert is for.
 print 'Network Name: ';
@@ -19,15 +53,15 @@ $net =~ s/(\r|\n)//gxsm;
 say q{};
 
 # Make sure etc/certs/ exists.
-if (!-d "$bin/../etc") { mkdir "$bin/../etc", 0755; }
-if (!-d "$bin/../etc/certs") { mkdir "$bin/../etc/certs", 0755; }
+if (!-d "$bin{etc}") { mkdir "$bin{etc}", 0755 }
+if (!-d "$bin{etc}/certs") { mkdir "$bin{etc}/certs", 0755 }
 
 # Generate key and cert.
-system 'openssl req -nodes -newkey rsa:2048 -keyout '.$bin.'/../etc/certs/'.$net.'.key -x509 -days 3650 -out '.$bin.'/../etc/certs/'.$net.'.cert';
-chmod 0400, "$bin/../etc/certs/$net.key";
+system "openssl req -nodes -newkey rsa:2048 -keyout $bin{etc}/certs/$net.key -x509 -days 3650 -out $bin{etc}/certs/$net.cert";
+chmod 0400, "$bin{etc}/certs/$net.key";
 
 # Get the fingerprint.
-my $fpr = `openssl x509 -noout -fingerprint < $bin/../etc/certs/$net.cert`;
+my $fpr = `openssl x509 -noout -fingerprint < $bin{etc}/certs/$net.cert`;
 my $fp;
 while ($fpr =~ s/(.*\n)//) {
     my $line = $1;
@@ -44,4 +78,4 @@ while ($fpr =~ s/(.*\n)//) {
 # Print the fingerprint.
 say 'Done. Fingerprint: '.$fp;
 
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

bin/wizard

@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+# bin/wizard - Wizard for creating local Auto configuration directories.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+use 5.010_000;
+use strict;
+use warnings;
+use Cwd;
+use FindBin qw($Bin);
+use File::Copy;
+our $VERSION = 1.00;
+my $Bin = $Bin;
+
+# Get current working directory.
+my $cwd = getcwd();
+
+# One argument required.
+if (!defined $ARGV[0]) {
+    say 'ERROR: Missing arguments.';
+    say 'Usage: auto-wizard <directory>';
+    exit;
+}
+
+# Strip trailing slash.
+my $installdir = $ARGV[0];
+$installdir =~ s/\/$//xsm;
+
+# Create missing directories.
+if (!-d "$cwd/$installdir") { mkdir "$cwd/$installdir" }
+if (!-d "$cwd/$installdir/etc") { mkdir "$cwd/$installdir/etc" }
+if (!-d "$cwd/$installdir/var") { mkdir "$cwd/$installdir/var" }
+
+# Copy over example.conf.
+copy("$Bin/../lib/autobot/3.0.0/dist/example.conf", "$cwd/$installdir/etc/example.conf");
+chmod 0644, "$cwd/$installdir/etc/example.conf";
+
+# Our work is done.
+print <<"MSG";
+Successfully installed to "$cwd/$installdir"!
+
+I've also created an example.conf for you and left it in etc/, configure it and
+rename it to auto.conf or any name of your choice.
+
+See the Xelhua Wiki at http://wiki.xelhua.org for complete documentation.
+
+After that, change directory to "$cwd/$installdir" and run `$Bin/auto` (or if
+"$Bin" is in your PATH; just `auto`).
+
+If you gave your config file a name other than auto.conf, pass -c=FILENAME to
+`auto`, like so, if your config is etc/foo.conf: $Bin/auto -c=foo.conf
+
+Enjoy.
+MSG

doc/CHANGELOG

@@ -2,6 +2,168 @@ Auto IRC Bot 3.0: Change Log
 -------------------------------------------------------------------------------
 
 3.0 Indev
+===============================================================================
+
+
+3.0 Alpha 10
+===============================================================================
+    * Werewolf moved to unstable/ for exclusion from alpha10.
+    * Werewolf: Fixed a bug causing double lynches occasionally.
+    * Werewolf: One bug fix and multiple bullets.
+    * Werewolf: Fixed timeout bug.
+    * Werewolf: Fixed various warnings.
+    * Werewolf: Handful of bugs fixed, timeouts rewritten, wolf assignment
+      rewritten. (see ROLES:Werewolf)
+    * Werewolf: Fixed an annoyance in VOTES.
+    * Werewolf: Fixed another round of bugs.
+    * Werewolf: Fixed a grammatical error. Thanks TAD!
+    * Werewolf: Fixed a bug that occasionally caused a person to get wolf
+      twice in the same game.
+    * Werewolf: Fixed a typo that broke the gun on occasion.
+    * Fixed a minor retract bug in Werewolf.
+    * Fixed two major bugs in Werewolf that messed up game play.
+    * Fixed several bugs and changed around JOIN/START/BEGIN in Werewolf.
+    * Fixed parsing of host masks with / in them. (if it was broken)
+    * Werewolf: Fixed a leave before game begin bug.
+    * Aliases now work in PM's to the bot too.
+    * Added an epic, Werewolf module.
+    * Made slog() saner.
+    * Syntax for mod_init() changed. Package name is no longer required.
+    * Added German translation to Greet help hash. - nridley
+    * Added German translation to FML help hash. - nridley
+    * Added German translation to Eval help hash. - nridley
+    * Added German translation to EightBall help hash. - nridley
+    * Added German translation to Dictionary help hash. - nridley
+    * Added German translation to Calc help hash. - nridley
+    * Added German translation to Bitly help hash. - nridley
+    * Added German translation to AUR help hash. - nridley
+
+3.0 Alpha 9
+===============================================================================
+    * Bug fix: Fixed an exploit in QDB RAND.
+    * UNO: Fixed a formatting issue in duration.
+
+3.0 Alpha 8
+===============================================================================
+    * Full support for custom PREFIX installs (including global installs) has
+      been completed.
+    * Added fastest/slowest game, most cards and most players records to UNO.
+    * Fixed a bug in UNO that allowed users to join more than once.
+    * Added optional uno:english option. See documentation for UNO.
+    * UNO has a new config option, uno:msg, for setting what method the bot
+      uses for private messages.
+    * Added command aliasing.
+    * Moved botinfo to State::IRC.
+    * Added hook on_selfkick for when we are kicked from a channel.
+    * Moved chanusers to State::IRC.
+    * Created State::IRC.
+    * UNO now keeps game duration and cards played count.
+    * Added a LOLCAT module for translating English to LOLCAT.
+    * EightBall module rewritten.
+    * Fixed a bug in LinkTitle that caused multi-line <title>'s to display
+      wrong.
+    * Added `wizard`, for creating local Auto config directories.
+    * Made Auto respond properly to PRIVMSGs received before connection.
+    * Added an AUR module.
+    * Fixed an exploit in QDB that allowed users to use services fantasy
+      commands with the bot's account.
+    * Heavily improved ./install.
+
+3.0 Alpha 7
+===============================================================================
+    * Fixed a bug in UNO where rehashing during a game caused a crash.
+    * Proto::IRC::umodes renamed to Proto::IRC::botinfo{svr}{modes}.
+    * Fixed a bug where incoming PART's from ourselves were not parsed.
+    * Our usermodes are now tracked in Proto::IRC::umodes.
+    * Added an Oper module.
+    * Added events on_cmode and on_umode.
+    * Added event on_myinfo for RPL_MYINFO (numeric 004).
+    * Raw hooks now take hook names and support multiple hooks. This changes
+      rchook_add and rchook_del.
+    * Vim modelines must be at the bottom of files. Modules updated.
+    * Renamed Lib::Users to Core::IRC::Users.
+    * Added Lib::Users, for network-wide user tracking. This brings many new
+      possibilities to modules, including an account system.
+    * Added hook on_namesreply.
+    * All data related to a network is now deleted on disconnect.
+    * Added hook on_disconnect.
+    * Added various options to bin/auto, including support for multiple config
+      files. See bin/auto -h for details.
+    * Changed on_nick, on_quit, on_part, and on_kick source hashrefs to include
+      server, removing svr.
+    * Bumped minimum API version to 3.0.0a7.
+    * Fixed the arguments on_whoreply passes.
+
+3.0 Alpha 6
+===============================================================================
+    * Bug fix: Fixed an issue with SASL timeout.
+    * Added hook on_capack.
+    * CAP is now core.
+    * Fixed a bug with multi-prefix support.
+    * Added fpfmt() to API::Std.
+    * Auto::GR renamed to $Auto::VERGITREV.
+    * Bumped minimum version for API to 3.0.0a6.
+    * Changed on_topic args to: full source hashref, new topic array
+    * on_topic is now triggered for any topic change, regardless of source.
+    * Now parsing numeric 004.
+    * Added hook on_isupport.
+    * Added a BotStats module for returning statistics about the bot.
+    * Now parsing numeric 396.
+    * Added who() to API::IRC.
+    * Added hook on_whoreply.
+    * PRIVMSGs and NOTICEs that would cause a >512 bytes resulting message are
+      now divided into multiple messages.
+    * Renamed botnick to botinfo.
+    * Renamed Parser::IRC to Proto::IRC.
+    * Added an Eval module.
+    * Added an UNO module.
+    * Added on_part hook.
+    
+3.0 Alpha 5
+===============================================================================
+    * Bug fix: Fixed broken rehash.
+    * Ignore PRIVMSG's if they're from an invalid source.
+    * Fixed an odd bug when viewing non-existent quotes.
+    * You can now define how many results are returned by QDB SEARCH/MORE at a
+      time with qdb_search_resnum in the config.
+    * Added SEARCH and MORE to QDB.
+    * Killed EMODS in the starter script and updated MODS
+    * Added core command MODLIST.
+    * Added command level 3 for logchan-only command.
+    * Added a LinkTitle module for getting the title of a web page posted in a
+      channel.
+
+3.0 Alpha 4
+===============================================================================
+    * Added a Dictionary module for looking up definitions of words.
+    * server:ajoin now supports channel keys by spacing the name and key.
+    * Hooks can now block events by returning -1.
+    * bin/buildmod now retrieves the POD from modules and creates man(1) page
+      plus HTML file.
+    * cjoin() now supports a channel key as the last argument.
+    * Added a ChanTopics module for advanced management of channel topics.
+    * bantype is now a required configuration value.
+    * Added ban() to API::IRC.
+    * Changed on_cprivmsg arguments to: \%src, $channel, @msg
+    * Changed on_uprivmsg arguments to: \%src, @msg
+    * Bug fix: Commands getting Permission denied even with incorrect prefix.
+    * Changed command callback arguments to: \%src, @args
+    * Bundle server with \%src in the on_rcjoin event.
+    * logchan is now joined automatically.
+    * Changed on_notice arguments to: \%src, $target, @msg
+    * Clean up shutdown.
+    * Created event on_shutdown.
+    * Shutdown if there are no more IRC connections.
+    * Added the ability to use printf(3) % variables in trans().
+    * Added slog() to API::Log for logging to IRC.
+    * Added a Greet module for greeting users on join.
+    * Added PostgreSQL support. Official modules do not support this yet.
+    * database:format now a required configuration value.
+    * Added support for MySQL. ./install --with-mysql
+    * Added a database upgrade script for upgrading the `qdb` table in 3.0.0a3
+      to the new format used by 3.0.0a4.
+
+3.0 Alpha 3
 ===============================================================================
     * Added command rate limiting.
     * Added module installer to ./install.

doc/CREDITS

@@ -9,6 +9,10 @@ Chazz "Alexandria" Wolcott <alyx@woomoo.org>
 
 Matthew "Mab879" Burket <matthew@assignitapp.com>
 - Spanish translations
+Noah "nridley" Ridley <nridley44@gmail.com>
+- Various.
+Eitan "variable" Adler <lists@eitanadler.com>
+- Werewolf improvements.
 
 -----------------------------------------------
 

doc/TODO

@@ -8,6 +8,8 @@ Legend:
     ? = Being questioned.
     + = Planned for Auto v3.1.
 
+ [ ] Cleanup
+     [ ] Replace println with Perl 5.10's say.
 
  [X] Language
      [X] Create method of translation.
@@ -16,20 +18,23 @@ Legend:
      [X] Add English strings
      [X] Add Spanish strings
      [X] Add French strings
+     [ ] Add Spanish, French and German translations to all official command help hashes.
 
  [!] API
      [X] Create basic modular functions
      [X] Create logging functions
      [X] Create command creation functions
-     [!] Create user permissions (levels)
 
  [!] IRC
      [X] Create IRC parser
 
  [!] DB
-     [X] Create Auto-Flatfile database format
-     [X] Implement Auto-Flatfile as the main format
-     [ ] Add MySQL support
+     [O] Create Auto-Flatfile database format
+     [O] Implement Auto-Flatfile as the main format
+     [X] Add SQLite support as default
+     [x] Add MySQL support
+     [X] Add PostgreSQL support
+     [O] Add Oracle DB support
 
  [O] Sys
      [ ] Create system file for UNIX (or: Linux, BSD, etc.)
@@ -37,18 +42,18 @@ Legend:
 
  [!] Features
      [X] Weather module
-     [!] Urban Dictionary module
-     [ ] UNO module
+     [ ] Urban Dictionary module
+     [X] UNO module
      [ ] Google Search module
      [ ] IRC Relay module
      [ ] (Google?) News module
-     [ ] QDB module
-     [ ] Tumblr module
+     [X] QDB module
+     [!] Tumblr module
      [X] Google Calculator module
      [ ] YouTube Search module
      [ ] Twitter module
-     [!] Advanced Topics module
-     [ ] Custom Triggers module
+     [X] Advanced Topics module
+     [!] Custom Triggers module
      [X] Shorten URL (bit.ly?) module
      [?] Bot Talk module
      [O] Minecraft<->IRC module

doc/WINDOWS

@@ -0,0 +1,18 @@
+Auto IRC Bot 3.0: Microsoft Windows Notes
+===============================================================================
+
+When running Auto on Microsoft Windows, you should be aware of the following:
+
+* Windows support has not been thoroughly tested, some scripts/features may not
+  function correctly.
+* Forking into the background is disabled.
+* Some file system operations may fail if Auto is installed to a path with
+  spaces. Please report these.
+
+For the full power of Auto; run him in a UNIX environment.
+
+Since Windows support can be considered experimental, testers are welcome and
+you should report anything you find to malfunction.
+
+At some point in the future, we hope to achieve Windows support with no core
+caveats. Again, reporting issues in Auto on Windows is highly appreciated.

etc/example.conf

@@ -86,10 +86,37 @@ user "#bot-ops" {
     privs "op";
 }
 
+# Command aliases.
+# These can be used to alias a shortcut to a longer command.
+# Like so: alias "PL UNO PLAY";
+aliases {
+    alias "RELOAD REHASH";
+}
+
+# Database.
+database {
+    # Format. This can be one of the following:
+    #     sqlite    Requires database:filename. Recommended.
+    #     mysql     Requires database:name,host,username,password and that Auto be built with --with-mysql. Optional: database:port
+    #     pgsql     Requires database:name,host,username,password and that Auto be built with --with-pgsql. Optional: database:port
+    format "sqlite";
+    
+    # If you chose SQLite, uncomment this and choose a filename.
+    # filename "somebot.db";
+    
+    # If you chose MySQL or PostgreSQL, uncomment these and set them.
+    # name "auto";
+    # host "localhost";
+    # username "root";
+    # password "moocows";
+}
 
 # Locale.
 locale "en_US";
 
+# Logging to IRC. Uncomment this and set it to setup an IRC logchan.
+# logchan "Freenode/#logchan";
+
 # Expire logs in days. 0 disables.
 expire_logs 15;
 
@@ -103,6 +130,14 @@ ratelimit_time 6;
 # How many commands can be used by a user in each period.
 ratelimit_amount 3;
 
+# Type of ban.
+# 1 - *!*@h
+# 2 - n!*@*
+# 3 - *!u@h
+# 4 - n!*u@h
+# 5 - *!*@*.h+
+bantype 1;
+
 # Module autoload.
 module "HelloChan";
 

install

@@ -6,43 +6,78 @@
 package Install;
 use strict;
 use warnings;
+use Getopt::Long;
 use English qw(-no_match_vars);
 use FindBin qw($Bin);
+use File::Copy;
+use File::Path qw(make_path remove_tree);
 our $Bin = $Bin;
-BEGIN { unshift(@INC, "$Bin/lib"); }
+BEGIN { unshift(@INC, "$Bin/lib") }
 use Lib::Install;
 
 # Installation script.
 our $VERSION = 1.00;
 our $ERROR = 0;
 
-# Iterate through the arguments passed to us.
-my $features = "base ssl";
-if (defined $ARGV[0]) {
-	foreach (@ARGV) {
-		if ($_ eq "-h" or $_ eq "--help") {
-			println "*** ./install help ***";
-			println " --enable-sasl - Enable support for SASL.";
-            println " --enable-ipv6 - Enable support for IPv6.";
-            println " --disable-ssl - Disable support for SSL.";
-			println "*** End of Help ***";
-			exit;
-		}
-		elsif ($_ eq "--enable-sasl") {
-			$features .= " sasl";
-		}
-        elsif ($_ eq "--disable-ssl") {
-            $features =~ s/ ssl//g;
-        }
-        elsif ($_ eq "--enable-ipv6") {
-            $features .= " ipv6";
-        }
-		else {
-			println "Warning: Unknown option '".$_."'";
-		}
-	}
+# Store the arguments passed to us.
+my ($opt_help, $opt_syswide, $PREFIX, $feature_nossl, $feature_sasl, $feature_ipv6, $feature_mysql, $feature_pgsql);
+GetOptions(
+    '--disable-ssl'    => \$feature_nossl,
+    '--enable-sasl'    => \$feature_sasl,
+    '--enable-ipv6'    => \$feature_ipv6,
+    '--with-mysql'     => \$feature_mysql,
+    '--with-pgsql'     => \$feature_pgsql,
+    '--prefix=s'       => \$PREFIX,
+    '--syswide'        => \$opt_syswide,
+    '--help'           => \$opt_help,
+);
+
+# If --help was passed.
+if ($opt_help) {
+    print <<"HELP";
+
+Auto IRC Bot Installation Wizard (v1.00).
+Usage: perl install [options]
+
+Options:
+    --disable-ssl  Disables SSL support.
+    --enable-sasl  Enables SASL support.
+    --enable-ipv6  Enables IPv6 support.
+    --with-mysql   Uses MySQL instead of SQLite.
+    --with-pgsql   Uses PostgreSQL instead of SQLite.
+    --syswide      Prefixes bin/ files with auto- (excluding `auto` itself), as
+                   well as installs build/ to lib/ instead. Always use this
+                   when installing to /usr.
+
+    --prefix=PREFIX  Installs files to PREFIX
+                     [$Bin]
+
+HELP
+    exit 1;
 }
 
+# Set features.
+my $features = 'base';
+$features .= ' ssl' unless $feature_nossl;
+$features .= ' sasl' if $feature_sasl;
+$features .= ' ipv6' if $feature_ipv6;
+if ($feature_mysql) { $features .= ' mysql' }
+elsif ($feature_pgsql) { $features .= ' pgsql' }
+else { $features .= ' sqlite' }
+
+# Where to install.
+my $upref;
+if (!$PREFIX) {
+    $PREFIX = $Bin;
+    $upref = 0;
+}
+else { $upref = 1 }
+
+# Adjust installation to be more appropriate for system-wide installs.
+my $libbuild = 0;
+if ($opt_syswide) { $libbuild = 1 }
+
+
 # Check Perl version.
 println "Checking Perl version..... $^V";
 eval {
@@ -52,32 +87,39 @@ eval {
 # Check operating system.
 print "Checking operating system..... $OSNAME - ";
 if ($OSNAME =~ /dos/i) {
-	print "DOS is not supported.\r\n";
+    print "DOS is not supported.\r\n";
+    exit;
 }
 elsif ($OSNAME eq "MSWin32") {
-	print "Microsoft Windows is not supported. Support is planned for the future.\r\n";
+    print "OK\r\n";
 }
 elsif ($OSNAME eq "NetWare") {
-	print "NetWare is not supported.\r\n";
+    print "NetWare is not supported.\r\n";
+    exit;
 }
 elsif ($OSNAME eq "linux") {
-	print "OK\n";
+    print "OK\n";
 }
 elsif ($OSNAME eq "os2") {
-	print "IBM OS/2 is not supported.\r\n";
+    print "IBM OS/2 is not supported.\r\n";
+    exit;
 }
 elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
-	print "OK\r";
+    print "OK\r";
 }
 elsif ($OSNAME eq "freebsd") {
-	print "OK\n";
+    print "OK\n";
 }
 elsif ($OSNAME eq "openbsd") {
-	print "OK\n";
+    print "OK\n";
+}
+elsif ($OSNAME eq "solaris") {
+    print "OK\n";
 }
 else {
-	print "Unknown operating system. Contact support.\r\n";
-}		
+    print "Unknown operating system. Contact support.\r\n";
+    exit;
+}    	
 
 # Check for Perl core modules.
 println "Checking for core Perl modules.....";
@@ -97,7 +139,9 @@ println 'Checking for required CPAN modules......';
 println "\0";
 #modfind("Mouse");
 modfind('DBI');
-modfind('DBD::SQLite');
+modfind('DBD::SQLite') if $features =~ /sqlite/;
+modfind('DBD::mysql') if $features =~ /mysql/;
+modfind('DBD::Pg') if $features =~ /pgsql/;
 modfind('Class::Unload');
 modfind('IO::Socket::INET6') if $features =~ /ipv6/;
 modfind('IO::Socket::SSL') if $features =~ /ssl/;
@@ -115,30 +159,66 @@ else {
 # Create build.
 println "\0";
 println "Building.....";
-if (!-d "$Bin/build") {
-	system "mkdir $Bin/build";
-}
-if (!-e "$Bin/build/time") {
-	system "touch $Bin/build/time";
-}
-if (!-e "$Bin/build/os") {
-	system "touch $Bin/build/os";
-}
-if (!-e "$Bin/build/perl") {
-	system "touch $Bin/build/perl";
-}
-if (!-e "$Bin/build/ver") {
-	system "touch $Bin/build/ver";
+if (!-d $PREFIX) { make_path($PREFIX) }
+my $libdir;
+if ($libbuild) { $libdir = "$PREFIX/lib/autobot/3.0.0" }
+else { $libdir = "$PREFIX/lib" }
+my $builddir;
+if ($libbuild) { $builddir = "$libdir/build" }
+else { $builddir = "$PREFIX/build" }
+if (!-d $builddir) { make_path($builddir) }
+build($features, $builddir, $opt_syswide);
+
+# Install.
+if ($upref) {
+    require File::Copy::Recursive;
+    File::Copy::Recursive->import('rcopy');
+    my $langdir;
+    if ($libbuild) { $langdir = "$libdir/lang" }
+    else { $langdir = "$PREFIX/lang" }
+    my $moddir;
+    if ($libbuild) { $moddir = "$libdir/modules" }
+    else { $moddir = "$PREFIX/modules" }
+    my $distdir;
+    if ($libbuild) { $distdir = "$libdir/dist" }
+    else { $distdir = "$PREFIX/dist" }
+    println "Installing.....";
+    if (!-d "$PREFIX/bin") { make_path("$PREFIX/bin") }
+    if (!-d $libdir) { make_path($libdir) }
+    if (!-d $langdir) { make_path($langdir) }
+    if (!-d $moddir) { make_path($moddir) }
+    if (!-d $distdir) { make_path($distdir) }
+
+    my $bgenssl = 'genssl';
+    my $bbuildmod = 'buildmod';
+    my $bwizard = 'wizard';
+    if ($libbuild) {
+        $bgenssl = "auto-$bgenssl";
+        $bbuildmod = "auto-$bbuildmod";
+        $bwizard = "auto-$bwizard";
+    }
+    copy("$Bin/bin/auto", "$PREFIX/bin/auto");
+    copy("$Bin/bin/buildmod", "$PREFIX/bin/$bbuildmod");
+    copy("$Bin/bin/genssl", "$PREFIX/bin/$bgenssl");
+    copy("$Bin/bin/wizard", "$PREFIX/bin/$bwizard");
+    chmod 0755, "$PREFIX/bin/auto", "$PREFIX/bin/$bgenssl", "$PREFIX/bin/$bbuildmod", "$PREFIX/bin/$bwizard";
+    rcopy("$Bin/lib/*", "$libdir/");
+    rcopy("$Bin/lang/*", "$langdir/");
+    rcopy("$Bin/modules/*", "$moddir/");
+    copy("$Bin/etc/example.conf", "$distdir/");
+    remove_tree("$libdir/File");
 }
 
-build($features);
 println 'Done.';
 
 println q{};
-installmods();
+if ($libbuild) {
+    println 'To install modules, run the auto-buildmod utility on a module.';
+}
+else { installmods($PREFIX) }
 println q{};
 
 # Success!
 println "Done. Auto successfully installed.";
 
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/API/IRC.pm

@@ -4,83 +4,125 @@
 package API::IRC;
 use strict;
 use warnings;
+use feature qw(switch);
 use Exporter;
+use base qw(Exporter);
 
-our @ISA       = qw(Exporter);
-our @EXPORT_OK = qw(cjoin cpart cmode umode kick privmsg notice quit nick names topic
-					usrc match_mask);
+our @EXPORT_OK = qw(ban cjoin cpart cmode umode kick privmsg notice quit nick names
+                    topic who usrc match_mask);
 
+# Create the on_disconnect event.
+API::Std::event_add('on_disconnect');
+
+# Set a ban, based on config bantype value.
+sub ban {
+    my ($svr, $chan, $type, $user) = @_;
+    my $cbt = (API::Std::conf_get('bantype'))[0][0];
+
+    # Prepare the mask we're going to ban.
+    my $mask;
+    given ($cbt) {
+        when (1) { $mask = '*!*@'.$user->{host} }
+        when (2) { $mask = $user->{nick}.'!*@*' }
+        when (3) { $mask = q{*!}.$user->{user}.q{@}.$user->{host} }
+        when (4) { $mask = $user->{nick}.q{!*}.$user->{user}.q{@}.$user->{host} }
+        when (5) {
+            my @hd = split m/[\.]/, $user->{host};
+            shift @hd;
+            $mask = '*!*@*.'.join q{ }, @hd;
+        }
+    }
+
+    # Now set the ban.
+    if (lc $type eq 'b') {
+        # We were requested to set a regular ban.
+        cmode($svr, $chan, "+b $mask");
+    }
+    elsif (lc $type eq 'q') {
+        # We were requested to set a ratbox-style quiet.
+        cmode($svr, $chan, "+q $mask");
+    }
+
+    return 1;
+}
 
 # Join a channel.
-sub cjoin 
-{
-	my ($svr, $chan) = @_;
-	
-	Auto::socksnd($svr, "JOIN $chan");
-	
-	return 1;
+sub cjoin {
+    my ($svr, $chan, $key) = @_;
+
+    Auto::socksnd($svr, 'JOIN '.((defined $key) ? "$chan $key" : $chan));
+
+    return 1;
 }
 
 # Part a channel.
-sub cpart 
-{
-	my ($svr, $chan, $reason) = @_;
-	
-	if (defined $reason) {
-		Auto::socksnd($svr, "PART $chan :$reason");
-	}
-	else {
-		Auto::socksnd($svr, "PART $chan :Leaving");
-	}
+sub cpart {
+    my ($svr, $chan, $reason) = @_;
 
-    if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; }
-	
-	return 1;
+    if (defined $reason) {
+        Auto::socksnd($svr, "PART $chan :$reason");
+    }
+    else {
+        Auto::socksnd($svr, "PART $chan :Leaving");
+    }
+
+    return 1;
 }
 
 # Set mode(s) on a channel.
-sub cmode 
-{
-	my ($svr, $chan, $modes) = @_;
+sub cmode {
+    my ($svr, $chan, $modes) = @_;
 
-	Auto::socksnd($svr, "MODE $chan $modes");
-	
-	return 1;
+    Auto::socksnd($svr, "MODE $chan $modes");
+
+    return 1;
 }
 
 # Set mode(s) on us.
-sub umode 
-{
-	my ($svr, $modes) = @_;
-	
-	Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
-	
-	return 1;
-} 
+sub umode {
+    my ($svr, $modes) = @_;
+
+    Auto::socksnd($svr, 'MODE '.$State::IRC::botinfo{$svr}{nick}." $modes");
+
+    return 1;
+}
 
 # Send a PRIVMSG.
-sub privmsg 
-{
-	my ($svr, $target, $message) = @_;
-	
-	Auto::socksnd($svr, "PRIVMSG $target :$message");
-	
-	return 1;
+sub privmsg {
+    my ($svr, $target, $message) = @_;
+
+    # Get maximum length.
+    my $maxlen = 510 - length q{:}.$State::IRC::botinfo{$svr}{nick}.q{!}.$State::IRC::botinfo{$svr}{user}.q{@}.$State::IRC::botinfo{$svr}{mask}." PRIVMSG $target :";
+
+    # Divide message if it surpasses the maximum length.
+    while (length $message >= $maxlen) {
+        my $submsg = substr $message, 0, $maxlen, q{};
+        Auto::socksnd($svr, "PRIVMSG $target :$submsg");
+    }
+    if (length $message) { Auto::socksnd($svr, "PRIVMSG $target :$message") }
+
+    return 1;
 }
 
 # Send a NOTICE.
-sub notice 
-{
-	my ($svr, $target, $message) = @_;
-	
-	Auto::socksnd($svr, "NOTICE $target :$message");
-	
-	return 1;
+sub notice {
+    my ($svr, $target, $message) = @_;
+
+    # Get maximum length.
+    my $maxlen = 510 - length q{:}.$State::IRC::botinfo{$svr}{nick}.q{!}.$State::IRC::botinfo{$svr}{user}.q{@}.$State::IRC::botinfo{$svr}{mask}." NOTICE $target :";
+
+    # Divide message if it surpasses the maximum length.
+    while (length $message >= $maxlen) {
+        my $submsg = substr $message, 0, $maxlen, q{};
+        Auto::socksnd($svr, "NOTICE $target :$submsg");
+    }
+    if (length $message) { Auto::socksnd($svr, "NOTICE $target :$message") }
+
+    return 1;
 }
 
 # Send an ACTION PRIVMSG.
-sub act
-{
+sub act {
     my ($svr, $target, $message) = @_;
 
     Auto::socksnd($svr, "PRIVMSG $target :\001ACTION $message\001");
@@ -89,100 +131,102 @@ sub act
 }
 
 # Change bot nickname.
-sub nick 
-{
-	my ($svr, $newnick) = @_;
-	
-	Auto::socksnd($svr, "NICK $newnick");
-	
-	$Parser::IRC::botnick{$svr}{newnick} = $newnick;
-	
-	return 1;
+sub nick {
+    my ($svr, $newnick) = @_;
+
+    Auto::socksnd($svr, "NICK $newnick");
+
+    $State::IRC::botinfo{$svr}{newnick} = $newnick;
+
+    return 1;
 }
 
 # Request the users of a channel.
-sub names
-{
-	my ($svr, $chan) = @_;
-	
-	Auto::socksnd($svr, "NAMES $chan");
-	
-	return 1;
+sub names {
+    my ($svr, $chan) = @_;
+
+    Auto::socksnd($svr, "NAMES $chan");
+
+    return 1;
 }
 
 # Send a topic to the channel.
-sub topic
-{
-	my ($svr, $chan, $topic) = @_;
-	
-	Auto::socksnd($svr, "TOPIC $chan :$topic");
-	
-	return 1;
+sub topic {
+    my ($svr, $chan, $topic) = @_;
+
+    Auto::socksnd($svr, "TOPIC $chan :$topic");
+
+    return 1;
 }
 
 # Kick a user.
-sub kick
-{
+sub kick {
     my ($svr, $chan, $nick, $msg) = @_;
 
-    Auto::socksnd($svr, "KICK $chan $nick :$msg");
+    Auto::socksnd($svr, "KICK $chan $nick :".((defined $msg) ? $msg : 'No reason'));
 
     return 1;
 }
 
 # Quit IRC.
-sub quit 
-{
-	my ($svr, $reason) = @_;
-	
-	if (defined $reason) {
-		Auto::socksnd($svr, "QUIT :$reason");
-	}
-	else {
-		Auto::socksnd($svr, "QUIT :Leaving");
-	}
-	
-	delete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr});
-	delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr});
-	
-	return 1;
+sub quit {
+    my ($svr, $reason) = @_;
+
+    if (defined $reason) {
+        Auto::socksnd($svr, "QUIT :$reason");
+    }
+    else {
+        Auto::socksnd($svr, 'QUIT :Leaving');
+    }
+
+    # Trigger on_disconnect.
+    API::Std::event_run('on_disconnect', $svr);
+
+    return 1;
 }
 
+# Send a WHO.
+sub who {
+    my ($svr, $nick) = @_;
+
+    Auto::socksnd($svr, "WHO $nick");
+
+    return 1;
+}
 
 # Get nick, ident and host from a <nick>!<ident>@<host>
-sub usrc
-{
-	my ($ex) = @_;
-	
-	my @si = split('!', $ex);
-	my @sii = split('@', $si[1]);
-	
-	return (
-		nick  => $si[0],
-		user => $sii[0],
-		host  => $sii[1]
-	);
+sub usrc {
+    my ($ex) = @_;
+
+    my @si = split m/[!]/xsm, $ex;
+    my @sii = split m/[@]/xsm, $si[1];
+
+    return (
+        nick  => $si[0],
+        user => $sii[0],
+        host  => $sii[1]
+    );
 }
 
 # Match two IRC masks.
-sub match_mask
-{
-	my ($mu, $mh) = @_;
-	
-	# Prepare the regex.
-	$mh =~ s/\./\\\./g;
-	$mh =~ s/\?/\./g;
-	$mh =~ s/\*/\.\*/g;
-	$mh = '^'.$mh.'$';
-	
-	# Let's grep the user's mask.
-	if (grep(/$mh/, $mu)) {
-		return 1;
-	}
-	
-	return 0;
+sub match_mask {
+    my ($mu, $mh) = @_;
+
+    # Prepare the regex.
+    $mh =~ s/\./\\\./gxsm;
+    $mh =~ s/\?/\./gxsm;
+    $mh =~ s/\*/\.\*/gxsm;
+    $mh =~ s/\//\\\//gxsm;
+    $mh = q{^}.$mh.q{$};
+
+    # Let's match the user's mask.
+    if ($mu =~ m/$mh/xsm) {
+        return 1;
+    }
+
+    return;
 }
 
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/API/Log.pm

@@ -4,24 +4,25 @@
 package API::Log;
 use strict;
 use warnings;
+use feature qw(say);
 use English qw(-no_match_vars);
 use POSIX;
 use Time::Local;
 use Exporter;
 use base qw(Exporter);
-use API::Std qw(conf_get);
+use API::Std qw(conf_get fpfmt);
 
-our @EXPORT_OK = qw(println dbug alog);
+our @EXPORT_OK = qw(println dbug alog slog);
 
 
 # Print with the system newline appended.
 sub println
 {
-	my ($out) = @_;
+    my ($out) = @_;
 
-	if (!defined $out) {
-		print $RS;
-	}
+    if (!defined $out) {
+        print $RS;
+    }
     else {
         print $out.$RS;
     }
@@ -32,81 +33,113 @@ sub println
 # Print only if in debug mode.
 sub dbug
 {
-	my ($out) = @_;
+    my ($out) = @_;
 
-	if ($Auto::DEBUG) {
-		# We're in debug mode; print it out.
-		println $out;
-	}
+    if ($Auto::DEBUG) {
+        # We're in debug mode; print it out.
+        say $out;
+    }
 
-	return 1;
+    return 1;
 }
 
 # Log to file.
 sub alog
 {
-	my ($lmsg) = @_;
+    my ($lmsg) = @_;
 
-	# Expire old logs first.
-	expire_logs();
+    # Expire old logs first.
+    expire_logs();
 
-	# Get date and time in the desired format.
-	my $date = POSIX::strftime('%Y%m%d', localtime);
-	my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
+    # Get date and time in the desired format.
+    my $date = POSIX::strftime('%Y%m%d', localtime);
+    my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
 
-	# Create var/ if it doesn't exist.
-	if (!-d "$Auto::Bin/../var") {
-		mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
-	}
-	# Create var/DATE.log if it doesn't exist.
-	if (!-e "$Auto::Bin/../var/$date.log") {
-		system "touch $Auto::Bin/../var/$date.log";
-	}
+    # Create var/ if it doesn't exist.
+    if (!-d "$Auto::bin{var}") {
+        mkdir "$Auto::bin{var}", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
+    }
 
-	# Open the logfile, print the log message to it and close it.
-	open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
-	print {$FLOG} "[$time] $lmsg\n" or return;
-	close $FLOG or return;
+    # Open the logfile, print the log message to it and close it.
+    open my $FLOG, '>>', "$Auto::bin{var}/$date.log" or return;
+    print {$FLOG} "[$time] $lmsg\n" or return;
+    close $FLOG or return;
 
-	return 1;
+    return 1;
 }
 
 # Expire old logs.
 sub expire_logs
 {
-	# Get configuration value.
-	my $celog = (conf_get('expire_logs'))[0][0] or return;
+    # Get configuration value.
+    my $celog = (conf_get('expire_logs'))[0][0] or return;
 
-	# Check for invalid values.
-	if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-		# Must be numbers only.
-		return;
-	}
-	elsif (!$celog) {
-		# No expire.
-		return;
-	}
+    # Check for invalid values.
+    if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+        # Must be numbers only.
+        return;
+    }
+    elsif (!$celog) {
+        # No expire.
+        return;
+    }
 
-	# Iterate through each logfile.
-	foreach my $file (glob "$Auto::Bin/../var/*") {
-		my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
+    # Iterate through each logfile.
+    foreach my $file (glob fpfmt("$Auto::bin{var}/*")) {
+        my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
 
-		# Convert filename to UNIX time.
-		my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
-		my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
-		$mm = $mm - 1;
-		my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
-		my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
+        # Convert filename to UNIX time.
+        my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
+        my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
+        $mm = $mm - 1;
+        my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
+        my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
 
-		# If it's older than <config_value> days, delete it.
-		if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
-			unlink "$Auto::Bin/../var/$file";
-		}
-	}
+        # If it's older than <config_value> days, delete it.
+        if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
+            unlink "$Auto::bin{var}/$file";
+        }
+    }
 
-	return 1;
+    return 1;
 }
 
+# Subroutine for logging to an IRC logchan.
+sub slog
+{
+    my ($msg) = @_;
+
+    # Check if logging to channel is enabled.
+    if (conf_get('logchan')) {
+        # It is, continue.
+
+        # Don't even bother with continuing if there are *NO* connections.
+        if (!keys %Auto::SOCKET) { return }
+
+        # Split the network and channel.
+        my ($net, $chan) = split m/[\/]/xsm, (conf_get('logchan'))[0][0];
+        $chan = lc $chan;
+
+        # Check if we're connected to the network.
+        if (!defined $Auto::SOCKET{$net}) {
+            dbug 'WARNING: slog(): Unable to log to IRC: Not connected to network.';
+            alog 'WARNING: slog(): Unable to log to IRC: Not connected to network.';
+            return;
+        }
+
+        # Check if we're in the channel.
+        if (!defined $Proto::IRC::botchans{$net}{$chan}) {
+            dbug 'WARNING: slog(): Unable to log to IRC: Not in channel.';
+            alog 'WARNING: slog(): Unable to log to IRC: Not in channel.';
+            return;
+        }
+
+        # Log to IRC.
+        API::IRC::privmsg($net, $chan, "\002LOG:\002 $msg");
+    }
+
+    return 1;
+}
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/API/Std.pm

@@ -4,358 +4,373 @@
 package API::Std;
 use strict;
 use warnings;
+use feature qw(say);
 use Exporter;
 use base qw(Exporter);
 
 
-our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
+our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS, %ALIASES, %RAWHOOKS);
 our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add 
-					cmd_del hook_add hook_del rchook_add rchook_del match_user
-					has_priv mod_exists ratelimit_check);
+                    cmd_del hook_add hook_del rchook_add rchook_del match_user
+                    has_priv mod_exists ratelimit_check fpfmt);
 
 
 # Initialize a module.
-sub mod_init
-{
-	my ($name, $author, $version, $autover, $pkg) = @_;
+sub mod_init {
+    my ($name, $author, $version, $autover) = @_;
+    my $pkg = caller 0;
 
     # Log/debug.
-	API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
-	API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
+    API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
+    API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
+    if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...') }
 
     # Check if this module is compatible with this version of Auto.
-	if ($autover ne '3.0.0d') {
-		API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
-		API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
-		return;
-	}
+    if ($autover !~ m/^3\.0\.0a(7|8|9|10)$/xsm) {
+        API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
+        API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
+        if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.') }
+        return;
+    }
 
-	# Run the module's _init sub.
+    # Run the module's _init sub.
     my $mi = eval($pkg.'::_init();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
 
-	if ($mi) {
-		# If successful, add to hash.
-		$MODULE{$name}{name}    = $name;
-		$MODULE{$name}{version} = $version;
-		$MODULE{$name}{author}  = $author;
-		$MODULE{$name}{pkg}     = $pkg;
+    if ($mi) {
+        # If successful, add to hash.
+        $MODULE{$name}{name}    = $name;
+        $MODULE{$name}{version} = $version;
+        $MODULE{$name}{author}  = $author;
+        $MODULE{$name}{pkg}     = $pkg;
 
-		API::Log::dbug('MODULES: '.$name.' successfully loaded.');
-		API::Log::alog('MODULES: '.$name.' successfully loaded.');
+        API::Log::dbug('MODULES: '.$name.' successfully loaded.');
+        API::Log::alog('MODULES: '.$name.' successfully loaded.');
+        if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.') }
 
-		return 1;
-	}
-	else {
-		# Otherwise, return a failed to load message.
-		API::Log::dbug('MODULES: Failed to load '.$name.q{.});
-		API::Log::alog('MODULES: Failed to load '.$name.q{.});
+        return 1;
+    }
+    else {
+        # Otherwise, return a failed to load message.
+        API::Log::dbug('MODULES: Failed to load '.$name.q{.});
+        API::Log::alog('MODULES: Failed to load '.$name.q{.});
+        if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}) }
+        # Just in case.
+        Class::Unload->unload($pkg);
 
-		return;
-	}
+        return;
+    }
 }
 
 # Check if a module exists.
-sub mod_exists
-{
-	my ($name) = @_;
+sub mod_exists {
+    my ($name) = @_;
 
-	if (defined $API::Std::MODULE{$name}) { return 1; }
+    if (defined $API::Std::MODULE{$name}) { return 1 }
 
-	return;
+    return;
 }
 
 # Void a module.
-sub mod_void
-{
-	my ($module) = @_;
+sub mod_void {
+    my ($module) = @_;
 
-	# Log/debug.
-	API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
-	API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
+    # Log/debug.
+    API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
+    API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
+    if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...') }
 
-	# Check if this module exists.
-	if (!defined $MODULE{$module}) {
-		API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
-		API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
-		return;
-	}
+    # Check if this module exists.
+    if (!defined $MODULE{$module}) {
+        API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
+        API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
+        if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?') }
+        return;
+    }
 
-	# Run the module's _void sub.
+    # Run the module's _void sub.
     my $mi = eval($MODULE{$module}{pkg}.'::_void();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
 
-	if ($mi) {
-		# If successful, delete class from program and delete module from hash.
-		Class::Unload->unload($MODULE{$module}{pkg});
-		delete $MODULE{$module};
-		API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
-		API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
-		return 1;
-	}
-	else {
-		# Otherwise, return a failed to unload message.
-		API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
-		API::Log::alog('MODULES: Failed to unload '.$module.q{.});
-		return;
-	}
+    if ($mi) {
+        # If successful, delete class from program and delete module from hash.
+        Class::Unload->unload($MODULE{$module}{pkg});
+        delete $MODULE{$module};
+        API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
+        API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
+        if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}) }
+        return 1;
+    }
+    else {
+        # Otherwise, return a failed to unload message.
+        API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
+        API::Log::alog('MODULES: Failed to unload '.$module.q{.});
+        if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}) }
+        return;
+    }
 }
 
 # Add a command to Auto.
-sub cmd_add
-{
-	my ($cmd, $lvl, $priv, $help, $sub) = @_;
-	$cmd = uc $cmd;
+sub cmd_add {
+    my ($cmd, $lvl, $priv, $help, $sub) = @_;
+    $cmd = uc $cmd;
 
-	if (defined $API::Std::CMDS{$cmd}) { return; }
-	if ($lvl =~ m/[^0-2]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+    if (defined $API::Std::CMDS{$cmd}) { return }
+    if ($lvl =~ m/[^0-3]/sm) { return } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
 
-	$API::Std::CMDS{$cmd}{lvl}   = $lvl;
-	$API::Std::CMDS{$cmd}{help}  = $help;
-	$API::Std::CMDS{$cmd}{priv}  = $priv;
-	$API::Std::CMDS{$cmd}{sub}   = $sub;
+    $API::Std::CMDS{$cmd}{lvl}   = $lvl;
+    $API::Std::CMDS{$cmd}{help}  = $help;
+    $API::Std::CMDS{$cmd}{priv}  = $priv;
+    $API::Std::CMDS{$cmd}{'sub'} = $sub;
 
-	return 1;
+    return 1;
 }
 
+# Alias a command to another.
+sub cmd_alias {
+    my ($alias, $cmd) = @_;
+    
+    # Prepare data.
+    $alias = uc $alias;
+    $cmd = uc $cmd;
+    
+    # Create alias.
+    $ALIASES{$alias} = $cmd;
+
+    return 1;
+}
 
 # Delete a command from Auto.
-sub cmd_del
-{
-	my ($cmd) = @_;
-	$cmd = uc $cmd;
+sub cmd_del {
+    my ($cmd) = @_;
+    $cmd = uc $cmd;
 
-	if (defined $API::Std::CMDS{$cmd}) {
-		delete $API::Std::CMDS{$cmd};
-	}
-	else {
-		return;
-	}
+    if (defined $API::Std::CMDS{$cmd}) {
+        delete $API::Std::CMDS{$cmd};
+    }
+    else {
+        return;
+    }
 
-	return 1;
+    return 1;
 }
 
 # Add an event to Auto.
-sub event_add
-{
-	my ($name) = @_;
+sub event_add {
+    my ($name) = @_;
 
-	if (!defined $EVENTS{lc $name}) {
-		$EVENTS{lc $name} = 1;
-		return 1;
-	}
-	else {
-		API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...');
-		return;
-	}
+    if (!defined $EVENTS{lc $name}) {
+        $EVENTS{lc $name} = 1;
+        return 1;
+    }
+    else {
+        API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...');
+        return;
+    }
 }
 
 # Delete an event from Auto.
-sub event_del
-{
-	my ($name) = @_;
+sub event_del {
+    my ($name) = @_;
 
-	if (defined $EVENTS{lc $name}) {
-		delete $EVENTS{lc $name};
-		delete $HOOKS{lc $name};
-		return 1;
-	}
-	else {
-		API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...');
-		return;
-	}
+    if (defined $EVENTS{lc $name}) {
+        delete $EVENTS{lc $name};
+        delete $HOOKS{lc $name};
+        return 1;
+    }
+    else {
+        API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...');
+        return;
+    }
 }
 
 # Trigger an event.
-sub event_run
-{
-	my ($event, @args) = @_;
+sub event_run {
+    my ($event, @args) = @_;
 
-	if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
-		foreach my $hk (keys %{ $HOOKS{lc $event} }) {
-			&{ $HOOKS{lc $event}{$hk} }(@args);
-		}
-	}
+    if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
+        foreach my $hk (keys %{ $HOOKS{lc $event} }) {
+            my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
+            if ($ri == -1) { last }
+        }
+    }
 
-	return 1;
+    return 1;
 }
 
 # Add a hook to Auto.
-sub hook_add
-{
-	my ($event, $name, $sub) = @_;
+sub hook_add {
+    my ($event, $name, $sub) = @_;
 
-	if (!defined $API::Std::HOOKS{lc $name}) {
-		if (defined $API::Std::EVENTS{lc $event}) {
-			$API::Std::HOOKS{lc $event}{lc $name} = $sub;
-			return 1;
-		}
-		else {
-			return;
-		}
-	}
-	else {
-		return;
-	}
+    if (!defined $API::Std::HOOKS{lc $name}) {
+        if (defined $API::Std::EVENTS{lc $event}) {
+            $API::Std::HOOKS{lc $event}{lc $name} = $sub;
+            return 1;
+        }
+        else {
+            return;
+        }
+    }
+    else {
+        return;
+    }
 }
 
 # Delete a hook from Auto.
-sub hook_del
-{
-	my ($event, $name) = @_;
+sub hook_del {
+    my ($event, $name) = @_;
 
-	if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
-		delete $API::Std::HOOKS{lc $event}{lc $name};
-		return 1;
-	}
-	else {
-		return;
-	}
+    if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
+        delete $API::Std::HOOKS{lc $event}{lc $name};
+        return 1;
+    }
+    else {
+        return;
+    }
 }
 
 # Add a timer to Auto.
-sub timer_add
-{
-	my ($name, $type, $time, $sub) = @_;
-	$name = lc $name;
+sub timer_add {
+    my ($name, $type, $time, $sub) = @_;
+    $name = lc $name;
 
-	# Check for invalid type/time.
-	if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-		return;
-	}
-	if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-		return;
-	}
+    # Check for invalid type/time.
+    if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+        return;
+    }
+    if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+        return;
+    }
 
-	if (!defined $Auto::TIMERS{$name}) {
-		$Auto::TIMERS{$name}{type} = $type;
-		$Auto::TIMERS{$name}{time} = time + $time;
-		if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
-		$Auto::TIMERS{$name}{sub}  = $sub;
-		return 1;
-	}
+    if (!defined $Auto::TIMERS{$name}) {
+        $Auto::TIMERS{$name}{type} = $type;
+        $Auto::TIMERS{$name}{time} = time + $time;
+        if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time }
+        $Auto::TIMERS{$name}{sub}  = $sub;
+        return 1;
+    }
 
     return 1;
 }
 
 # Delete a timer from Auto.
-sub timer_del
-{
-	my ($name) = @_;
-	$name = lc $name;
+sub timer_del {
+    my ($name) = @_;
+    $name = lc $name;
 
-	if (defined $Auto::TIMERS{$name}) {
-		delete $Auto::TIMERS{$name};
-		return 1;
-	}
+    if (defined $Auto::TIMERS{$name}) {
+        delete $Auto::TIMERS{$name};
+        return 1;
+    }
 
-	return;
+    return;
 }
 
 # Hook onto a raw command.
-sub rchook_add
-{
-	my ($cmd, $sub) = @_;
-	$cmd = uc $cmd;
+sub rchook_add {
+    my ($cmd, $name, $sub) = @_;
+    $cmd = uc $cmd;
 
-	if (defined $Parser::IRC::RAWC{$cmd}) { return; }
+    # Make sure core doesn't already handle this.
+    if (defined $Proto::IRC::RAWC{$cmd}) { return }
+    # If the hook already exists, ignore it.
+    if (defined $RAWHOOKS{$cmd}{$name}) { return }
+    
+    # Create the hook.
+    $RAWHOOKS{$cmd}{$name} = $sub;
 
-	$Parser::IRC::RAWC{$cmd} = $sub;
-
-	return 1;
+    return 1;
 }
 
 # Delete a raw command hook.
-sub rchook_del
-{
-	my ($cmd) = @_;
-	$cmd = uc $cmd;
+sub rchook_del {
+    my ($cmd, $name) = @_;
+    $cmd = uc $cmd;
 
-	if (!defined $Parser::IRC::RAWC{$cmd}) { return; }
+    # Make sure the hook exists.
+    if (!defined $RAWHOOKS{$cmd}{$name}) { return }
 
-	delete $Parser::IRC::RAWC{$cmd};
+    # Delete it.
+    delete $RAWHOOKS{$cmd}{$name};
 
-	return 1;
+    return 1;
 }
 
 # Configuration value getter.
-sub conf_get
-{
-	my ($value) = @_;
+sub conf_get {
+    my ($value) = @_;
 
-	# Create an array out of the value.
-	my @val;
-	if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-		@val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-	}
-	else {
-		@val = ($value);
-	}
-	# Undefine this as it's unnecessary now.
-	undef $value;
+    # Create an array out of the value.
+    my @val;
+    if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+        @val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+    }
+    else {
+        @val = ($value);
+    }
+    # Undefine this as it's unnecessary now.
+    undef $value;
 
-	# Get the count of elements in the array.
-	my $count = scalar @val;
+    # Get the count of elements in the array.
+    my $count = scalar @val;
 
-	# Return the requested configuration value(s).
-	if ($count == 1) {
-		if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') {
-			return %{ $Auto::SETTINGS{$val[0]} };
-		}
-		else {
-			return $Auto::SETTINGS{$val[0]};
-		}
-	}
-	elsif ($count == 2) {
-		if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') {
-			return %{ $Auto::SETTINGS{$val[0]}{$val[1]} };
-		}
-		else {
-			return $Auto::SETTINGS{$val[0]}{$val[1]};
-		}
-	}
-	elsif ($count == 3) {
-		if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') {
-			return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} };
-		}
-		else {
-			return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]};
-		}
-	}
-	else {
-		return;
-	}
+    # Return the requested configuration value(s).
+    if ($count == 1) {
+        if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') {
+            return %{ $Auto::SETTINGS{$val[0]} };
+        }
+        else {
+            return $Auto::SETTINGS{$val[0]};
+        }
+    }
+    elsif ($count == 2) {
+        if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') {
+            return %{ $Auto::SETTINGS{$val[0]}{$val[1]} };
+        }
+        else {
+            return $Auto::SETTINGS{$val[0]}{$val[1]};
+        }
+    }
+    elsif ($count == 3) {
+        if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') {
+            return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} };
+        }
+        else {
+            return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]};
+        }
+    }
+    else {
+        return;
+    }
 }
 
 # Translation subroutine.
-sub trans
-{
-	my ($id) = @_;
-	$id =~ s/ /_/gsm;
+sub trans {
+    my $id = shift;
+    $id =~ s/ /_/gsm;
 
-	if (defined $API::Std::LANGE{$id}) {
-		return $API::Std::LANGE{$id};
-	}
-	else {
-		$id =~ s/_/ /gsm;
-		return $id;
-	}
+    if (defined $API::Std::LANGE{$id}) {
+        return sprintf $API::Std::LANGE{$id}, @_;
+    }
+    else {
+        $id =~ s/_/ /gsm;
+        return $id;
+    }
 }
 
 # Match user subroutine.
-sub match_user
-{
-	my (%user) = @_;
+sub match_user {
+    my (%user) = @_;
 
-	# Get data from config.
-    if (!conf_get('user')) { return; }
-	my %uhp = conf_get('user');
+    # Get data from config.
+    if (!conf_get('user')) { return }
+    my %uhp = conf_get('user');
 
-	foreach my $userkey (keys %uhp) {
-		# For each user block.
-		my %ulhp = %{ $uhp{$userkey} };
-		foreach my $uhk (keys %ulhp) {
+    foreach my $userkey (keys %uhp) {
+        # For each user block.
+        my %ulhp = %{ $uhp{$userkey} };
+        foreach my $uhk (keys %ulhp) {
             # For each user.
 
-			if ($uhk eq 'net') {
+            if ($uhk eq 'net') {
                 if (defined $user{svr}) {
                     if (lc $user{svr} ne lc(($ulhp{$uhk})[0][0])) {
                         # config.user:net conflicts with irc.user:svr.
@@ -364,60 +379,58 @@ sub match_user
                 }
             }
             elsif ($uhk eq 'mask') {
-				# Put together the user information.
-				my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
-				if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
-					# We've got a host match.
-					return $userkey;
-				}
-			}
+                # Put together the user information.
+                my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
+                if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
+                    # We've got a host match.
+                    return $userkey;
+                }
+            }
             elsif ($uhk eq 'chanstatus' and defined $ulhp{'net'}) {
                 my ($ccst, $ccnm) = split m/[:]/sm, ($ulhp{$uhk})[0][0]; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
                 my $svr = $ulhp{net}[0];
                 if (defined $Auto::SOCKET{$svr}) {
                     if ($ccnm eq 'CURRENT' and defined $user{chan}) {
-                        if (defined $Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
-                            if ($Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+                        if (defined $State::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
+                            if ($State::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
                         }
                     }
                     else {
-                        foreach my $bcj (keys %{ $Parser::IRC::botchans{$svr} }) {
+                        foreach my $bcj (keys %{ $Proto::IRC::botchans{$svr} }) {
                             if (API::IRC::match_mask($bcj, $ccnm)) {
-                                if (defined $Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
-                                    if ($Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+                                if (defined $State::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
+                                    if ($State::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
                                 }
                             }
                         }
                     }
                 }
             }
-		}
-	}
+        }
+    }
 
-	return;
+    return;
 }
 
 # Privilege subroutine.
-sub has_priv
-{
-	my ($cuser, $cpriv) = @_;
+sub has_priv {
+    my ($cuser, $cpriv) = @_;
 
-	if (conf_get("user:$cuser:privs")) {
-		my $cups = (conf_get("user:$cuser:privs"))[0][0];
+    if (conf_get("user:$cuser:privs")) {
+        my $cups = (conf_get("user:$cuser:privs"))[0][0];
 
-		if (defined $Auto::PRIVILEGES{$cups}) {
-			foreach (@{ $Auto::PRIVILEGES{$cups} }) {
-				if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
-			}
-		}
-	}
+        if (defined $Auto::PRIVILEGES{$cups}) {
+            foreach (@{ $Auto::PRIVILEGES{$cups} }) {
+                if ($_ eq $cpriv or $_ eq 'ALL') { return 1 }
+            }
+        }
+    }
 
-	return;
+    return;
 }
 
 # Ratelimit check subroutine.
-sub ratelimit_check
-{
+sub ratelimit_check {
     my (%src) = @_;
 
     # Check if ratelimit is set to on.
@@ -430,13 +443,14 @@ sub ratelimit_check
         # If the user has not passed the rate limit.
         if ($Core::IRC::usercmd{$src{nick}.'@'.$src{host}.'/'.$src{svr}} <= (conf_get('ratelimit_amount'))[0][0]) {
             # Increment their uses and return 1.
+
             $Core::IRC::usercmd{$src{nick}.'@'.$src{host}.'/'.$src{svr}}++;
             return 1;
         }
         else {
-            # Increment their uses and return 0.
+            # Increment their uses and return false.
             $Core::IRC::usercmd{$src{nick}.'@'.$src{host}.'/'.$src{svr}}++;
-            return 0;
+            return;
         }
     }
     else {
@@ -448,55 +462,72 @@ sub ratelimit_check
 }
 
 # Error subroutine.
-sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
-{
-	my ($lvl, $msg, $fatal) = @_;
+sub err { ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
+    my ($lvl, $msg, $fatal) = @_;
 
-	# Check for an invalid level.
-	if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-		return;
-	}
-	if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-		return;
-	}
+    # Check for an invalid level.
+    if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+        return;
+    }
+    if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+        return;
+    }
 
-	# Level 1: Print to screen.
-	if ($lvl >= 1) {
-		API::Log::println("ERROR: $msg");
-	}
-	# Level 2: Log to file.
-	if ($lvl >= 2) {
-		API::Log::alog("ERROR: $msg");
-	}
+    # Level 1: Print to screen.
+    if ($lvl >= 1) {
+        say "ERROR: $msg";
+    }
+    # Level 2: Log to file.
+    if ($lvl >= 2) {
+        API::Log::alog("ERROR: $msg");
+    }
+    # Level 3: Log to IRC.
+    if ($lvl >= 3) {
+        API::Log::slog("ERROR: $msg");
+    }
 
-	# If it's a fatal error, exit the program.
-	if ($fatal) { exit; }
+    # If it's a fatal error, exit the program.
+    if ($fatal) {
+        API::Std::event_run('on_shutdown');
+        exit; 
+    }
 
-	return 1;
+    return 1;
 }
 
 # Warn subroutine.
-sub awarn
-{
-	my ($lvl, $msg) = @_;
+sub awarn {
+    my ($lvl, $msg) = @_;
 
-	# Check for an invalid level.
-	if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
-		return;
-	}
+    # Check for an invalid level.
+    if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
+        return;
+    }
 
-	# Level 1: Print to screen.
-	if ($lvl >= 1) {
-		API::Log::println("WARNING: $msg");
-	}
-	# Level 2: Log to file.
-	if ($lvl >= 2) {
-		API::Log::alog("WARNING: $msg");
-	}
+    # Level 1: Print to screen.
+    if ($lvl >= 1) {
+        say "WARNING: $msg";
+    }
+    # Level 2: Log to file.
+    if ($lvl >= 2) {
+        API::Log::alog("WARNING: $msg");
+    }
+    # Level 3: Log to IRC.
+    if ($lvl >= 3) {
+        API::Log::slog("WARNING: $msg");
+    }
 
-	return 1;
+    return 1;
+}
+
+# Formatting a file path.
+sub fpfmt {
+    my ($path) = @_;
+
+    if ($path =~ m/\s/xsm) { return "\"$path\"" }
+    else { return $path }
 }
 
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/Core/Cmd.pm

@@ -16,19 +16,18 @@ our %HELP_MODLOAD = (
 # MODLOAD callback.
 sub cmd_modload
 {
-    my (%data) = @_;
-    my @argv = @{ $data{args} };
+    my ($src, @argv) = @_;
     
     # Check for the needed parameters.
     if (!defined $argv[0]) {
-        notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-        return 0;
+        notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
+        return;
     }
 
     # Check if the module is already loaded.
     if (API::Std::mod_exists($argv[0])) {
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 is already loaded.");
-        return 0;
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is already loaded.");
+        return;
     }
 
     # Go for it!
@@ -37,12 +36,12 @@ sub cmd_modload
     # Check if we were successful or not.
     if ($tn) {
         # We were!
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 successfully loaded.");
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 successfully loaded.");
     }
     else {
         # We weren't.
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 failed to load.");
-        return 0;
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to load.");
+        return;
     }
 
     return 1;
@@ -55,19 +54,18 @@ our %HELP_MODUNLOAD = (
 # MODUNLOAD callback.
 sub cmd_modunload
 {
-    my (%data) = @_;
-    my @argv = @{ $data{args} };
+    my ($src, @argv) = @_;
     
     # Check for the needed parameters.
     if (!defined $argv[0]) {
-        notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-        return 0;
+        notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
+        return;
     }
 
     # Check if the module exists.
     if (!API::Std::mod_exists($argv[0])) {
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 is not loaded.");
-        return 0;
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded.");
+        return;
     }
 
     # Go for it!
@@ -76,12 +74,12 @@ sub cmd_modunload
     # Check if we were successful or not.
     if ($tn) {
         # We were!
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 successfully unloaded.");
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 successfully unloaded.");
     }
     else {
         # We weren't.
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 failed to unload.");
-        return 0;
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to unload.");
+        return;
     }
 
     return 1;
@@ -94,19 +92,18 @@ our %HELP_MODRELOAD = (
 # MODRELOAD callback.
 sub cmd_modreload
 {
-    my (%data) = @_;
-    my @argv = @{ $data{args} };
+    my ($src, @argv) = @_;
     
     # Check for the needed parameters.
     if (!defined $argv[0]) {
-        notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-        return 0;
+        notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
+        return;
     }
 
     # Check if the module exists.
     if (!API::Std::mod_exists($argv[0])) {
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 is not loaded.");
-        return 0;
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded.");
+        return;
     }
 
     # Go for it!
@@ -117,33 +114,54 @@ sub cmd_modreload
     # Check if we were successful or not.
     if ($tvn and $tln) {
         # We were!
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 successfully reloaded.");
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 successfully reloaded.");
     }
     else {
         # We weren't.
-        notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 failed to reload.");
-        return 0;
+        notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to reload.");
+        return;
     }
 
     return 1;
 }
 
+# Help hash for MODLIST. Spanish, French and German needed.
+our %HELP_MODLIST = (
+    'en' => "This will return a list of all currently loaded modules. \2Syntax:\2 MODLIST",
+);
+# MODLIST callback.
+sub cmd_modlist
+{
+    my ($src, undef) = @_;
+
+    # Iterate through all loaded modules.
+    my $str;
+    foreach (keys %API::Std::MODULE) {
+        $str .= ", \2$_\2 (v".$API::Std::MODULE{$_}{version}.')';
+    }
+
+    # Return it.
+    $str = substr $str, 2;
+    notice($src->{svr}, $src->{nick}, "\2Module List:\2 $str");
+
+    return 1;
+}
+
 # Help hash for SHUTDOWN. Spanish, French and German needed.
 our %HELP_SHUTDOWN = (
-    'en' => 'This will send out shutdown notifications, quit all networks, flush the database then exit the program.',
+    'en' => "This will send out shutdown notifications, quit all networks, flush the database then exit the program. \2Syntax:\2 SHUTDOWN",
 );
 # SHUTDOWN callback.
 sub cmd_shutdown
 {
-    my (%data) = @_;
+    my ($src, undef) = @_;
     
     # Goodbye world!
-    notice($data{svr}, $data{nick}, "Shutting down.");
-    dbug "Got SHUTDOWN from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Shutting down. . .";
-    alog "Got SHUTDOWN from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Shutting down. . .";
-    quit($_, "SHUTDOWN from ".$data{nick}."/".$data{svr}) foreach (keys %Auto::SOCKET);
-    $Auto::DB->disconnect;
-    system("rm $Auto::Bin/auto.pid");
+    notice($src->{svr}, $src->{nick}, "Shutting down.");
+    dbug "Got SHUTDOWN from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Shutting down. . .";
+    alog "Got SHUTDOWN from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Shutting down. . .";
+    quit($_, "SHUTDOWN from ".$src->{nick}."/".$src->{svr}) foreach (keys %Auto::SOCKET);
+    API::Std::event_run('on_shutdown');
     exit;
 
     # To appease PerlCritic.
@@ -157,22 +175,21 @@ our %HELP_RESTART = (
 # RESTART callback.
 sub cmd_restart
 {
-    my (%data) = @_;
+    my ($src, undef) = @_;
     
     # Goodbye world!
-    notice($data{svr}, $data{nick}, "Restarting.");
-    dbug "Got RESTART from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Restarting. . .";
-    alog "Got RESTART from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Restarting. . .";
-    quit($_, "RESTART from ".$data{nick}."/".$data{svr}) foreach (keys %Auto::SOCKET);
-    $Auto::DB->disconnect;
-    system("rm $Auto::Bin/auto.pid") if -e "$Auto::Bin/auto.pid";
+    notice($src->{svr}, $src->{nick}, "Restarting.");
+    dbug "Got RESTART from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Restarting. . .";
+    alog "Got RESTART from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Restarting. . .";
+    quit($_, "RESTART from ".$src->{nick}."/".$src->{svr}) foreach (keys %Auto::SOCKET);
+    API::Std::event_run('on_shutdown');
 
     # Time to come back from the dead!
     if ($Auto::DEBUG) {
-        system("$Auto::Bin/auto -d -nuc");
+        exec "perl $Auto::Bin/auto -d -nuc";
     }
     else {
-        system("$Auto::Bin/auto -nuc");
+        exec "perl $Auto::Bin/auto -nuc";
     }
     exit;
 
@@ -187,16 +204,16 @@ our %HELP_REHASH = (
 # REHASH callback.
 sub cmd_rehash
 {
-    my (%data) = @_;
+    my ($src, undef) = @_;
     
     # Send out notifications.
-    notice($data{svr}, $data{nick}, "Rehashing.");
-    dbug "Got REHASH from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Rehashing. . .";
-    alog "Got REHASH from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Rehashing. . .";
+    notice($src->{svr}, $src->{nick}, "Rehashing.");
+    dbug "Got REHASH from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Rehashing. . .";
+    alog "Got REHASH from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Rehashing. . .";
 
     # Rehash.
     Lib::Auto::rehash();
-    notice($data{svr}, $data{nick}, "Done.");
+    notice($src->{svr}, $src->{nick}, "Done.");
 
     return 1;
 }
@@ -208,18 +225,17 @@ our %HELP_HELP = (
 # HELP callback.
 sub cmd_help
 {
-    my (%data) = @_;
-    my @argv = @{ $data{args} }; delete $data{args};
+    my ($src, @argv) = @_;
 
     # Check for arguments and reply accordingly.
     if (!defined $argv[0]) {
         # No command specified. List commands.
         my $cmdlist = '';
         foreach (sort keys %API::Std::CMDS) {
-            if (defined $data{chan}) {
+            if (defined $src->{chan}) {
                 if ($API::Std::CMDS{$_}{lvl} == 0 or $API::Std::CMDS{$_}{lvl} == 2) {
                     if ($API::Std::CMDS{$_}{priv}) {
-                        if (has_priv(match_user(%data), $API::Std::CMDS{$_}{priv})) {
+                        if (has_priv(match_user(%$src), $API::Std::CMDS{$_}{priv})) {
                             $cmdlist .= ", \002".uc($_)."\002";
                         }
                     }
@@ -231,7 +247,7 @@ sub cmd_help
             else {
                 if ($API::Std::CMDS{$_}{lvl} == 1 or $API::Std::CMDS{$_}{lvl} == 2) {
                     if ($API::Std::CMDS{$_}{priv}) {
-                        if (has_priv(match_user(%data), $API::Std::CMDS{$_}{priv})) {
+                        if (has_priv(match_user(%$src), $API::Std::CMDS{$_}{priv})) {
                             $cmdlist .= ", \002".uc($_)."\002";
                         }
                     }
@@ -243,19 +259,19 @@ sub cmd_help
         }
         $cmdlist = substr($cmdlist, 2);
 
-        notice($data{svr}, $data{nick}, "Command List: ".$cmdlist);
+        notice($src->{svr}, $src->{nick}, "Command List: ".$cmdlist);
     }
     else {
         # Help for a specific command was requested. Lets get it.
         my $rcm = uc($argv[0]);
 
-        if (defined $API::Std::CMDS{$rcm}{help}) {
+        if (exists $API::Std::CMDS{$rcm}{help}) {
             # If there is help for this command.
             
             # Check for necessary privileges.
             if ($API::Std::CMDS{$rcm}{priv}) {
-                if (!has_priv(match_user(%data), $API::Std::CMDS{$rcm}{priv})) {
-                    notice($data{svr}, $data{nick}, trans("Access denied").".");
+                if (!has_priv(match_user(%$src), $API::Std::CMDS{$rcm}{priv})) {
+                    notice($src->{svr}, $src->{nick}, trans("Access denied").".");
                     return;
                 }
             }
@@ -266,30 +282,30 @@ sub cmd_help
                 # Get the language.
                 my ($lang, undef) = split('_', $Auto::LOCALE);
 
-                if (defined ${ $API::Std::CMDS{$rcm}{help} }{$lang}) {
+                if (exists ${ $API::Std::CMDS{$rcm}{help} }{$lang}) {
                     # If help for this command is available in the configured language.
-                    notice($data{svr}, $data{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{$lang});
+                    notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{$lang});
                 }
                 else {
                     # If it isn't, default to English.
-                    if (defined ${ $API::Std::CMDS{$rcm}{help} }{en}) {
+                    if (exists ${ $API::Std::CMDS{$rcm}{help} }{en}) {
                         # If help for this command is available in English.
-                        notice($data{svr}, $data{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{en});
+                        notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{en});
                     }
                     else {
                         # If it isn't, no help.
-                        notice($data{svr}, $data{nick}, "No help for \002".$rcm."\002 available.");
+                        notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
                     }
                 }
             }
             else {
                 # If it isn't valid, no help.
-                notice($data{svr}, $data{nick}, "No help for \002".$rcm."\002 available.");
+                notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
             }
         }
         else {
             # If there is no help, don't give any.
-            notice($data{svr}, $data{nick}, "No help for \002".$rcm."\002 available.");
+            notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
         }
     }
 
@@ -298,4 +314,4 @@ sub cmd_help
 
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/Core/IRC.pm

@@ -12,29 +12,90 @@ our (%usercmd);
 
 # CTCP VERSION reply.
 hook_add("on_uprivmsg", "ctcp_version_reply", sub {
-    my (($svr, @ex)) = @_;
-    my %src = usrc(substr($ex[0], 1));
+    my (($src, @msg)) = @_;
 
-    if ($ex[3] eq ":\001VERSION\001") {
+    if ($msg[0] eq "\001VERSION\001") {
         if (Auto::RSTAGE ne 'd') {
-            notice($svr, $src{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE." ".$OSNAME."\001");
+            notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE." ".$OSNAME."\001");
         }
         else {
-            notice($svr, $src{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-".Auto::GR." ".$OSNAME."\001");
+            notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-$Auto::VERGITREV ".$OSNAME."\001");
         }
     }
 
     return 1;
 });
 
+# Command alias parsing for channel messages.
+hook_add('on_cprivmsg', 'irc.commands.aliases', sub {
+    my (($src, $chan, ($cmd, @args))) = @_;
+
+    # Check for valid length.
+    if (length $cmd >= 2) {
+        my $ipref = substr $cmd, 0, 1, q{};
+        my $upref = (conf_get('fantasy_pf'))[0][0];
+        # Check if the prefix is valid.
+        if ($upref eq $ipref) {
+            # It is, check for an alias.
+            if (defined $API::Std::ALIASES{uc $cmd}) {
+                # Get aliased command.
+                my @actual;
+                if ($API::Std::ALIASES{uc $cmd} =~ m/ /xsm) { @actual = split /\s/xsm, $API::Std::ALIASES{uc $cmd} }
+                else { @actual = ($API::Std::ALIASES{uc $cmd}) }
+                # Prepare data.
+                my @msg = (
+                        q{:}.$src->{nick}.q{!}.$src->{user}.q{@}.$src->{host},
+                        'PRIVMSG',
+                        $chan,
+                        q{:}.$upref.$actual[0],
+                );
+                # Rest of the data.
+                if (scalar @actual > 1) { for (1..$#actual) { push @msg, $actual[$_] } }
+                if (defined $args[0]) { foreach (@args) { push @msg, $_ } }
+                # Simulate a PRIVMSG.
+                Proto::IRC::privmsg($src->{svr}, @msg);
+            }
+        }
+    }
+
+    return 1;
+});
+                        
+# Command alias parsing for private messages.
+hook_add('on_uprivmsg', 'irc.commands.aliases', sub {
+    my (($src, ($cmd, @args))) = @_;
+
+    # Check for an alias.
+    if (defined $API::Std::ALIASES{uc $cmd}) {
+        # Get aliased command.
+        my @actual;
+        if ($API::Std::ALIASES{uc $cmd} =~ m/ /xsm) { @actual = split /\s/xsm, $API::Std::ALIASES{uc $cmd} }
+        else { @actual = ($API::Std::ALIASES{uc $cmd}) }
+        # Prepare data.
+        my @msg = (
+            q{:}.$src->{nick}.q{!}.$src->{user}.q{@}.$src->{host},
+            'PRIVMSG',
+            $State::IRC::botinfo{$src->{svr}}{nick},
+            q{:}.$actual[0],
+        );
+        # Rest of the data.
+        if (scalar @actual > 1) { for (1..$#actual) { push @msg, $actual[$_] } }
+        if (defined $args[0]) { foreach (@args) { push @msg, $_ } }
+        # Simulate a PRIVMSG.
+        Proto::IRC::privmsg($src->{svr}, @msg);
+    }
+
+    return 1;
+});
+                        
 # QUIT hook; delete user from chanusers.
 hook_add("on_quit", "quit_update_chanusers", sub {
-    my (($svr, $src, undef)) = @_;
+    my (($src, undef)) = @_;
     my %src = %{ $src };
 
     # Delete the user from all channels.
-    foreach my $ccu (keys %{ $Parser::IRC::chanusers{$svr} }) {
-        if (defined $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}) { delete $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}; }
+    foreach my $ccu (keys %{ $State::IRC::chanusers{$src{svr}}}) {
+        if (defined $State::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}) { delete $State::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}} }
     }
 
     return 1;
@@ -44,22 +105,31 @@ hook_add("on_quit", "quit_update_chanusers", sub {
 hook_add("on_connect", "on_connect_modes", sub {
     my ($svr) = @_;
 
-	if (conf_get("server:$svr:modes")) {
-		my $connmodes = (conf_get("server:$svr:modes"))[0][0];
-		API::IRC::umode($svr, $connmodes);
-	}
+    if (conf_get("server:$svr:modes")) {
+        my $connmodes = (conf_get("server:$svr:modes"))[0][0];
+        API::IRC::umode($svr, $connmodes);
+    }
+
+    return 1;
+});
+
+# Self-WHO on connect.
+hook_add('on_connect', 'on_connect_selfwho', sub {
+    my ($svr) = @_;
+
+    API::IRC::who($svr, $State::IRC::botinfo{$svr}{nick});
 
     return 1;
 });
 
 # Plaintext auth.
 hook_add("on_connect", "plaintext_auth", sub {
-	my ($svr) = @_;
+    my ($svr) = @_;
     
     if (conf_get("server:$svr:idstr")) {
-		my $idstr = (conf_get("server:$svr:idstr"))[0][0];
-		Auto::socksnd($svr, $idstr);
-	}
+        my $idstr = (conf_get("server:$svr:idstr"))[0][0];
+        Auto::socksnd($svr, $idstr);
+    }
 
     return 1;
 });
@@ -68,19 +138,96 @@ hook_add("on_connect", "plaintext_auth", sub {
 hook_add("on_connect", "autojoin", sub {
     my ($svr) = @_;
 
-	# Get the auto-join from the config.
-	my @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] };
-	
-	# Join the channels.
-	if (!defined $cajoin[1]) {
-		# For single-line ajoins.
-		my @sajoin = split(',', $cajoin[0]);
-		
-		API::IRC::cjoin($svr, $_) foreach (@sajoin);
-	}
-	else {
-		# For multi-line ajoins.
-		API::IRC::cjoin($svr, $_) foreach (@cajoin);
+    # Get the auto-join from the config.
+    my @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] };
+    
+    # Join the channels.
+    if (!defined $cajoin[1]) {
+        # For single-line ajoins.
+        my @sajoin = split(',', $cajoin[0]);
+        
+        foreach (@sajoin) {
+            # Check if a key was specified.
+            if ($_ =~ m/\s/xsm) {
+                # There was, join with it.
+                my ($chan, $key) = split / /;
+                API::IRC::cjoin($svr, $chan, $key);
+            }
+            else {
+                # Else join without one.
+                API::IRC::cjoin($svr, $_);
+            }
+        }
+    }
+    else {
+        # For multi-line ajoins.
+        foreach (@cajoin) {
+            # Check if a key was specified.
+            if ($_ =~ m/\s/xsm) {
+                # There was, join with it.
+                my ($chan, $key) = split / /;
+                API::IRC::cjoin($svr, $chan, $key);
+            }
+            else {
+                # Else join without one.
+                API::IRC::cjoin($svr, $_);
+            }
+        }
+    }
+    # And logchan, if applicable.
+    if (conf_get('logchan')) {
+        my ($lcn, $lcc) = split '/', (conf_get('logchan'))[0][0];
+        if ($lcn eq $svr) {
+            API::IRC::cjoin($svr, $lcc);
+        }
+    }
+
+    return 1;
+});
+
+# WHO reply.
+hook_add('on_whoreply', 'selfwho.getdata', sub {
+    my (($svr, $nick, undef, $user, $mask, undef, undef, undef, undef)) = @_;
+
+    # Check if it's for us.
+    if ($nick eq $State::IRC::botinfo{$svr}{nick}) {
+        # It is. Set data.
+        $State::IRC::botinfo{$svr}{user} = $user;
+        $State::IRC::botinfo{$svr}{mask} = $mask;
+    }
+
+    return 1;
+});
+
+# ISUPPORT - Set prefixes and channel modes.
+hook_add('on_isupport', 'core.prefixchanmode.getdata', sub {
+    my (($svr, @ex)) = @_;
+
+    # Find PREFIX and CHANMODES.
+    foreach my $ex (@ex) {
+        if ($ex =~ m/^PREFIX/xsm) {
+            # Found PREFIX.
+            my $rpx = substr($ex, 8);
+            my ($pm, $pp) = split('\)', $rpx);
+            my @apm = split(//, $pm);
+            my @app = split(//, $pp);
+            foreach my $ppm (@apm) {
+                # Store data.
+                $Proto::IRC::csprefix{$svr}{$ppm} = shift(@app);
+            }
+        }
+        elsif ($ex =~ m/^CHANMODES/xsm) {
+            # Found CHANMODES.
+            my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
+            # List modes.
+            foreach (split(//, $mtl)) { $Proto::IRC::chanmodes{$svr}{$_} = 1 }
+            # Modes with parameter.
+            foreach (split(//, $mtp)) { $Proto::IRC::chanmodes{$svr}{$_} = 2 }
+            # Modes with parameter when +.
+            foreach (split(//, $mtpp)) { $Proto::IRC::chanmodes{$svr}{$_} = 3 }
+            # Modes without parameter.
+            foreach (split(//, $mts)) { $Proto::IRC::chanmodes{$svr}{$_} = 4 }
+        }
     }
 
     return 1;
@@ -103,6 +250,52 @@ sub clear_usercmd_timer
     return 1;
 }
 
+# Server data deletion on disconnect.
+hook_add('on_disconnect', 'core.irc.deldata', sub {
+    my ($svr) = @_;
+
+    # Delete all data related to the server.
+    if (defined $Proto::IRC::got_001{$svr}) { delete $Proto::IRC::got_001{$svr} }
+    if (defined $State::IRC::botinfo{$svr}) { delete $State::IRC::botinfo{$svr} }
+    if (defined $Proto::IRC::botchans{$svr}) { delete $Proto::IRC::botchans{$svr} }
+    if (defined $State::IRC::chanusers{$svr}) { delete $State::IRC::chanusers{$svr} }
+    if (defined $Proto::IRC::csprefix{$svr}) { delete $Proto::IRC::csprefix{$svr} }
+    if (defined $Proto::IRC::chanmodes{$svr}) { delete $Proto::IRC::chanmodes{$svr} }
+    if (defined $Proto::IRC::cap{$svr}) { delete $Proto::IRC::cap{$svr} }
+
+    return 1;
+});
+
+# Track our usermodes.
+hook_add('on_umode', 'core.irc.state.umode', sub {
+    my (($svr, $modes)) = @_;
+
+    # Remove anything after a space.
+    $modes =~ s/(\s.*)//xsm;
+
+    # Split the modes.
+    my @modes = split //, $modes;
+
+    # Set operator to 1.
+    my $op = 1;
+    # Iterate through the modes.
+    foreach (@modes) {
+        if ($_ eq '-') { $op = 0 }
+        elsif ($_ eq '+') { $op = 1 }
+        else {
+            # Adjust our modes.
+            if ($op) {
+                $State::IRC::botinfo{$svr}{modes} .= $_;
+            }
+            else {
+                $State::IRC::botinfo{$svr}{modes} =~ s/($_)//xsm;
+            }
+        }
+    }
+
+    return 1;
+});
+
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/Core/IRC/Users.pm

@@ -0,0 +1,132 @@
+# lib/Core/IRC/Users.pm - IRC user tracking.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package Core::IRC::Users;
+use strict;
+use warnings;
+use API::Std qw(hook_add);
+our %users;
+
+# Initialize the ircusers_create and ircusers_delete events.
+API::Std::event_add('ircusers_create');
+API::Std::event_add('ircusers_delete');
+
+# Create the on_rcjoin hook.
+hook_add('on_rcjoin', 'ircusers.onjoin', sub {
+    my ($src, $chan) = @_;
+
+    # Add the user to the users hash, if not already defined.
+    if (!$users{$src->{svr}}{lc $src->{nick}}) {
+        $users{$src->{svr}}{lc $src->{nick}} = $src->{nick};
+        API::Std::event_run('ircusers_create', ($src->{svr}, $src->{nick}));
+    }
+
+    return 1;
+});
+
+# Create the on_namesreply hook.
+hook_add('on_namesreply', 'ircusers.names', sub {
+    my ($svr, $chan, undef) = @_;
+
+    # Iterate through the users for this channel.
+    foreach (keys %{$State::IRC::chanusers{$svr}{$chan}}) {
+        # Check if the user already exists.
+        if (!$users{$svr}{$_}) {
+            # They do not; WHO them.
+            API::IRC::who($svr, $_);
+        }
+    }
+
+    return 1;
+});
+
+# Create the on_whoreply hook.
+hook_add('on_whoreply', 'ircusers.who', sub {
+    my ($svr, $nick, undef) = @_;
+
+    # Ensure it is not us.
+    if (lc $nick ne lc $State::IRC::botinfo{$svr}{nick}) {
+        # It is not. Check if they're already in the users hash.
+        if (!$users{$svr}{lc $nick}) {
+            # They are not; add them.
+            $users{$svr}{lc $nick} = $nick;
+        }
+    }
+
+    return 1;
+});
+
+# Create the on_nick hook.
+hook_add('on_nick', 'ircusers.onnick', sub {
+    my ($src, $newnick) = @_;
+
+    # Modify the user's entry in the users hash.
+    if ($users{$src->{svr}}{lc $src->{nick}}) {
+        $users{$src->{svr}}{lc $newnick} = $newnick;
+        delete $users{$src->{svr}}{lc $src->{nick}};
+    }
+
+    return 1;
+});
+
+# Create the on_kick hook.
+hook_add('on_kick', 'ircusers.onkick', sub {
+    my ($src, $kchan, $user, undef) = @_;
+
+    # Ensure there is a users hash entry for this user.
+    if ($users{$src->{svr}}{lc $user}) {
+        # Figure out if the user is in any other channel we're in.
+        my $ri = 0;
+        foreach my $chan (keys %{$State::IRC::chanusers{$src->{svr}}}) {
+            if ($chan ne $kchan) {
+                if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $user}) { $ri++; last }
+            }
+        }
+        if (!$ri) {
+            # They are not, delete them.
+            delete $users{$src->{svr}}{lc $user};
+            API::Std::event_run('ircusers_delete', ($src->{svr}, $user));
+        }
+    }
+
+    return 1;
+});
+
+# Create the on_part hook.
+hook_add('on_part', 'ircusers.onpart', sub {
+    my ($src, $pchan, undef) = @_;
+
+    # Ensure there is a users hash entry for this user.
+    if ($users{$src->{svr}}{lc $src->{nick}}) {
+        # Figure out if the user is in any other channel we're in.
+        my $ri = 0;
+        foreach my $chan (keys %{$State::IRC::chanusers{$src->{svr}}}) {
+            if ($chan ne $pchan) {
+                if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $src->{nick}}) { $ri++; last }
+            }
+        }
+        if (!$ri) {
+            # They are not, delete them.
+            delete $users{$src->{svr}}{lc $src->{nick}};
+            API::Std::event_run('ircusers_delete', ($src->{svr}, $src->{nick}));
+        }
+    }
+
+    return 1;
+});
+
+# Create the on_quit hook.
+hook_add('on_quit', 'ircusers.onquit', sub {
+    my ($src, undef) = @_;
+
+    # Delete the user's entry from the users hash.
+    if ($users{$src->{svr}}{lc $src->{nick}}) {
+        delete $users{$src->{svr}}{lc $src->{nick}};
+    }
+
+    return 1;
+});
+
+
+1;
+# vim: set ai et sw=4 ts=4:

lib/File/Copy/Recursive.pm

@@ -0,0 +1,708 @@
+package File::Copy::Recursive;
+
+use strict;
+BEGIN {
+    # Keep older versions of Perl from trying to use lexical warnings
+    $INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006;
+}
+use warnings;
+
+use Carp;
+use File::Copy; 
+use File::Spec; #not really needed because File::Copy already gets it, but for good measure :)
+
+use vars qw( 
+    @ISA      @EXPORT_OK $VERSION  $MaxDepth $KeepMode $CPRFComp $CopyLink 
+    $PFSCheck $RemvBase $NoFtlPth  $ForcePth $CopyLoop $RMTrgFil $RMTrgDir 
+    $CondCopy $BdTrgWrn $SkipFlop  $DirPerms
+);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir);
+$VERSION = '0.38';
+
+$MaxDepth = 0;
+$KeepMode = 1;
+$CPRFComp = 0; 
+$CopyLink = eval { local $SIG{'__DIE__'};symlink '',''; 1 } || 0;
+$PFSCheck = 1;
+$RemvBase = 0;
+$NoFtlPth = 0;
+$ForcePth = 0;
+$CopyLoop = 0;
+$RMTrgFil = 0;
+$RMTrgDir = 0;
+$CondCopy = {};
+$BdTrgWrn = 0;
+$SkipFlop = 0;
+$DirPerms = 0777; 
+
+my $samecheck = sub {
+   return 1 if $^O eq 'MSWin32'; # need better way to check for this on winders...
+   return if @_ != 2 || !defined $_[0] || !defined $_[1];
+   return if $_[0] eq $_[1];
+
+   my $one = '';
+   if($PFSCheck) {
+      $one    = join( '-', ( stat $_[0] )[0,1] ) || '';
+      my $two = join( '-', ( stat $_[1] )[0,1] ) || '';
+      if ( $one eq $two && $one ) {
+          carp "$_[0] and $_[1] are identical";
+          return;
+      }
+   }
+
+   if(-d $_[0] && !$CopyLoop) {
+      $one    = join( '-', ( stat $_[0] )[0,1] ) if !$one;
+      my $abs = File::Spec->rel2abs($_[1]);
+      my @pth = File::Spec->splitdir( $abs );
+      while(@pth) {
+         my $cur = File::Spec->catdir(@pth);
+         last if !$cur; # probably not necessary, but nice to have just in case :)
+         my $two = join( '-', ( stat $cur )[0,1] ) || '';
+         if ( $one eq $two && $one ) {
+             # $! = 62; # Too many levels of symbolic links
+             carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";
+             return;
+         }
+      
+         pop @pth;
+      }
+   }
+
+   return 1;
+};
+
+my $glob = sub {
+    my ($do, $src_glob, @args) = @_;
+    
+    local $CPRFComp = 1;
+    
+    my @rt;
+    for my $path ( glob($src_glob) ) {
+        my @call = [$do->($path, @args)] or return;
+        push @rt, \@call;
+    }
+    
+    return @rt;
+};
+
+my $move = sub {
+   my $fl = shift;
+   my @x;
+   if($fl) {
+      @x = fcopy(@_) or return;
+   } else {
+      @x = dircopy(@_) or return;
+   }
+   if(@x) {
+      if($fl) {
+         unlink $_[0] or return;
+      } else {
+         pathrmdir($_[0]) or return;
+      }
+      if($RemvBase) {
+         my ($volm, $path) = File::Spec->splitpath($_[0]);
+         pathrm(File::Spec->catpath($volm,$path,''), $ForcePth, $NoFtlPth) or return;
+      }
+   }
+  return wantarray ? @x : $x[0];
+};
+
+my $ok_todo_asper_condcopy = sub {
+    my $org = shift;
+    my $copy = 1;
+    if(exists $CondCopy->{$org}) {
+        if($CondCopy->{$org}{'md5'}) {
+
+        }
+        if($copy) {
+
+        }
+    }
+    return $copy;
+};
+
+sub fcopy { 
+   $samecheck->(@_) or return;
+   if($RMTrgFil && (-d $_[1] || -e $_[1]) ) {
+      my $trg = $_[1];
+      if( -d $trg ) {
+        my @trgx = File::Spec->splitpath( $_[0] );
+        $trg = File::Spec->catfile( $_[1], $trgx[ $#trgx ] );
+      }
+      $samecheck->($_[0], $trg) or return;
+      if(-e $trg) {
+         if($RMTrgFil == 1) {
+            unlink $trg or carp "\$RMTrgFil failed: $!";
+         } else {
+            unlink $trg or return;
+         }
+      }
+   }
+   my ($volm, $path) = File::Spec->splitpath($_[1]);
+   if($path && !-d $path) {
+      pathmk(File::Spec->catpath($volm,$path,''), $NoFtlPth);
+   }
+   if( -l $_[0] && $CopyLink ) {
+      carp "Copying a symlink ($_[0]) whose target does not exist" 
+          if !-e readlink($_[0]) && $BdTrgWrn;
+      symlink readlink(shift()), shift() or return;
+   } else {  
+      copy(@_) or return;
+
+      my @base_file = File::Spec->splitpath($_[0]);
+      my $mode_trg = -d $_[1] ? File::Spec->catfile($_[1], $base_file[ $#base_file ]) : $_[1];
+
+      chmod scalar((stat($_[0]))[2]), $mode_trg if $KeepMode;
+   }
+   return wantarray ? (1,0,0) : 1; # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings
+}
+
+sub rcopy { 
+    if (-l $_[0] && $CopyLink) {
+        goto &fcopy;    
+    }
+    
+    goto &dircopy if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
+    goto &fcopy;
+}
+
+sub rcopy_glob {
+    $glob->(\&rcopy, @_);
+}
+
+sub dircopy {
+   if($RMTrgDir && -d $_[1]) {
+      if($RMTrgDir == 1) {
+         pathrmdir($_[1]) or carp "\$RMTrgDir failed: $!";
+      } else {
+         pathrmdir($_[1]) or return;
+      }
+   }
+   my $globstar = 0;
+   my $_zero = $_[0];
+   my $_one = $_[1];
+   if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*') {
+       $globstar = 1;
+       $_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) );
+   }
+
+   $samecheck->(  $_zero, $_[1] ) or return;
+   if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) {
+       $! = 20; 
+       return;
+   } 
+
+   if(!-d $_[1]) {
+      pathmk($_[1], $NoFtlPth) or return;
+   } else {
+      if($CPRFComp && !$globstar) {
+         my @parts = File::Spec->splitdir($_zero);
+         while($parts[ $#parts ] eq '') { pop @parts; }
+         $_one = File::Spec->catdir($_[1], $parts[$#parts]);
+      }
+   }
+   my $baseend = $_one;
+   my $level   = 0;
+   my $filen   = 0;
+   my $dirn    = 0;
+
+   my $recurs; #must be my()ed before sub {} since it calls itself
+   $recurs =  sub {
+      my ($str,$end,$buf) = @_;
+      $filen++ if $end eq $baseend; 
+      $dirn++ if $end eq $baseend;
+      
+      $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
+      mkdir($end,$DirPerms) or return if !-d $end;
+      chmod scalar((stat($str))[2]), $end if $KeepMode;
+      if($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth) {
+         return ($filen,$dirn,$level) if wantarray;
+         return $filen;
+      }
+      $level++;
+
+      
+      my @files;
+      if ( $] < 5.006 ) {
+          opendir(STR_DH, $str) or return;
+          @files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH));
+          closedir STR_DH;
+      }
+      else {
+          opendir(my $str_dh, $str) or return;
+          @files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh));
+          closedir $str_dh;
+      }
+
+      for my $file (@files) {
+          my ($file_ut) = $file =~ m{ (.*) }xms;
+          my $org = File::Spec->catfile($str, $file_ut);
+          my $new = File::Spec->catfile($end, $file_ut);
+          if( -l $org && $CopyLink ) {
+              carp "Copying a symlink ($org) whose target does not exist" 
+                  if !-e readlink($org) && $BdTrgWrn;
+              symlink readlink($org), $new or return;
+          } 
+          elsif(-d $org) {
+              $recurs->($org,$new,$buf) if defined $buf;
+              $recurs->($org,$new) if !defined $buf;
+              $filen++;
+              $dirn++;
+          } 
+          else {
+              if($ok_todo_asper_condcopy->($org)) {
+                  if($SkipFlop) {
+                      fcopy($org,$new,$buf) or next if defined $buf;
+                      fcopy($org,$new) or next if !defined $buf;                      
+                  }
+                  else {
+                      fcopy($org,$new,$buf) or return if defined $buf;
+                      fcopy($org,$new) or return if !defined $buf;
+                  }
+                  chmod scalar((stat($org))[2]), $new if $KeepMode;
+                  $filen++;
+              }
+          }
+      }
+      1;
+   };
+
+   $recurs->($_zero, $_one, $_[2]) or return;
+   return wantarray ? ($filen,$dirn,$level) : $filen;
+}
+
+sub fmove { $move->(1, @_) } 
+
+sub rmove { 
+    if (-l $_[0] && $CopyLink) {
+        goto &fmove;    
+    }
+    
+    goto &dirmove if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
+    goto &fmove;
+}
+
+sub rmove_glob {
+    $glob->(\&rmove, @_);
+}
+
+sub dirmove { $move->(0, @_) }
+
+sub pathmk {
+   my @parts = File::Spec->splitdir( shift() );
+   my $nofatal = shift;
+   my $pth = $parts[0];
+   my $zer = 0;
+   if(!$pth) {
+      $pth = File::Spec->catdir($parts[0],$parts[1]);
+      $zer = 1;
+   }
+   for($zer..$#parts) {
+      $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
+      mkdir($pth,$DirPerms) or return if !-d $pth && !$nofatal;
+      mkdir($pth,$DirPerms) if !-d $pth && $nofatal;
+      $pth = File::Spec->catdir($pth, $parts[$_ + 1]) unless $_ == $#parts;
+   }
+   1;
+} 
+
+sub pathempty {
+   my $pth = shift; 
+
+   return 2 if !-d $pth;
+
+   my @names;
+   my $pth_dh;
+   if ( $] < 5.006 ) {
+       opendir(PTH_DH, $pth) or return;
+       @names = grep !/^\.+$/, readdir(PTH_DH);
+   }
+   else {
+       opendir($pth_dh, $pth) or return;
+       @names = grep !/^\.+$/, readdir($pth_dh);       
+   }
+   
+   for my $name (@names) {
+      my ($name_ut) = $name =~ m{ (.*) }xms;
+      my $flpth     = File::Spec->catdir($pth, $name_ut);
+
+      if( -l $flpth ) {
+	      unlink $flpth or return; 
+      }
+      elsif(-d $flpth) {
+          pathrmdir($flpth) or return;
+      } 
+      else {
+          unlink $flpth or return;
+      }
+   }
+
+   if ( $] < 5.006 ) {
+       closedir PTH_DH;
+   }
+   else {
+       closedir $pth_dh;
+   }
+   
+   1;
+}
+
+sub pathrm {
+   my $path = shift;
+   return 2 if !-d $path;
+   my @pth = File::Spec->splitdir( $path );
+   my $force = shift;
+
+   while(@pth) { 
+      my $cur = File::Spec->catdir(@pth);
+      last if !$cur; # necessary ??? 
+      if(!shift()) {
+         pathempty($cur) or return if $force;
+         rmdir $cur or return;
+      } 
+      else {
+         pathempty($cur) if $force;
+         rmdir $cur;
+      }
+      pop @pth;
+   }
+   1;
+}
+
+sub pathrmdir {
+    my $dir = shift;
+    if( -e $dir ) {
+        return if !-d $dir;
+    }
+    else {
+        return 2;
+    }
+
+    pathempty($dir) or return;
+    
+    rmdir $dir or return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Copy::Recursive - Perl extension for recursively copying files and directories
+
+=head1 SYNOPSIS
+
+  use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
+
+  fcopy($orig,$new[,$buf]) or die $!;
+  rcopy($orig,$new[,$buf]) or die $!;
+  dircopy($orig,$new[,$buf]) or die $!;
+
+  fmove($orig,$new[,$buf]) or die $!;
+  rmove($orig,$new[,$buf]) or die $!;
+  dirmove($orig,$new[,$buf]) or die $!;
+  
+  rcopy_glob("orig/stuff-*", $trg [, $buf]) or die $!;
+  rmove_glob("orig/stuff-*", $trg [,$buf]) or die $!;
+
+=head1 DESCRIPTION
+
+This module copies and moves directories recursively (or single files, well... singley) to an optional depth and attempts to preserve each file or directory's 
+mode.
+
+=head1 EXPORT
+
+None by default. But you can export all the functions as in the example above and the path* functions if you wish.
+
+=head2 fcopy()
+
+This function uses File::Copy's copy() function to copy a file but not a directory. Any directories are recursively created if need be.
+One difference to File::Copy::copy() is that fcopy attempts to preserve the mode (see Preserving Mode below)
+The optional $buf in the synopsis if the same as File::Copy::copy()'s 3rd argument
+returns the same as File::Copy::copy() in scalar context and 1,0,0 in list context to accomidate rcopy()'s list context on regular files. (See below for more 
+info)
+
+=head2 dircopy()
+
+This function recursively traverses the $orig directory's structure and recursively copies it to the $new directory.
+$new is created if necessary (multiple non existant directories is ok (IE foo/bar/baz). The script logically and portably creates all of them if necessary).
+It attempts to preserve the mode (see Preserving Mode below) and 
+by default it copies all the way down into the directory, (see Managing Depth) below.
+If a directory is not specified it croaks just like fcopy croaks if its not a file that is specified.
+
+returns true or false, for true in scalar context it returns the number of files and directories copied,
+In list context it returns the number of files and directories, number of directories only, depth level traversed.
+
+  my $num_of_files_and_dirs = dircopy($orig,$new);
+  my($num_of_files_and_dirs,$num_of_dirs,$depth_traversed) = dircopy($orig,$new);
+  
+Normally it stops and return's if a copy fails, to continue on regardless set $File::Copy::Recursive::SkipFlop to true.
+
+    local $File::Copy::Recursive::SkipFlop = 1;
+
+That way it will copy everythgingit can ina directory and won't stop because of permissions, etc...
+
+=head2 rcopy()
+
+This function will allow you to specify a file *or* directory. It calls fcopy() if its a file and dircopy() if its a directory.
+If you call rcopy() (or fcopy() for that matter) on a file in list context, the values will be 1,0,0 since no directories and no depth are used. 
+This is important becasue if its a directory in list context and there is only the initial directory the return value is 1,1,1.
+
+=head2 rcopy_glob()
+
+This function lets you specify a pattern suitable for perl's glob() as the first argument. Subsequently each path returned by perl's glob() gets rcopy()ied.
+
+It returns and array whose items are array refs that contain the return value of each rcopy() call.
+
+It forces behavior as if $File::Copy::Recursive::CPRFComp is true.
+
+=head2 fmove()
+
+Copies the file then removes the original. You can manage the path the original file is in according to $RemvBase.
+
+=head2 dirmove()
+
+Uses dircopy() to copy the directory then removes the original. You can manage the path the original directory is in according to $RemvBase.
+
+=head2 rmove()
+
+Like rcopy() but calls fmove() or dirmove() instead.
+
+=head2 rmove_glob()
+
+Like rcopy_glob() but calls rmove() instead of rcopy()
+
+=head3 $RemvBase
+
+Default is false. When set to true the *move() functions will not only attempt to remove the original file or directory but will remove the given path it is in.
+
+So if you:
+
+   rmove('foo/bar/baz', '/etc/');
+   # "baz" is removed from foo/bar after it is successfully copied to /etc/
+   
+   local $File::Copy::Recursive::Remvbase = 1;
+   rmove('foo/bar/baz','/etc/');
+   # if baz is successfully copied to /etc/ :
+   # first "baz" is removed from foo/bar
+   # then "foo/bar is removed via pathrm()
+
+=head4 $ForcePth
+
+Default is false. When set to true it calls pathempty() before any directories are removed to empty the directory so it can be rmdir()'ed when $RemvBase is in 
+effect.
+
+=head2 Creating and Removing Paths
+
+=head3 $NoFtlPth
+
+Default is false. If set to true  rmdir(), mkdir(), and pathempty() calls in pathrm() and pathmk() do not return() on failure.
+
+If its set to true they just silently go about their business regardless. This isn't a good idea but its there if you want it.
+
+=head3 $DirPerms
+
+Mode to pass to any mkdir() calls. Defaults to 0777 as per umask()'s POD. Explicitly having this allows older perls to be able to use FCR and might add a bit of 
+flexibility for you.
+
+Any value you set it to should be suitable for oct()
+
+=head3 Path functions
+
+These functions exist soley because they were necessary for the move and copy functions to have the features they do and not because they are of themselves the 
+purpose of this module. That being said, here is how they work so you can understand how the copy and move funtions work and use them by themselves if you wish.
+
+=head4 pathrm()
+
+Removes a given path recursively. It removes the *entire* path so be carefull!!!
+
+Returns 2 if the given path is not a directory.
+
+  File::Copy::Recursive::pathrm('foo/bar/baz') or die $!;
+  # foo no longer exists
+
+Same as:
+
+  rmdir 'foo/bar/baz' or die $!;
+  rmdir 'foo/bar' or die $!;
+  rmdir 'foo' or die $!;
+
+An optional second argument makes it call pathempty() before any rmdir()'s when set to true.
+
+  File::Copy::Recursive::pathrm('foo/bar/baz', 1) or die $!;
+  # foo no longer exists
+
+Same as:PFSCheck
+
+  File::Copy::Recursive::pathempty('foo/bar/baz') or die $!;
+  rmdir 'foo/bar/baz' or die $!;
+  File::Copy::Recursive::pathempty('foo/bar/') or die $!;
+  rmdir 'foo/bar' or die $!;
+  File::Copy::Recursive::pathempty('foo/') or die $!;
+  rmdir 'foo' or die $!;
+
+An optional third argument acts like $File::Copy::Recursive::NoFtlPth, again probably not a good idea.
+
+=head4 pathempty()
+
+Recursively removes the given directory's contents so it is empty. returns 2 if argument is not a directory, 1 on successfully emptying the directory.
+
+   File::Copy::Recursive::pathempty($pth) or die $!;
+   # $pth is now an empty directory
+
+=head4 pathmk()
+
+Creates a given path recursively. Creates foo/bar/baz even if foo does not exist.
+
+   File::Copy::Recursive::pathmk('foo/bar/baz') or die $!;
+
+An optional second argument if true acts just like $File::Copy::Recursive::NoFtlPth, which means you'd never get your die() if something went wrong. Again, 
+probably a *bad* idea.
+
+=head4 pathrmdir()
+
+Same as rmdir() but it calls pathempty() first to recursively empty it first since rmdir can not remove a directory with contents.
+Just removes the top directory the path given instead of the entire path like pathrm(). Return 2 if given argument does not exist (IE its already gone). Return 
+false if it exists but is not a directory.
+
+=head2 Preserving Mode
+
+By default a quiet attempt is made to change the new file or directory to the mode of the old one.
+To turn this behavior off set
+  $File::Copy::Recursive::KeepMode
+to false;
+
+=head2 Managing Depth
+
+You can set the maximum depth a directory structure is recursed by setting:
+  $File::Copy::Recursive::MaxDepth 
+to a whole number greater than 0.
+
+=head2 SymLinks
+
+If your system supports symlinks then symlinks will be copied as symlinks instead of as the target file.
+Perl's symlink() is used instead of File::Copy's copy()
+You can customize this behavior by setting $File::Copy::Recursive::CopyLink to a true or false value.
+It is already set to true or false dending on your system's support of symlinks so you can check it with an if statement to see how it will behave:
+
+    if($File::Copy::Recursive::CopyLink) {
+        print "Symlinks will be preserved\n";
+    } else {
+        print "Symlinks will not be preserved because your system does not support it\n";
+    }
+
+If symlinks are being copied you can set $File::Copy::Recursive::BdTrgWrn to true to make it carp when it copies a link whose target does not exist. Its false 
+by default.
+
+    local $File::Copy::Recursive::BdTrgWrn  = 1;
+
+=head2 Removing existing target file or directory before copying.
+
+This can be done by setting $File::Copy::Recursive::RMTrgFil or $File::Copy::Recursive::RMTrgDir for file or directory behavior respectively.
+
+0 = off (This is the default)
+
+1 = carp() $! if removal fails
+
+2 = return if removal fails
+
+    local $File::Copy::Recursive::RMTrgFil = 1;
+    fcopy($orig, $target) or die $!;
+    # if it fails it does warn() and keeps going
+
+    local $File::Copy::Recursive::RMTrgDir = 2;
+    dircopy($orig, $target) or die $!;
+    # if it fails it does your "or die"
+
+This should be unnecessary most of the time but its there if you need it :)
+
+=head2 Turning off stat() check
+
+By default the files or directories are checked to see if they are the same (IE linked, or two paths (absolute/relative or different relative paths) to the same 
+file) by comparing the file's stat() info. 
+It's a very efficient check that croaks if they are and shouldn't be turned off but if you must for some weird reason just set $File::Copy::Recursive::PFSCheck 
+to a false value. ("PFS" stands for "Physical File System")
+
+=head2 Emulating cp -rf dir1/ dir2/
+
+By default dircopy($dir1,$dir2) will put $dir1's contents right into $dir2 whether $dir2 exists or not.
+
+You can make dircopy() emulate cp -rf by setting $File::Copy::Recursive::CPRFComp to true.
+
+NOTE: This only emulates -f in the sense that it does not prompt. It does not remove the target file or directory if it exists.
+If you need to do that then use the variables $RMTrgFil and $RMTrgDir described in "Removing existing target file or directory before copying" above.
+
+That means that if $dir2 exists it puts the contents into $dir2/$dir1 instead of $dir2 just like cp -rf.
+If $dir2 does not exist then the contents go into $dir2 like normal (also like cp -rf)
+
+So assuming 'foo/file':
+
+    dircopy('foo', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/file
+
+    $File::Copy::Recursive::CPRFComp = 1;
+    dircopy('foo', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/foo/file
+
+You can also specify a star for cp -rf glob type behavior:
+
+    dircopy('foo/*', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/file
+
+    $File::Copy::Recursive::CPRFComp = 1;
+    dircopy('foo/*', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/file
+
+NOTE: The '*' is only like cp -rf foo/* and *DOES NOT EXPAND PARTIAL DIRECTORY NAMES LIKE YOUR SHELL DOES* (IE not like cp -rf fo* to copy foo/*)
+
+=head2 Allowing Copy Loops
+
+If you want to allow:
+
+  cp -rf . foo/
+
+type behavior set $File::Copy::Recursive::CopyLoop to true.
+
+This is false by default so that a check is done to see if the source directory will contain the target directory and croaks to avoid this problem.
+
+If you ever find a situation where $CopyLoop = 1 is desirable let me know (IE its a bad bad idea but is there if you want it)
+
+(Note: On Windows this was necessary since it uses stat() to detemine samedness and stat() is essencially useless for this on Windows. 
+The test is now simply skipped on Windows but I'd rather have an actual reliable check if anyone in Microsoft land would care to share)
+
+=head1 SEE ALSO
+
+L<File::Copy> L<File::Spec>
+
+=head1 TO DO
+
+I am currently working on and reviewing some other modules to use in the new interface so we can lose the horrid globals as well as some other undesirable 
+traits and also more easily make available some long standing requests.
+
+Tests will be easier to do with the new interface and hence the testing focus will shift to the new interface and aim to be comprehensive.
+
+The old interface will work, it just won't be brought in until it is used, so it will add no overhead for users of the new interface.
+
+I'll add this after the latest verision has been out for a while with no new features or issues found :)
+
+=head1 AUTHOR
+
+Daniel Muey, L<http://drmuey.com/cpan_contact.pl>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Daniel Muey
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut
+

lib/Lib/Auto.pm

@@ -4,18 +4,23 @@
 package Lib::Auto;
 use strict;
 use warnings;
+use feature qw(say);
 use English qw(-no_match_vars);
 use Sys::Hostname;
 use feature qw(switch);
-use API::Std qw(conf_get err);
-use API::Log qw(println dbug alog);
+use API::Std qw(hook_add conf_get err);
+use API::Log qw(dbug alog);
 our $VERSION = 3.000000;
 
+# Core events.
+API::Std::event_add('on_shutdown');
+API::Std::event_add('on_rehash');
+
 # Update checker.
 sub checkver
 {
     if (!$Auto::NUC and Auto::RSTAGE ne 'd') {
-        println '* Connecting to update server...';
+        say '* Connecting to update server...';
         my $uss = IO::Socket::INET->new(
             'Proto'    => 'tcp',
             'PeerAddr' => 'dist.xelhua.org',
@@ -33,11 +38,11 @@ sub checkver
             }
             elsif ($v eq 'version') {
                 if (Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE ne $c) {
-                    println('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.' - Latest version: '.$c);
-                    println('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll);
+                    say('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.' - Latest version: '.$c);
+                    say('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll);
                 }
                 else {
-                    println('* Auto is up-to-date.');
+                    say('* Auto is up-to-date.');
                 }
             }
         }
@@ -50,7 +55,7 @@ sub rehash
     my %newsettings = $Auto::CONF->parse or err(2, 'Failed to parse configuration file!', 0) and return;
 
     # Check for required configuration values.
-    my @REQCVALS = qw(locale expire_logs server fantasy_pf);
+    my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit bantype);
     foreach my $REQCVAL (@REQCVALS) {
         if (!defined $newsettings{$REQCVAL}) {
             err(2, "Missing required configuration value: $REQCVAL", 0) and return;
@@ -118,7 +123,7 @@ sub rehash
     if (conf_get('module')) {
         alog '* Loading modules...';
         foreach (@{ (conf_get('module'))[0] }) {
-            if (!API::Std::mod_exists($_)) { Auto::mod_load($_); }
+            if (!API::Std::mod_exists($_)) { Auto::mod_load($_) }
         }
     }
 
@@ -129,80 +134,117 @@ sub rehash
     # Iterate through each configured server.
     foreach my $cskey (keys %cservers) {
         if (!defined $Auto::SOCKET{$cskey}) {
-            # Prepare socket data.
-            my %conndata = (
-                Proto => 'tcp',
-                LocalAddr => $cservers{$cskey}{'bind'}[0],
-                PeerAddr  => $cservers{$cskey}{'host'}[0],
-                PeerPort  => $cservers{$cskey}{'port'}[0],
-                Timeout   => 20,
-            );
-            # Set IPv6/SSL data.
-            my $use6 = 0;
-            my $usessl = 0;
-            if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
-            if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
-
-            # CertFP.
-            if ($usessl) {
-                if (defined $cservers{$cskey}{'certfp'}[0]) {
-                    if ($cservers{$cskey}{'certfp'}[0] eq 1) {
-                        $conndata{'SSL_use_cert'} = 1;
-                        if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
-                            $conndata{'SSL_cert_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
-                        }
-                        if (defined $cservers{$cskey}{'certfp_key'}[0]) {
-                            $conndata{'SSL_key_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
-                        }
-                        if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
-                            $conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
-                        }
-                    }
-                }
-            }
-
-            # Create the socket.
-            if ($use6) {
-                $Auto::SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
-                err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-                    and delete $Auto::SOCKET{$cskey} and next;
-            }
-            else {
-                if ($usessl) {
-                    $Auto::SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
-                    err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-                        and delete $Auto::SOCKET{$cskey} and next;
-                }
-                else {
-                    $Auto::SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
-                    err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-                        and delete $Auto::SOCKET{$cskey} and next;
-                }
-            }
-
-            # Send PASS if we have one.
-            if (defined $cservers{$cskey}{'pass'}[0]) {
-                Auto::socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
-                err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-                    and next;
-            }
-            API::Std::event_run('on_preconnect', $cskey);
-            # Send NICK/USER.
-            API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
-            Auto::socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
-            err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
-                and next;
-            # Add to select.
-            $Auto::SELECT->add($Auto::SOCKET{$cskey});
-            # Success!
-            alog '** Successfully connected to server: '.$cskey;
-            dbug '** Successfully connected to server: '.$cskey;
+            ircsock(\%{$cservers{$cskey}}, $cskey);
         }
     }
 
+    # Check for server connections.
+    if (!keys %Auto::SOCKET) {
+        err(2, 'No IRC connections -- Exiting program.', 0);
+        API::Std::event_run('on_shutdown');
+        exit 1;
+    }
+
+    # Now trigger on_rehash.
+    API::Std::event_run('on_rehash');
+
     return 1;
 }
 
+# Socket creation.
+sub ircsock {
+    my ($cdata, $svrname) = @_;
+
+    # Prepare socket data.
+    my %conndata = (
+        Proto => 'tcp',
+        LocalAddr => $cdata->{'bind'}[0],
+        PeerAddr  => $cdata->{'host'}[0],
+        PeerPort  => $cdata->{'port'}[0],
+        Timeout   => 20,
+    );
+    # Set IPv6/SSL data.
+    my $use6 = 0;
+    my $usessl = 0;
+    if (defined $cdata->{'ipv6'}[0]) { $use6 = $cdata->{'ipv6'}[0] }
+    if (defined $cdata->{'ssl'}[0]) { $usessl = $cdata->{'ssl'}[0] }
+
+    # Check for appropriate build data.
+    if ($usessl) {
+        if ($Auto::ENFEAT !~ m/ssl/ixsm) { err(2, '** Auto not built with SSL support: Aborting connection to '.$svrname, 0); return }
+    }
+    if ($use6) {
+        if ($Auto::ENFEAT !~ m/ipv6/ixsm) { err(2, '** Auto not built with IPv6 support: Aborting connection to '.$svrname, 0); return }
+    }
+
+    # CertFP.
+    if ($usessl) {
+        if (defined $cdata->{'certfp'}[0]) {
+            if ($cdata->{'certfp'}[0] eq 1) {
+                $conndata{'SSL_use_cert'} = 1;
+                if (defined $cdata->{'certfp_cert'}[0]) {
+                    $conndata{'SSL_cert_file'} = "$Auto::bin{etc}/certs/".$cdata->{'certfp_cert'}[0];
+                }
+                if (defined $cdata->{'certfp_key'}[0]) {
+                    $conndata{'SSL_key_file'} = "$Auto::bin{etc}/certs/".$cdata->{'certfp_key'}[0];
+                }
+                if (defined $cdata->{'certfp_pass'}[0]) {
+                    $conndata{'SSL_passwd_cb'} = sub { return $cdata->{'certfp_pass'}[0] };
+                }
+            }
+        }
+    }
+
+    # Create the socket.
+    if ($use6) {
+        $Auto::SOCKET{$svrname} = IO::Socket::INET6->new(%conndata) or # Or error.
+        err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
+            and delete $Auto::SOCKET{$svrname} and return;
+    }
+    else {
+        if ($usessl) {
+            $Auto::SOCKET{$svrname} = IO::Socket::SSL->new(%conndata) or # Or error.
+            err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
+            and delete $Auto::SOCKET{$svrname} and next;
+        }
+        else {
+            $Auto::SOCKET{$svrname} = IO::Socket::INET->new(%conndata) or # Or error.
+            err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
+            and delete $Auto::SOCKET{$svrname} and next;
+            binmode($Auto::SOCKET{$svrname}, ':encoding(UTF-8)');
+        }
+    }
+
+    # Create a CAP entry if it doesn't already exist.
+    if (!$Proto::IRC::cap{$svrname}) { $Proto::IRC::cap{$svrname} = 'multi-prefix' }
+    # Send PASS if we have one.
+    if (defined $cdata->{'pass'}[0]) {
+        Auto::socksnd($svrname, 'PASS :'.$cdata->{'pass'}[0]) or return;
+    }
+    # Send CAP LS.
+    Auto::socksnd($svrname, 'CAP LS');
+    # Trigger on_preconnect.
+    API::Std::event_run('on_preconnect', $svrname);
+    # Send NICK/USER.
+    API::IRC::nick($svrname, $cdata->{'nick'}[0]);
+    Auto::socksnd($svrname, 'USER '.$cdata->{'ident'}[0].q{ }.hostname.q{ }.$cdata->{'host'}[0].' :'.$cdata->{'realname'}[0]) or return;
+    # Add to select.
+    $Auto::SELECT->add($Auto::SOCKET{$svrname});
+    # Success!
+    alog '** Successfully connected to server: '.$svrname;
+    dbug '** Successfully connected to server: '.$svrname;
+
+    return 1;
+}
+
+# Shutdown.
+hook_add('on_shutdown', 'shutdown.core_cleanup', sub {
+    if (defined $Auto::DB) { $Auto::DB->disconnect }
+    if ($Auto::UPREFIX) { if (-e "$Auto::bin{cwd}/auto.pid") { unlink "$Auto::bin{cwd}/auto.pid" } }
+    else { if (-e "$Auto::Bin/auto.pid") { unlink "$Auto::Bin/auto.pid" } }
+    return 1;
+});
+
 ###################
 # Signal handlers #
 ###################
@@ -211,13 +253,10 @@ sub rehash
 sub signal_term
 {
     API::Std::event_run('on_sigterm');
-    foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGTERM'); }
-    $Auto::DB->disconnect;
+    API::Std::event_run('on_shutdown');
+    foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGTERM') }
     dbug '!!! Caught SIGTERM; terminating...';
     alog '!!! Caught SIGTERM; terminating...';
-    if (-e "$Auto::Bin/auto.pid") {
-        unlink "$Auto::Bin/auto.pid";
-    }
     sleep 1;
     exit;
 }
@@ -226,13 +265,10 @@ sub signal_term
 sub signal_int
 {
     API::Std::event_run('on_sigint');
-    foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGINT'); }
-    $Auto::DB->disconnect;
+    API::Std::event_run('on_shutdown');
+    foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGINT') }
     dbug '!!! Caught SIGINT; terminating...';
     alog '!!! Caught SIGINT; terminating...';
-    if (-e "$Auto::Bin/auto.pid") {
-        unlink "$Auto::Bin/auto.pid";
-    }
     sleep 1;
     exit;
 }
@@ -253,7 +289,7 @@ sub signal_perlwarn
     my ($warnmsg) = @_;
     $warnmsg =~ s/(\n|\r)//xsmg;
     alog 'Perl Warning: '.$warnmsg;
-    if ($Auto::DEBUG) { println 'Perl Warning: '.$warnmsg; }
+    if ($Auto::DEBUG) { say 'Perl Warning: '.$warnmsg }
     return 1;
 }
 
@@ -265,16 +301,13 @@ sub signal_perldie
 
     return if $EXCEPTIONS_BEING_CAUGHT;
     alog 'Perl Fatal: '.$diemsg.' -- Terminating program!';
-    foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'A fatal error occurred!'); }
-    $Auto::DB->disconnect;
-    if (-e "$Auto::Bin/auto.pid") {
-        unlink "$Auto::Bin/auto.pid";
-    }
+    foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'A fatal error occurred!') }
+    API::Std::event_run('on_shutdown');
     sleep 1;
-    println 'FATAL: '.$diemsg;
+    say 'FATAL: '.$diemsg;
     exit;
 }
 
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/Lib/Install.pm

@@ -6,8 +6,6 @@ use strict;
 use warnings;
 use Exporter;
 use English qw(-no_match_vars);
-use FindBin qw($Bin);
-our $Bin = $Bin;
 
 our $VERSION = 1.00;
 our @ISA = qw(Exporter);
@@ -39,28 +37,33 @@ sub modfind
 
 sub build
 {
-    my ($features) = @_;
+    my ($features, $Bin, $syswide) = @_;
+    if (!defined $syswide) { $syswide = 0 }
 
-    open(my $FTIME, q{>}, "$Bin/build/time") or println "Failed to install." and exit;
+    open(my $FTIME, q{>}, "$Bin/time") or println "Failed to install." and exit;
     print $FTIME time."\n" or println "Failed to install." and exit;
     close $FTIME or println "Failed to install." and exit;
 
-    open(my $FOS, q{>}, "$Bin/build/os") or println "Failed to install." and exit;
+    open(my $FOS, q{>}, "$Bin/os") or println "Failed to install." and exit;
     print $FOS $OSNAME."\n" or println "Failed to install." and exit;
     close $FOS or println "Failed to install." and exit;
 
-    open(my $FFEAT, q{>}, "$Bin/build/feat") or println "Failed to install." and exit;
+    open(my $FFEAT, q{>}, "$Bin/feat") or println "Failed to install." and exit;
     print $FFEAT $features."\n" or println "Failed to install." and exit;
     close $FFEAT or println "Failed to install." and exit;
 
-    open(my $FPERL, q{>}, "$Bin/build/perl") or println "Failed to install." and exit;
+    open(my $FPERL, q{>}, "$Bin/perl") or println "Failed to install." and exit;
     print $FPERL "$]\n" or println "Failed to install." and exit;
     close $FPERL or println "Failed to install." and exit;
 
-    open(my $FVER, q{>}, "$Bin/build/ver") or println "Failed to install." and exit;
+    open(my $FVER, q{>}, "$Bin/ver") or println "Failed to install." and exit;
     print $FVER "3.0.0d\n" or println "Failed to install." and exit;
     close $FVER or println "Failed to install." and exit;
 
+    open my $FSYS, '>', "$Bin/syswide" or println "Failed to install." and exit;
+    print {$FSYS} "$syswide\n" or println "Failed to install." and exit;
+    close $FSYS or println "Failed to install." and exit;
+
     return 1;
 }
 
@@ -114,21 +117,22 @@ sub checkcore
 
 sub installmods
 {
+    my ($prefix) = @_;
     print 'Would you like to install any official modules? [y/n] ';
     my $response = <STDIN>;
     chomp $response;
     if (lc $response eq 'y') {
         println 'What modules would you like to install? (separate by commas)';
-        println 'Available modules: Badwords, Bitly, Calc, EightBall, FML, HelloChan, IsItUp, QDB, SASLAuth, Weather';
+        println 'Available modules: AUR, Badwords, Bitly, BotStats, Calc, ChanTopics, Dictionary, EightBall, Eval, FML, Greet, HelloChan, IsItUp, LinkTitle, LOLCAT, Oper, QDB, SASLAuth, UNO, Weather, Werewolf';
         print '> ';
         my $modules = <STDIN>; chomp $modules;
         $modules =~ s/ //g;
         my @modst = split ',', $modules;
         foreach (@modst) {
-            system "$Bin/bin/buildmod $_";
+            system "perl \"$prefix/bin/buildmod\" $_";
         }
     }
 }
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/Parser/Config.pm

@@ -12,18 +12,18 @@ sub new
     my ($file) = @_;
     my $self = bless {}, $class;
 
-	# Check to see if the configuration file exists.
-	if (!-e "$Auto::Bin/../etc/$file") {
-		return 0;
-	}
-	
-	# Open, read and close the config.
-	open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
-	my @cosfl = <$FCONF> or return 0;
-	close $FCONF or return 0;
-	
-	# Save it to self variable.
-	$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";
+    # Check to see if the configuration file exists.
+    if (!-e "$Auto::bin{etc}/$file") {
+        return;
+    }
+    
+    # Open, read and close the config.
+    open(my $FCONF, q{<}, "$Auto::bin{etc}/$file") or return;
+    my @cosfl = <$FCONF> or return;
+    close $FCONF or return;
+    
+    # Save it to self variable.
+    $self->{'config'}->{'path'} = "$Auto::bin{etc}/$file";
 
     return $self;
 }
@@ -31,150 +31,150 @@ sub new
 # Parse the configuration file.
 sub parse 
 {
-	# Get the path to the file.
-	my $self = shift;
-	my $file = $self->{'config'}->{'path'};
-	my $blk = 0;
-	my (%rs);
-	
-	# Open, read and close it.
-	open(my $FCONF, q{<}, "$file") or return 0;
-	my @fbuf = <$FCONF> or return 0;
-	close $FCONF or return 0;
-	
-	# Iterate the file.
-	foreach my $buff (@fbuf) {
-		# Main newline buffer.
-		if (defined $buff) {
-			# If the line begins with a #, it's a comment so ignore it.
-			if (substr($buff, 0, 1) eq '#') {
-				next;
-			}
-			
-			if ($buff =~ m/;/) {
-				# Semicolon buffer.
-				my @asbuf = split(';', $buff);
-				foreach my $asbuff (@asbuf) {
-					if (defined $asbuff) {
-						
-						# Space buffer.
-						my @ebuf = split(' ', $asbuff);
-						if (!defined $ebuf[0] or !defined $ebuf[1]) {
-							# Garbage. Ignoring.
-							next;
-						}
-						my $param = $ebuf[1];
-						
-						if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
-							# Multi-word string.
-							$param = substr($param, 1);
-							
-							for (my $i = 2; $i < scalar(@ebuf); $i++) {
-								if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
-									$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
-									last;
-								}
-								else {
-									$param .= " ".$ebuf[$i];
-								}
-							}
-						}
-						elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
-							# Single-word string.
-							$param = substr($param, 1, length($ebuf[1]) - 2);
-						}
-						elsif ($param =~ m/[0-9]/) {
-							# Numeric.
-							$param =~ s/[^0-9.]//g;
-						}
-						else {
-							# Garbage.
-							next;
-						}
-						
-						my @param = ($param);
-								
-						unless (!$blk) {
-							# We're inside a block.
-							if ($blk =~ m/@@@/) {
-								# We're inside a block with a parameter.
-								my @sblk = split('@@@', $blk);
-								
-								# Check to see if this config option already exists.
-								if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
-									# It does, so merely push this second one to the existing array.
-									push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
-								}
-								else {
-									# It doesn't, create it as an array.
-									@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
-								}
-							}
-							else {
-								# We're inside a block with no parameter.
-								
-								# Check to see if this config option already exists.
-								if (defined $rs{$blk}{$ebuf[0]}) {
-									# It does, so merely push this second one to the existing array.
+    # Get the path to the file.
+    my $self = shift;
+    my $file = $self->{'config'}->{'path'};
+    my $blk = 0;
+    my (%rs);
+    
+    # Open, read and close it.
+    open(my $FCONF, q{<}, "$file") or return;
+    my @fbuf = <$FCONF> or return;
+    close $FCONF or return;
+    
+    # Iterate the file.
+    foreach my $buff (@fbuf) {
+        # Main newline buffer.
+        if (defined $buff) {
+            # If the line begins with a #, it's a comment so ignore it.
+            if (substr($buff, 0, 1) eq '#') {
+                next;
+            }
+            
+            if ($buff =~ m/;/) {
+                # Semicolon buffer.
+                my @asbuf = split(';', $buff);
+                foreach my $asbuff (@asbuf) {
+                    if (defined $asbuff) {
+                        
+                        # Space buffer.
+                        my @ebuf = split(' ', $asbuff);
+                        if (!defined $ebuf[0] or !defined $ebuf[1]) {
+                            # Garbage. Ignoring.
+                            next;
+                        }
+                        my $param = $ebuf[1];
+                        
+                        if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
+                            # Multi-word string.
+                            $param = substr($param, 1);
+                            
+                            for (my $i = 2; $i < scalar(@ebuf); $i++) {
+                                if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
+                                    $param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
+                                    last;
+                                }
+                                else {
+                                    $param .= " ".$ebuf[$i];
+                                }
+                            }
+                        }
+                        elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
+                            # Single-word string.
+                            $param = substr($param, 1, length($ebuf[1]) - 2);
+                        }
+                        elsif ($param =~ m/[0-9]/) {
+                            # Numeric.
+                            $param =~ s/[^0-9.]//g;
+                        }
+                        else {
+                            # Garbage.
+                            next;
+                        }
+                        
+                        my @param = ($param);
+                                
+                        unless (!$blk) {
+                            # We're inside a block.
+                            if ($blk =~ m/@@@/) {
+                                # We're inside a block with a parameter.
+                                my @sblk = split('@@@', $blk);
+                                
+                                # Check to see if this config option already exists.
+                                if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
+                                    # It does, so merely push this second one to the existing array.
+                                    push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
+                                }
+                                else {
+                                    # It doesn't, create it as an array.
+                                    @{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
+                                }
+                            }
+                            else {
+                                # We're inside a block with no parameter.
+                                
+                                # Check to see if this config option already exists.
+                                if (defined $rs{$blk}{$ebuf[0]}) {
+                                    # It does, so merely push this second one to the existing array.
                                     push(@{ $rs{$blk}{$ebuf[0]} }, $param);
-								}
-								else {
-									# It doesn't, create it as an array.
-									@{ $rs{$blk}{$ebuf[0]} } = @param;
-								}
-							}
-						}
-						else {
-							# We're not inside a block.
-							
-							# Check to see if this config option already exists.
-							if (defined $rs{$ebuf[0]}) {
-								# It does, so merely push this second one to the existing array.
-								push(@{ $rs{$ebuf[0]} }, $param);
-							}
-							else {
-								# It doesn't, create it as an array.
-								@{ $rs{$ebuf[0]} } = @param;
-							}
-						}	
-					}
-				}
-			}
-			else {
-				# No semicolon space buffer.
-				my @ebuf = split(' ', $buff);
-				
-				if (!defined $ebuf[0]) {
-					# Garbage. Ignoring.
-					next;
-				}
-				
-				if (defined $ebuf[1]) {
-					if ($ebuf[1] eq '{') {
-						# This is the beginning of a block with no parameter.
+                                }
+                                else {
+                                    # It doesn't, create it as an array.
+                                    @{ $rs{$blk}{$ebuf[0]} } = @param;
+                                }
+                            }
+                        }
+                        else {
+                            # We're not inside a block.
+                            
+                            # Check to see if this config option already exists.
+                            if (defined $rs{$ebuf[0]}) {
+                                # It does, so merely push this second one to the existing array.
+                                push(@{ $rs{$ebuf[0]} }, $param);
+                            }
+                            else {
+                                # It doesn't, create it as an array.
+                                @{ $rs{$ebuf[0]} } = @param;
+                            }
+                        }    
+                    }
+                }
+            }
+            else {
+                # No semicolon space buffer.
+                my @ebuf = split(' ', $buff);
+                
+                if (!defined $ebuf[0]) {
+                    # Garbage. Ignoring.
+                    next;
+                }
+                
+                if (defined $ebuf[1]) {
+                    if ($ebuf[1] eq '{') {
+                        # This is the beginning of a block with no parameter.
                         $blk = $ebuf[0];
-					}
-					elsif (defined $ebuf[2]) {
-						if ($ebuf[2] eq '{') {
-							# This is the beginning of a block with a parameter.
-							my $param = $ebuf[1];
-							$param =~ s/"//g;
-							$blk = $ebuf[0].'@@@'.$param;
-						}
-					}
-				}
-				if ($ebuf[0] eq '}') {
-					# This is the end of a block.
-					$blk = 0;
-				}
-			}
-		}
-	}	
-	
-	# Return the configuration data.
-	return %rs;				
+                    }
+                    elsif (defined $ebuf[2]) {
+                        if ($ebuf[2] eq '{') {
+                            # This is the beginning of a block with a parameter.
+                            my $param = $ebuf[1];
+                            $param =~ s/"//g;
+                            $blk = $ebuf[0].'@@@'.$param;
+                        }
+                    }
+                }
+                if ($ebuf[0] eq '}') {
+                    # This is the end of a block.
+                    $blk = 0;
+                }
+            }
+        }
+    }    
+    
+    # Return the configuration data.
+    return %rs;                
 }
 
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/Parser/IRC.pm

@@ -1,656 +0,0 @@
-# lib/Parser/IRC.pm - Subroutines for parsing incoming data from IRC.
-# Copyright (C) 2010-2011 Xelhua Development Group, et al.
-# This program is free software; rights to this code are stated in doc/LICENSE.
-package Parser::IRC;
-use strict;
-use warnings;
-use API::Std qw(conf_get err awarn trans);
-use API::IRC;
-
-# Raw parsing hash.
-our %RAWC = (
-	'001'      => \&num001,
-	'005'      => \&num005,
-	'353'      => \&num353,
-	'432'      => \&num432,
-	'433'      => \&num433,
-	'438'      => \&num438,
-	'465'      => \&num465,
-	'471'      => \&num471,
-	'473'      => \&num473,
-	'474'      => \&num474,
-	'475'      => \&num475,
-	'477'      => \&num477,
-	'JOIN'     => \&cjoin,
-    'KICK'     => \&kick,
-    'MODE'     => \&mode,
-	'NICK'     => \&nick,
-	'NOTICE'   => \&notice,
-    'PART'     => \&part,
-	'PRIVMSG'  => \&privmsg,
-	'QUIT'     => \&quit,
-    'TOPIC'    => \&topic,
-);
-
-# Variables for various functions.
-our (%got_001, %botnick, %botchans, %csprefix, %chanusers, %chanmodes);
-
-# Events.
-API::Std::event_add("on_connect");
-API::Std::event_add("on_rcjoin");
-API::Std::event_add("on_ucjoin");
-API::Std::event_add("on_kick");
-API::Std::event_add("on_nick");
-API::Std::event_add("on_notice");
-API::Std::event_add("on_cprivmsg");
-API::Std::event_add("on_uprivmsg");
-API::Std::event_add("on_quit");
-API::Std::event_add("on_topic");
-
-# Parse raw data.
-sub ircparse
-{
-	my ($svr, $data) = @_;
-	
-	# Split spaces into @ex.
-	my @ex = split(' ', $data);
-	
-	# Make sure there is enough data.
-	if (defined $ex[0] and defined $ex[1]) {
-		# If it's a ping...
-		if ($ex[0] eq 'PING') {
-			# send a PONG.
-			Auto::socksnd($svr, "PONG ".$ex[1]);
-		}
-		# If it's AUTHENTICATE
-		elsif ($ex[0] eq 'AUTHENTICATE') {
-			if (API::Std::mod_exists("SASLAuth")) {
-				m_SASLAuth::handle_authenticate($svr, @ex);
-			}
-		}
-		else {
-			# otherwise, check %RAWC for ex[1].
-			if (defined $RAWC{$ex[1]}) {
-				&{ $RAWC{$ex[1]} }($svr, @ex);
-			}
-		}
-	}
-	
-	return 1;
-}
-
-###########################
-# Raw parsing subroutines #
-###########################
-
-# Parse: Numeric:001
-# Successful connection.
-sub num001
-{
-	my ($svr, @ex) = @_;
-	
-	$got_001{$svr} = 1;
-	
-	# In case we don't get NICK from the server.
-	if (defined $botnick{$svr}{newnick}) {
-		$botnick{$svr}{nick} = $botnick{$svr}{newnick};
-		delete $botnick{$svr}{newnick};
-	}
-
-    # Trigger on_connect.
-    API::Std::event_run("on_connect", $svr);
-		
-	return 1;
-}
-
-# Parse: Numeric:005
-# Prefixes and channel modes.
-sub num005
-{
-	my ($svr, @ex) = @_;
-	
-	# Find PREFIX and CHANMODES.
-	foreach my $ex (@ex) {
-		if ($ex =~ m/^PREFIX/xsm) {
-			# Found PREFIX.
-			my $rpx = substr($ex, 8);
-			my ($pm, $pp) = split('\)', $rpx);
-			my @apm = split(//, $pm);
-			my @app = split(//, $pp);
-			foreach my $ppm (@apm) {
-				# Store data.
-				$csprefix{$svr}{$ppm} = shift(@app);
-			}
-		}
-        elsif ($ex =~ m/^CHANMODES/xsm) {
-            # Found CHANMODES.
-            my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
-            # List modes.
-            foreach (split(//, $mtl)) { $chanmodes{$svr}{$_} = 1; }
-            # Modes with parameter.
-            foreach (split(//, $mtp)) { $chanmodes{$svr}{$_} = 2; }
-            # Modes with parameter when +.
-            foreach (split(//, $mtpp)) { $chanmodes{$svr}{$_} = 3; }
-            # Modes without parameter.
-            foreach (split(//, $mts)) { $chanmodes{$svr}{$_} = 4; }
-        }
-	}
-				
-	return 1;
-}
-
-# Parse: Numeric:353
-# NAMES reply.
-sub num353
-{
-	my ($svr, @ex) = @_;
-	
-	# Get rid of the colon.
-	$ex[5] = substr($ex[5], 1);
-	# Delete the old chanusers hash if it exists.
-	delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
-	# Iterate through each user.
-	for (my $i = 5; $i < scalar(@ex); $i++) {
-		my $fi = 0;
-		foreach (keys %{ $csprefix{$svr} }) {
-			# Check if the user has status in the channel.
-			if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) {
-				# He/she does. Lets set that.
-				if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) {
-					# If the user has multiple statuses.
-					$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_;
-				}
-				else {
-					# Or not.
-					$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
-				}
-				$fi = 1;
-			}
-		}
-		# They had status, so go to the next user.
-		next if $fi;
-		# They didn't, set them as a normal user.
-		if (!defined $chanusers{$svr}{$ex[4]}{lc($ex[$i])}) {
-			$chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1;
-		}
-	}
-	
-	return 1;
-}
-
-# Parse: Numeric:432
-# Erroneous nickname.
-sub num432
-{
-	my ($svr, undef) = @_;
-	
-	if ($got_001{$svr}) {
-		err(3, "Got error from server[".$svr."]: Erroneous nickname.", 0);
-	}
-	else {
-		err(2, "Got error from server[".$svr."] before 001: Erroneous nickname. Closing connection.", 0);
-		API::IRC::quit($svr, "An error occurred.");
-	}
-	
-	delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
-	
-	return 1;
-}
-
-# Parse: Numeric:433
-# Nickname is already in use.
-sub num433
-{
-	my ($svr, undef) = @_;
-	
-	if (defined $botnick{$svr}{newnick}) {
-		API::IRC::nick($svr, $botnick{$svr}{newnick}."_");
-		delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
-	}
-	
-	return 1;
-}
-
-# Parse: Numeric:438
-# Nick change too fast.
-sub num438
-{
-	my ($svr, @ex) = @_;
-	
-	if (defined $botnick{$svr}{newnick}) {
-		API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub { 
-			API::IRC::nick($Parser::IRC::botnick{$svr}{newnick});
-			delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
-		 });
-	}
-	
-	return 1;
-}
-
-# Parse: Numeric:465
-# You're banned creep!
-sub num465
-{
-	my ($svr, undef) = @_;
-	
-	err(3, "Banned from ".$svr."! Closing link...", 0);
-	
-	return 1;
-}
-
-# Parse: Numeric:471
-# Cannot join channel: Channel is full.
-sub num471
-{
-	my ($svr, (undef, undef, undef, $chan)) = @_;
-	
-	err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is full.", 0);
-	
-	return 1;
-}
-
-# Parse: Numeric:473
-# Cannot join channel: Channel is invite-only.
-sub num473
-{
-	my ($svr, (undef, undef, undef, $chan)) = @_;
-	
-	err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is invite-only.", 0);
-	
-	return 1;
-}
-
-# Parse: Numeric:474
-# Cannot join channel: Banned from channel.
-sub num474
-{
-	my ($svr, (undef, undef, undef, $chan)) = @_;
-	
-	err(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0);
-	
-	return 1;
-}
-
-# Parse: Numeric:475
-# Cannot join channel: Bad key.
-sub num475
-{
-	my ($svr, (undef, undef, undef, $chan)) = @_;
-	
-	err(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0);
-	
-	return 1;
-}
-
-# Parse: Numeric:477
-# Cannot join channel: Need registered nickname.
-sub num477
-{
-	my ($svr, (undef, undef, undef, $chan)) = @_;
-	
-	err(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0);
-	
-	return 1;
-}
-
-# Parse: JOIN
-sub cjoin
-{
-	my ($svr, @ex) = @_;
-	my %src = API::IRC::usrc(substr($ex[0], 1));
-	
-	# Check if this is coming from ourselves.
-	if ($src{nick} eq $botnick{$svr}{nick}) {
-		$botchans{$svr}{substr $ex[2], 1} = 1;
-		API::Std::event_run("on_ucjoin", ($svr, substr($ex[2], 1)));
-	}
-	else {
-		# It isn't. Update chanusers and trigger on_rcjoin.
-        $chanusers{$svr}{substr $ex[2], 1}{$src{nick}} = 1;
-		API::Std::event_run("on_rcjoin", ($svr, \%src, substr($ex[2], 1)));
-	}
-	
-	return 1;
-}
-
-# Parse: KICK
-sub kick
-{
-    my ($svr, @ex) = @_;
-    my %src = API::IRC::usrc(substr($ex[0], 1));
-
-    # Update chanusers.
-    delete $chanusers{$svr}{$ex[2]}{$ex[3]} if defined $chanusers{$svr}{$ex[2]}{$ex[3]};
-
-    # Set $msg to the kick message.
-    my $msg = 0;
-    if (defined $ex[4]) {
-        $msg = substr($ex[4], 1);
-        if (defined $ex[5]) {
-            for (my $i = 5; $i < scalar(@ex); $i++) {
-                $msg .= " ".$ex[$i];
-            }
-        }
-    }
-
-    # Check if we were the ones kicked.
-    if (lc($ex[3]) eq lc($botnick{$svr}{nick})) {
-        # We were kicked!
-
-        # Delete channel from botchans.
-        delete $botchans{$svr}{$ex[2]};
-
-        # Log this horrible act.
-        API::Log::alog("I was kicked from ".$svr."/".$ex[2]." by ".$src{nick}."! Reason: ".$msg);
-
-        # Rejoin if we're told to in config.
-        if (conf_get("server:$svr:autorejoin")) {
-            if ((conf_get("server:$svr:autorejoin"))[0][0] eq 1) {
-                API::IRC::cjoin($svr, $ex[2]);
-            }
-        }
-    }
-    else {
-        # We weren't. Update chanusers and trigger on_kick.
-        if (defined $chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $chanusers{$svr}{$ex[2]}{$ex[3]}; }
-        API::Std::event_run("on_kick", ($svr, \%src, $ex[2], $ex[3], $msg));
-    }
-
-    return 1;
-}
-
-# Parse: MODE
-sub mode
-{
-    my ($svr, @ex) = @_;
-
-    if ($ex[2] ne $botnick{$svr}{nick}) {
-        # Set data we'll need later.
-        my $chan = $ex[2];
-        my $modes = $ex[3];
-        # Get rid of the useless data, so the mode parser will work smoothly.
-        shift @ex; shift @ex; shift @ex; shift @ex;
-
-        # Check if the modes contain any status modes.
-        my $nt = 0;
-        foreach (keys %{ $csprefix{$svr} }) {
-            if ($modes =~ /($_)/) {
-                $nt = 1;
-                last;
-            }
-        }
-
-        if ($nt) {
-            # It did. Lets parse the changes.
-            
-            my @ma = split(//, $modes);
-
-            my $op = 1;
-            foreach my $maf (@ma) {
-                if ($maf eq '+') {
-                    # If it's a +, change the operator to 1.
-                    $op = 1;
-                }
-                elsif ($maf eq '-') {
-                    # If it's a -, change the operator to 2.
-                    $op = 2;
-                }
-                else {
-                    # It's a mode, lets check if it's a status mode.
-                    my $nnt = 0;
-                    foreach (keys %{ $csprefix{$svr} }) {
-                        if ($maf eq $_) {
-                            $nnt = 1;
-                            last;
-                        }
-                    }
-
-                    if ($nnt) {
-                        # It is a status mode, lets parse changes.
-                        my $user = shift(@ex);
-
-                        if (defined $chanusers{$svr}{$chan}{$user}) {
-                            if ($op == 1) {
-                                if ($chanusers{$svr}{$chan}{$user} eq 1) {
-                                    $chanusers{$svr}{$chan}{$user} = $maf;
-                                }
-                                else {
-                                    $chanusers{$svr}{$chan}{$user} .= $maf;
-                                }
-                            }
-                            elsif ($op == 2) {
-                                if (length($chanusers{$svr}{$chan}{$user}) == 1) {
-                                    $chanusers{$svr}{$chan}{$user} = 1;
-                                }
-                                else {
-                                    $chanusers{$svr}{$chan}{$user} =~ s/($maf)//gxsm;
-                                }
-                            }
-                        }
-                        else {
-                            $chanusers{$svr}{$chan}{$user} = $maf;
-                        }
-                    }
-                    else {
-                        # It is not. Lets adjust arguments accordingly.
-                        if (defined $chanmodes{$svr}{$maf}) {
-                            if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex; }
-                            if ($chanmodes{$svr}{$maf} == 3) { 
-                                if ($op == 1) { shift @ex; }
-                            }
-                        }
-                    }
-                }
-            }   
-        }
-    }
-
-    return 1;
-}
-
-# Parse: NICK
-sub nick
-{
-	my ($svr, ($uex, undef, $nex)) = @_;
-    $nex = substr($nex, 1);
-
-	my %src = API::IRC::usrc(substr($uex, 1));
-	
-	# Check if this is coming from ourselves.
-	if ($src{nick} eq $botnick{$svr}{nick}) {
-		# It is. Update bot nick hash.
-		$botnick{$svr}{nick} = $nex;
-		delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
-	}
-	else {
-		# It isn't. Update chanusers and trigger on_nick.
-        foreach my $chk (keys %{ $chanusers{$svr} }) {
-            if (defined $chanusers{$svr}{$chk}{$src{nick}}) {
-                $chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{nick}};
-                delete $chanusers{$svr}{$chk}{$src{nick}};
-            }
-        }
-		API::Std::event_run("on_nick", ($svr, \%src, $nex));
-	}
-	
-	return 1;	
-}
-
-# Parse: NOTICE
-sub notice
-{
-	my ($svr, @ex) = @_;
-	
-	API::Std::event_run("on_notice", ($svr, @ex));
-	
-	return 1;
-}
-
-# Parse: PART
-sub part
-{
-    my ($svr, @ex) = @_;
-    my %src = API::IRC::usrc(substr($ex[0], 1));
-
-    # Delete them from chanusers.
-    delete $chanusers{$svr}{$ex[2]}{$src{nick}} if defined $chanusers{$svr}{$ex[2]}{$src{nick}};
-    
-    # Set $msg to the part message.
-    my $msg = 0;
-    if (defined $ex[3]) {
-        $msg = substr($ex[3], 1);
-        if (defined $ex[4]) {
-            for (my $i = 4; $i < scalar(@ex); $i++) {
-                $msg .= " ".$ex[$i];
-            }
-        }
-    }
-
-    # Trigger on_part.
-    API::Std::event_run("on_part", ($svr, \%src, $ex[2], $msg));
-
-    return 1;
-}
-
-# Parse: PRIVMSG
-sub privmsg
-{
-	my ($svr, @ex) = @_;
-	my %data = API::IRC::usrc(substr($ex[0], 1));
-
-	my @argv;
-	for (my $i = 4; $i < scalar(@ex); $i++) {
-		push(@argv, $ex[$i]);
-	}
-	$data{svr} = $svr;
-	@{ $data{args} } = @argv;
-	
-	my ($cmd, $cprefix, $rprefix);
-	# Check if it's to a channel or to us.
-	if (lc($ex[2]) eq lc($botnick{$svr}{nick})) {
-		# It is coming to us in a private message.
-		$cmd = uc(substr($ex[3], 1));
-		if (defined $API::Std::CMDS{$cmd}) {
-            # If this is indeed a command, continue.
-			if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
-                # Ensure the level is private or all.
-                if (!defined $Core::IRC::usercmd{$data{nick}.'@'.$data{host}}) { $Core::IRC::usercmd{$data{nick}.'@'.$data{host}} = 0; }
-                if (API::Std::ratelimit_check(%data)) {
-                    # Continue if the user has not passed the ratelimit amount.
-				    if ($API::Std::CMDS{$cmd}{priv}) {
-                        # If this command requires a privilege...
-                        if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
-                            # Make sure they have it.
-                            &{ $API::Std::CMDS{$cmd}{'sub'} }(%data);
-                        }
-                        else {
-                            # Else give them the boot.
-                            API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
-                        }
-                    }
-                    else {
-                        # Else execute the command without any extra checks.
-                        &{ $API::Std::CMDS{$cmd}{'sub'} }(%data);
-                    }
-                }
-                else {
-                    # Send them a notice about their bad deed.
-                    API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
-                }
-			}
-		}
-		
-		# Trigger event on_uprivmsg.
-		API::Std::event_run("on_uprivmsg", ($svr, @ex));
-	}
-	else {
-		# It is coming to us in a channel message.
-		$data{chan} = $ex[2];
-		$cprefix = (conf_get("fantasy_pf"))[0][0];
-		$rprefix = substr($ex[3], 1, 1);
-		$cmd = uc(substr($ex[3], 2));
-		if (defined $API::Std::CMDS{$cmd}) {
-            # If this is indeed a command, continue.
-			if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
-                # Ensure the level is public or all.
-                if (!defined $Core::IRC::usercmd{$data{nick}.'@'.$data{host}}) { $Core::IRC::usercmd{$data{nick}.'@'.$data{host}} = 0; }
-                if (API::Std::ratelimit_check(%data)) {
-                    # Continue if the user has not passed the ratelimit amount.
-                    if ($API::Std::CMDS{$cmd}{priv}) {
-                        # If this command takes a privilege...
-                        if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
-                            # Make sure they have it.
-                            &{ $API::Std::CMDS{$cmd}{'sub'} }(%data) if $rprefix eq $cprefix;
-                        }
-                         else {
-                            # Else give them the boot.
-                            API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
-                        }
-                    }
-                    else {
-                        # Else continue executing without any extra checks.
-                        &{ $API::Std::CMDS{$cmd}{'sub'} }(%data) if $rprefix eq $cprefix;
-                    }
-                }
-                else {
-                    # Send them a notice about their bad deed.
-                    API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
-                }
-            }
-		}
-		
-		# Trigger event on_cprivmsg.
-		API::Std::event_run("on_cprivmsg", ($svr, @ex));
-	}
-	
-	return 1;
-}
-
-# Parse: QUIT
-sub quit
-{
-    my ($svr, @ex) = @_;
-	my %src = API::IRC::usrc(substr($ex[0], 1));
-
-    # Set $msg to the quit message.
-    my $msg = 0;
-    if (defined $ex[2]) {
-        $msg = substr($ex[2], 1);
-        if (defined $ex[3]) {
-            for (my $i = 3; $i < scalar(@ex); $i++) {
-                $msg .= " ".$ex[$i];
-            }
-        }
-    }
-
-    # Trigger on_quit.
-    API::Std::event_run("on_quit", ($svr, \%src, $msg));
-    
-    return 1;
-}
-
-# Parse: TOPIC
-sub topic
-{
-	my ($svr, @ex) = @_;
-	my %src = API::IRC::usrc(substr($ex[0], 1));
-	
-	# Ignore it if it's coming from us.
-	if (lc($src{nick}) ne lc($botnick{$svr}{nick})) {
-		$src{chan} = $ex[2];
-		my (@argv);
-		$argv[0] = substr($ex[3], 1);
-		if (defined $ex[4]) {
-			for (my $i = 4; $i < scalar(@ex); $i++) {
-				push(@argv, $ex[$i]);
-			}
-		}
-		API::Std::event_run("on_topic", ($svr, \%src, @argv));
-	}
-	
-	return 1;
-}
-
-
-1;
-# vim: set ai sw=4 ts=4:

lib/Parser/Lang.pm

@@ -10,58 +10,58 @@ use API::Log qw(dbug alog);
 # Parser.
 sub parse
 {
-	my ($lang) = @_;
-	
-	# Check that the language file exists.
-	unless (-e "$Auto::Bin/../lang/$lang.alf") {
-		# Otherwise, use English.
-		dbug "Language '$lang' not found. Using English.";
-		alog "Language '$lang' not found. Using English.";
-		$lang = "en";
-	}
-	
-	# Open, read and close the file.
-	open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0;
-	my @fbuf = <$FALF>;
-	close $FALF;
-	
-	# Iterate the file buffer.
-	foreach my $buff (@fbuf) {
-		if (defined $buff) {
-			# Space buffer.
-			my @sbuf = split(' ', $buff);
-			
-			# Check for all required values.
-			if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
-				# Missing a value.
-				next;
-			}
-			
-			# Make sure the first value is "msge".
-			if ($sbuf[0] ne "msge") {
-				# It isn't.
-				next;
-			}
-			
-			my $id = $sbuf[1];
-			my $val = $sbuf[2];
-			
-			# If the translation is multi-word, continue to parse.
-			if (defined $sbuf[3]) {
-				for (my $i = 3; $i < scalar(@sbuf); $i++) {
-					$val .= " ".$sbuf[$i];
-				}
-			}
-			
-			# Save to memory.
-			$id =~ s/"//g;
-			$val =~ s/"//g;
-			$API::Std::LANGE{$id} = $val;
-		}
-	}
-	return 1;
+    my ($lang) = @_;
+    
+    # Check that the language file exists.
+    if (!-e "$Auto::bin{lng}/$lang.alf") {
+        # Otherwise, use English.
+        dbug "Language '$lang' not found. Using English.";
+        alog "Language '$lang' not found. Using English.";
+        $lang = 'en';
+    }
+    
+    # Open, read and close the file.
+    open(my $FALF, '<', "$Auto::bin{lng}/$lang.alf") or return;
+    my @fbuf = <$FALF>;
+    close $FALF;
+    
+    # Iterate the file buffer.
+    foreach my $buff (@fbuf) {
+        if (defined $buff) {
+            # Space buffer.
+            my @sbuf = split(' ', $buff);
+            
+            # Check for all required values.
+            if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
+                # Missing a value.
+                next;
+            }
+            
+            # Make sure the first value is "msge".
+            if ($sbuf[0] ne "msge") {
+                # It isn't.
+                next;
+            }
+            
+            my $id = $sbuf[1];
+            my $val = $sbuf[2];
+            
+            # If the translation is multi-word, continue to parse.
+            if (defined $sbuf[3]) {
+                for (my $i = 3; $i < scalar(@sbuf); $i++) {
+                    $val .= " ".$sbuf[$i];
+                }
+            }
+            
+            # Save to memory.
+            $id =~ s/"//g;
+            $val =~ s/"//g;
+            $API::Std::LANGE{$id} = $val;
+        }
+    }
+    return 1;
 }
 
 
 1;
-# vim: set ai sw=4 ts=4:
+# vim: set ai et sw=4 ts=4:

lib/Proto/IRC.pm

@@ -0,0 +1,775 @@
+# lib/Proto/IRC.pm - Subroutines for parsing incoming data from IRC.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package Proto::IRC;
+use strict;
+use warnings;
+use feature qw(switch);
+use API::Std qw(conf_get err awarn trans);
+use API::IRC;
+
+# Raw parsing hash.
+our %RAWC = (
+    '001'      => \&num001,
+    '004'      => \&num004,
+    '005'      => \&num005,
+    '352'      => \&num352,
+    '353'      => \&num353,
+    '396'      => \&num396,
+    '432'      => \&num432,
+    '433'      => \&num433,
+    '438'      => \&num438,
+    '465'      => \&num465,
+    '471'      => \&num471,
+    '473'      => \&num473,
+    '474'      => \&num474,
+    '475'      => \&num475,
+    '477'      => \&num477,
+    'CAP'      => \&cap,
+    'JOIN'     => \&cjoin,
+    'KICK'     => \&kick,
+    'MODE'     => \&mode,
+    'NICK'     => \&nick,
+    'NOTICE'   => \&notice,
+    'PART'     => \&part,
+    'PRIVMSG'  => \&privmsg,
+    'QUIT'     => \&quit,
+    'TOPIC'    => \&topic,
+);
+
+# Variables for various functions.
+our (%got_001, %botchans, %csprefix, %chanmodes, %cap);
+
+# Events.
+API::Std::event_add('on_capack');
+API::Std::event_add('on_cmode');
+API::Std::event_add('on_umode');
+API::Std::event_add('on_connect');
+API::Std::event_add('on_rcjoin');
+API::Std::event_add('on_ucjoin');
+API::Std::event_add('on_isupport');
+API::Std::event_add('on_kick');
+API::Std::event_add('on_selfkick');
+API::Std::event_add('on_myinfo');
+API::Std::event_add('on_namesreply');
+API::Std::event_add('on_nick');
+API::Std::event_add('on_notice');
+API::Std::event_add('on_part');
+API::Std::event_add('on_upart');
+API::Std::event_add('on_cprivmsg');
+API::Std::event_add('on_uprivmsg');
+API::Std::event_add('on_quit');
+API::Std::event_add('on_topic');
+API::Std::event_add('on_whoreply');
+
+# Parse raw data.
+sub ircparse
+{
+    my ($svr, $data) = @_;
+
+    # Split spaces into @ex.
+    my @ex = split /\s+/, $data;
+
+    # Make sure there is enough data.
+    if (defined $ex[0] and defined $ex[1]) {
+        # If it's a ping...
+        if ($ex[0] eq 'PING') {
+            # send a PONG.
+            Auto::socksnd($svr, "PONG $ex[1]");
+        }
+        # If it's AUTHENTICATE
+        elsif ($ex[0] eq 'AUTHENTICATE') {
+            if (API::Std::mod_exists('SASLAuth')) {
+                M::SASLAuth::handle_authenticate($svr, @ex);
+            }
+        }
+        # Check if it's handled by core.
+        elsif (defined $RAWC{$ex[1]}) {
+            &{ $RAWC{$ex[1]} }($svr, @ex);
+        }
+        else {
+            # otherwise, check for a raw hook.
+            if (defined $API::Std::RAWHOOKS{$ex[1]}) {
+                foreach (keys %{$API::Std::RAWHOOKS{$ex[1]}}) {
+                    &{ $API::Std::RAWHOOKS{$ex[1]}{$_} }($svr, @ex);
+                }
+            }
+        }
+    }
+
+    return 1;
+}
+
+###########################
+# Raw parsing subroutines #
+###########################
+
+# Parse: Numeric:001
+# Successful connection.
+sub num001 {
+    my ($svr, @ex) = @_;
+
+    $got_001{$svr} = 1;
+
+    # In case we don't get NICK from the server.
+    if (!defined $State::IRC::botinfo{$svr}{nick}) {
+        $State::IRC::botinfo{$svr}{nick} = $State::IRC::botinfo{$svr}{newnick};
+        delete $State::IRC::botinfo{$svr}{newnick};
+    }
+
+    # Log.
+    API::Log::alog "! Successfully connected to $svr as $State::IRC::botinfo{$svr}{nick}";
+    API::Log::dbug "! Successfully connected to $svr as $State::IRC::botinfo{$svr}{nick}";
+
+    # Trigger on_connect.
+    API::Std::event_run('on_connect', $svr);
+
+    return 1;
+}
+
+# Parse: Numeric:004
+# Server information.
+sub num004 {
+    my ($svr, @ex) = @_;
+
+    # Log server name and version.
+    API::Log::alog "! $svr: $ex[3] running version $ex[4]";
+    API::Log::dbug "! $svr: $ex[3] running version $ex[4]";
+
+    # Trigger on_myinfo.
+    API::Std::event_run('on_myinfo', ($svr, @ex[3..$#ex]));
+
+    return 1;
+}
+
+# Parse: Numeric:005
+# Server ISUPPORT.
+sub num005 {
+    my ($svr, @ex) = @_;
+
+    # Trigger on_isupport.
+    API::Std::event_run('on_isupport', ($svr, @ex[3..$#ex]));
+
+    return 1;
+}
+
+# Parse: Numeric:352
+# WHO reply.
+sub num352 {
+    my ($svr, @ex) = @_;
+
+    # Trigger on_whoreply.
+    $ex[9] =~ s/^://xsm;
+    API::Std::event_run('on_whoreply', ($svr, $ex[7], $ex[3], $ex[4], $ex[5], $ex[6], $ex[8], $ex[9], @ex[10..$#ex]));
+
+    return 1;
+}
+
+# Parse: Numeric:353
+# NAMES reply.
+sub num353 {
+    my ($svr, @ex) = @_;
+
+    # Get rid of the colon.
+    $ex[5] =~ s/^://xsm;
+    # Trigger on_namesreply.
+    API::Std::event_run('on_namesreply', ($svr, $ex[4], @ex[5..$#ex]));
+    
+    return 1;
+}
+
+# Parse: Numeric:396
+# Hidden host changed.
+sub num396 {
+    my ($svr, @ex) = @_;
+
+    # Update our mask.
+    $State::IRC::botinfo{$svr}{mask} = $ex[3];
+
+    return 1;
+}
+
+# Parse: Numeric:432
+# Erroneous nickname.
+sub num432 {
+    my ($svr, undef) = @_;
+
+    if ($got_001{$svr}) {
+        err(3, "Got error from server[$svr]: Erroneous nickname.", 0);
+    }
+    else {
+        err(2, "Got error from server[$svr] before connection complete: Erroneous nickname. Closing connection.", 0);
+        API::IRC::quit($svr, 'An error occurred.');
+    }
+
+    if (defined $State::IRC::botinfo{$svr}{newnick}) { delete $State::IRC::botinfo{$svr}{newnick} }
+
+    return 1;
+}
+
+# Parse: Numeric:433
+# Nickname is already in use.
+sub num433 {
+    my ($svr, undef) = @_;
+
+    if (defined $State::IRC::botinfo{$svr}{newnick}) {
+        API::IRC::nick($svr, $State::IRC::botinfo{$svr}{newnick}.'_');
+    }
+
+    return 1;
+}
+
+# Parse: Numeric:438
+# Nick change too fast.
+sub num438 {
+    my ($svr, @ex) = @_;
+
+    if (defined $State::IRC::botinfo{$svr}{newnick}) {
+        API::Std::timer_add('num438_'.$State::IRC::botinfo{$svr}{newnick}, 1, $ex[11], sub {
+            API::IRC::nick($State::IRC::botinfo{$svr}{newnick});
+            if (defined $State::IRC::botinfo{$svr}{newnick}) { delete $State::IRC::botinfo{$svr}{newnick} }
+         });
+    }
+
+    return 1;
+}
+
+# Parse: Numeric:465
+# You're banned creep!
+sub num465 {
+    my ($svr, undef) = @_;
+
+    err(3, "Banned from $svr.! Closing link...", 0);
+
+    return 1;
+}
+
+# Parse: Numeric:471
+# Cannot join channel: Channel is full.
+sub num471 {
+    my ($svr, (undef, undef, undef, $chan)) = @_;
+
+    err(3, "Cannot join channel $chan on $svr: Channel is full.", 0);
+
+    return 1;
+}
+
+# Parse: Numeric:473
+# Cannot join channel: Channel is invite-only.
+sub num473 {
+    my ($svr, (undef, undef, undef, $chan)) = @_;
+
+    err(3, "Cannot join channel $chan on $svr: Channel is invite-only.", 0);
+
+    return 1;
+}
+
+# Parse: Numeric:474
+# Cannot join channel: Banned from channel.
+sub num474 {
+    my ($svr, (undef, undef, undef, $chan)) = @_;
+
+    err(3, "Cannot join channel $chan on $svr: Banned from channel.", 0);
+    
+    return 1;
+}
+
+# Parse: Numeric:475
+# Cannot join channel: Bad key.
+sub num475 {
+    my ($svr, (undef, undef, undef, $chan)) = @_;
+
+    err(3, "Cannot join channel $chan on $svr: Bad key.", 0);
+    
+    return 1;
+}
+
+# Parse: Numeric:477
+# Cannot join channel: Need registered nickname.
+sub num477 {
+    my ($svr, (undef, undef, undef, $chan)) = @_;
+    
+    err(3, "Cannot join channel $chan on $svr: Need registered nickname.", 0);
+    
+    return 1;
+}
+
+# Parse: CAP
+sub cap {
+    my ($svr, @ex) = @_;
+    my $capout;
+
+    # Iterate ex[3].
+    given ($ex[3]) {
+        when ('LS') {
+            # Get our CAP REQ list.
+            my @capreq = ();
+            if ($cap{$svr} =~ m/\s/xsm) { @capreq = split ' ', $cap{$svr} }
+            else { push @capreq, $cap{$svr} }
+
+            # Iterate through what we received from the server.
+            $ex[4] =~ s/^://xsm;
+            foreach my $scap (@ex[4..$#ex]) {
+                # Check if we support this.
+                foreach my $icap (@capreq) {
+                    if ($icap eq $scap) {
+                        $capout .= " $scap";
+                    }
+                }
+            }
+            
+            # Send CAP REQ/CAP END based on what both we and the server support.
+            if (!$capout) { Auto::socksnd($svr, 'CAP END') }
+            else {
+                $capout = substr $capout, 1;
+                Auto::socksnd($svr, "CAP REQ :$capout");
+            }
+        }
+        when ('ACK') {
+            # Iterate through the ACK arguments.
+            $ex[4] =~ s/^://xsm;
+            my $sasl = 0;
+            foreach (@ex[4..$#ex]) {
+                if ($_ eq 'sasl') { $sasl++ }
+                API::Std::event_run('on_capack', ($svr, $_));
+            }
+            Auto::socksnd($svr, 'CAP END') unless $sasl;
+        }
+        when ('NAK') {
+            # This should never happen, but just in case...
+            API::Log::awarn(2, "$svr: CAP failed: Server refused '$capout'");
+            Auto::socksnd($svr, 'CAP END');
+        }
+    }
+
+    return 1;
+}
+
+# Parse: JOIN
+sub cjoin {
+    my ($svr, @ex) = @_;
+    my %src = API::IRC::usrc(substr($ex[0], 1));
+    my $chan = $ex[2];
+    $chan =~ s/^://gxsm;
+    
+    # Check if this is coming from ourselves.
+    if ($src{nick} eq $State::IRC::botinfo{$svr}{nick}) {
+        $botchans{$svr}{lc $chan} = 1;
+        API::Std::event_run("on_ucjoin", ($svr, $chan));
+    }
+    else {
+        # It isn't. Update chanusers and trigger on_rcjoin.
+        $State::IRC::chanusers{$svr}{lc $chan}{$src{nick}} = 1;
+        $src{svr} = $svr;
+        API::Std::event_run("on_rcjoin", (\%src, $chan));
+    }
+    
+    return 1;
+}
+
+# Parse: KICK
+sub kick {
+    my ($svr, @ex) = @_;
+
+    my %src = API::IRC::usrc(substr($ex[0], 1));
+    $src{svr} = $svr;
+
+    # Update chanusers.
+    delete $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]} if defined $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]};
+
+    # Set $msg to the kick message.
+    my $msg = 0;
+    if (defined $ex[4]) {
+        $msg = substr($ex[4], 1);
+        if (defined $ex[5]) {
+            for (my $i = 5; $i < scalar(@ex); $i++) {
+                $msg .= " ".$ex[$i];
+            }
+        }
+    }
+
+    # Check if we were the ones kicked.
+    if (lc($ex[3]) eq lc($State::IRC::botinfo{$svr}{nick})) {
+        # We were kicked!
+
+        # Delete channel from botchans.
+        delete $botchans{$svr}{$ex[2]};
+
+        # Log this horrible act.
+        API::Log::alog("I was kicked from ".$svr."/".$ex[2]." by ".$src{nick}."! Reason: ".$msg);
+
+        # Rejoin if we're told to in config.
+        if (conf_get("server:$svr:autorejoin")) {
+            if ((conf_get("server:$svr:autorejoin"))[0][0] eq 1) {
+                API::IRC::cjoin($svr, $ex[2]);
+            }
+        }
+
+        # Trigger on_selfkick.
+        API::Std::event_run('on_selfkick', (\%src, $ex[2], $msg));
+    }
+    else {
+        # We weren't. Update chanusers and trigger on_kick.
+        if (defined $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]} }
+        API::Std::event_run("on_kick", (\%src, $ex[2], $ex[3], $msg));
+    }
+
+    return 1;
+}
+
+# Parse: MODE
+sub mode {
+    my ($svr, @ex) = @_;
+
+    if ($ex[2] ne $State::IRC::botinfo{$svr}{nick}) {
+        # Set data we'll need later.
+        my $chan = $ex[2];
+        $ex[3] =~ s/^://xsm;
+        my $modes = $ex[3];
+        my $fmodes = join ' ', @ex[3..$#ex];
+        $modes =~ s/^://xsm;
+        # Get rid of the useless data, so the mode parser will work smoothly.
+        shift @ex; shift @ex; shift @ex; shift @ex;
+
+        # Check if the modes contain any status modes.
+        my $nt = 0;
+        foreach (keys %{ $csprefix{$svr} }) {
+            if ($modes =~ /($_)/) {
+                $nt = 1;
+                last;
+            }
+        }
+
+        if ($nt) {
+            # It did. Lets parse the changes.
+            
+            my @ma = split(//, $modes);
+
+            my $op = 1;
+            foreach my $maf (@ma) {
+                if ($maf eq '+') {
+                    # If it's a +, change the operator to 1.
+                    $op = 1;
+                }
+                elsif ($maf eq '-') {
+                    # If it's a -, change the operator to 2.
+                    $op = 2;
+                }
+                else {
+                    # It's a mode, lets check if it's a status mode.
+                    my $nnt = 0;
+                    foreach (keys %{ $csprefix{$svr} }) {
+                        if ($maf eq $_) {
+                            $nnt = 1;
+                            last;
+                        }
+                    }
+
+                    if ($nnt) {
+                        # It is a status mode, lets parse changes.
+                        my $user = shift(@ex);
+
+                        if (defined $State::IRC::chanusers{$svr}{$chan}{$user}) {
+                            if ($op == 1) {
+                                if ($State::IRC::chanusers{$svr}{$chan}{$user} eq 1) {
+                                    $State::IRC::chanusers{$svr}{$chan}{$user} = $maf;
+                                }
+                                else {
+                                    $State::IRC::chanusers{$svr}{$chan}{$user} .= $maf;
+                                }
+                            }
+                            elsif ($op == 2) {
+                                if (length($State::IRC::chanusers{$svr}{$chan}{$user}) == 1) {
+                                    $State::IRC::chanusers{$svr}{$chan}{$user} = 1;
+                                }
+                                else {
+                                    $State::IRC::chanusers{$svr}{$chan}{$user} =~ s/($maf)//gxsm;
+                                }
+                            }
+                        }
+                        else {
+                            $State::IRC::chanusers{$svr}{$chan}{$user} = $maf;
+                        }
+                    }
+                    else {
+                        # It is not. Lets adjust arguments accordingly.
+                        if (defined $chanmodes{$svr}{$maf}) {
+                            if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex }
+                            if ($chanmodes{$svr}{$maf} == 3) { 
+                                if ($op == 1) { shift @ex }
+                            }
+                        }
+                    }
+                }
+            }   
+        }
+        # Trigger on_cmode.
+        API::Std::event_run('on_cmode', ($svr, $chan, $fmodes));
+    }
+    else {
+        # User mode change; trigger on_umode.
+        $ex[3] =~ s/^://xsm;
+        API::Std::event_run('on_umode', ($svr, @ex[3..$#ex]));
+    }
+    return 1;
+}
+
+# Parse: NICK
+sub nick {
+    my ($svr, ($uex, undef, $nex)) = @_;
+    $nex =~ s/^://gxsm;
+
+    my %src = API::IRC::usrc(substr($uex, 1));
+    $src{svr} = $svr;
+ 
+    # Check if this is coming from ourselves.
+    if ($src{nick} eq $State::IRC::botinfo{$svr}{nick}) {
+        # It is. Update bot nick hash.
+        $State::IRC::botinfo{$svr}{nick} = $nex;
+        delete $State::IRC::botinfo{$svr}{newnick} if (defined $State::IRC::botinfo{$svr}{newnick});
+    }
+    else {
+        # It isn't. Update chanusers and trigger on_nick.
+        foreach my $chk (keys %{ $State::IRC::chanusers{$svr} }) {
+            if (defined $State::IRC::chanusers{$svr}{$chk}{$src{nick}}) {
+                $State::IRC::chanusers{$svr}{$chk}{$nex} = $State::IRC::chanusers{$svr}{$chk}{$src{nick}};
+                delete $State::IRC::chanusers{$svr}{$chk}{$src{nick}};
+            }
+        }
+        API::Std::event_run("on_nick", (\%src, $nex));
+    }
+    
+    return 1;    
+}
+
+# Parse: NOTICE
+sub notice {
+    my ($svr, @ex) = @_;
+
+    # Ensure this is coming from a user rather than a server.
+    if ($ex[0] !~ m/!/xsm) { return }
+
+    # Prepare all the data.
+    my %src = API::IRC::usrc(substr $ex[0], 1);
+    my $target = $ex[2];
+    shift @ex; shift @ex; shift @ex;
+    $ex[0] = substr $ex[0], 1;
+    $src{svr} = $svr;
+    
+    # Send it off.
+    API::Std::event_run("on_notice", (\%src, $target, @ex));
+    
+    return 1;
+}
+
+# Parse: PART
+sub part {
+    my ($svr, @ex) = @_;
+
+    my %src = API::IRC::usrc(substr($ex[0], 1));
+    $src{svr} = $svr;
+    
+    # Check if it's from us or someone else.
+    if ($src{nick} eq $State::IRC::botinfo{$svr}{nick}) {
+        # Delete this channel from botchans.
+        if ($botchans{$svr}{$ex[2]}) { delete $botchans{$svr}{$ex[2]} }
+        # Trigger on_upart.
+        API::Std::event_run('on_upart', ($svr, $ex[2]));
+    }
+    else {
+        # Delete them from chanusers.
+        delete $State::IRC::chanusers{$svr}{$ex[2]}{$src{nick}} if defined $State::IRC::chanusers{$svr}{$ex[2]}{$src{nick}};
+    
+        # Set $msg to the part message.
+        my $msg = 0;
+        if (defined $ex[3]) {
+            $msg = substr($ex[3], 1);
+            if (defined $ex[4]) {
+                for (my $i = 4; $i < scalar(@ex); $i++) {
+                    $msg .= " ".$ex[$i];
+                }
+            }
+        }
+
+        # Trigger on_part.
+        API::Std::event_run("on_part", (\%src, $ex[2], $msg));
+    }
+
+    return 1;
+}
+
+# Parse: PRIVMSG
+sub privmsg {
+    my ($svr, @ex) = @_;
+    my %data;
+
+    # Ensure this is coming from a user rather than a server.
+    if ($ex[0] !~ m/!/xsm) { 
+        %data = (
+                'nick' => substr($ex[0], 1),
+                'user' => '*',
+                'host' => '*'
+                );
+    }
+    else { %data = API::IRC::usrc(substr($ex[0], 1)) }
+
+    my @argv;
+    for (my $i = 4; $i < scalar(@ex); $i++) {
+        push(@argv, $ex[$i]);
+    }
+    $data{svr} = $svr;
+    
+    my ($cmd, $cprefix, $rprefix);
+    # Check if it's to a channel or to us.
+    if (lc($ex[2]) eq lc($State::IRC::botinfo{$svr}{nick})) {
+        # It is coming to us in a private message.
+        
+        # Ensure it's a valid length.
+        if (length($ex[3]) > 1) {
+            $cmd = uc(substr($ex[3], 1));
+            if (defined $API::Std::CMDS{$cmd}) {
+                # If this is indeed a command, continue.
+                if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
+                    # Ensure the level is private or all.
+                    if (API::Std::ratelimit_check(%data)) {
+                        # Continue if the user has not passed the ratelimit amount.
+                        if ($API::Std::CMDS{$cmd}{priv}) {
+                            # If this command requires a privilege...
+                            if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
+                                # Make sure they have it.
+                                &{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
+                            }
+                            else {
+                                # Else give them the boot.
+                                API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
+                            }
+                        }
+                        else {
+                            # Else execute the command without any extra checks.
+                            &{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
+                        }
+                    }
+                    else {
+                        # Send them a notice about their bad deed.
+                        API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
+                    }
+                }
+            }
+        }
+
+        # Trigger event on_uprivmsg.
+        shift @ex; shift @ex; shift @ex;
+        $ex[0] = substr $ex[0], 1;
+        API::Std::event_run("on_uprivmsg", (\%data, @ex));
+    }
+    else {
+        # It is coming to us in a channel message.
+        $data{chan} = $ex[2];
+        # Ensure it's a valid length before continuing.
+        if (length($ex[3]) > 1) {
+            $cprefix = (conf_get("fantasy_pf"))[0][0];
+            $rprefix = substr($ex[3], 1, 1);
+            $cmd = uc(substr($ex[3], 2));
+            if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
+                # If this is indeed a command, continue.
+                if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
+                    # Ensure the level is public or all.
+                    if (API::Std::ratelimit_check(%data)) {
+                        # Continue if the user has not passed the ratelimit amount.
+                        if ($API::Std::CMDS{$cmd}{priv}) {
+                            # If this command takes a privilege...
+                            if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
+                                # Make sure they have it.
+                                &{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
+                            }
+                            else {
+                                # Else give them the boot.
+                                API::IRC::notice($data{svr}, $data{nick}, API::Std::trans('Permission denied').q{.});
+                            }
+                        }
+                        else {
+                            # Else continue executing without any extra checks.
+                            &{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
+                        }
+                    }
+                    else {
+                        # Send them a notice about their bad deed.
+                        API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
+                    }
+                }
+                elsif ($API::Std::CMDS{$cmd}{lvl} == 3) {
+                    # Or if it's a logchan command...
+                    my ($lcn, $lcc) = split '/', (conf_get('logchan'))[0][0];
+                    if ($lcn eq $data{svr} and lc $lcc eq lc $data{chan}) {
+                        # Check if it's being sent from the logchan.
+                        if ($API::Std::CMDS{$cmd}{priv}) {
+                            # If this command takes a privilege...
+                            if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
+                                # Make sure they have it.
+                                &{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
+                            }
+                            else {
+                                # Else give them the boot.
+                                API::IRC::notice($data{svr}, $data{nick}, API::Std::trans('Permission denied').q{.});
+                            }
+                        }
+                        else {
+                            # Else continue executing without any extra checks.
+                            &{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
+                        }
+                    }
+                }
+            }
+        }
+
+        # Trigger event on_cprivmsg.
+        my $target = $ex[2]; delete $data{chan};
+        shift @ex; shift @ex; shift @ex;
+        $ex[0] = substr $ex[0], 1;
+        API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
+    }
+    
+    return 1;
+}
+
+# Parse: QUIT
+sub quit {
+    my ($svr, @ex) = @_;
+
+    my %src = API::IRC::usrc(substr($ex[0], 1));
+    $src{svr} = $svr;
+
+    # Set $msg to the quit message.
+    my $msg = 0;
+    if (defined $ex[2]) {
+        $msg = substr($ex[2], 1);
+        if (defined $ex[3]) {
+            for (my $i = 3; $i < scalar(@ex); $i++) {
+                $msg .= " ".$ex[$i];
+            }
+        }
+    }
+
+    # Trigger on_quit.
+    API::Std::event_run("on_quit", (\%src, $msg));
+    
+    return 1;
+}
+
+# Parse: TOPIC
+sub topic {
+    my ($svr, @ex) = @_;
+    my %src = API::IRC::usrc(substr($ex[0], 1));
+    $src{svr} = $svr;
+    $src{chan} = $ex[2];
+    $ex[3] = substr $ex[3], 1;
+    
+    # Trigger on_topic.
+    API::Std::event_run('on_topic', (\%src, @ex[3..$#ex]));
+    
+    return 1;
+}
+
+
+1;
+# vim: set ai et sw=4 ts=4:

lib/State/IRC.pm

@@ -0,0 +1,49 @@
+# lib/State/IRC.pm - IRC state data.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package State::IRC;
+use strict;
+use warnings;
+use API::Std qw(hook_add);
+our (%chanusers, %botinfo);
+
+# Create on_namesreply hook.
+hook_add('on_namesreply', 'state.irc.names', sub {
+    my ($svr, $chan, @data) = @_;
+
+    # Delete the old chanusers hash if it exists.
+    if (defined $chanusers{$svr}{$chan}) { delete $chanusers{$svr}{$chan} }
+    # Iterate through each user.
+    for (1..$#data) {
+        my $fi = 0;
+        PFITER: foreach my $spfx (keys %{ $Proto::IRC::csprefix{$svr} }) {
+            # Check if the user has status in the channel.
+            if (substr($data[$_], 0, 1) eq $Proto::IRC::csprefix{$svr}{$spfx}) {
+                # He/she does. Lets set that.
+                if (defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
+                    # If the user has multiple statuses.
+                    $chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $chanusers{$svr}{$chan}{lc $data[$_]}.$spfx;
+                    delete $chanusers{$svr}{$chan}{lc $data[$_]};
+                }
+                else {
+                    # Or not.
+                    $chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $spfx;
+                }
+                $fi = 1;
+                $data[$_] = substr $data[$_], 1;
+            }
+        }
+        # Check if there's still a prefix.
+        foreach my $spfx (keys %{$Proto::IRC::csprefix{$svr}}) {
+            if (substr($data[$_], 0, 1) eq $Proto::IRC::csprefix{$svr}{$spfx}) { goto 'PFITER' }
+        }
+        # They had status, so go to the next user.
+        next if $fi;
+        # They didn't, set them as a normal user.
+        if (!defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
+            $chanusers{$svr}{$chan}{lc $data[$_]} = 1;
+        }
+    }
+
+    return 1;
+});

modules/AUR.pm

@@ -0,0 +1,119 @@
+# Module: AUR. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::AUR;
+use strict;
+use warnings;
+use WWW::AUR;
+use API::Std qw(cmd_add cmd_del trans);
+use API::IRC qw(notice privmsg);
+
+# Initialization subroutine.
+sub _init {
+    # Create the AUR command.
+    cmd_add('AUR', 0, 0, \%M::AUR::HELP_AUR, \&M::AUR::cmd_aur) or return;
+    # Success.
+    return 1;
+}
+
+# Void subroutine.
+sub _void {
+    # Delete the AUR command.
+    cmd_del('AUR') or return;
+
+    # Success.
+    return 1;
+}
+
+
+# Help hash for AUR. Spanish and French translations needed.
+our %HELP_AUR = (
+    en => "This command allows you to lookup a module in the Arch Linux AUR. \2Syntax:\2 AUR <module>",
+    de => "Dieser Befehl ermoeglicht du auf nachschlagst ein Modul in der Arch Linux AUR. \2Syntax:\2 AUR <module>",
+);
+
+# Callback for AUR command.
+sub cmd_aur {
+    my ($src, ($mod)) = @_;
+
+    # Check for needed parameters.
+    if (!defined $mod) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Create an instance of WWW::AUR.
+    my $aur = WWW::AUR->new;
+    # Create an instance of WWW::AUR::Package.
+    my $pkg = $aur->find($mod);
+
+    # Check if there was a result.
+    if (defined $pkg) {
+        # Return the results.
+        privmsg($src->{svr}, $src->{chan}, "Results for \2$mod\2:");
+        privmsg($src->{svr}, $src->{chan}, 'ID: '.$pkg->id.' | Name: '.$pkg->name.' | Version: '.$pkg->version);
+        privmsg($src->{svr}, $src->{chan}, 'Maintainer: '.$pkg->maintainer->name);
+        privmsg($src->{svr}, $src->{chan}, 'URL: https://aur.archlinux.org/packages.php?ID='.$pkg->id);
+    }
+    else {
+        # Else return no results.
+        privmsg($src->{svr}, $src->{chan}, "No results for \2$mod\2.");
+    }
+
+    return 1;
+}
+
+# Start initialization.
+API::Std::mod_init('AUR', 'Xelhua', '1.00', '3.0.0a10');
+# build: cpan=WWW::AUR perl=5.010000
+
+__END__
+
+=head1 NAME
+
+AUR - AUR package information module.
+
+=head1 VERSION
+
+ 1.00
+
+=head1 SYNOPSIS
+
+ <JohnSmith> !aur autobot-git
+ <Auto> Results for autobot-git:
+ <Auto> ID: 47329 Name: autobot-git Version: 20110311-1
+ <Auto> Maintainer: iElijah101
+ <Auto> URL: https://aur.archlinux.org/packages.php?ID=47329
+
+=head1 DESCRIPTION
+
+This module adds a command to allow getting information on a package in the
+Arch User Repository at https://aur.archlinux.org.
+
+=head1 DEPENDENCIES
+
+This module is dependent on the following modules from CPAN:
+
+=over
+
+=item L<WWW::AUR>
+
+Interface to the Arch User Repository.
+
+=back
+
+=head1 AUTHOR
+
+This module was written by Matthew Barksdale.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group.
+
+Released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et sw=4 ts=4:

modules/Badwords.pm

@@ -1,23 +1,23 @@
 # Module: Badwords. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_Badwords;
+package M::Badwords;
 use strict;
 use warnings;
 use feature qw(switch);
 use API::Std qw(hook_add hook_del conf_get err);
-use API::IRC qw(privmsg notice kick cmode);
+use API::IRC qw(privmsg notice kick ban);
 
 # Initialization subroutine.
 sub _init 
 {
     # Check for required configuration values.
-	if (!conf_get('badwords')) {
-		err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
-		return;
-	}
+    if (!conf_get('badwords')) {
+        err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
+        return;
+    }
     # Create the act_on_badword hook.
-	hook_add('on_cprivmsg', 'act_on_badword', \&m_Badwords::actonbadword) or return;
+    hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return;
 
     # Success.
     return 1;
@@ -27,23 +27,21 @@ sub _init
 sub _void 
 {
     # Delete the act_on_badword hook.
-	hook_del('act_on_badword') or return 0;
+    hook_del('act_on_badword') or return;
 
     # Success.
-	return 1;
+    return 1;
 }
 
 # Callback for act_on_badword hook.
 sub actonbadword
 {
-	my (($svr, @ex)) = @_;
-    my %src = API::IRC::usrc(substr $ex[0], 1);
+    my (($src, $chan, @msg)) = @_;
 
-	my $msg = substr $ex[3], 1;
-    for (my $i = 4; $i < scalar @ex; $i++) { $msg .= q{ }.$ex[$i]; }
+    my $msg = join ' ', @msg;
 
-    if (conf_get("badwords:$ex[2]:word")) {
-        my @words = @{ (conf_get("badwords:$ex[2]:word"))[0] };
+    if (conf_get("badwords:$chan:word")) {
+        my @words = @{ (conf_get("badwords:$chan:word"))[0] };
 
         foreach (@words) {
             my ($w, $a) = split m/[:]/, $_;
@@ -51,17 +49,17 @@ sub actonbadword
             if ($msg =~ m/($w)/ixsm) {
                 given ($a) {
                     when ('kick') { 
-                        kick($svr, $ex[2], $src{nick}, 'Foul language is prohibited here.'); 
+                        kick($src->{svr}, $chan, $src->{nick}, 'Foul language is prohibited here.'); 
                     }
                     when ('kickban') { 
-                        cmode($svr, $ex[2], '+b *!*@'.$src{host}); 
-                        kick($svr, $ex[2], $src{nick}, 'Foul language is prohibited here.'); 
+                        ban($src->{svr}, $chan, 'b', $src); 
+                        kick($src->{svr}, $chan, $src->{nick}, 'Foul language is prohibited here.'); 
                     }
                     when ('quiet') { 
-                        cmode($svr, $ex[2], '+q *!*@'.$src{host}); 
+                        ban($src->{svr}, $chan, 'q', $src); 
                     }
                     default { 
-                        kick($svr, $ex[2], $src{nick}, 'Foul language is prohibited here.'); 
+                        kick($src->{svr}, $chan, $src->{nick}, 'Foul language is prohibited here.'); 
                     }
                 }
             }
@@ -72,8 +70,7 @@ sub actonbadword
 }
 
 
-API::Std::mod_init("Badwords", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a10');
 # build: perl=5.010000
 
 __END__
@@ -124,6 +121,8 @@ Changing the obvious to your wish.
 
 =over
 
-This module is compatible with Auto version 3.0.0a3+.
+This module is compatible with Auto version 3.0.0a10+.
 
 =back
+
+# vim: set ai et sw=4 ts=4:

modules/Bitly.pm

@@ -1,7 +1,7 @@
 # Module: Bitly. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_Bitly;
+package M::Bitly;
 use strict;
 use warnings;
 use API::Std qw(cmd_add cmd_del conf_get err trans);
@@ -13,13 +13,13 @@ use URI::Escape;
 sub _init 
 {
     # Check for required configuration values.
-	if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) {
-		err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0);
-		return 0;
-	}
+    if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) {
+        err(2, 'Please verify that you have bitly_user and bitly_key defined in your configuration file.', 0);
+        return;
+    }
     # Create the SHORTEN and REVERSE commands.
-	cmd_add("SHORTEN", 0, 0, \%m_Bitly::HELP_SHORTEN, \&m_Bitly::shorten) or return 0;
-	cmd_add("REVERSE", 0, 0, \%m_Bitly::HELP_REVERSE, \&m_Bitly::reverse) or return 0;
+    cmd_add('SHORTEN', 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return;
+    cmd_add('REVERSE', 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return;
 
     # Success.
     return 1;
@@ -29,62 +29,63 @@ sub _init
 sub _void 
 {
     # Delete the SHORTEN and REVERSE commands.
-	cmd_del("SHORTEN") or return 0;
-	cmd_del("REVERSE") or return 0;
+    cmd_del('SHORTEN') or return;
+    cmd_del('REVERSE') or return;
 
     # Success.
-	return 1;
+    return 1;
 }
 
 # Help hashes.
 our %HELP_SHORTEN = (
-    'en' => "This command will shorten an URL using Bit.ly. \002Syntax:\002 SHORTEN <url>",
+    en => "This command will shorten an URL using Bit.ly. \2Syntax:\2 SHORTEN <url>",
+    de => "Dieser Befehl wird eine URL verkuerzen. \2Syntax:\2 SHORTEN <url>",
 );
 our %HELP_REVERSE = (
-    'en' => "This command will expand a Bit.ly URL. \002Syntax:\002 REVERSE <url>",
+    en => "This command will expand a Bit.ly URL. \2Syntax:\2 REVERSE <url>",
+    de => "Dieser Befehl wird eine URL erweitern. \2Syntax:\2 REVERSE <url>",
 );
 
 # Callback for SHORTEN command.
 sub shorten 
 {
-	my (%data) = @_;
+    my ($src, @args) = @_;
 
     # Create an instance of LWP::UserAgent.
-	my $ua = LWP::UserAgent->new();
-	$ua->agent('Auto IRC Bot');
-	$ua->timeout(2);
+    my $ua = LWP::UserAgent->new();
+    $ua->agent('Auto IRC Bot');
+    $ua->timeout(2);
     
     # Put together the call to the Bit.ly API. 
-	my @args = @{ $data{args} };
     if (!defined $args[0]) {
-        notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-        return 0;
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
+        return;
     }
-	my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
+    my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
     $surl = uri_escape($surl);
-	my $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt";
+    my $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt";
     # Get the response via HTTP.
     my $response = $ua->get($url);
 
-	if ($response->is_success) {
+    if ($response->is_success) {
         # If successful, decode the content.
         my $d = $response->decoded_content;
-		chomp $d;
+        chomp $d;
         # And send to channel.
-		privmsg($data{svr}, $data{chan}, "URL: ".$d);
-	}
+        privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
+    }
     else {
         # Otherwise, send an error message.
-        privmsg($data{svr}, $data{chan}, "An error occurred while shortening your URL.");
+        privmsg($src->{svr}, $src->{chan}, 'An error occurred while shortening your URL.');
     }
 
-	return 1;
+    return 1;
 }
 
 # Callback for REVERSE command.
 sub reverse 
 {
-    my (%data) = @_;
+    my ($src, @args) = @_;
 
     # Create an instance of LWP::UserAgent.
     my $ua = LWP::UserAgent->new();
@@ -92,10 +93,9 @@ sub reverse
     $ua->timeout(2);
 
     # Put together the call to the Bit.ly API.
-    my @args = @{ $data{args} }; 
     if (!defined $args[0]) {
-        notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-        return 0;
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
+        return;
     }
     my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
     $surl = uri_escape($surl);
@@ -106,22 +106,21 @@ sub reverse
     if ($response->is_success) {
         # If successful, decode the content.
         my $d = $response->decoded_content;
-		chomp $d;
+        chomp $d;
         # And send it to channel.
-	    privmsg($data{svr}, $data{chan}, "URL: ".$d);
-	}
-	else {
+        privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
+    }
+    else {
         # Otherwise, send an error message.
-		privmsg($data{svr}, $data{chan}, "An error occurred while reversing your URL.");
-	}
+        privmsg($src->{svr}, $src->{chan}, 'An error occurred while reversing your URL.');
+    }
 
-	return 1;
+    return 1;
 }
 
 
 # Start initialization.
-API::Std::mod_init("Bitly", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a10');
 # build: cpan=LWP::UserAgent,URI::Escape perl=5.010000
 
 __END__
@@ -170,7 +169,7 @@ Add Bitly to module auto-load and the following to your configuration file:
 
 =over
 
-* Add Spanish, French and German translations for the help hashes.
+* Add Spanish and German translations for the help hashes.
 
 =back
 
@@ -178,9 +177,11 @@ Add Bitly to module auto-load and the following to your configuration file:
 
 =over
 
-This module adds  extra dependencies: LWP::UserAgent and URI::Escape. 
-You can get it from the CPAN <http://www.cpan.org>.
+This module adds extra dependencies: LWP::UserAgent and URI::Escape. You can
+get it from the CPAN <http://www.cpan.org>.
 
-This module is compatible with Auto version 3.0.0a2+.
+This module is compatible with Auto version 3.0.0a10+.
 
 =back
+
+# vim: set ai et sw=4 ts=4:

modules/BotStats.pm

@@ -0,0 +1,116 @@
+# Module: BotStats. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::BotStats;
+use strict;
+use warnings;
+use English qw(-no_match_vars);
+use API::Std qw(cmd_add cmd_del);
+use API::IRC qw(privmsg);
+
+# Initialization subroutine.
+sub _init {
+    # Create the STATS command.
+    cmd_add('STATS', 2, 0, \%M::BotStats::HELP_STATS, \&M::BotStats::stats) or return;
+
+    # Success.
+    return 1;
+}
+
+# Void subroutine.
+sub _void {
+    # Delete the STATS command.
+    cmd_del('STATS') or return;
+
+    # Success.
+    return 1;
+}
+
+# Help hash for STATS. Spanish, German and French translations needed.
+our %HELP_STATS = (
+    'en' => "This command will return information about the bot (uptime, version, etc.). \2Syntax:\2 STATS",
+);
+
+# Callback for STATS command.
+sub stats {
+    my ($src, undef) = @_;
+
+    # Check if this was private or public.
+    my $target;
+    if ($src->{chan}) {
+        $target = $src->{chan};
+    }
+    else {
+        $target = $src->{nick};
+    }
+
+    # Get uptime data.
+    my $uptime = time - $Auto::STARTTIME;
+    my $days = my $hours = my $mins = my $secs = 0;
+    while ($uptime >= 86_400) { $days++; $uptime -= 86_400 }
+    while ($uptime >= 3_600) { $hours++; $uptime -= 3_600 }
+    while ($uptime >= 60) { $mins++; $uptime -= 60 }
+    while ($uptime >= 1) { $secs++; $uptime-- }
+
+    # Return it.
+    privmsg($src->{svr}, $target, "I have been running for \2$days\2 days, \2$hours\2 hours, \2$mins\2 minutes, and \2$secs\2 seconds.");
+
+    # Return version data.
+    privmsg($src->{svr}, $target, 'I am running '.Auto::NAME.' (version '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.") for Perl $PERL_VERSION on $OSNAME.");
+
+    # Get network and channel data.
+    my $nets = keys %Auto::SOCKET;
+    my $chans;
+    foreach my $net (keys %Auto::SOCKET) {
+        foreach (keys %{$Proto::IRC::botchans{$net}}) { $chans++ }
+    }
+
+    # Return network/channel data.
+    privmsg($src->{svr}, $target, "I am on \2$chans\2 channels across \2$nets\2 networks.");
+
+    return 1;
+}
+
+
+API::Std::mod_init('BotStats', 'Xelhua', '1.00', '3.0.0a10');
+# build: perl=5.010000
+
+__END__
+
+=head1 NAME
+
+BotStats - General information about the bot
+
+=head1 VERSION
+
+ 1.00
+
+=head1 SYNOPSIS
+
+ <starcoder> !stats
+ <blue> I have been running for 0 days, 0 hours, 1 minutes, and 5 seconds.
+ <blue> I am running Auto IRC Bot (version 3.0.0a10) for Perl v5.12.3 on linux.
+ <blue> I am on 2 channels, across 1 networks.
+
+=head1 DESCRIPTION
+
+This module creates the STATS command, for returning general information about
+the bot such as uptime, version, etc.
+
+This module is compatible with Auto v3.0.0a10+.
+
+=head1 AUTHOR
+
+This module was written by Elijah Perrault.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group.
+
+This module is released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et sw=4 ts=4:

modules/Calc.pm

@@ -1,7 +1,7 @@
 # Module: Calc. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_Calc;
+package M::Calc;
 use strict;
 use warnings;
 use API::Std qw(cmd_add cmd_del trans);
@@ -13,79 +13,73 @@ use JSON -support_by_pp;
 # Initialization subroutine.
 sub _init 
 {
-    # Check for JSON::PP.
-    eval {
-        require JSON::PP;
-        1;
-    } or return 0;
-	# Create the CALC command.
-	cmd_add("CALC", 0, 0, \%m_Calc::HELP_CALC, \&m_Calc::calc) or return 0;
+    # Create the CALC command.
+    cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return;
 
-	# Success.
-	return 1;
+    # Success.
+    return 1;
 }
 
 # Void subroutine.
 sub _void 
 {
-	# Delete the CALC command.
-	cmd_del("CALC") or return 0;
+    # Delete the CALC command.
+    cmd_del("CALC") or return;
 
-	# Success.
-	return 1;
+    # Success.
+    return 1;
 }
 
 # Help hash.
 our %FHELP_CALC = (
-	'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC <expression>",
+    en => "This command will calculate an expression using Google Calculator. \2Syntax:\2 CALC <expression>",
+    de => "Dieser Befehl berechnet einen Ausdruck mit den Google Rechner. \2Syntax:\2 CALC <expression>",
 );
 
 # Callback for CALC command.
 sub calc
 {
-	my (%data) = @_;
+    my ($src, @args) = @_;
 
-	# Create an instance of LWP::UserAgent.
-	my $ua = LWP::UserAgent->new();
-	$ua->agent('Auto IRC Bot');
-	$ua->timeout(2);
-	# Create an instance of JSON.
-	my $json = JSON->new();    
-	# Put together the call to the Google Calculator API. 
-	my @args = @{ $data{args} };
+    # Create an instance of LWP::UserAgent.
+    my $ua = LWP::UserAgent->new();
+    $ua->agent('Auto IRC Bot');
+    $ua->timeout(2);
+    # Create an instance of JSON.
+    my $json = JSON->new();    
+    # Put together the call to the Google Calculator API. 
     if (!defined $args[0]) {
-        notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-        return 0;
+        notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
+        return;
     }
     my $expr = join(' ', @args);
-	my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr);
-	# Get the response via HTTP.
-	my $response = $ua->get($url);
+    my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr);
+    # Get the response via HTTP.
+    my $response = $ua->get($url);
 
-	if ($response->is_success) {
-	    # If successful, decode the content.
-		my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
+    if ($response->is_success) {
+        # If successful, decode the content.
+        my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
 
-		if ($d->{error} eq "" or $d->{error} == 0) {
-	        # And send to channel
-            privmsg($data{svr}, $data{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
-		}
-		else {
-	        # Otherwise, send an error message.
-			privmsg($data{svr}, $data{chan}, "Google Calculator sent an error.");
-		}
-	}
-	else {
-	    # Otherwise, send an error message.
-		privmsg($data{svr}, $data{chan}, "An error occurred while sending your expression to Google Calculator.");
-	}
+        if ($d->{error} eq "" or $d->{error} == 0) {
+            # And send to channel
+            privmsg($src->{svr}, $src->{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
+        }
+        else {
+            # Otherwise, send an error message.
+            privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
+        }
+    }
+    else {
+        # Otherwise, send an error message.
+        privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator.");
+    }
 
-	return 1;
+    return 1;
 }
 
 # Start initialization.
-API::Std::mod_init("Calc", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a10');
 # build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000
 
 __END__
@@ -114,7 +108,7 @@ Google Calculator.
 
 =over
 
-* Add Spanish, French and German translations for the help hash.
+* Add Spanish and French translations for the help hash.
 
 =back
 
@@ -125,6 +119,8 @@ Google Calculator.
 This module requires LWP::UserAgent, URI::Escape and JSON/JSON::PP. 
 All are obtainable from the CPAN <http://www.cpan.org>.
 
-This module is compatible with Auto version 3.0.0a2+.
+This module is compatible with Auto version 3.0.0a10+.
 
 =back
+
+# vim: set ai et sw=4 ts=4:

modules/ChanTopics.pm

@@ -0,0 +1,346 @@
+# Module: ChanTopics. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::ChanTopics;
+use strict;
+use warnings;
+use API::Std qw(cmd_add cmd_del trans);
+use API::IRC qw(notice topic);
+
+# Initialization subroutine.
+sub _init
+{
+    # PostgreSQL is not supported.
+    if ($Auto::ENFEAT =~ /pgsql/) { err(3, 'Unable to load ChanTopics: PostgreSQL is not supported.', 0); return }
+    
+    # Create database table if it's missing.
+    $Auto::DB->do('CREATE TABLE IF NOT EXISTS topics (net TEXT, chan TEXT, topic TEXT, divider TEXT, owner TEXT, verb TEXT, status TEXT, other TEXT, static TEXT)') or print "$!\n" and return;
+
+    # Create the TOPIC command.
+    cmd_add('TOPIC', 0, 'topic.topic', \%M::ChanTopics::HELP_TOPIC, \&M::ChanTopics::cmd_topic) or return;
+    # Create the DIVIDER command.
+    cmd_add('DIVIDER', 0, 'topic.topic', \%M::ChanTopics::HELP_DIVIDER, \&M::ChanTopics::cmd_divider) or return;
+    # Create the OWNER command.
+    cmd_add('OWNER', 0, 'topic.owner', \%M::ChanTopics::HELP_OWNER, \&M::ChanTopics::cmd_owner) or return;
+    # Create the VERB command.
+    cmd_add('VERB', 0, 'topic.status', \%M::ChanTopics::HELP_VERB, \&M::ChanTopics::cmd_verb) or return;
+    # Create the STATUS command.
+    cmd_add('STATUS', 0, 'topic.status', \%M::ChanTopics::HELP_STATUS, \&M::ChanTopics::cmd_status) or return;
+    # Create the OTHER command.
+    cmd_add('OTHER', 0, 'topic.static', \%M::ChanTopics::HELP_OTHER, \&M::ChanTopics::cmd_other) or return;
+    # Create the STATIC command.
+    cmd_add('STATIC', 0, 'topic.static', \%M::ChanTopics::HELP_STATIC, \&M::ChanTopics::cmd_static) or return;
+    # Create the TSYNC command.
+    cmd_add('TSYNC', 0, 'topic.topic', \%M::ChanTopics::HELP_TSYNC, \&M::ChanTopics::cmd_tsync) or return;
+
+    return 1;
+}
+
+# Void subroutine.
+sub _void
+{
+    # Delete all the commands.
+    cmd_del('TOPIC') or return;
+    cmd_del('DIVIDER') or return;
+    cmd_del('OWNER') or return;
+    cmd_del('VERB') or return;
+    cmd_del('STATUS') or return;
+    cmd_del('OTHER') or return;
+    cmd_del('STATIC') or return;
+    cmd_del('TSYNC') or return;
+
+    return 1;
+}
+
+# Help hashes for the TOPIC, OWNER, VERB, STATUS, OTHER, STATIC, DIVIDER and TSYNC commands. Spanish, French and German translations needed.
+our %HELP_TOPIC = (
+    'en' => "This command allows you to set the topic section of a channel topic. \002Syntax:\002 TOPIC <new topic>",
+);
+our %HELP_DIVIDER = (
+    'en' => "This command allows you to set the divider for topic sections in a channel topic. \002Syntax:\002 DIVIDER <new divider>",
+);
+our %HELP_OWNER = (
+    'en' => "This command allows you to set the channel owner section of a channel topic. \002Syntax:\002 OWNER <new owner>",
+);
+our %HELP_VERB = (
+    'en' => "This command allows you to set the status verb section of a channel topic. \002Syntax:\002 VERB <new verb>",
+);
+our %HELP_STATUS = (
+    'en' => "This command allows you to set the status section of a channel topic. \002Syntax:\002 STATUS <new status>",
+);
+our %HELP_OTHER = (
+    'en' => "This command allows you to set the other static section of a channel topic. \002Syntax:\002 OTHER <new other static>",
+);
+our %HELP_STATIC = (
+    'en' => "This command allows you to set the static section of a channel topic. \002Syntax:\002 STATIC <new static>",
+);
+our %HELP_TSYNC = (
+    'en' => "This command allows you to sync the channel topic with the topic in the database. \002Syntax:\002 TSYNC",
+);
+
+# Callback for TOPIC command.
+sub cmd_topic
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Get existing topic data.
+    my (undef, $div, $owner, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Query the database with the new topic.
+    my $dbq = $Auto::DB->prepare('UPDATE topics SET topic = ? WHERE net = ? AND chan = ?') or return;
+    $dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: ".join(' ', @argv)." $div $owner $verb $status $div $other $div $static");
+
+    return 1;
+}
+
+# Callback for DIVIDER command.
+sub cmd_divider
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Get existing topic data.
+    my ($topic, undef, $owner, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Query the database with the new divider.
+    my $dbq = $Auto::DB->prepare('UPDATE topics SET divider = ? WHERE net = ? AND chan = ?') or return;
+    $dbq->execute($argv[0], lc $src->{svr}, lc $src->{chan}) or return;
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: $topic $argv[0] $owner $verb $status $argv[0] $other $argv[0] $static");
+
+    return 1;
+}
+
+# Callback for OWNER command.
+sub cmd_owner
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Get existing topic data.
+    my ($topic, $div, undef, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Query the database with the new owner.
+    my $dbq = $Auto::DB->prepare('UPDATE topics SET owner = ? WHERE net = ? AND chan = ?') or return;
+    $dbq->execute($argv[0], lc $src->{svr}, lc $src->{chan}) or return;
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: $topic $div $argv[0] $verb $status $div $other $div $static");
+
+    return 1;
+}
+
+# Callback for VERB command.
+sub cmd_verb
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Get existing topic data.
+    my ($topic, $div, $owner, undef, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Query the database with the new verb.
+    my $dbq = $Auto::DB->prepare('UPDATE topics SET verb = ? WHERE net = ? AND chan = ?') or return;
+    $dbq->execute($argv[0], lc $src->{svr}, lc $src->{chan}) or return;
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $argv[0] $status $div $other $div $static");
+
+    return 1;
+}
+
+# Callback for STATUS command.
+sub cmd_status
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Get existing topic data.
+    my ($topic, $div, $owner, $verb, undef, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Query the database with the new status.
+    my $dbq = $Auto::DB->prepare('UPDATE topics SET status = ? WHERE net = ? AND chan = ?') or return;
+    $dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb ".join(' ', @argv)." $div $other $div $static");
+
+    return 1;
+}
+
+# Callback for OTHER command.
+sub cmd_other
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Get existing topic data.
+    my ($topic, $div, $owner, $verb, $status, undef, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Query the database with the new other.
+    my $dbq = $Auto::DB->prepare('UPDATE topics SET other = ? WHERE net = ? AND chan = ?') or return;
+    $dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb $status $div ".join(' ', @argv)." $div $static");
+
+    return 1;
+}
+
+# Callback for STATIC command.
+sub cmd_static
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Get existing topic data.
+    my ($topic, $div, $owner, $verb, $status, $other, undef) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Query the database with the new static.
+    my $dbq = $Auto::DB->prepare('UPDATE topics SET static = ? WHERE net = ? AND chan = ?') or return;
+    $dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb $status $div $other $div ".join(' ', @argv));
+
+    return 1;
+}
+
+# Callback for TSYNC command.
+sub cmd_tsync
+{
+    my ($src, @argv) = @_;
+
+    # Get the topic data.
+    my ($topic, $div, $owner, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
+
+    # Set new topic.
+    topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb $status $div $other $div $static");
+
+    return 1;
+}
+
+# Subroutine for getting topic data.
+sub _getdata
+{
+    my ($net, $chan) = @_;
+
+    # Check if there is a database entry for this channel.
+    if (!$Auto::DB->selectrow_array('SELECT * FROM topics WHERE net = "'.$net.'" AND chan = "'.$chan.'"')) {
+        # There is not; create it.
+        my $dbq = $Auto::DB->prepare('INSERT INTO topics (net, chan, topic, divider, owner, verb, status, other, static) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)') or return;
+        $dbq->execute($net, $chan, 'NULL', 'NULL', 'NULL', 'NULL', 'NULL', 'NULL', 'NULL') or return;
+    }
+
+    # Now retrieve all the desired data.
+    my $dbq = $Auto::DB->prepare('SELECT topic,divider,owner,verb,status,other,static FROM topics WHERE net = ? AND chan = ?') or return;
+    $dbq->execute($net, $chan) or return;
+    my $data = $dbq->fetchrow_hashref or return;
+    
+    # And return it.
+    return ($data->{topic}, $data->{divider}, $data->{owner}, $data->{verb}, $data->{status}, $data->{other}, $data->{static});
+}
+
+
+API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a10');
+# build: perl=5.010000
+
+__END__
+
+=head1 ChanTopics
+
+=head2 Description
+
+=over
+
+This module adds the TOPIC, DIVIDER, OWNER, VERB, STATUS, OTHER and STATIC
+commands for advanced yet simple management of a channel's topic.
+
+Topic Format: Topic: TOPIC DIVIDER OWNER VERB STATUS DIVIDER OTHER DIVIDER STATIC
+
+=back
+
+=head2 How To Use
+
+=over
+
+This module adds the topic.topic, topic.owner, topic.status and topic.static
+privileges. topic.topic grants access to TOPIC, topic.owner to OWNER,
+topic.status to VERB and STATUS, and topic.static to OTHER and STATIC.
+
+=back
+
+=head2 Examples
+
+=over
+
+<JohnSmith> !topic Random Nonsense
+* Auto changes topic to: Topic: Random Nonsense | JohnSmith is here | Welcome to #johnsmith | Website at http://example.com
+<JohnSmith> !status sleeping
+* Auto changes topic to: Topic: Random Nonsense | JohnSmith is sleeping | Welcome to #johnsmith | Website at http://example.com
+
+=back
+
+=head2 To Do
+
+=over
+
+* Spanish, French and German translations for the help hashes.
+
+=back
+
+=head2 Technical
+
+=over
+
+This module adds no extra dependencies.
+
+This module is not compatible with PostgreSQL, yet.
+
+This module is compatible with Auto v3.0.0a10+.
+
+Ported from v1.0.
+
+=back
+
+# vim: set ai et sw=4 ts=4:

modules/Dictionary.pm

@@ -0,0 +1,106 @@
+# Module: Dictionary. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::Dictionary;
+use strict;
+use warnings;
+use Net::Dict;
+use API::Std qw(cmd_add cmd_del trans);
+use API::IRC qw(notice privmsg);
+
+# Initialization subroutine.
+sub _init
+{
+    # Create the DICT command.
+    cmd_add('DICT', 0, 0, \%M::Dictionary::HELP_DICT, \&M::Dictionary::cmd_dict) or return;
+
+    # Success.
+    return 1;
+}
+
+# Void subroutine.
+sub _void
+{
+    # Delete the DICT command.
+    cmd_del('DICT') or return;
+
+    # Success.
+    return 1;
+}
+
+
+# Help hash for DICT. Spanish, French and German translations needed.
+our %HELP_DICT = (
+    en => "This command allows you to lookup a word through Dict.org. \2Syntax:\2 DICT <word>",
+    de => "Dieser Befehl ermoeglicht du auf nachschlagst ein Wort durch Dict.org. \2Syntax:\2 DICT <word>",
+);
+
+# Callback for DICT command.
+sub cmd_dict
+{
+    my ($src, ($word)) = @_;
+
+    # Check for needed parameters.
+    if (!defined $word) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Create an instance of Net::Dict.
+    my $dictv = Net::Dict->new('dict.org');
+
+    # Get the definition for this word.
+    my $res = $dictv->define($word);
+
+    # Check if there was a result.
+    if (defined $res) {
+        # Return the results.
+        privmsg($src->{svr}, $src->{chan}, "Results for \2$word\2:");
+        foreach (@{ $res }) {
+            # Split the newlines.
+            my @lines = split m/\n/, @$_[1];
+            foreach (@lines) {
+                if ($_ =~ m/[^\s]/) {
+                    privmsg($src->{svr}, $src->{chan}, $_);
+                }
+            }
+        }
+    }
+    else {
+        # Else return no results.
+        privmsg($src->{svr}, $src->{chan}, "No results for \2$word\2.");
+    }
+
+    return 1;
+}
+
+
+# Start initialization.
+API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a10');
+# build: cpan=Net::Dict perl=5.010000
+
+__END__
+
+=head1 Dictionary
+
+=head2 Description
+
+=over
+
+This module allows users to lookup definitions for words from dict.org via the
+DICT command.
+
+=back
+
+=head2 Technical
+
+=over
+
+This module adds an extra dependency: Net::Dict. You can get it from the CPAN
+<http://www.cpan.org>.
+
+This module is compatible with Auto v3.0.0a10+.
+
+=back
+
+# vim: set ai et sw=4 ts=4:

modules/EightBall.pm

@@ -1,152 +1,146 @@
 # Module: EightBall. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_EightBall;
+package M::EightBall;
 use strict;
 use warnings;
-use feature qw(switch);
 use API::Std qw(cmd_add cmd_del trans);
 use API::IRC qw(privmsg notice);
 our $ANSWER = 0;
+my @responses = (
+    'Yes!',
+    'No!',
+    'Yes... No... Yes... No... Hmm... No.',
+    'Hmm... it seems likely.',
+    'Very unlikely.',
+    'Heck no!',
+    'Definite yes!',
+    'Magic unavailable. Try again later.',
+    'Possibly, I wouldn\'t count on it though.',
+    'Outcome looks bad.',
+    'Outcome looks good.',
+    'Can\'t tell now. Maybe another time.',
+    'Sorry, but no.',
+);
 
 # Initialization subroutine.
-sub _init 
-{
+sub _init {
     # Create the 8BALL and RIGBALL commands.
-	cmd_add("8BALL", 0, 0, \%m_EightBall::HELP_8BALL, \&m_EightBall::c_8ball) or return 0;
-	cmd_add("RIGBALL", 1, "cmd.rigball", \%m_EightBall::HELP_RIGBALL, \&m_EightBall::rigball) or return 0;
+    cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return;
+    cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return;
 
     # Success.
     return 1;
 }
 
 # Void subroutine.
-sub _void 
-{
+sub _void {
     # Delete the 8BALL and RIGBALL commands.
-	cmd_del("8BALL") or return 0;
-	cmd_del("RIGBALL") or return 0;
+    cmd_del('8BALL') or return;
+    cmd_del('RIGBALL') or return;
 
     # Success.
-	return 1;
+    return 1;
 }
 
 # Help hashes.
 our %HELP_8BALL = (
-    'en' => "This command will ask the magic 8-Ball your question. \002Syntax:\002 8BALL <question>",
+    en => "This command will ask the magic 8-Ball your question. \2Syntax:\2 8BALL <question>",
+    de => "Dieser Befehl fragt die magische 8-Kugel eine Frage. \2Syntax:\2 8BALL <question>",
 );
 our %HELP_RIGBALL = (
-    'en' => "This command will \"rig\" (set) the answer of the next 8-Ball question. \002Syntax:\002 RIGBALL <answer>",
+    en => "This command will \"rig\" (set) the answer of the next 8-Ball question. \2Syntax:\2 RIGBALL <answer>",
+    de => "Dieser Befehl wird festgelegt die Antwort der naechsten 8-Kugel Frage. \2Syntax:\2 RIGBALL <answer>",
 );
 
 # Callback for 8BALL command.
-sub c_8ball
-{
-	my (%data) = @_;
-    my @argv = @{ $data{args} }; delete $data{args};
+sub c_8ball {
+    my ($src, @argv) = @_;
 
     if (!defined $argv[0]) {
-        notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
         return;
     }
 
-    privmsg($data{svr}, $data{chan}, "\002Question:\002 ".join(" ", @argv));
-    
-    my $a = '';
+    # Return the question.
+    privmsg($src->{svr}, $src->{chan}, "\2Question:\2 ".join q{ }, @argv);
+
+    # Set answer.
+    my $answer;
     if (!$ANSWER) {
-        my $rn = int(rand(12));
-        given ($rn) {
-            when (1) { $a = "Yes!"; }
-            when (2) { $a = "No!"; }
-            when (3) { $a = "Yes... No... Yes... No... No."; }
-            when (4) { $a = "Hmm... it seems likely."; }
-            when (5) { $a = "Very unlikely."; }
-            when (6) { $a = "Heck no!"; }
-            when (7) { $a = "Definite yes!"; }
-            when (8) { $a = "Magic unavailable. Try again later."; }
-            when (9) { $a = "Possibly, I wouldn't count on it though."; }
-            when (10) { $a = "Outcome looks bad."; }
-            when (11) { $a = "Outcome looks good."; }
-            when (12) { $a = "Can't tell now. Maybe another time."; }
-            default { $a = "Sorry, but no."; }
-        }
+        $answer = $responses[int rand scalar @responses];
     }
     else {
-        $a = $ANSWER;
+        $answer = $ANSWER;
         $ANSWER = 0;
     }
 
-    privmsg($data{svr}, $data{chan}, "\002Answer:\002 ".$a);
-    
-	return 1;
+    # Return it.
+    privmsg($src->{svr}, $src->{chan}, "\2Answer:\2 $answer");
+
+    return 1;
 }
 
 # Callback for RIGBALL command.
-sub rigball 
-{
-    my (%data) = @_;
-    my @argv = @{ $data{args} }; delete $data{args};
+sub rigball {
+    my ($src, @argv) = @_;
 
     # Check for necessary parameters.
     if (!defined $argv[0]) {
-        privmsg($data{svr}, $data{nick}, trans("Not enough parameters").".");
+        privmsg($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
         return;
     }
 
-    $ANSWER = join(" ", @argv);
-    privmsg($data{svr}, $data{nick}, "Answer set to: ".$ANSWER);
+    # Return result.
+    $ANSWER = join q{ }, @argv;
+    privmsg($src->{svr}, $src->{nick}, "Answer set to: $ANSWER");
 
-	return 1;
+    return 1;
 }
 
 
 # Start initialization.
-API::Std::mod_init("EightBall", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('EightBall', 'Xelhua', '2.00', '3.0.0a10');
 # build: perl=5.010000
 
 __END__
 
-=head1 EightBall
+=head1 NAME
 
-=head2 Description
+EightBall - A magic eightball module.
 
-=over
+=head1 VERSION
 
-This module adds the 8BALL and RIGBALL commands, 8BALL is a channel
-command for asking the magic 8-Ball a question, RIGBALL is a private
-command for setting ("rigging") the 8-Ball's next answer.
+ 2.00
 
-=back
+=head1 SYNOPSIS
 
-=head2 Examples
+ <JohnSmith> !8ball Will I be rich?
+ <Auto> Question: Will I be rich?
+ <Auto> Answer: Heck no!
+ >Auto< rigball Of course!
+ <JohnSmith> !8ball Will I be famous?
+ <Auto> Question: Will I be famous?
+ <Auto> Answer: Of course!
 
-=over
+=head1 DESCRIPTION
 
-<JohnSmith> !8ball Will I be rich?
-<Auto> Question: Will I be rich?
-<Auto> Answer: Heck no!
->Auto< rigball Of course!
-<JohnSmith> !8ball Will I be famous?
-<Auto> Question: Will I be famous?
-<Auto> Answer: Of course!
+This module adds the 8BALL and RIGBALL commands, 8BALL is a channel command for
+asking the magic 8-Ball a question, RIGBALL is a private command for setting
+("rigging") the 8-Ball's next answer.
 
-=back
+=head1 AUTHOR
 
-=head2 To Do
+This module was written by Elijah Perrault.
 
-=over
+This module is maintained by Xelhua Development Group.
 
-* Add Spanish, French and German translations for the help hashes.
+=head1 LICENSE AND COPYRIGHT
 
-=back
+This module is Copyright 2010-2011 Xelhua Development Group.
 
-=head2 Technical
+Released under the same licensing terms as Auto itself.
 
-=over
+=cut
 
-This module is compatible with Auto version 3.0.0a2+.
-
-Ported from Auto 1.0.
-
-=back
+# vim: set ai et sw=4 ts=4:

modules/Eval.pm

@@ -0,0 +1,108 @@
+# Module: Eval. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::Eval;
+use strict;
+use warnings;
+use English qw(-no_match_vars);
+use API::Std qw(cmd_add cmd_del trans);
+use API::IRC qw(privmsg notice);
+
+# Initialization subroutine.
+sub _init {
+    # Create the EVAL command.
+    cmd_add('EVAL', 2, 'cmd.eval', \%M::Eval::HELP_EVAL, \&M::Eval::cmd_eval) or return;
+
+    # Success.
+    return 1;
+}
+
+# Void subroutine.
+sub _void {
+    # Delete the EVAL command.
+    cmd_del('EVAL') or return;
+
+    # Success.
+    return 1;
+}
+
+# Help hash for EVAL command. Spanish and French translations are needed.
+our %HELP_EVAL = (
+    en => "This command allows you to eval Perl code. USE WITH CAUTION. \2Syntax:\2 EVAL <expression>",
+    de => "Dieser Befehl ermoeglicht du auf bewertst Perl Code. GEBRAUCH MIT VORSICHT. \2Syntax:\2 EVAL <expression>",
+);
+
+# Callback for EVAL command.
+sub cmd_eval {
+    my ($src, @argv) = @_;
+
+    # Check for needed parameter.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Evaluate the expression and return the result.
+    my $expr = join ' ', @argv;
+    my $result = eval($expr);
+    if (!defined $result) { $result = 'None' }
+    if ($EVAL_ERROR) {
+        $result = $EVAL_ERROR;
+        $result =~ s/(\r|\n)//gxsm;
+    }
+
+    # Return the result.
+    if (!defined $src->{chan}) {
+        notice($src->{svr}, $src->{nick}, "Output: $result");
+    }
+    else {
+        privmsg($src->{svr}, $src->{chan}, "$src->{nick}: $result");
+    }
+
+    return 1;
+}
+
+
+# Start initialization.
+API::Std::mod_init('Eval', 'Xelhua', '1.01', '3.0.0a10');
+# build: perl=5.010000
+
+__END__
+
+=head1 NAME
+
+Eval - Allows you to evaluate Perl code from IRC
+
+=head1 VERSION
+
+ 1.01
+
+=head1 SYNOPSIS
+
+ >blue< eval 1;
+ -blue- Output: 1
+
+=head1 DESCRIPTION
+
+This module adds the EVAL command which allows you to evaluate Perl code from
+IRC, returning the output via notice.
+
+This command requires the cmd.eval privilege.
+
+This module is compatible with Auto v3.0.0a10+.
+
+=head1 AUTHOR
+
+This module was written by Elijah Perrault.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group.
+
+This module is released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et sw=4 ts=4:

modules/FML.pm

@@ -1,7 +1,7 @@
 # Module: FML. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_FML;
+package M::FML;
 use strict;
 use warnings;
 use API::Std qw(cmd_add cmd_del trans);
@@ -12,7 +12,7 @@ use LWP::UserAgent;
 sub _init 
 {
     # Create the FML command.
-	cmd_add("FML", 0, 0, \%m_FML::HELP_FML, \&m_FML::fml) or return 0;
+    cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return;
 
     # Success.
     return 1;
@@ -22,53 +22,53 @@ sub _init
 sub _void 
 {
     # Delete the FML command.
-	cmd_del("FML") or return 0;
+    cmd_del('FML') or return;
 
     # Success.
-	return 1;
+    return 1;
 }
 
 # Help hash.
 our %HELP_FML = (
-    'en' => "This command will return a random FML quote. \002Syntax:\002 FML",
+    en => "This command will return a random FML quote. \2Syntax:\2 FML",
+    de => "Dieser Befehl liefert eine zufaellige Zitat von FML. \2Syntax:\2 FML",
 );
 
 # Callback for FML command.
 sub fml
 {
-	my (%data) = @_;
+    my ($src, undef) = @_;
 
     # Create an instance of LWP::UserAgent.
-	my $ua = LWP::UserAgent->new();
-	$ua->agent('Auto IRC Bot');
-	$ua->timeout(2);
+    my $ua = LWP::UserAgent->new();
+    $ua->agent('Auto IRC Bot');
+    $ua->timeout(2);
     
     # Get the random FML via HTTP.
-    my $rp = $ua->get("http://rscript.org/lookup.php?type=fml");
+    my $rp = $ua->get('http://rscript.org/lookup.php?type=fml');
 
-	if ($rp->is_success) {
+    if ($rp->is_success) {
         # If successful, decode the content.
         my $d = $rp->decoded_content;
-		$d =~ s/(\n|\r)//g;
+        $d =~ s/(\n|\r)//g;
 
         # Get the FML.
         my (undef, $dfa) = split('Text: ', $d);
         my ($fml, undef) = split('Agree:', $dfa);
 
         # And send to channel.
-		privmsg($data{svr}, $data{chan}, "\002Random FML:\002 ".$fml);
-	}
+        privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
+    }
     else {
         # Otherwise, send an error message.
-        privmsg($data{svr}, $data{chan}, "An error occurred while retrieving the FML.");
+        privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving the FML.");
     }
 
-	return 1;
+    return 1;
 }
 
 # Start initialization.
-API::Std::mod_init("FML", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a10');
 # build: cpan=LWP::UserAgent perl=5.010000
 
 __END__
@@ -99,7 +99,7 @@ have my hand back?" FML
 
 =over
 
-* Add Spanish, French and German translations for the help hash.
+* Add Spanish and French translations for the help hash.
 
 =back
 
@@ -110,8 +110,10 @@ have my hand back?" FML
 This module adds an extra dependency: LWP::UserAgent. You can get it from
 the CPAN <http://www.cpan.org>.
 
-This module is compatible with Auto version 3.0.0a2+.
+This module is compatible with Auto version 3.0.0a10+.
 
 Ported from Auto 2.0.
 
 =back
+
+# vim: set ai et sw=4 ts=4:

modules/Greet.pm

@@ -0,0 +1,161 @@
+# Module: Greet. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::Greet;
+use strict;
+use warnings;
+use feature qw(switch);
+use API::Std qw(cmd_add cmd_del hook_add hook_del trans);
+use API::IRC qw(privmsg notice);
+
+# Initialization subroutine.
+sub _init
+{
+    # Not compatible with PostgreSQL.
+    if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load Greet: PostgreSQL is not supported.', 0); return }
+
+    # Create the `greets` table.
+    $Auto::DB->do('CREATE TABLE IF NOT EXISTS greets (nick TEXT, greet TEXT)') or return;
+    # Create the GREET command.
+    cmd_add('GREET', 2, 'cmd.greet', \%M::Greet::HELP_GREET, \&M::Greet::cmd_greet) or return;
+    # Create the greet_onjoin hook.
+    hook_add('on_rcjoin', 'greet_onjoin', \&M::Greet::hook_rcjoin) or return;
+
+    # Success.
+    return 1;
+}
+
+# Void subroutine.
+sub _void
+{
+    # Delete the GREET command.
+    cmd_del('GREET') or return;
+    # Delete the greet_onjoin hook.
+    hook_del('on_rcjoin') or return;
+
+    # Success.
+    return 1;
+}
+
+# Help hash for GREET. Spanish and French translation needed.
+our %HELP_GREET = (
+    en => "This command allows management of greets. \2Syntax:\2 GREET (ADD|DEL) [nick] [greet]",
+    de => "Dieser Befehl ermoeglicht die Verwaltung von Gruesse. \2Syntax:\2 GREET (ADD|DEL) [nick] [greet]",
+);
+# Callback for GREET.
+sub cmd_greet
+{
+    my ($src, @argv) = @_;
+
+    # Check for required parameters.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Check what action we're being told to take.
+    given (uc $argv[0]) {
+        when ('ADD') {
+            # GREET ADD
+            
+            # Check for needed parameters.
+            if (!defined $argv[1] or !defined $argv[2]) {
+                notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+                return;
+            }
+            my $nick = $argv[1]; shift @argv; shift @argv;
+            $nick = lc $nick;
+            my $greet = join(' ', @argv);
+
+            # Make sure it doesn't already exist.
+            if ($Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"')) {
+                notice($src->{svr}, $src->{nick}, "A greet for \002$nick\002 already exists.");
+                return;
+            }
+
+            # Insert into database.
+            my $dbq = $Auto::DB->prepare('INSERT INTO greets (nick, greet) VALUES (?, ?)') or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
+            $dbq->execute($nick, $greet) or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
+
+            API::Log::slog('cmd_greet(): Creating new greet.');
+            # Done.
+            notice($src->{svr}, $src->{nick}, "Successfully added greet for \002$nick\002.");
+        }
+        when ('DEL') {
+            # GREET DEL
+            
+            # Check for needed parameters.
+            if (!defined $argv[1]) {
+                notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+                return;
+            }
+            my $nick = lc $argv[1];
+
+            # Check if there is a greet for this user.
+            if (!$Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"')) {
+                notice($src->{svr}, $src->{nick}, "There is no greet for \002$nick\002.");
+                return;
+            }
+
+            # Delete it.
+            $Auto::DB->do('DELETE FROM greets WHERE nick = "'.$nick.'"') or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
+            notice($src->{svr}, $src->{nick}, "Greet for \002$nick\002 successfully deleted.");
+        }
+        default { notice($src->{svr}, $src->{nick}, "Unknown action \002$argv[0]\002. \002Syntax:\002 GREET (ADD|DEL)"); return }
+    }
+
+    return 1;
+}
+
+# Call back for on_rcjoin hook.
+sub hook_rcjoin
+{
+    my (($src, $chan)) = @_;
+    my $nick = lc $src->{nick};
+
+    # Check if there's a greet for this user.
+    if ($Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"')) {
+        # Get data.
+        my @data = $Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"');
+        
+        # Send the greet.
+        privmsg($src->{svr}, $chan, "[\002".$src->{nick}."\002] ".$data[1]);
+    }
+
+    return 1;
+}
+
+# Start initialization.
+API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a10');
+# build: perl=5.010000
+
+__END__
+
+=head1 Greet
+
+=head2 Description
+
+=over
+
+This module adds GREET ADD|DEL for greet management. Greets are sent when a
+user that has a greet in the database joins a channel the bot is in.
+
+=back
+
+=head2 To Do
+
+=over
+
+* Add Spanish and French translations for the help hash.
+
+=back
+
+=head2 Technical
+
+=over
+
+This module is compatible with Auto version 3.0.0a10+.
+
+=back
+
+# vim: set ai et sw=4 ts=4:

modules/HelloChan.pm

@@ -1,7 +1,7 @@
 # Module: HelloChan.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_HelloChan;
+package M::HelloChan;
 use strict;
 use warnings;
 use API::Std qw(hook_add hook_del);
@@ -10,32 +10,71 @@ use API::IRC qw(privmsg);
 # Initialization subroutine.
 sub _init
 {
-	# Add a hook for when we join a channel.
-	hook_add("on_ucjoin", "HelloChan", \&m_HelloChan::hello) or return 0;
-	return 1;
+    # Add a hook for when we join a channel.
+    hook_add('on_ucjoin', 'HelloChan', \&M::HelloChan::hello) or return;
+    return 1;
 }
 
 # Void subroutine.
 sub _void
 {
-	# Delete the hook.
-	hook_del("on_ucjoin", "HelloChan") or return 0;
-	return 1;
+    # Delete the hook.
+    hook_del('on_ucjoin', 'HelloChan') or return;
+    return 1;
 }
 
 # Main subroutine.
 sub hello
 {
-	my (($svr, $chan)) = @_;
-	
-	# Send a PRIVMSG.
-	privmsg($svr, $chan, "Hello channel! I am a bot!");
-	
-	return 1;
+    my (($svr, $chan)) = @_;
+    
+    # Send a PRIVMSG.
+    privmsg($svr, $chan, 'Hello channel! I am a bot!');
+    
+    return 1;
 }
 
 
 # Start initialization.
-API::Std::mod_init("HelloChan", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a10');
 # build: perl=5.010000
+
+__END__
+
+=head1 NAME
+
+HelloChan - An example module. Also, cows go moo.
+
+=head1 VERSION
+
+ 1.00
+
+=head1 SYNOPSIS
+
+ * Auto has joined #moocows
+ <Auto> Hello channel! I am a bot!
+
+=head1 DESCRIPTION
+
+This module sends "Hello channel! I am a bot!" whenever it 
+joins a channel.
+
+=head1 INSTALL
+
+No additonal steps need to be taking to use this module.
+
+=head1 AUTHOR
+
+This module was written by Elijah Perrault.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group.
+
+Released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et sw=4 ts=4:

modules/IsItUp.pm

@@ -1,7 +1,7 @@
 # Module: IsItUp. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_IsItUp;
+package M::IsItUp;
 use strict;
 use warnings;
 use API::Std qw(cmd_add cmd_del trans);
@@ -11,67 +11,65 @@ use LWP::UserAgent;
 # Initialization subroutine.
 sub _init 
 {
-	# Create the ISITUP command.
-	cmd_add("ISITUP", 0, 0, \%m_IsItUp::HELP_ISITUP, \&m_IsItUp::check) or return 0;
+    # Create the ISITUP command.
+    cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return;
 
-	# Success.
-	return 1;
+    # Success.
+    return 1;
 }
 
 # Void subroutine.
 sub _void 
 {
-	# Delete the ISITUP command.
-	cmd_del("ISITUP") or return 0;
+    # Delete the ISITUP command.
+    cmd_del('ISITUP') or return;
 
-	# Success.
-	return 1;
+    # Success.
+    return 1;
 }
 
 # Help hashes.
 our %HELP_ISITUP = (
-	'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>",
+    'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>",
 );
 
 # Callback for ISITUP command.
 sub check
 {
-	my (%data) = @_;
+    my ($src, @argv) = @_;
 
-	# Create an instance of LWP::UserAgent.
-	my $ua = LWP::UserAgent->new();
-	$ua->agent('Auto IRC Bot');
-	$ua->timeout(2);
-	my @args = @{ $data{args} };
-	my $curl = $args[0];
-	# Do we have enough parameters?
-	if (!defined $args[0]) {
-		notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-		return 0;
-	}
-	# Does the URL start with http(s)?
-	if ($curl !~ m/^http/) {
-		$curl = "http://".$curl;
-	}
+    # Create an instance of LWP::UserAgent.
+    my $ua = LWP::UserAgent->new();
+    $ua->agent('Auto IRC Bot');
+    $ua->timeout(2);
+    # Do we have enough parameters?
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+    my $curl = $argv[0];
+    # Does the URL start with http(s)?
+    if ($curl !~ m/^http/) {
+        $curl = 'http://'.$curl;
+    }
 
-	# Get the response via HTTP.
-	my $response = $ua->get($curl);
+    # Get the response via HTTP.
+    my $response = $ua->get($curl);
 
-	if ($response->is_success) {
-		# If successful, it's up.
-		privmsg($data{svr}, $data{chan}, $curl." appears to be up from here.");
-	}
-	else {
-		# Otherwise, it's down.
-		privmsg($data{svr}, $data{chan}, $curl." appears to be down from here.");
-	}
+    if ($response->is_success) {
+        # If successful, it's up.
+        privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
+    }
+    else {
+        # Otherwise, it's down.
+        privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
+    }
 
-	return 1;
+    return 1;
 }
 
 # Start initialization.
-API::Std::mod_init("IsItUp", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a10');
 # build: cpan=LWP::UserAgent perl=5.010000
 
 __END__
@@ -111,6 +109,8 @@ appears up or down to Auto.
 This module requires LWP::UserAgent. You can get it from
 the CPAN <http://www.cpan.org>.
 
-This module is compatible with Auto version 3.0.0a2+.
+This module is compatible with Auto version 3.0.0a10+.
 
 =back
+
+# vim: set ai et sw=4 ts=4:

modules/LOLCAT.pm

@@ -0,0 +1,100 @@
+# Module: LOLCAT. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::LOLCAT;
+use strict;
+use warnings;
+use API::Std qw(cmd_add cmd_del trans);
+use API::IRC qw(privmsg notice);
+use Acme::LOLCAT;
+
+# Initialization subroutine.
+sub _init {
+    # Create LOLCAT command.
+    cmd_add('LOLCAT', 0, 0, \%M::LOLCAT::HELP_LOLCAT, \&M::LOLCAT::cmd_lolcat) or return;
+    # Success.
+    return 1;
+}
+
+# Void subroutine.
+sub _void {
+    # Delete LOLCAT command.
+    cmd_del('LOLCAT') or return;
+    # Success.
+    return 1;
+}
+
+# Help for LOLCAT.
+our %HELP_LOLCAT = (
+    en => "This command will translate English to LOLCAT speak. \2Syntax:\2 LOLCAT <text>",
+);
+
+# Callback for LOLCAT command.
+sub cmd_lolcat {
+    my ($src, @argv) = @_;
+
+    # At least one parameter is required.
+    if (!defined $argv[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
+        return;
+    }
+
+    # Return LOLCAT translation.
+    privmsg($src->{svr}, $src->{chan}, 'Result: '.translate(join q{ }, @argv));
+    
+    return 1;
+}
+
+# Start initialization.
+API::Std::mod_init('LOLCAT', 'Xelhua', '1.00', '3.0.0a10');
+# build: perl=5.010000 cpan=Acme::LOLCAT
+
+__END__
+
+=head1 NAME
+
+LOLCAT - Translates English into LOLCAT.
+
+=head1 VERSION
+
+ 1.00
+
+=head1 SYNOPSIS
+
+ <starcoder> !lolcat You too can speak like a lolcat!
+ <Auto> Result: YU T CAN SPEKK LIEK LOLCAT!  KTHXBYE!
+
+=head1 DESCRIPTION
+
+This will create the LOLCAT command which allows you to translate English text
+into LOLCAT speak.
+
+See also: http://en.wikipedia.org/wiki/Lolcat
+
+=head1 DEPENDENCIES
+
+This module is dependent on the following modules from CPAN:
+
+=over
+
+=item L<Acme::LOLCAT>
+
+This is what the module uses to translate English into LOLCAT.
+
+=back
+
+=head1 AUTHOR
+
+This module was written by Elijah Perrault.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group.
+
+Released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et ts=4 sw=4:

modules/LinkTitle.pm

@@ -0,0 +1,128 @@
+# Module: LinkTitle. See below for documentation.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::LinkTitle;
+use strict;
+use warnings;
+use LWP::UserAgent;
+use HTML::Entities;
+use API::Std qw(hook_add hook_del);
+use API::IRC qw(privmsg);
+
+# Initialization subroutine.
+sub _init
+{
+    # Create the on_cprivmsg hook.
+    hook_add('on_cprivmsg', 'privmsg.html.returntitle', \&M::LinkTitle::gettitle) or return;
+
+    # Success.
+    return 1;
+}
+
+# Void subroutine.
+sub _void
+{
+    # Delete the hook we created.
+    hook_del('on_cprivmsg', 'privmsg.html.returntitle') or return;
+
+    # Success.
+    return 1;
+}
+
+# Hook callback.
+sub gettitle
+{
+    my ($src, $chan, @msg) = @_;
+
+    # Check if the message contains a URL.
+    foreach my $smw (@msg) {
+        if ($smw =~ m{(http|https)://}xsm) {
+            # We've got a match, connect to the server.
+            my $srv = $1;
+            # Create an instance of LWP::UserAgent.
+            my $ua = LWP::UserAgent->new();
+            $ua->agent('Auto IRC Bot');
+            $ua->timeout(3);
+            # Get data.
+            my $res = $ua->get($smw);
+            
+            # Check if we're successful.
+            if ($res->is_success) {
+                # We were, decode the data.
+                my $data = $res->decoded_content;
+
+                # Strip newlines.
+                $data =~ s/(\n|\r)//gxsm;
+                
+                # Check for <title>
+                if ($data =~ m{<title>(.*)</title>}ixsm) {
+                    # Found. Decode it.
+                    my $title = decode_entities($1);
+                    # Return to channel.
+                    privmsg($src->{svr}, $chan, "\2Title:\2 $title");
+                }
+            }
+        }
+    }
+
+    return 1;
+}
+
+# Start initialization.
+API::Std::mod_init('LinkTitle', 'Xelhua', '1.01', '3.0.0a10');
+# build: cpan=LWP::UserAgent,HTML::Entities perl=5.010000
+
+__END__
+
+=head1 NAME
+
+LinkTitle - A module for returning the page title of links.
+
+=head1 VERSION
+
+ 1.01
+
+=head1 SYNOPSIS
+
+ <starcoder> http://xelhua.org/auto.php 
+ <blue> Title: Xelhua / Projects / Auto
+
+=head1 DESCRIPTION
+
+This module will make Auto parse all links sent to a channel. When a link is
+detected, Auto will connect to it and get the page title by scanning for the
+<title> tag and returning its contents to the channel.
+
+=head1 DEPENDENCIES
+
+This module is dependent on two modules from the CPAN.
+
+=over
+
+=item L<LWP::UserAgent|LWP::UserAgent>
+
+This module is used for connecting to the target web server via HTTP(S).
+
+=item L<HTML::Entities|HTML::Entities>
+
+This module is used for decoding HTML entities in the response we receive from
+the server.
+
+=back
+
+=head1 AUTHOR
+
+This module was written by Elijah Perrault.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group. All rights
+reserved.
+
+This module is released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et sw=4 ts=4:

modules/Oper.pm

@@ -0,0 +1,119 @@
+# Module: Oper.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+package M::Oper;
+use strict;
+use warnings;
+use API::Std qw(hook_add hook_del rchook_add rchook_del conf_get);
+use API::Log qw(alog);
+
+# Initialization subroutine.
+sub _init
+{
+    # Add a hook for when we join a channel.
+    hook_add('on_connect', 'Oper.onconnect', \&M::Oper::on_connect) or return;
+    # Add a hook for when we get numeric 491 (ERR_NOOPERHOST)
+    rchook_add('491', 'Oper.on381', \&M::Oper::on_num491) or return;
+    return 1;
+}
+
+# Void subroutine.
+sub _void
+{
+    # Delete the hooks.
+    hook_del('on_connect', 'Oper.onconnect') or return;
+    rchook_del('381', 'Oper.on381') or return;
+    rchook_del('313', 'Oper.on313') or return;
+    rchook_del('491', 'Oper.on491') or return;
+    return 1;
+}
+
+# On connect subroutine.
+sub on_connect
+{
+    my ($svr) = @_;
+    # Get the configuration values.
+    my $u = (conf_get("server:$svr:oper_username"))[0][0] if conf_get("server:$svr:oper_username");
+    my $p = (conf_get("server:$svr:oper_password"))[0][0] if conf_get("server:$svr:oper_password");
+    # They don't exist - don't continue.
+    return if !$u or !$p;
+    # Send the OPER command.
+    oper($svr, $u, $p);
+    return 1;
+}
+
+# On 491 subroutine
+sub on_num491 {
+    my ($svr, @ex) = @_;
+    my $reason = join ' ', @ex[3 .. $#ex];
+    $reason =~ s/://xsm;
+    alog("FAILED OPER on ".$svr.": ".$reason);
+    return 1;
+}
+
+# A subroutine to check if we are opered on a server
+sub is_opered {
+    my ($svr) = @_;
+    # Auto is not opered.
+    return if $State::IRC::botinfo{$svr}{modes} !~ m/o/xsm;
+    # Auto is opered.
+    return 1 if $State::IRC::botinfo{$svr}{modes} =~ m/o/xsm;
+    return;
+}
+
+# Start of the API
+
+# Sends the OPER command to the specified server.
+sub oper {
+    my ($svr, $user, $pass) = @_;
+    Auto::socksnd($svr, "OPER $user $pass");
+    return 1;
+}
+
+# Start initialization.
+API::Std::mod_init('Oper', 'Xelhua', '1.01', '3.0.0a10');
+# build: perl=5.010000
+
+__END__
+
+=head1 NAME
+
+Oper - Auto oper-on-connect module.
+
+=head1 VERSION
+
+ 1.01
+
+=head1 SYNOPSIS
+
+ No commands are currently associated with Oper.
+
+=head1 DESCRIPTION
+
+This module adds the ability for Auto to oper on networks he is
+configured to do so on.
+
+=head1 INSTALL
+
+Before using Oper,  add the following to the server block in your
+configuration file, only for servers you wish for Auto to oper on
+though:
+
+ oper_username <username>;
+ oper_password <password>;
+
+=head1 AUTHOR
+
+This module was written by Matthew Barksdale.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group.
+
+Released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et sw=4 ts=4:

modules/QDB.pm

@@ -1,20 +1,24 @@
 # Module: QDB. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_QDB;
+package M::QDB;
 use strict;
 use warnings;
 use feature qw(switch);
-use API::Std qw(cmd_add cmd_del trans has_priv match_user);
+use API::Std qw(cmd_add cmd_del trans has_priv conf_get match_user);
 use API::IRC qw(privmsg notice);
+our @BUFFER;
 
 sub _init
 {
     # Create the QDB command.
-    cmd_add('QDB', 0, 0, \%m_QDB::HELP_QDB, \&m_QDB::cmd_qdb) or return;
+    cmd_add('QDB', 0, 0, \%M::QDB::HELP_QDB, \&M::QDB::cmd_qdb) or return;
+    
+    # Check the database format. Fail to load if it's PostgreSQL.
+    if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load QDB: PostgreSQL is not supported.', 0); return }
 
     # Check for database table.
-    $Auto::DB->do('CREATE TABLE IF NOT EXISTS qdb (key INTEGER PRIMARY KEY, creator TEXT, time INTEGER, quote TEXT)') or return;
+    $Auto::DB->do('CREATE TABLE IF NOT EXISTS qdb (quoteid INTEGER PRIMARY KEY, creator TEXT, time INTEGER, quote TEXT)') or return;
 
     # Success.
     return 1;
@@ -31,142 +35,229 @@ sub _void
 
 # Help hash for QDB. Spanish, French and German translations needed.
 our %HELP_QDB = (
-    'en' => "This command allows you to add, read, and delete quotes. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]",
+    'en' => "This command allows you to add, read, and delete quotes. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL) [quote|expression]",
 );
 sub cmd_qdb
 {
-    my (%data) = @_;
-    my @argv = @{ $data{args} };
+    my ($src, @argv) = @_;
 
     # Check for needed parameter.
     if (!defined $argv[0]) {
-        notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
         return;
     }
     
-    # ADD|VIEW|COUNT|RAND|DEL.
+    # ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL.
     given (uc $argv[0]) {
         when ('ADD') {
             # QDB ADD.
             if (!defined $argv[1]) {
-                notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
+                notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
                 return;
             }
 
-            # Get rid of the ADD part.
-            shift @argv;
-
             # Insert into database.
             my $dbq = $Auto::DB->prepare('INSERT INTO qdb (creator, time, quote) VALUES (?, ?, ?)') or 
-                notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
-            $dbq->execute($data{nick}, time, join(q{ }, @argv)) or
-                notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
+                notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
+            $dbq->execute($src->{nick}, time, join(q{ }, @argv[1..$#argv])) or
+                notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
 
             # Get ID.
             my $count = $Auto::DB->selectrow_array('SELECT COUNT(*) FROM qdb') or
-                notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
+                notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
 
-            privmsg($data{svr}, $data{chan}, 'Quote successfully submitted. ID: '.$count);
+            privmsg($src->{svr}, $src->{chan}, 'Quote successfully submitted. ID: '.$count);
         }
         when ('VIEW') {
             # QDB VIEW.
             if (!defined $argv[1]) {
-                notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
+                notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
                 return;
             }
 
             # Get quote.
-            my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE key = ?') or
-                notice($data{svr}, $data{nick}, trans('An error occurred').'. Quote might not exist.') and return;
-            $dbq->execute($argv[1]) or notice($data{svr}, $data{nick}, trans('An error occurred').'. Quote might not exist.') and return;
+            my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE quoteid = ?') or
+                notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.') and return;
+            $dbq->execute($argv[1]) or notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.') and return;
             my @data = $dbq->fetchrow_array;
 
+            # Check for an unusual issue.
+            if (!defined $data[1]) { notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.'); return }
+
             # Send it back.
-            privmsg($data{svr}, $data{chan}, "\002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
-            privmsg($data{svr}, $data{chan}, $data[3]);
+            privmsg($src->{svr}, $src->{chan}, "\002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
+            privmsg($src->{svr}, $src->{chan}, '> '.$data[3]);
         }
         when ('COUNT') {
             # Get count.
             my $count = $Auto::DB->selectrow_array('SELECT COUNT(*) FROM qdb') or
-                notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
+                notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
 
             # Send it back.
-            privmsg($data{svr}, $data{chan}, "There is currently \002$count\002 quotes in my database.");
+            privmsg($src->{svr}, $src->{chan}, "There is currently \002$count\002 quotes in my database.");
         }
         when ('RAND') {
             # Get count.
             my $count = $Auto::DB->selectrow_array('SELECT COUNT(*) FROM qdb') or
-                notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
+                notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
 
             # Random number.
             my $rand = int(rand($count));
-            if ($rand == 0) { $rand = $count; }
+            if ($rand == 0) { $rand = $count }
 
             # Get quote.
-            my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE key = ?') or
-                notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
-            $dbq->execute($rand) or notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
+            my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE quoteid = ?') or
+                notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
+            $dbq->execute($rand) or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
             my @data = $dbq->fetchrow_array;
 
             # Send it back.
-            privmsg($data{svr}, $data{chan}, "\002ID:\002 $data[0] - \002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
-            privmsg($data{svr}, $data{chan}, $data[3]);
+            privmsg($src->{svr}, $src->{chan}, "\002ID:\002 $data[0] - \002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
+            privmsg($src->{svr}, $src->{chan}, '> '.$data[3]);
+        }
+        when ('SEARCH') {
+            # QDB SEARCH.
+
+            # Get all quotes.
+            my $dbq = $Auto::DB->prepare('SELECT * FROM qdb') or return;
+            $dbq->execute or return;
+            my $quotes = $dbq->fetchall_hashref('quoteid') or return;
+
+            # Set expression.
+            my $expr = my $rexpr = join ' ', @argv[1 .. $#argv];
+            $rexpr =~ s{\(}{\\\(}g;
+            $rexpr =~ s{\)}{\\\)}g;
+            $rexpr =~ s{\?}{\\\?}g;
+            $rexpr =~ s{\*}{\\\*}g;
+            $rexpr =~ s{\[}{\\\[}g;
+            $rexpr =~ s{\]}{\\\]}g;
+            $rexpr =~ s{\.}{\\\.}g;
+            $rexpr =~ s{\$}{\\\$}g;
+            $rexpr =~ s{\^}{\\\^}g;
+
+            # Clear the buffer.
+            @BUFFER = ();
+
+            # Iterate through all quotes.
+            foreach my $qkt (keys %$quotes) {
+                # Check if we have a match.
+                if ($quotes->{$qkt}->{quote} =~ m/$rexpr/ixsm) {
+                    # Match. Add to buffer.
+                    push @BUFFER, "\2ID:\2 $qkt - ".$quotes->{$qkt}->{quote};
+                }
+            }
+
+            # Check if we had any matches.
+            if (!defined $BUFFER[0]) {
+                privmsg($src->{svr}, $src->{chan}, "No results for \2$expr\2.");
+                return;
+            }
+
+            # Return four quotes.
+            privmsg($src->{svr}, $src->{chan}, "\2".scalar @BUFFER."\2 results for \2$expr\2:");
+            my $i = 0;
+            my $si = 3;
+            if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1 }
+            while ($i <= $si) {
+                if (!defined $BUFFER[0]) {
+                    last;
+                }
+
+                privmsg($src->{svr}, $src->{chan}, shift @BUFFER);
+                $i++;
+            }
+        }
+        when ('MORE') {
+            # Check if there's any quotes in the buffer.
+            if (!defined $BUFFER[0]) { 
+                notice($src->{svr}, $src->{nick}, 'No quotes in buffer.');
+                return; 
+            }
+
+            # Return four quotes.
+            my $i = 0;
+            my $si = 3;
+            if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1 }
+            while ($i <= $si) {
+                if (!defined $BUFFER[0]) {
+                    last;
+                }
+
+                privmsg($src->{svr}, $src->{chan}, shift @BUFFER);
+                $i++;
+            }
         }
         when ('DEL') {
             # Check for the cmd.qdbdel privilege.
-            if (!has_priv(match_user(%data), 'cmd.qdbdel')) {
-                notice($data{svr}, $data{chan}, trans('Permission denied').q{.});
+            if (!has_priv(match_user(%$src), 'cmd.qdbdel')) {
+                notice($src->{svr}, $src->{chan}, trans('Permission denied').q{.});
                 return;
             }
             # Check for the needed parameter.
             if (!defined $argv[1]) {
-                notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
+                notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
                 return;
             }
             
             # Update database.
-            my $dbq = $Auto::DB->do("UPDATE qdb SET quote = \"NOTICE: Quote deleted.\" WHERE key = $argv[1]");
+            my $dbq = $Auto::DB->do("UPDATE qdb SET quote = \"NOTICE: Quote deleted.\" WHERE quoteid = $argv[1]");
 
-            notice($data{svr}, $data{nick}, (($dbq) ? 'Done.' : trans('An error occurred').q{.}));
+            notice($src->{svr}, $src->{nick}, (($dbq) ? 'Done.' : trans('An error occurred').q{.}));
         }
-        default { notice($data{svr}, $data{nick}, "Unknown action \002".uc($argv[0])."\002. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]"); return; }
+        default { notice($src->{svr}, $src->{nick}, "Unknown action \002".uc($argv[0])."\002. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]"); return }
     }
 
     return 1;
 }
 
 
-API::Std::mod_init('QDB', 'Xelhua', '1.00', '3.0.0d', __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('QDB', 'Xelhua', '1.04', '3.0.0a10');
 # build: perl=5.010000
 
 __END__
 
-=head1 QDB
+=head1 NAME
 
-=head2 Description
+QDB - Quote database module.
 
-=over
+=head1 VERSION
 
-This module adds the QDB (ADD|VIEW|COUNT|RAND|DEL) command, for adding,
-viewing, listing number of, viewing a random, deleting a quote from the Auto
-database.
+ 1.04
 
-=back
+=head1 SYNOPSIS
 
-=head2 Examples
+ <JohnSmith> !qdb add <JohnDoe> moocows
+ <Auto> Quote successfully submitted. ID: 732
 
-=over
+=head1 DESCRIPTION
 
-<JohnSmith> !qdb add <JohnDoe> moocows
-<Auto> Quote successfully submitted. ID: 732
+This module adds the QDB (ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL) command, for
+adding, viewing, listing number of, viewing a random, deleting a quote from the
+Auto database.
 
-=back
+=head1 INSTALL
 
-=head2 Technical
+Before using QDB, we'd recommend adding the following to your configuration
+file:
 
-=over
+ qdb_search_resnum <number>;
 
-This module is compatible with Auto v3.0.0a3+.
+Where <number> is the amount of results returned per SEARCH/MORE load.
 
-=back
+This is not required, 4 will be used if it is not specified.
+
+=head1 AUTHOR
+
+This module was written by Elijah Perrault.
+
+This module is maintained by Xelhua Development Group.
+
+=head1 LICENSE AND COPYRIGHT
+
+This module is Copyright 2010-2011 Xelhua Development Group.
+
+Released under the same licensing terms as Auto itself.
+
+=cut
+
+# vim: set ai et sw=4 ts=4:

modules/SASLAuth.pm

@@ -1,7 +1,7 @@
 # Module: SASLAuth. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_SASLAuth;
+package M::SASLAuth;
 use strict;
 use warnings;
 use feature qw(switch);
@@ -13,62 +13,43 @@ use API::IRC qw(privmsg);
 # Initialization subroutine.
 sub _init
 {
-	# Check if this Auto was built with SASL support.
-	err(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/;
-	# Add a hook for before we connect.
-    hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); }
-    ) or return 0;
-    # Hook for parsing CAP.
-    rchook_add('CAP', \&m_SASLAuth::handle_cap) or return 0;
+    # Check if this Auto was built with SASL support.
+    if ($Auto::ENFEAT !~ m/sasl/xsm) { err(2, 'Auto was not built with SASL support. Aborting SASLAuth.', 0) and return }
+    # Add sasl to supported CAP for servers configured with SASL.
+    my %servers = conf_get('server');
+    foreach my $svr (keys %servers) {
+        if (conf_get("server:$svr:sasl_username") and conf_get("server:$svr:sasl_password") and conf_get("server:$svr:sasl_timeout")) { $Proto::IRC::cap{$svr} .= ' sasl' }
+    }
+    # Hook for when CAP ACK sasl is received.
+    hook_add('on_capack', 'sasl.cap', \&M::SASLAuth::handle_capack) or return;
     # Hook for parsing 903.
-    rchook_add('903', \&m_SASLAuth::handle_903) or return 0;
+    rchook_add('903', 'sasl.903', \&M::SASLAuth::handle_903) or return;
     # Hook for parsing 904.
-    rchook_add('904', \&m_SASLAuth::handle_904) or return 0;
+    rchook_add('904', 'sasl.904', \&M::SASLAuth::handle_904) or return;
     # Hook for parsing 906.
-    rchook_add('906', \&m_SASLAuth::handle_906) or return 0;
-	return 1;
+    rchook_add('906', 'sasl.906', \&M::SASLAuth::handle_906) or return;
+    return 1;
 }
 
 # Void subroutine.
 sub _void
 {
-	# Delete the hooks.
-	hook_del("on_preconnect", "CAP") or return 0;
-    rchook_del('CAP');
-    rchook_del('903');
-    rchook_del('904');
-    rchook_del('906');
-	return 1;
+    # Delete the hooks.
+    hook_del('on_capack') or return;
+    rchook_del('903', 'sasl.903') or return;
+    rchook_del('904', 'sasl.904') or return;
+    rchook_del('906', 'sasl.906') or return;
+    return 1;
 }
 
-sub handle_cap {
-    my ($srv, @parv) = @_;
-    my $line = join(' ',@parv);
-    my ($tosend);
-    
-    given ($line) {
-        when (/ LS /) {
-            $tosend .= 'multi-prefix ' if $line =~ /multi-prefix/i;
-            $tosend .= 'sasl ' if $line =~ /sasl/ and conf_get("server:$srv:sasl_username");
-            awarn(2, "SASL is unavailable on this server.") if $tosend !~ /sasl/;
-            if ($tosend eq '') { Auto::socksnd($srv, 'CAP END') }
-            else { Auto::socksnd($srv, "CAP REQ :$tosend"); }
-        }
-        when (/ ACK /) {
-            if ( $line =~ /sasl/) {
-                Auto::socksnd($srv, 'AUTHENTICATE PLAIN');
-                timer_add('auth_timeout', 1, (conf_get("server:$srv:sasl_timeout"))[0][0], sub { Auto::socksnd($srv, 'CAP END'); });
-            }
-            else {
-                Auto::socksnd($srv, 'CAP END');
-                awarn(2, "SASL authentication failed at ACK");
-            }
-        }
-        when (/ NAK /) {
-            Auto::socksnd($srv, 'CAP END');
-            awarn(2, "SASL authentication failed. Server refused ".$tosend);
-        }
+sub handle_capack {
+    my (($svr, $sacap)) = @_;
+ 
+    if ($sacap eq 'sasl') {
+        Auto::socksnd($svr, 'AUTHENTICATE PLAIN');
+        timer_add('auth_timeout_'.$svr, 1, (conf_get("server:$svr:sasl_timeout"))[0][0], sub { Auto::socksnd($svr, 'CAP END') });
     }
+    
     return 1;
 }
 
@@ -105,8 +86,8 @@ sub handle_authenticate
 sub handle_903 
 { 
     my ($srv, undef) = @_; 
-    Auto::socksnd($srv, 'CAP END');
-    timer_del('auth_timeout');
+    timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
+    timer_del('auth_timeout_'.$srv);
 }
 
 # Parse: Numeric:904
@@ -114,8 +95,8 @@ sub handle_903
 sub handle_904 
 { 
     my ($srv, undef) = @_; 
-    Auto::socksnd($srv, 'CAP END');
-    timer_del('auth_timeout');
+    timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
+    timer_del('auth_timeout_'.$srv);
     awarn(2, "SASL authentication failed!");
 }
 
@@ -123,20 +104,19 @@ sub handle_904
 # SASL authentication aborted.
 sub handle_906 
 {
-	my ($svr, undef) = @_;
-	Auto::socksnd($svr, 'CAP END');
-    timer_del('auth_timeout');
+    my ($svr, undef) = @_;
+    timer_add('cap_end_'.$svr, 1, 2, sub { Auto::socksnd($svr, 'CAP END') });
+    timer_del('auth_timeout_'.$svr);
     awarn(2, "SASL authentication aborted!");
 }
 
 # Start initialization.
-API::Std::mod_init("SASLAuth", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a10');
 # build: perl=5.010000
 
 __END__
 
-=head1 SASL Auth
+=head1 SASLAuth
 
 =head2 Description
 
@@ -188,6 +168,8 @@ block(s) you wish to use SASL with:
 This adds an extra dependency: You must build Auto with the 
 --enable-sasl option.
 
-This module is compatible with Auto v3.0.0a1+.
+This module is compatible with Auto v3.0.0a10+.
 
 =back
+
+# vim: set ai et sw=4 ts=4:

modules/Weather.pm

@@ -1,7 +1,7 @@
 # Module: Weather. See below for documentation.
 # Copyright (C) 2010-2011 Xelhua Development Group, et al.
 # This program is free software; rights to this code are stated in doc/LICENSE.
-package m_Weather;
+package M::Weather;
 use strict;
 use warnings;
 use API::Std qw(cmd_add cmd_del trans);
@@ -12,75 +12,73 @@ use XML::Simple;
 # Initialization subroutine.
 sub _init 
 {
-	# Create the Weather command.
-	cmd_add("WEATHER", 0, 0, \%m_Weather::HELP_WEATHER, \&m_Weather::weather) or return 0;
+    # Create the Weather command.
+    cmd_add('WEATHER', 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return;
 
-	# Success.
-	return 1;
+    # Success.
+    return 1;
 }
 
 # Void subroutine.
 sub _void 
 {
-	# Delete the Weather command.
-	cmd_del("WEATHER") or return 0;
+    # Delete the Weather command.
+    cmd_del('WEATHER') or return;
 
-	# Success.
-	return 1;
+    # Success.
+    return 1;
 }
 
 # Help hashes.
 our %HELP_WEATHER = (
-	'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>",
+    'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>",
 );
 
 # Callback for Weather command.
 sub weather
 {
-	my (%data) = @_;
+    my ($src, @args) = @_;
 
-	# Create an instance of LWP::UserAgent.
-	my $ua = LWP::UserAgent->new();
-	$ua->agent('Auto IRC Bot');
-	$ua->timeout(2);
-	# Put together the call to the Wunderground API. 
-	my @args = @{ $data{args} };
-	if (!defined $args[0]) {
-		notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
-		return 0;
-	}
-	my $loc = join(' ', @args);
-	$loc =~ s/ /%20/g;
-	my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc;
-	# Get the response via HTTP.
-	my $response = $ua->get($url);
+    # Create an instance of LWP::UserAgent.
+    my $ua = LWP::UserAgent->new();
+    $ua->agent('Auto IRC Bot');
+    $ua->timeout(2);
+    # Put together the call to the Wunderground API. 
+    if (!defined $args[0]) {
+        notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
+        return;
+    }
+    my $loc = join(' ', @args);
+    $loc =~ s/ /%20/g;
+    my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc;
+    # Get the response via HTTP.
+    my $response = $ua->get($url);
 
-	if ($response->is_success) {
-	# If successful, decode the content.
-		my $d = XMLin($response->decoded_content);
-	# And send to channel
-		if (!ref($d->{observation_location}->{country})) {
-			my $windc = $d->{wind_string};
-			if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); }
-			privmsg($data{svr}, $data{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
-			privmsg($data{svr}, $data{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
-		}
-		else {
-		# Otherwise, send an error message.
-			privmsg($data{svr}, $data{chan}, "Location not found.");
-		}
-	}
-	else {
-	# Otherwise, send an error message.
-		privmsg($data{svr}, $data{chan}, "An error occurred while retrieving your weather.");
-	}
+    if ($response->is_success) {
+    # If successful, decode the content.
+        my $d = XMLin($response->decoded_content);
+    # And send to channel
+        if (!ref($d->{observation_location}->{country})) {
+            my $windc = $d->{wind_string};
+            if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1) }
+            privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
+            privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
+        }
+        else {
+        # Otherwise, send an error message.
+            privmsg($src->{svr}, $src->{chan}, 'Location not found.');
+        }
+    }
+    else {
+    # Otherwise, send an error message.
+        privmsg($src->{svr}, $src->{chan}, 'An error occurred while retrieving your weather.');
+    }
 
-	return 1;
+    return 1;
 }
 
 # Start initialization.
-API::Std::mod_init("Weather", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
-# vim: set ai sw=4 ts=4:
+API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a10');
 # build: cpan=LWP::UserAgent,XML::Simple perl=5.010000
 
 __END__
@@ -122,6 +120,8 @@ From the NE at 9 MPH Gusting to 22 MPH Conditions: Overcast
 This module requires LWP::UserAgent and XML::Simple. Both are 
 obtainable from CPAN <http://www.cpan.org>.
 
-This module is compatible with Auto version 3.0.0a2+.
+This module is compatible with Auto version 3.0.0a10+.
 
 =back
+
+# vim: set ai et sw=4 ts=4:

scripts/licenses.pl

@@ -0,0 +1,70 @@
+# OSI-approved software licenses as of February 26, 2011.
+my %licenses = (
+    auto   => 'Same license as Auto itself',
+    afl    => 'Academic Free License',
+    agpl   => 'Affero GNU Public License',
+    apl    => 'Adaptive Public License',
+    apache => 'Apache License',
+    apsl   => 'Apple Public Source License',
+    art    => 'Artistic License',
+    aal    => 'Attribution Assurance License',
+    nbsd   => 'New BSD License',
+    sbsd   => 'Simplified BSD License',
+    bsl    => 'Boost Software License',
+    catosl => 'Computer Associates Trusted Open Source License',
+    cddl   => 'Common Development and Distribution License',
+    cpal   => 'Common Public Attribution License',
+    cua    => 'CUA Office Public License',
+    eudgsl => 'EU DataGrid Software License',
+    epl    => 'Eclipse Public License',
+    ecl    => 'Educational Community License',
+    efl    => 'Eiffel Forum License',
+    enpl   => 'Entessa Public License',
+    eupl   => 'European Union Public License',
+    fair   => 'Fair License',
+    fwl    => 'Frameworx License',
+    gpl2   => 'GNU General Public License v2',
+    gpl3   => 'GNU General Public License v3',
+    lgpl   => 'GNU Lesser General Public License',
+    ibm    => 'IBM Public License',
+    ipa    => 'IPA Font License',
+    isc    => 'ISC License',
+    lppl   => 'LaTeX Project Public License',
+    lpl    => 'Lucent Public License',
+    miros  => 'MirOS Licence',
+    mspl   => 'Microsoft Public License',
+    msrl   => 'Microsoft Reciprocal License',
+    mit    => 'MIT License',
+    msl    => 'Motosoto License',
+    mpl    => 'Mozilla Public License',
+    mtl    => 'Multics License',
+    nasa   => 'NASA Open Source Agreement',
+    ntpl   => 'NTP License',
+    naumen => 'Naumen Public License',
+    nhgpl  => 'Nethack General Public License',
+    nosl   => 'Nokia Open Source License',
+    nposl  => 'Non-Profit Open Software License',
+    oclc   => 'OCLC Research Public License',
+    ofl    => 'Open Font License',
+    ogtsl  => 'Open Group Test Suite License',
+    osl    => 'Open Software License',
+    php    => 'PHP License',
+    pgsql  => 'The PostgreSQL License',
+    python => 'Python License',
+    pysfl  => 'Python Software Foundation License',
+    qpl    => 'Qt Public License',
+    real   => 'RealNetworks Public Source License',
+    rpl    => 'Reciprocal Public License',
+    rscpl  => 'Ricoh Source Code Public License',
+    simple => 'Simple Public License',
+    scl    => 'Sleepycat License',
+    spl    => 'Sun Public License',
+    sowpl  => 'Sybase Open Watcom Public License',
+    ncsa   => 'University of Illinois/NCSA Open Source License',
+    vsl    => 'Vovida Software License',
+    w3c    => 'W3C License',
+    wxwll  => 'wxWindows Library License',
+    xnet   => 'X.Net License',
+    zpl    => 'Zope Public License',
+    zlib   => 'zlib/libpng license'
+);

scripts/upgrade.pl

@@ -0,0 +1,66 @@
+# upgrade.pl - Upgrade SQLite database from 3.0.0a3 to 3.0.0a4.
+# Copyright (C) 2010-2011 Xelhua Development Group, et al.
+# This program is free software; rights to this code are stated in doc/LICENSE.
+use 5.010_000;
+use strict;
+use warnings;
+use DBI;
+use DBD::SQLite;
+use Carp;
+use Cwd;
+our $Bin = getcwd();
+
+#################
+# Configuration #
+#################
+
+# Old database filename. (relative to etc/)
+my $olddbfile = 'auto.db';
+# New database filename. (relative to etc/)
+my $newdbfile = 'somebot.db';
+
+##########################
+# Program - Don't touch. #
+##########################
+
+# Print startup message.
+say 'Converting database from Auto-3.0.0a3 format to Auto-3.0.0a4 format...';
+
+# Connect to database.
+my $DB = DBI->connect("dbi:SQLite:dbname=$Bin/etc/$olddbfile") or croak 'Failed to open old DB!';
+
+# Query the database for the data from the `qdb` table.
+my $dbq = $DB->prepare('SELECT * FROM qdb') or croak 'Failed to query for `qdb` data!';
+$dbq->execute() or croak 'Failed to query for `qdb` data!';
+my $data = $dbq->fetchall_hashref('key');
+my %data = %$data;
+
+# Disconnect from database.
+$DB->disconnect;
+
+
+# Now, connect to the new database so we can enter the data in the new format.
+if (!-e "$Bin/etc/$newdbfile") {
+    system "touch $Bin/etc/$newdbfile";
+    chmod 0755, "$Bin/etc/$newdbfile";
+}
+
+$DB = DBI->connect("dbi:SQLite:dbname=$Bin/etc/$newdbfile") or croak 'Failed to open new DB!';
+
+# Create the `qdb` table.
+$DB->do('CREATE TABLE IF NOT EXISTS qdb (quoteid INTEGER PRIMARY KEY, creator TEXT, time INT, quote TEXT)') or croak 'Failed to create `qdb` table!';
+
+# Iterate through the data.
+foreach my $qid (sort keys %data) {
+    # Prepare query to insert data.
+    my $ndbq = $DB->prepare('INSERT INTO qdb (quoteid, creator, time, quote) VALUES (?, ?, ?, ?)') or croak 'Failed to query `qdb` table!';
+
+    # Insert data.
+    $ndbq->execute($qid, $data{$qid}{creator}, $data{$qid}{'time'}, $data{$qid}{quote}) or croak 'Failed to query `qdb` table!';
+}
+
+# Disconnect from database.
+$DB->disconnect;
+
+# Success.
+say 'Done.';