#!/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 Mouse; use IO::Socket; use Async; use FindBin qw($Bin); our $Bin = $Bin; BEGIN { unshift(@INC, "$Bin/../src"); } use API::Std qw(conf_get err); use API::Log qw(println alog dbug); #use DB::Flatfile; use Parser::Config; use Parser::Lang; #use Parser::IRC; #use Sys; # Set version information. use constant { NAME => 'Auto IRC Bot', VER => 3, SVER => 0, REV => 0, RSTAGE => 'd' }; # Print startup message. println "* ".NAME." (version ".VER.".".SVER.".".REV.RSTAGE.") is starting up..."; # 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"; # Check for required configuration values. my @REQCVALS = qw(locale expire_logs servers); 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"; our $STARTTIME = time; println "* Auto successfully started at ".POSIX::strftime("%Y-%m-%d %I:%M:%S %p", localtime)."."; alog "Auto successfully started."; # Expire old logs. API::Log::expire_logs(); ## Create sockets. println "* Connecting to servers..."; # Get servers from config. my %cservers = conf_get("server"); # Set the hashes and processes hashes. my (%SOCKET, %SOCKPROC); 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 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; socksnd($cskey, "NICK ".$cservers{$cskey}{'nick'}[0]) or err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0) and next; # Create the process. $SOCKPROC{$cskey} = Async->new(sub { # Infinite loop. while (1) { # Read data from socket. my $data = readline($SOCKET{$cskey}); # Lost connection: kill process. unless (defined $data) { die; } # Get rid of the newlines. chomp $data; # Debug. dbug "$cskey -> You: $data"; } }) or err(2, "Failed to create process for ".$cskey, 0) and next; # Success! println " Successfully connected to server: ".$cskey; $it = 1; } # Success! if ($it) { println " Success: Connected to server(s)."; } else { err(2, "No server connections.", 1); } undef $it; # Keep Auto alive. while (1) { sleep 1; } ############### # Subroutines # ############### # Send data to socket. sub socksnd { my ($svr, $data) = @_; if (defined $SOCKET{$svr}) { send($SOCKET{$svr}, $data."\n", 0); dbug "You -> $svr: $data"; return 1; } else { return 0; } }