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

Deleted trunk/

Browse Source
This commit is contained in:
Elijah Perrault committed 2011-01-28 22:39:21 -07:00
1 parent 41d74bd20e
commit e8d4123156
4 files changed
-1118
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

trunk/README.pod
-24
View File
@@ -1,24 +0,0 @@
=head1 Auto Indev Trunk
=head2 Description
=over
The trunk is used for including code in Auto's Git that does not yet work.
This way the developer's can collaborate on the code to fix it more quickly.
NOTE: The code in trunk DOES NOT work. Do not use it.
=back
=head2 Bugs
=head3 #1
=over
See: snapshot-201101260534
Parser::IRC is not getting %API::Std::CMDS correctly.
See: L225-L233 of bin/auto, L92-107 of API::Std, L338-L375 of Parser::IRC
trunk/snapshot-201101260534/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/snapshot-201101260534/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);
our (%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/snapshot-201101260534/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;