sydney/Autobot
1
0 Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Updated.

Browse Source
This commit is contained in:
Elijah Perrault committed 2011-01-25 22:39:13 -07:00
1 parent 0b7634750f
commit 1921357367
3 files changed
-1094
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

trunk/bin/auto
-328
View File
@@ -1,328 +0,0 @@
#!/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 Class::Unload;
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'
};
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 "* ".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";
# 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();
# 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 = $$;
}
## 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, %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 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;
}
# 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]);
# 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) {
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!
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;
### NOTE: REMOVE THIS FROM MAINLINE CODE. IT IS FOR DEVELOPMENT PURPOSES ONLY. ###
sub hw {
my ($svr, %src, @argv) = @_;
API::IRC::privmsg($svr, $src{chan}, @argv);
return 1;
}
API::Std::cmd_add("SAY", 0, 0, 0, \&Auto::hw) or exit;
### End ###
# Check timers.
while (1) {
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};
}
}
}
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;
}
}
# Load a module.
sub mod_load {
my ($module) = @_;
if (-e "$Bin/../modules/".lc($module).".pm") {
do "$Bin/../modules/".lc($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;
}
trunk/src/API/Std.pm
-366
View File
@@ -1,366 +0,0 @@
# 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.
# Standard API subroutines.
package API::Std;
use strict;
use warnings;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add cmd_del);
my (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
# Initialize a module.
sub mod_init
{
my ($name, $author, $version, $autover, $pkg) = @_;
# 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."...");
# 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 0;
}
# Run the module's _init sub.
my $mi = eval($pkg."::_init();");
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.");
return 1;
}
else {
# Otherwise, return a failed to load message.
API::Log::dbug("MODULES: Failed to load ".$name.".");
API::Log::alog("MODULES: Failed to load ".$name.".");
return 0;
}
}
# Void a 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."...");
# Check if this module exists.
unless (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 0;
}
# Run the module's _init sub.
my $mi = eval($MODULE{$module}{pkg}."::_void();");
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.".");
API::Log::alog("MODULES: Successfully unloaded ".$module.".");
return 1;
}
else {
# Otherwise, return a failed to unload message.
API::Log::dbug("MODULES: Failed to unload ".$module.".");
API::Log::alog("MODULES: Failed to unload ".$module.".");
return 0;
}
}
# Add a command to Auto.
sub cmd_add
{
my ($cmd, $lvl, $fhelp, $shelp, $sub) = @_;
$cmd = uc($cmd);
return 0 if (defined $API::Std::CMDS{$cmd});
return 0 if ($lvl =~ m/[^0-2]/);
$API::Std::CMDS{$cmd}{lvl} = $lvl;
$API::Std::CMDS{$cmd}{fhelp} = $fhelp;
$API::Std::CMDS{$cmd}{shelp} = $shelp;
$API::Std::CMDS{$cmd}{sub} = $sub;
return 1;
}
# Delete a command from Auto.
sub cmd_del
{
my ($cmd) = @_;
$cmd = uc($cmd);
if (defined $API::Std::CMDS{$cmd}) {
delete $API::Std::CMDS{$cmd};
}
else {
return 0;
}
return 1;
}
# Add an event to Auto.
sub event_add
{
my ($name) = @_;
unless (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 0;
}
}
# Delete an event from Auto.
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 0;
}
}
# Trigger an event.
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);
}
}
return 1;
}
# Add a hook to Auto.
sub hook_add
{
my ($event, $name, $sub) = @_;
unless (defined $HOOKS{lc($name)}) {
if (defined $EVENTS{lc($event)}) {
$HOOKS{lc($event)}{lc($name)} = $sub;
return 1;
}
else {
return 0;
}
}
else {
return 0;
}
}
# Delete a hook from Auto.
sub hook_del
{
my ($event, $name) = @_;
if (defined $HOOKS{lc($event)}{lc($name)}) {
delete $HOOKS{lc($event)}{lc($name)};
return 1;
}
else {
return 0;
}
}
# Add a timer to Auto.
sub timer_add
{
my ($name, $type, $time, $sub) = @_;
$name = lc($name);
# Check for invalid type/time.
if ($type =~ m/[^1-2]/) {
return 0;
}
if ($time =~ m/[^0-9]/) {
return 0;
}
unless (defined $Auto::TIMERS{$name}) {
$Auto::TIMERS{$name}{type} = $type;
$Auto::TIMERS{$name}{time} = time + $time;
$Auto::TIMERS{$name}{secs} = $time if ($type == 2);
$Auto::TIMERS{$name}{sub} = $sub;
return 1;
}
else {
return 0;
}
}
# Delete a timer from Auto.
sub timer_del
{
my ($name) = @_;
$name = lc($name);
if (defined $Auto::TIMERS{$name}) {
delete $Auto::TIMERS{$name};
return 1;
}
return 0;
}
# Configuration value getter.
sub conf_get
{
my ($value) = @_;
# Create an array out of the value.
my @val;
if ($value =~ m/:/) {
@val = split(':', $value);
}
else {
@val = ($value);
}
# Undefine this as it's unnecessary now.
undef $value;
# 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 0;
}
}
# Translation subroutine.
sub trans
{
my ($id) = @_;
$id =~ s/ /_/g;
if (defined $API::Std::LANGE{$id}) {
return $API::Std::LANGE{$id};
}
else {
$id =~ s/_/ /g;
return $id;
}
}
# Privilege subroutine.
sub has_priv
{
my (%user, $priv) = @_;
return 1;
}
# Error subroutine.
sub err
{
my ($lvl, $msg, $fatal) = @_;
# Check for an invalid level.
if ($lvl =~ m/[^0-9]/) {
return 0;
}
if ($fatal =~ m/[^0-1]/) {
return 0;
}
# 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");
}
# If it's a fatal error, exit the program.
if ($fatal) {
exit;
}
}
# Warn subroutine.
sub awarn
{
my ($lvl, $msg) = @_;
# Check for an invalid level.
if ($lvl =~ m/[^0-9]/) {
return 0;
}
# 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");
}
}
1;
trunk/src/Parser/IRC.pm
-400
View File
@@ -1,400 +0,0 @@
# 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.
# Subroutines for parsing incoming data from IRC.
package Parser::IRC;
use strict;
use warnings;
use API::Std qw(conf_get err awarn);
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,
'NICK' => \&nick,
'PRIVMSG' => \&privmsg,
);
# Variables for various functions.
our (%got_001, %botnick, %botchans, %csprefix, %chanusers);
# Events.
API::Std::event_add("on_rcjoin");
API::Std::event_add("on_ucjoin");
API::Std::event_add("on_nick");
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]);
}
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};
}
# Modes on connect.
unless (!conf_get("server:$svr:modes")) {
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
API::IRC::umode($svr, $connmodes);
}
# Identify string.
unless (!conf_get("server:$svr:idstr")) {
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
Auto::socksnd($svr, $idstr);
}
# 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);
}
return 1;
}
# Parse: Numeric:005
# Prefixes.
sub num005
{
my ($svr, @ex) = @_;
# Find PREFIX.
foreach my $ex (@ex) {
if (substr($ex, 0, 7) eq "PREFIX=") {
# Found.
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);
}
}
}
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}) {
# It is. Add channel to array and trigger on_ucjoin.
unless (defined $botchans{$svr}) {
@{ $botchans{$svr} } = (substr($ex[2], 1));
}
else {
push(@{ $botchans{$svr} }, substr($ex[2], 1));
}
API::Std::event_run("on_ucjoin", ($svr, substr($ex[2], 1)));
}
else {
# It isn't. Trigger on_rcjoin.
API::Std::event_run("on_rcjoin", ($svr, %src, substr($ex[2], 1)));
}
return 1;
}
# Parse: NICK
sub nick
{
my ($svr, ($uex, undef, $nex)) = @_;
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. Trigger on_nick.
API::Std::event_run("on_nick", ($svr, %src, $nex));
}
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]);
}
# 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.
if (defined $API::Std::CMDS{$cmd}) {
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
eval {
&{ $API::Std::CMDS{$cmd}{sub} }($svr, %src, @argv);
};
}
}
}
else {
# It is coming to us in a channel message.
$src{chan} = $ex[2];
if (defined $API::Std::CMDS{$cmd}) {
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
eval {
&{ $API::Std::CMDS{$cmd}{sub} }($svr, %src, @argv);
};
}
}
}
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;