137 lines
3.3 KiB
Perl
Executable File
137 lines
3.3 KiB
Perl
Executable File
#!/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 "Great 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 "Great 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);
|
|
# 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]);
|
|
socksnd($cskey, "NICK ".$cservers{$cskey}{'nick'}[0]);
|
|
# 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";
|
|
}
|
|
});
|
|
}
|
|
|
|
# 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;
|
|
}
|
|
}
|