#!/usr/bin/env perl

# Auto IRC Bot. An advanced, lightweight and powerful IRC bot.
# Copyright (C) 2010-2011 Xelhua Development Team (doc/CREDITS)
# This program is free software; rights to this code are stated in doc/LICENSE.
package Auto;
require 5.10.0;
use strict;
use warnings;
use POSIX;
use locale;
use feature qw(switch);
use Mouse;
use IO::Socket;
use IO::Select;
use Class::Unload;
use FindBin qw($Bin);
our $Bin = $Bin;
BEGIN { 
    unshift(@INC, "$Bin/../src"); 

    # Set version information.
    use constant {
	    NAME   => 'Auto IRC Bot',
	    VER    => 3,
	    SVER   => 0,
	    REV    => 0,
	    RSTAGE => 'd'
    };
}
use API::Std qw(conf_get err cmd_add cmd_del);
use API::Log qw(println alog dbug);
use DB::Flatfile;
use Parser::Config;
use Parser::Lang;
use Parser::IRC;
use Core::IRC;


our $VERSION = 3.0.0;
$0 = NAME;

# Check for build files.
unless (-e "$Bin/../build/os" and -e "$Bin/../build/perl" and -e "$Bin/../build/time" and -e "$Bin/../build/ver") {
	println "Missing build file(s). Please build Auto before running it." and exit;
}

# Check build OS.
open(my $BFOS, q{<}, "$Bin/../build/os") or println "Cannot start: Broken build." and exit;
my @BFOS = <$BFOS>;
close $BFOS;
if ($BFOS[0] ne $^O."\n") {
	println "Cannot start: Broken build." and exit;
}
undef @BFOS;

# Check build features.
our $ENFEAT;
open(my $BFFEAT, q{<}, "$Bin/../build/feat") or println "Cannot start: Broken build." and exit;
my @BFFEAT = <$BFFEAT>;
close $BFFEAT;
$ENFEAT = substr($BFFEAT[0], 0, length($BFFEAT[0]) - 1);
undef @BFFEAT;

# Check build Perl version.
open(my $BFPERL, q{<}, "$Bin/../build/perl") or println "Cannot start: Broken build." and exit;
my @BFPERL = <$BFPERL>;
close $BFPERL;
if ($BFPERL[0] ne $]."\n") {
	println "Cannot start: Broken build." and exit;
}
undef @BFPERL;

# Check build Auto version.
open(my $BFVER, q{<}, "$Bin/../build/ver") or println "Cannot start: Broken build." and exit;
my @BFVER = <$BFVER>;
close $BFVER;
if ($BFVER[0] ne VER.".".SVER.".".REV.RSTAGE."\n") {
	println "Cannot start: Broken build." and exit;
}
undef @BFVER;

# Set signal handlers.
$SIG{TERM} = \&signal_TERM;
$SIG{INT}  = \&signal_INT;
$SIG{HUP}  = \&signal_HUP;
API::Std::event_add("on_sigterm");
API::Std::event_add("on_sigint");
API::Std::event_add("on_sighup");


# Print startup message.
println <<'EOF';
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
EOF
println "* ".NAME." (version ".VER.".".SVER.".".REV.RSTAGE.") is starting up...";

our ($APID, %TIMERS);

# Check for debug mode.
our $DEBUG = 0;
if (defined $ARGV[0]) {
	if ($ARGV[0] eq '-d') {
		$DEBUG = 1;
	}
}

# 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);
our %SETTINGS = $CONF->parse or err(1, "Failed to parse configuration file!", 1);
println " Success";

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;
	}
}

# Check for required configuration values.
my @REQCVALS = qw(locale expire_logs server fantasy_pf);
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);
	}
}
undef @REQCVALS;

# Parse translations.
println "* Parsing translation files...";
our $LOCALE = (conf_get("locale"))[0][0];
my @lang = split('_', $LOCALE);
Parser::Lang::parse($lang[0]) or err(2, "Failed to parse translation files!", 1);
undef @lang;
println " Success";

# Expire old logs.
API::Log::expire_logs();

# Load database.
DB::load();

# Parse privileges.
our (%PRIVILEGES);
# If there are any privsets.
if (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");
		
		# 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} } = ($_);
							}
						}
					}
				}
			}
		}
	}
}

# Successful startup.
our $STARTTIME = time;
println "* Auto successfully started at ".POSIX::strftime("%Y-%m-%d %I:%M:%S %p", localtime).".";
alog "Auto successfully started.";

# Fork into the background if not in debug mode.
unless ($DEBUG) {
    println "*** Becoming a daemon...";
    open(STDIN, q{<}, '/dev/null') or err(2, "Can't read /dev/null: $!", 1);
    open(STDOUT, q{>>}, '/dev/null') or err(2, "Can't write to /dev/null: $!", 1);
    open(STDERR, q{>>}, '/dev/null') or err(2, "Can't write to /dev/null: $!", 1);
    $APID = fork();
    unless ($APID == 0) {
        alog "* Successfully forked into the background. Process ID: ".$APID;
        unless (-e "$Bin/auto.pid") {
			system("touch $Bin/auto.pid");
		}
		open(my $FPID, q{>}, "$Bin/auto.pid") or exit;
		print $FPID "$APID\n" or exit;
		close $FPID or exit;
        exit;
    }
    POSIX::setsid() or err(2, "Can't start a new session: $!", 1);
}
else {
    $APID = $$;
}

# Events.
API::Std::event_add("on_preconnect");

# Load modules.
if (conf_get("module")) {
	alog "* Loading modules...";
	dbug "* Loading modules...";
	foreach (@{ (conf_get("module"))[0] }) {
		mod_load($_);
	}
}

## Create sockets.
alog "* Connecting to servers...";
dbug "* Connecting to servers...";
# Get servers from config.
my %cservers = conf_get("server");
# Set the hashes and processes hashes.
my (%SOCKET, %SOCKETH, $SELECT);
$SELECT = IO::Select->new();
my $it = 0;
# Iterate through each configured server.
foreach my $cskey (keys %cservers) {
	# Create the socket.
	$SOCKET{$cskey} = IO::Socket::INET->new(
		Proto => "tcp",
		LocalAddr => $cservers{$cskey}{'bind'}[0],
		PeerAddr  => $cservers{$cskey}{'host'}[0],
		PeerPort  => $cservers{$cskey}{'port'}[0]
	) or err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0) and next; # Or error.
	# 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].":".$cservers{$cskey}{'port'}[0]."]", 0) 
			and next;
	}
	API::Std::event_run("on_preconnect", $cskey);
	# Send USER and NICK.
	socksnd($cskey, "USER ".$cservers{$cskey}{'ident'}[0]." * * :".$cservers{$cskey}{'realname'}[0]) or
		err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0) 
		and next;
	API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
	# Add to select.
	$SELECT->add($SOCKET{$cskey});
	# Success!
	alog "** Successfully connected to server: ".$cskey;
	dbug "** Successfully connected to server: ".$cskey;
	$it = 1;
}

# Success!
if ($it) {
	alog "** Success: Connected to server(s).";
	dbug "** Success: Connected to server(s).";
}
else {
	err(2, "No server connections.", 1);
}
undef $it;

# Create core hooks.
API::Std::hook_add("on_uprivmsg", "ctcp_version_reply", \&Core::IRC::version_reply);

# 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) {
			$sockid = $_ if ($SOCKET{$_} eq $sock);
		}
		# Read the data.
		my $data = readline($sock);
		if (!defined $data) {
			# Got EOF, close socket
			err(2, "Lost connection to $sockid!", 0);
			$SELECT->remove($sock);
		}
		# Remove the newlines.
		chomp $data;
		# Debug.
		dbug $sockid." >> ".$data;
		
		# Parse data.
		Parser::IRC::ircparse($sockid, $data);
	}
}

###############
# Subroutines #
###############

# Send data to socket.
sub socksnd 
{
	my ($svr, $data) = @_;
	
	if (defined $SOCKET{$svr}) {
		send($SOCKET{$svr}, $data."\n", 0);
		dbug "$svr << $data";
		return 1;
	}
	else {
		return 0;
	}
}

# Load a module.
sub mod_load {
    my ($module) = @_;
    
    if (-e "$Bin/../modules/".$module.".pm") {
        do "$Bin/../modules/".$module.".pm" and return 1 or print $@ and return 0;
    }
    else {
        return 0;
    }
}


## Signal handlers

# SIGTERM
sub signal_TERM
{
	API::Std::event_run("on_sigterm");
	API::IRC::quit($_, "Caught SIGTERM") foreach (keys %SOCKET);
	DB::flush();
	dbug "!!! Caught SIGTERM; terminating...";
	alog "!!! Caught SIGTERM; terminating...";
	if (-e "$Bin/auto.pid") {
		system("rm $Bin/auto.pid");
	}
	sleep 1;
	exit;
}

# SIGINT
sub signal_INT
{
	API::Std::event_run("on_sigint");
	API::IRC::quit($_, "Caught SIGINT") foreach (keys %SOCKET);
	DB::flush();
	dbug "!!! Caught SIGINT; terminating...";
	alog "!!! Caught SIGINT; terminating...";
	if (-e "$Bin/auto.pid") {
		system("rm $Bin/auto.pid");
	}
	sleep 1;
	exit;
}

# SIGHUP
sub signal_HUP
{
	API::Std::event_run("on_sighup");
	dbug "!!! Caught SIGHUP but rehash is unavailable; ignoring";
	alog "!!! Caught SIGHUP but rehash is unavailable; ignoring";
	return 1;
}