* Removed dependency Async.
* Rewrote the socket engine. * Added cmd_add|del|run() to API::Std for commands. * Parse PRIVMSG.
This commit is contained in:
1 parent
17c00c5afd
commit
41d74bd20e
5 files changed
+114
-27
No files matched your search
@@ -11,7 +11,7 @@ use POSIX;
|
|||||||
use locale;
|
use locale;
|
||||||
use Mouse;
|
use Mouse;
|
||||||
use IO::Socket;
|
use IO::Socket;
|
||||||
use Async;
|
use IO::Select;
|
||||||
use Class::Unload;
|
use Class::Unload;
|
||||||
use FindBin qw($Bin);
|
use FindBin qw($Bin);
|
||||||
our $Bin = $Bin;
|
our $Bin = $Bin;
|
||||||
@@ -104,7 +104,7 @@ our %SETTINGS = $CONF->parse or err(1, "Failed to parse configuration file!", 1)
|
|||||||
println " Success";
|
println " Success";
|
||||||
|
|
||||||
# Check for required configuration values.
|
# Check for required configuration values.
|
||||||
my @REQCVALS = qw(locale expire_logs server);
|
my @REQCVALS = qw(locale expire_logs server fantasy_pf);
|
||||||
foreach my $REQCVAL (@REQCVALS) {
|
foreach my $REQCVAL (@REQCVALS) {
|
||||||
if (!conf_get($REQCVAL)) {
|
if (!conf_get($REQCVAL)) {
|
||||||
my $err = 2;
|
my $err = 2;
|
||||||
@@ -164,7 +164,8 @@ dbug "* Connecting to servers...";
|
|||||||
# Get servers from config.
|
# Get servers from config.
|
||||||
my %cservers = conf_get("server");
|
my %cservers = conf_get("server");
|
||||||
# Set the hashes and processes hashes.
|
# Set the hashes and processes hashes.
|
||||||
my (%SOCKET, %SOCKPROC);
|
my (%SOCKET, %SOCKETH, $SELECT);
|
||||||
|
$SELECT = IO::Select->new();
|
||||||
my $it = 0;
|
my $it = 0;
|
||||||
# Iterate through each configured server.
|
# Iterate through each configured server.
|
||||||
foreach my $cskey (keys %cservers) {
|
foreach my $cskey (keys %cservers) {
|
||||||
@@ -186,25 +187,8 @@ foreach my $cskey (keys %cservers) {
|
|||||||
err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0)
|
err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0)
|
||||||
and next;
|
and next;
|
||||||
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
|
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
|
||||||
# Create the process.
|
# Add to select.
|
||||||
$SOCKPROC{$cskey} = Async->new(sub {
|
$SELECT->add($SOCKET{$cskey});
|
||||||
# Infinite loop.
|
|
||||||
while (1) {
|
|
||||||
# Read data from socket.
|
|
||||||
my $data = readline($SOCKET{$cskey});
|
|
||||||
# Lost connection: kill process.
|
|
||||||
unless (defined $data) {
|
|
||||||
exit;
|
|
||||||
}
|
|
||||||
# Get rid of the newlines.
|
|
||||||
chomp $data;
|
|
||||||
# Debug.
|
|
||||||
dbug "$cskey -> You: $data";
|
|
||||||
|
|
||||||
# Parse data.
|
|
||||||
Parser::IRC::ircparse($cskey, $data);
|
|
||||||
}
|
|
||||||
}) or err(2, "Failed to create process for ".$cskey, 0) and next;
|
|
||||||
# Success!
|
# Success!
|
||||||
alog "** Successfully connected to server: ".$cskey;
|
alog "** Successfully connected to server: ".$cskey;
|
||||||
dbug "** Successfully connected to server: ".$cskey;
|
dbug "** Successfully connected to server: ".$cskey;
|
||||||
@@ -221,8 +205,9 @@ else {
|
|||||||
}
|
}
|
||||||
undef $it;
|
undef $it;
|
||||||
|
|
||||||
# Check timers.
|
# Infinite while loop.
|
||||||
while (1) {
|
while (1) {
|
||||||
|
# Timer check.
|
||||||
foreach my $tk (keys %TIMERS) {
|
foreach my $tk (keys %TIMERS) {
|
||||||
if ($TIMERS{$tk}{time} <= time) {
|
if ($TIMERS{$tk}{time} <= time) {
|
||||||
&{ $TIMERS{$tk}{sub} }();
|
&{ $TIMERS{$tk}{sub} }();
|
||||||
@@ -240,7 +225,28 @@ while (1) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
sleep 1;
|
# 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);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
###############
|
###############
|
||||||
@@ -254,7 +260,7 @@ sub socksnd
|
|||||||
|
|
||||||
if (defined $SOCKET{$svr}) {
|
if (defined $SOCKET{$svr}) {
|
||||||
send($SOCKET{$svr}, $data."\n", 0);
|
send($SOCKET{$svr}, $data."\n", 0);
|
||||||
dbug "You -> $svr: $data";
|
dbug "$svr << $data";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
|||||||
@@ -3,6 +3,10 @@ Auto IRC Bot 3.0: Change Log
|
|||||||
|
|
||||||
3.0 Indev
|
3.0 Indev
|
||||||
==================================================================
|
==================================================================
|
||||||
|
* Removed dependency Async.
|
||||||
|
* Rewrote the socket engine.
|
||||||
|
* Added cmd_add|del|run() to API::Std for commands.
|
||||||
|
* Parse PRIVMSG.
|
||||||
* Enabled ./install features are now stored in $Auto::ENFEAT.
|
* Enabled ./install features are now stored in $Auto::ENFEAT.
|
||||||
* Added --enable-sasl option to ./install for enabling SASL.
|
* Added --enable-sasl option to ./install for enabling SASL.
|
||||||
* Added names() to API::IRC which sends NAMES.
|
* Added names() to API::IRC which sends NAMES.
|
||||||
|
|||||||
@@ -112,7 +112,6 @@ else {
|
|||||||
println "\0";
|
println "\0";
|
||||||
println "--- CPAN Modules ---";
|
println "--- CPAN Modules ---";
|
||||||
modfind("Mouse");
|
modfind("Mouse");
|
||||||
modfind("Async");
|
|
||||||
modfind("Class::Unload");
|
modfind("Class::Unload");
|
||||||
modfind("MIME::Base64") if ($features =~ /sasl/);
|
modfind("MIME::Base64") if ($features =~ /sasl/);
|
||||||
|
|
||||||
|
|||||||
+49
-1
@@ -8,10 +8,10 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
|
|
||||||
|
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
|
||||||
our @ISA = qw(Exporter);
|
our @ISA = qw(Exporter);
|
||||||
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del);
|
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del);
|
||||||
|
|
||||||
my (%LANGE, %MODULE, %EVENTS, %HOOKS);
|
|
||||||
|
|
||||||
|
|
||||||
# Initialize a module.
|
# Initialize a module.
|
||||||
@@ -92,13 +92,51 @@ sub mod_void
|
|||||||
# Add a command to Auto.
|
# Add a command to Auto.
|
||||||
sub cmd_add
|
sub cmd_add
|
||||||
{
|
{
|
||||||
|
my ($cmd, $lvl, $fhelp, $shelp, $sub) = @_;
|
||||||
|
$cmd = uc($cmd);
|
||||||
|
|
||||||
|
return 0 if (defined $CMDS{$cmd});
|
||||||
|
return 0 if ($lvl =~ m/[^0-2]/);
|
||||||
|
|
||||||
|
$CMDS{$cmd}{lvl} = $lvl;
|
||||||
|
$CMDS{$cmd}{fhelp} = $fhelp;
|
||||||
|
$CMDS{$cmd}{shelp} = $shelp;
|
||||||
|
$CMDS{$cmd}{sub} = $sub;
|
||||||
|
|
||||||
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# Delete a command from Auto.
|
# Delete a command from Auto.
|
||||||
sub cmd_del
|
sub cmd_del
|
||||||
{
|
{
|
||||||
|
my ($cmd) = @_;
|
||||||
|
$cmd = uc($cmd);
|
||||||
|
|
||||||
|
if (defined $CMDS{$cmd}) {
|
||||||
|
delete $CMDS{$cmd};
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Run a command if it exists.
|
||||||
|
sub cmd_run
|
||||||
|
{
|
||||||
|
my ($cmd, $lvl, %src, @argv) = @_;
|
||||||
|
$cmd = uc($cmd);
|
||||||
|
|
||||||
|
return 0 if (!defined $CMDS{$cmd});
|
||||||
|
|
||||||
|
if ($CMDS{$cmd}{lvl} == $lvl or $CMDS{$cmd}{lvl} == 2) {
|
||||||
|
API::Log::println $cmd;
|
||||||
|
&{ $CMDS{$cmd}{sub} }(%src, @argv);
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Add an event to Auto.
|
# Add an event to Auto.
|
||||||
@@ -283,6 +321,16 @@ sub trans
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Privilege subroutine.
|
||||||
|
sub has_priv
|
||||||
|
{
|
||||||
|
my (%user, $priv) = @_;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
# Error subroutine.
|
# Error subroutine.
|
||||||
sub err
|
sub err
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -25,6 +25,7 @@ our %RAWC = (
|
|||||||
'477' => \&num477,
|
'477' => \&num477,
|
||||||
'JOIN' => \&cjoin,
|
'JOIN' => \&cjoin,
|
||||||
'NICK' => \&nick,
|
'NICK' => \&nick,
|
||||||
|
'PRIVMSG' => \&privmsg,
|
||||||
);
|
);
|
||||||
|
|
||||||
# Variables for various functions.
|
# Variables for various functions.
|
||||||
@@ -334,6 +335,35 @@ sub nick
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Parse: PRIVMSG
|
||||||
|
sub privmsg
|
||||||
|
{
|
||||||
|
my ($svr, @ex) = @_;
|
||||||
|
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||||
|
|
||||||
|
my $cprefix = (conf_get("fantasy_pf"))[0][0];
|
||||||
|
my $rprefix = substr($ex[3], 1, 1);
|
||||||
|
my $cmd = uc(substr($ex[3], 2));
|
||||||
|
my (@argv);
|
||||||
|
for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||||
|
push(@argv, $ex[$i]);
|
||||||
|
}
|
||||||
|
$src{svr} = $svr;
|
||||||
|
|
||||||
|
# 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.
|
||||||
|
API::Std::cmd_run($cmd, 1, %src, @argv);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
# It is coming to us in a channel message.
|
||||||
|
$src{chan} = $ex[2];
|
||||||
|
API::Std::cmd_run($cmd, 0, %src, @argv);
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
# Parse: TOPIC
|
# Parse: TOPIC
|
||||||
sub topic
|
sub topic
|
||||||
{
|
{
|
||||||
|
|||||||
Reference in new issue
Block a user