Getting rid of tabs.
This commit is contained in:
Elijah Perrault committed
1 parent
ad799a32a2
commit
cc1c8fd5bc
20 files changed
+1279
-1277
No files matched your search
+88
-88
@@ -48,68 +48,68 @@ sub ban
|
||||
# Join a channel.
|
||||
sub cjoin
|
||||
{
|
||||
my ($svr, $chan, $key) = @_;
|
||||
|
||||
Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan"));
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $chan, $key) = @_;
|
||||
ssss
|
||||
ssssAuto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan"));
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Part a channel.
|
||||
sub cpart
|
||||
{
|
||||
my ($svr, $chan, $reason) = @_;
|
||||
|
||||
if (defined $reason) {
|
||||
Auto::socksnd($svr, "PART $chan :$reason");
|
||||
}
|
||||
else {
|
||||
Auto::socksnd($svr, "PART $chan :Leaving");
|
||||
}
|
||||
ssssmy ($svr, $chan, $reason) = @_;
|
||||
ssss
|
||||
ssssif (defined $reason) {
|
||||
ssss Auto::socksnd($svr, "PART $chan :$reason");
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss Auto::socksnd($svr, "PART $chan :Leaving");
|
||||
ssss}
|
||||
|
||||
if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; }
|
||||
|
||||
return 1;
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Set mode(s) on a channel.
|
||||
sub cmode
|
||||
{
|
||||
my ($svr, $chan, $modes) = @_;
|
||||
ssssmy ($svr, $chan, $modes) = @_;
|
||||
|
||||
Auto::socksnd($svr, "MODE $chan $modes");
|
||||
|
||||
return 1;
|
||||
ssssAuto::socksnd($svr, "MODE $chan $modes");
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Set mode(s) on us.
|
||||
sub umode
|
||||
{
|
||||
my ($svr, $modes) = @_;
|
||||
|
||||
Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $modes) = @_;
|
||||
ssss
|
||||
ssssAuto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Send a PRIVMSG.
|
||||
sub privmsg
|
||||
{
|
||||
my ($svr, $target, $message) = @_;
|
||||
|
||||
Auto::socksnd($svr, "PRIVMSG $target :$message");
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $target, $message) = @_;
|
||||
ssss
|
||||
ssssAuto::socksnd($svr, "PRIVMSG $target :$message");
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Send a NOTICE.
|
||||
sub notice
|
||||
{
|
||||
my ($svr, $target, $message) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NOTICE $target :$message");
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $target, $message) = @_;
|
||||
ssss
|
||||
ssssAuto::socksnd($svr, "NOTICE $target :$message");
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Send an ACTION PRIVMSG.
|
||||
@@ -125,33 +125,33 @@ sub act
|
||||
# Change bot nickname.
|
||||
sub nick
|
||||
{
|
||||
my ($svr, $newnick) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NICK $newnick");
|
||||
|
||||
$Parser::IRC::botnick{$svr}{newnick} = $newnick;
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $newnick) = @_;
|
||||
ssss
|
||||
ssssAuto::socksnd($svr, "NICK $newnick");
|
||||
ssss
|
||||
ssss$Parser::IRC::botnick{$svr}{newnick} = $newnick;
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Request the users of a channel.
|
||||
sub names
|
||||
{
|
||||
my ($svr, $chan) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NAMES $chan");
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $chan) = @_;
|
||||
ssss
|
||||
ssssAuto::socksnd($svr, "NAMES $chan");
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Send a topic to the channel.
|
||||
sub topic
|
||||
{
|
||||
my ($svr, $chan, $topic) = @_;
|
||||
|
||||
Auto::socksnd($svr, "TOPIC $chan :$topic");
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $chan, $topic) = @_;
|
||||
ssss
|
||||
ssssAuto::socksnd($svr, "TOPIC $chan :$topic");
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Kick a user.
|
||||
@@ -167,54 +167,54 @@ sub kick
|
||||
# Quit IRC.
|
||||
sub quit
|
||||
{
|
||||
my ($svr, $reason) = @_;
|
||||
|
||||
if (defined $reason) {
|
||||
Auto::socksnd($svr, "QUIT :$reason");
|
||||
}
|
||||
else {
|
||||
Auto::socksnd($svr, "QUIT :Leaving");
|
||||
}
|
||||
|
||||
delete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr});
|
||||
delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr});
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, $reason) = @_;
|
||||
ssss
|
||||
ssssif (defined $reason) {
|
||||
ssss Auto::socksnd($svr, "QUIT :$reason");
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss Auto::socksnd($svr, "QUIT :Leaving");
|
||||
ssss}
|
||||
ssss
|
||||
ssssdelete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr});
|
||||
ssssdelete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr});
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
|
||||
# Get nick, ident and host from a <nick>!<ident>@<host>
|
||||
sub usrc
|
||||
{
|
||||
my ($ex) = @_;
|
||||
|
||||
my @si = split('!', $ex);
|
||||
my @sii = split('@', $si[1]);
|
||||
|
||||
return (
|
||||
nick => $si[0],
|
||||
user => $sii[0],
|
||||
host => $sii[1]
|
||||
);
|
||||
ssssmy ($ex) = @_;
|
||||
ssss
|
||||
ssssmy @si = split('!', $ex);
|
||||
ssssmy @sii = split('@', $si[1]);
|
||||
ssss
|
||||
ssssreturn (
|
||||
ssss nick => $si[0],
|
||||
ssss user => $sii[0],
|
||||
ssss host => $sii[1]
|
||||
ssss);
|
||||
}
|
||||
|
||||
# Match two IRC masks.
|
||||
sub match_mask
|
||||
{
|
||||
my ($mu, $mh) = @_;
|
||||
|
||||
# Prepare the regex.
|
||||
$mh =~ s/\./\\\./g;
|
||||
$mh =~ s/\?/\./g;
|
||||
$mh =~ s/\*/\.\*/g;
|
||||
$mh = '^'.$mh.'$';
|
||||
|
||||
# Let's grep the user's mask.
|
||||
if (grep(/$mh/, $mu)) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
ssssmy ($mu, $mh) = @_;
|
||||
ssss
|
||||
ssss# Prepare the regex.
|
||||
ssss$mh =~ s/\./\\\./g;
|
||||
ssss$mh =~ s/\?/\./g;
|
||||
ssss$mh =~ s/\*/\.\*/g;
|
||||
ssss$mh = '^'.$mh.'$';
|
||||
ssss
|
||||
ssss# Let's grep the user's mask.
|
||||
ssssif (grep(/$mh/, $mu)) {
|
||||
ssss return 1;
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
+55
-55
@@ -18,11 +18,11 @@ our @EXPORT_OK = qw(println dbug alog slog);
|
||||
# Print with the system newline appended.
|
||||
sub println
|
||||
{
|
||||
my ($out) = @_;
|
||||
ssssmy ($out) = @_;
|
||||
|
||||
if (!defined $out) {
|
||||
print $RS;
|
||||
}
|
||||
ssssif (!defined $out) {
|
||||
ssss print $RS;
|
||||
ssss}
|
||||
else {
|
||||
print $out.$RS;
|
||||
}
|
||||
@@ -33,79 +33,79 @@ sub println
|
||||
# Print only if in debug mode.
|
||||
sub dbug
|
||||
{
|
||||
my ($out) = @_;
|
||||
ssssmy ($out) = @_;
|
||||
|
||||
if ($Auto::DEBUG) {
|
||||
# We're in debug mode; print it out.
|
||||
say $out;
|
||||
}
|
||||
ssssif ($Auto::DEBUG) {
|
||||
ssss # We're in debug mode; print it out.
|
||||
ssss say $out;
|
||||
ssss}
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Log to file.
|
||||
sub alog
|
||||
{
|
||||
my ($lmsg) = @_;
|
||||
ssssmy ($lmsg) = @_;
|
||||
|
||||
# Expire old logs first.
|
||||
expire_logs();
|
||||
ssss# Expire old logs first.
|
||||
ssssexpire_logs();
|
||||
|
||||
# Get date and time in the desired format.
|
||||
my $date = POSIX::strftime('%Y%m%d', localtime);
|
||||
my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
|
||||
ssss# Get date and time in the desired format.
|
||||
ssssmy $date = POSIX::strftime('%Y%m%d', localtime);
|
||||
ssssmy $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
|
||||
|
||||
# Create var/ if it doesn't exist.
|
||||
if (!-d "$Auto::Bin/../var") {
|
||||
mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
}
|
||||
# Create var/DATE.log if it doesn't exist.
|
||||
if (!-e "$Auto::Bin/../var/$date.log") {
|
||||
system "touch $Auto::Bin/../var/$date.log";
|
||||
}
|
||||
ssss# Create var/ if it doesn't exist.
|
||||
ssssif (!-d "$Auto::Bin/../var") {
|
||||
ssss mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
ssss}
|
||||
ssss# Create var/DATE.log if it doesn't exist.
|
||||
ssssif (!-e "$Auto::Bin/../var/$date.log") {
|
||||
ssss system "touch $Auto::Bin/../var/$date.log";
|
||||
ssss}
|
||||
|
||||
# Open the logfile, print the log message to it and close it.
|
||||
open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
|
||||
print {$FLOG} "[$time] $lmsg\n" or return;
|
||||
close $FLOG or return;
|
||||
ssss# Open the logfile, print the log message to it and close it.
|
||||
ssssopen my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
|
||||
ssssprint {$FLOG} "[$time] $lmsg\n" or return;
|
||||
ssssclose $FLOG or return;
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Expire old logs.
|
||||
sub expire_logs
|
||||
{
|
||||
# Get configuration value.
|
||||
my $celog = (conf_get('expire_logs'))[0][0] or return;
|
||||
ssss# Get configuration value.
|
||||
ssssmy $celog = (conf_get('expire_logs'))[0][0] or return;
|
||||
|
||||
# Check for invalid values.
|
||||
if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
# Must be numbers only.
|
||||
return;
|
||||
}
|
||||
elsif (!$celog) {
|
||||
# No expire.
|
||||
return;
|
||||
}
|
||||
ssss# Check for invalid values.
|
||||
ssssif ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss # Must be numbers only.
|
||||
ssss return;
|
||||
ssss}
|
||||
sssselsif (!$celog) {
|
||||
ssss # No expire.
|
||||
ssss return;
|
||||
ssss}
|
||||
|
||||
# Iterate through each logfile.
|
||||
foreach my $file (glob "$Auto::Bin/../var/*") {
|
||||
my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
|
||||
ssss# Iterate through each logfile.
|
||||
ssssforeach my $file (glob "$Auto::Bin/../var/*") {
|
||||
ssss my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
|
||||
|
||||
# Convert filename to UNIX time.
|
||||
my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
$mm = $mm - 1;
|
||||
my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
|
||||
ssss # Convert filename to UNIX time.
|
||||
ssss my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
ssss my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
ssss $mm = $mm - 1;
|
||||
ssss my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
ssss my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
|
||||
|
||||
# If it's older than <config_value> days, delete it.
|
||||
if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
unlink "$Auto::Bin/../var/$file";
|
||||
}
|
||||
}
|
||||
ssss # If it's older than <config_value> days, delete it.
|
||||
ssss if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
ssss unlink "$Auto::Bin/../var/$file";
|
||||
ssss }
|
||||
ssss}
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Subroutine for logging to an IRC logchan.
|
||||
|
||||
+263
-263
@@ -11,237 +11,237 @@ use base qw(Exporter);
|
||||
|
||||
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
|
||||
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add
|
||||
cmd_del hook_add hook_del rchook_add rchook_del match_user
|
||||
has_priv mod_exists ratelimit_check);
|
||||
ssss cmd_del hook_add hook_del rchook_add rchook_del match_user
|
||||
ssss has_priv mod_exists ratelimit_check);
|
||||
|
||||
|
||||
# Initialize a module.
|
||||
sub mod_init
|
||||
{
|
||||
my ($name, $author, $version, $autover, $pkg) = @_;
|
||||
ssssmy ($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.'...');
|
||||
ssssAPI::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||
ssssAPI::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('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.0a4' and $autover ne '3.0.0a5') {
|
||||
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.');
|
||||
ssssif ($autover ne '3.0.0a4' and $autover ne '3.0.0a5') {
|
||||
ssss API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
|
||||
ssss API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); }
|
||||
return;
|
||||
}
|
||||
ssss return;
|
||||
ssss}
|
||||
|
||||
# Run the module's _init sub.
|
||||
ssss# Run the module's _init sub.
|
||||
my $mi = eval($pkg.'::_init();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
||||
|
||||
if ($mi) {
|
||||
# If successful, add to hash.
|
||||
$MODULE{$name}{name} = $name;
|
||||
$MODULE{$name}{version} = $version;
|
||||
$MODULE{$name}{author} = $author;
|
||||
$MODULE{$name}{pkg} = $pkg;
|
||||
ssssif ($mi) {
|
||||
ssss # If successful, add to hash.
|
||||
ssss $MODULE{$name}{name} = $name;
|
||||
ssss $MODULE{$name}{version} = $version;
|
||||
ssss $MODULE{$name}{author} = $author;
|
||||
ssss $MODULE{$name}{pkg} = $pkg;
|
||||
|
||||
API::Log::dbug('MODULES: '.$name.' successfully loaded.');
|
||||
API::Log::alog('MODULES: '.$name.' successfully loaded.');
|
||||
ssss API::Log::dbug('MODULES: '.$name.' successfully loaded.');
|
||||
ssss API::Log::alog('MODULES: '.$name.' successfully loaded.');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.'); }
|
||||
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
# Otherwise, return a failed to load message.
|
||||
API::Log::dbug('MODULES: Failed to load '.$name.q{.});
|
||||
API::Log::alog('MODULES: Failed to load '.$name.q{.});
|
||||
ssss return 1;
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss # Otherwise, return a failed to load message.
|
||||
ssss API::Log::dbug('MODULES: Failed to load '.$name.q{.});
|
||||
ssss API::Log::alog('MODULES: Failed to load '.$name.q{.});
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}); }
|
||||
|
||||
return;
|
||||
}
|
||||
ssss return;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Check if a module exists.
|
||||
sub mod_exists
|
||||
{
|
||||
my ($name) = @_;
|
||||
ssssmy ($name) = @_;
|
||||
|
||||
if (defined $API::Std::MODULE{$name}) { return 1; }
|
||||
ssssif (defined $API::Std::MODULE{$name}) { return 1; }
|
||||
|
||||
return;
|
||||
ssssreturn;
|
||||
}
|
||||
|
||||
# Void a module.
|
||||
sub mod_void
|
||||
{
|
||||
my ($module) = @_;
|
||||
ssssmy ($module) = @_;
|
||||
|
||||
# Log/debug.
|
||||
API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
|
||||
API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
|
||||
ssss# Log/debug.
|
||||
ssssAPI::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
|
||||
ssssAPI::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...'); }
|
||||
|
||||
# Check if this module exists.
|
||||
if (!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?');
|
||||
ssss# Check if this module exists.
|
||||
ssssif (!defined $MODULE{$module}) {
|
||||
ssss API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
|
||||
ssss API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?'); }
|
||||
return;
|
||||
}
|
||||
ssss return;
|
||||
ssss}
|
||||
|
||||
# Run the module's _void sub.
|
||||
ssss# Run the module's _void sub.
|
||||
my $mi = eval($MODULE{$module}{pkg}.'::_void();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
||||
|
||||
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.q{.});
|
||||
API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
|
||||
ssssif ($mi) {
|
||||
ssss # If successful, delete class from program and delete module from hash.
|
||||
ssss Class::Unload->unload($MODULE{$module}{pkg});
|
||||
ssss delete $MODULE{$module};
|
||||
ssss API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
|
||||
ssss API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}); }
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
# Otherwise, return a failed to unload message.
|
||||
API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
|
||||
API::Log::alog('MODULES: Failed to unload '.$module.q{.});
|
||||
ssss return 1;
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss # Otherwise, return a failed to unload message.
|
||||
ssss API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
|
||||
ssss API::Log::alog('MODULES: Failed to unload '.$module.q{.});
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}); }
|
||||
return;
|
||||
}
|
||||
ssss return;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Add a command to Auto.
|
||||
sub cmd_add
|
||||
{
|
||||
my ($cmd, $lvl, $priv, $help, $sub) = @_;
|
||||
$cmd = uc $cmd;
|
||||
ssssmy ($cmd, $lvl, $priv, $help, $sub) = @_;
|
||||
ssss$cmd = uc $cmd;
|
||||
|
||||
if (defined $API::Std::CMDS{$cmd}) { return; }
|
||||
if ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssssif (defined $API::Std::CMDS{$cmd}) { return; }
|
||||
ssssif ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
|
||||
$API::Std::CMDS{$cmd}{lvl} = $lvl;
|
||||
$API::Std::CMDS{$cmd}{help} = $help;
|
||||
$API::Std::CMDS{$cmd}{priv} = $priv;
|
||||
$API::Std::CMDS{$cmd}{'sub'} = $sub;
|
||||
ssss$API::Std::CMDS{$cmd}{lvl} = $lvl;
|
||||
ssss$API::Std::CMDS{$cmd}{help} = $help;
|
||||
ssss$API::Std::CMDS{$cmd}{priv} = $priv;
|
||||
ssss$API::Std::CMDS{$cmd}{'sub'} = $sub;
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
|
||||
# Delete a command from Auto.
|
||||
sub cmd_del
|
||||
{
|
||||
my ($cmd) = @_;
|
||||
$cmd = uc $cmd;
|
||||
ssssmy ($cmd) = @_;
|
||||
ssss$cmd = uc $cmd;
|
||||
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
delete $API::Std::CMDS{$cmd};
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
ssssif (defined $API::Std::CMDS{$cmd}) {
|
||||
ssss delete $API::Std::CMDS{$cmd};
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss return;
|
||||
ssss}
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Add an event to Auto.
|
||||
sub event_add
|
||||
{
|
||||
my ($name) = @_;
|
||||
ssssmy ($name) = @_;
|
||||
|
||||
if (!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;
|
||||
}
|
||||
ssssif (!defined $EVENTS{lc $name}) {
|
||||
ssss $EVENTS{lc $name} = 1;
|
||||
ssss return 1;
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...');
|
||||
ssss return;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Delete an event from Auto.
|
||||
sub event_del
|
||||
{
|
||||
my ($name) = @_;
|
||||
ssssmy ($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;
|
||||
}
|
||||
ssssif (defined $EVENTS{lc $name}) {
|
||||
ssss delete $EVENTS{lc $name};
|
||||
ssss delete $HOOKS{lc $name};
|
||||
ssss return 1;
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...');
|
||||
ssss return;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Trigger an event.
|
||||
sub event_run
|
||||
{
|
||||
my ($event, @args) = @_;
|
||||
ssssmy ($event, @args) = @_;
|
||||
|
||||
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
|
||||
foreach my $hk (keys %{ $HOOKS{lc $event} }) {
|
||||
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
|
||||
ssssif (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
|
||||
ssss foreach my $hk (keys %{ $HOOKS{lc $event} }) {
|
||||
ssss my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
|
||||
if ($ri == -1) { last; }
|
||||
}
|
||||
}
|
||||
ssss }
|
||||
ssss}
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Add a hook to Auto.
|
||||
sub hook_add
|
||||
{
|
||||
my ($event, $name, $sub) = @_;
|
||||
ssssmy ($event, $name, $sub) = @_;
|
||||
|
||||
if (!defined $API::Std::HOOKS{lc $name}) {
|
||||
if (defined $API::Std::EVENTS{lc $event}) {
|
||||
$API::Std::HOOKS{lc $event}{lc $name} = $sub;
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
ssssif (!defined $API::Std::HOOKS{lc $name}) {
|
||||
ssss if (defined $API::Std::EVENTS{lc $event}) {
|
||||
ssss $API::Std::HOOKS{lc $event}{lc $name} = $sub;
|
||||
ssss return 1;
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss return;
|
||||
ssss }
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss return;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Delete a hook from Auto.
|
||||
sub hook_del
|
||||
{
|
||||
my ($event, $name) = @_;
|
||||
ssssmy ($event, $name) = @_;
|
||||
|
||||
if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
|
||||
delete $API::Std::HOOKS{lc $event}{lc $name};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
ssssif (defined $API::Std::HOOKS{lc $event}{lc $name}) {
|
||||
ssss delete $API::Std::HOOKS{lc $event}{lc $name};
|
||||
ssss return 1;
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss return;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Add a timer to Auto.
|
||||
sub timer_add
|
||||
{
|
||||
my ($name, $type, $time, $sub) = @_;
|
||||
$name = lc $name;
|
||||
ssssmy ($name, $type, $time, $sub) = @_;
|
||||
ssss$name = lc $name;
|
||||
|
||||
# Check for invalid type/time.
|
||||
if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
ssss# Check for invalid type/time.
|
||||
ssssif ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss return;
|
||||
ssss}
|
||||
ssssif ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss return;
|
||||
ssss}
|
||||
|
||||
if (!defined $Auto::TIMERS{$name}) {
|
||||
$Auto::TIMERS{$name}{type} = $type;
|
||||
$Auto::TIMERS{$name}{time} = time + $time;
|
||||
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
|
||||
$Auto::TIMERS{$name}{sub} = $sub;
|
||||
return 1;
|
||||
}
|
||||
ssssif (!defined $Auto::TIMERS{$name}) {
|
||||
ssss $Auto::TIMERS{$name}{type} = $type;
|
||||
ssss $Auto::TIMERS{$name}{time} = time + $time;
|
||||
ssss if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
|
||||
ssss $Auto::TIMERS{$name}{sub} = $sub;
|
||||
ssss return 1;
|
||||
ssss}
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -249,123 +249,123 @@ sub timer_add
|
||||
# Delete a timer from Auto.
|
||||
sub timer_del
|
||||
{
|
||||
my ($name) = @_;
|
||||
$name = lc $name;
|
||||
ssssmy ($name) = @_;
|
||||
ssss$name = lc $name;
|
||||
|
||||
if (defined $Auto::TIMERS{$name}) {
|
||||
delete $Auto::TIMERS{$name};
|
||||
return 1;
|
||||
}
|
||||
ssssif (defined $Auto::TIMERS{$name}) {
|
||||
ssss delete $Auto::TIMERS{$name};
|
||||
ssss return 1;
|
||||
ssss}
|
||||
|
||||
return;
|
||||
ssssreturn;
|
||||
}
|
||||
|
||||
# Hook onto a raw command.
|
||||
sub rchook_add
|
||||
{
|
||||
my ($cmd, $sub) = @_;
|
||||
$cmd = uc $cmd;
|
||||
ssssmy ($cmd, $sub) = @_;
|
||||
ssss$cmd = uc $cmd;
|
||||
|
||||
if (defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||
ssssif (defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||
|
||||
$Parser::IRC::RAWC{$cmd} = $sub;
|
||||
ssss$Parser::IRC::RAWC{$cmd} = $sub;
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Delete a raw command hook.
|
||||
sub rchook_del
|
||||
{
|
||||
my ($cmd) = @_;
|
||||
$cmd = uc $cmd;
|
||||
ssssmy ($cmd) = @_;
|
||||
ssss$cmd = uc $cmd;
|
||||
|
||||
if (!defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||
ssssif (!defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||
|
||||
delete $Parser::IRC::RAWC{$cmd};
|
||||
ssssdelete $Parser::IRC::RAWC{$cmd};
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Configuration value getter.
|
||||
sub conf_get
|
||||
{
|
||||
my ($value) = @_;
|
||||
ssssmy ($value) = @_;
|
||||
|
||||
# Create an array out of the value.
|
||||
my @val;
|
||||
if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
@val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
}
|
||||
else {
|
||||
@val = ($value);
|
||||
}
|
||||
# Undefine this as it's unnecessary now.
|
||||
undef $value;
|
||||
ssss# Create an array out of the value.
|
||||
ssssmy @val;
|
||||
ssssif ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss @val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss @val = ($value);
|
||||
ssss}
|
||||
ssss# Undefine this as it's unnecessary now.
|
||||
ssssundef $value;
|
||||
|
||||
# Get the count of elements in the array.
|
||||
my $count = scalar @val;
|
||||
ssss# Get the count of elements in the array.
|
||||
ssssmy $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;
|
||||
}
|
||||
ssss# Return the requested configuration value(s).
|
||||
ssssif ($count == 1) {
|
||||
ssss if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') {
|
||||
ssss return %{ $Auto::SETTINGS{$val[0]} };
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss return $Auto::SETTINGS{$val[0]};
|
||||
ssss }
|
||||
ssss}
|
||||
sssselsif ($count == 2) {
|
||||
ssss if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') {
|
||||
ssss return %{ $Auto::SETTINGS{$val[0]}{$val[1]} };
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss return $Auto::SETTINGS{$val[0]}{$val[1]};
|
||||
ssss }
|
||||
ssss}
|
||||
sssselsif ($count == 3) {
|
||||
ssss if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') {
|
||||
ssss return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} };
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]};
|
||||
ssss }
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss return;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Translation subroutine.
|
||||
sub trans
|
||||
{
|
||||
my $id = shift;
|
||||
$id =~ s/ /_/gsm;
|
||||
ssss$id =~ s/ /_/gsm;
|
||||
|
||||
if (defined $API::Std::LANGE{$id}) {
|
||||
return sprintf $API::Std::LANGE{$id}, @_;
|
||||
}
|
||||
else {
|
||||
$id =~ s/_/ /gsm;
|
||||
return $id;
|
||||
}
|
||||
ssssif (defined $API::Std::LANGE{$id}) {
|
||||
ssss return sprintf $API::Std::LANGE{$id}, @_;
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss $id =~ s/_/ /gsm;
|
||||
ssss return $id;
|
||||
ssss}
|
||||
}
|
||||
|
||||
# Match user subroutine.
|
||||
sub match_user
|
||||
{
|
||||
my (%user) = @_;
|
||||
ssssmy (%user) = @_;
|
||||
|
||||
# Get data from config.
|
||||
ssss# Get data from config.
|
||||
if (!conf_get('user')) { return; }
|
||||
my %uhp = conf_get('user');
|
||||
ssssmy %uhp = conf_get('user');
|
||||
|
||||
foreach my $userkey (keys %uhp) {
|
||||
# For each user block.
|
||||
my %ulhp = %{ $uhp{$userkey} };
|
||||
foreach my $uhk (keys %ulhp) {
|
||||
ssssforeach my $userkey (keys %uhp) {
|
||||
ssss # For each user block.
|
||||
ssss my %ulhp = %{ $uhp{$userkey} };
|
||||
ssss foreach my $uhk (keys %ulhp) {
|
||||
# For each user.
|
||||
|
||||
if ($uhk eq 'net') {
|
||||
ssss if ($uhk eq 'net') {
|
||||
if (defined $user{svr}) {
|
||||
if (lc $user{svr} ne lc(($ulhp{$uhk})[0][0])) {
|
||||
# config.user:net conflicts with irc.user:svr.
|
||||
@@ -374,13 +374,13 @@ sub match_user
|
||||
}
|
||||
}
|
||||
elsif ($uhk eq 'mask') {
|
||||
# Put together the user information.
|
||||
my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
|
||||
if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
|
||||
# We've got a host match.
|
||||
return $userkey;
|
||||
}
|
||||
}
|
||||
ssss # Put together the user information.
|
||||
ssss my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
|
||||
ssss if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
|
||||
ssss # We've got a host match.
|
||||
ssss return $userkey;
|
||||
ssss }
|
||||
ssss }
|
||||
elsif ($uhk eq 'chanstatus' and defined $ulhp{'net'}) {
|
||||
my ($ccst, $ccnm) = split m/[:]/sm, ($ulhp{$uhk})[0][0]; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
my $svr = $ulhp{net}[0];
|
||||
@@ -401,28 +401,28 @@ sub match_user
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
ssss }
|
||||
ssss}
|
||||
|
||||
return;
|
||||
ssssreturn;
|
||||
}
|
||||
|
||||
# Privilege subroutine.
|
||||
sub has_priv
|
||||
{
|
||||
my ($cuser, $cpriv) = @_;
|
||||
ssssmy ($cuser, $cpriv) = @_;
|
||||
|
||||
if (conf_get("user:$cuser:privs")) {
|
||||
my $cups = (conf_get("user:$cuser:privs"))[0][0];
|
||||
ssssif (conf_get("user:$cuser:privs")) {
|
||||
ssss my $cups = (conf_get("user:$cuser:privs"))[0][0];
|
||||
|
||||
if (defined $Auto::PRIVILEGES{$cups}) {
|
||||
foreach (@{ $Auto::PRIVILEGES{$cups} }) {
|
||||
if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
|
||||
}
|
||||
}
|
||||
}
|
||||
ssss if (defined $Auto::PRIVILEGES{$cups}) {
|
||||
ssss foreach (@{ $Auto::PRIVILEGES{$cups} }) {
|
||||
ssss if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss}
|
||||
|
||||
return;
|
||||
ssssreturn;
|
||||
}
|
||||
|
||||
# Ratelimit check subroutine.
|
||||
@@ -461,59 +461,59 @@ sub ratelimit_check
|
||||
# Error subroutine.
|
||||
sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
|
||||
{
|
||||
my ($lvl, $msg, $fatal) = @_;
|
||||
ssssmy ($lvl, $msg, $fatal) = @_;
|
||||
|
||||
# Check for an invalid level.
|
||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
ssss# Check for an invalid level.
|
||||
ssssif ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss return;
|
||||
ssss}
|
||||
ssssif ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss return;
|
||||
ssss}
|
||||
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
say "ERROR: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("ERROR: $msg");
|
||||
}
|
||||
ssss# Level 1: Print to screen.
|
||||
ssssif ($lvl >= 1) {
|
||||
ssss say "ERROR: $msg";
|
||||
ssss}
|
||||
ssss# Level 2: Log to file.
|
||||
ssssif ($lvl >= 2) {
|
||||
ssss API::Log::alog("ERROR: $msg");
|
||||
ssss}
|
||||
# Level 3: Log to IRC.
|
||||
if ($lvl >= 3) {
|
||||
API::Log::slog("ERROR: $msg");
|
||||
}
|
||||
|
||||
# If it's a fatal error, exit the program.
|
||||
if ($fatal) { exit; }
|
||||
ssss# If it's a fatal error, exit the program.
|
||||
ssssif ($fatal) { exit; }
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Warn subroutine.
|
||||
sub awarn
|
||||
{
|
||||
my ($lvl, $msg) = @_;
|
||||
ssssmy ($lvl, $msg) = @_;
|
||||
|
||||
# Check for an invalid level.
|
||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
ssss# Check for an invalid level.
|
||||
ssssif ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
ssss return;
|
||||
ssss}
|
||||
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
say "WARNING: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("WARNING: $msg");
|
||||
}
|
||||
ssss# Level 1: Print to screen.
|
||||
ssssif ($lvl >= 1) {
|
||||
ssss say "WARNING: $msg";
|
||||
ssss}
|
||||
ssss# Level 2: Log to file.
|
||||
ssssif ($lvl >= 2) {
|
||||
ssss API::Log::alog("WARNING: $msg");
|
||||
ssss}
|
||||
# Level 3: Log to IRC.
|
||||
if ($lvl >= 3) {
|
||||
API::Log::slog("WARNING: $msg");
|
||||
}
|
||||
|
||||
return 1;
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
+21
-21
@@ -43,22 +43,22 @@ hook_add("on_quit", "quit_update_chanusers", sub {
|
||||
hook_add("on_connect", "on_connect_modes", sub {
|
||||
my ($svr) = @_;
|
||||
|
||||
if (conf_get("server:$svr:modes")) {
|
||||
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
||||
API::IRC::umode($svr, $connmodes);
|
||||
}
|
||||
ssssif (conf_get("server:$svr:modes")) {
|
||||
ssss my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
||||
ssss API::IRC::umode($svr, $connmodes);
|
||||
ssss}
|
||||
|
||||
return 1;
|
||||
});
|
||||
|
||||
# Plaintext auth.
|
||||
hook_add("on_connect", "plaintext_auth", sub {
|
||||
my ($svr) = @_;
|
||||
ssssmy ($svr) = @_;
|
||||
|
||||
if (conf_get("server:$svr:idstr")) {
|
||||
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
||||
Auto::socksnd($svr, $idstr);
|
||||
}
|
||||
ssss my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
||||
ssss Auto::socksnd($svr, $idstr);
|
||||
ssss}
|
||||
|
||||
return 1;
|
||||
});
|
||||
@@ -67,14 +67,14 @@ hook_add("on_connect", "plaintext_auth", sub {
|
||||
hook_add("on_connect", "autojoin", sub {
|
||||
my ($svr) = @_;
|
||||
|
||||
# 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]);
|
||||
|
||||
ssss# Get the auto-join from the config.
|
||||
ssssmy @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] };
|
||||
ssss
|
||||
ssss# Join the channels.
|
||||
ssssif (!defined $cajoin[1]) {
|
||||
ssss # For single-line ajoins.
|
||||
ssss my @sajoin = split(',', $cajoin[0]);
|
||||
ssss
|
||||
foreach (@sajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
@@ -84,13 +84,13 @@ hook_add("on_connect", "autojoin", sub {
|
||||
}
|
||||
else {
|
||||
# Else join without one.
|
||||
API::IRC::cjoin($svr, $_);
|
||||
ssss API::IRC::cjoin($svr, $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# For multi-line ajoins.
|
||||
foreach (@cajoin) {
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss # For multi-line ajoins.
|
||||
ssss foreach (@cajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
# There was, join with it.
|
||||
|
||||
+152
-152
@@ -12,18 +12,18 @@ sub new
|
||||
my ($file) = @_;
|
||||
my $self = bless {}, $class;
|
||||
|
||||
# Check to see if the configuration file exists.
|
||||
if (!-e "$Auto::Bin/../etc/$file") {
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Open, read and close the config.
|
||||
open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
|
||||
my @cosfl = <$FCONF> or return 0;
|
||||
close $FCONF or return 0;
|
||||
|
||||
# Save it to self variable.
|
||||
$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";
|
||||
ssss# Check to see if the configuration file exists.
|
||||
ssssif (!-e "$Auto::Bin/../etc/$file") {
|
||||
ssss return 0;
|
||||
ssss}
|
||||
ssss
|
||||
ssss# Open, read and close the config.
|
||||
ssssopen(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
|
||||
ssssmy @cosfl = <$FCONF> or return 0;
|
||||
ssssclose $FCONF or return 0;
|
||||
ssss
|
||||
ssss# Save it to self variable.
|
||||
ssss$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";
|
||||
|
||||
return $self;
|
||||
}
|
||||
@@ -31,148 +31,148 @@ sub new
|
||||
# Parse the configuration file.
|
||||
sub parse
|
||||
{
|
||||
# Get the path to the file.
|
||||
my $self = shift;
|
||||
my $file = $self->{'config'}->{'path'};
|
||||
my $blk = 0;
|
||||
my (%rs);
|
||||
|
||||
# Open, read and close it.
|
||||
open(my $FCONF, q{<}, "$file") or return 0;
|
||||
my @fbuf = <$FCONF> or return 0;
|
||||
close $FCONF or return 0;
|
||||
|
||||
# Iterate the file.
|
||||
foreach my $buff (@fbuf) {
|
||||
# Main newline buffer.
|
||||
if (defined $buff) {
|
||||
# If the line begins with a #, it's a comment so ignore it.
|
||||
if (substr($buff, 0, 1) eq '#') {
|
||||
next;
|
||||
}
|
||||
|
||||
if ($buff =~ m/;/) {
|
||||
# Semicolon buffer.
|
||||
my @asbuf = split(';', $buff);
|
||||
foreach my $asbuff (@asbuf) {
|
||||
if (defined $asbuff) {
|
||||
|
||||
# Space buffer.
|
||||
my @ebuf = split(' ', $asbuff);
|
||||
if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
my $param = $ebuf[1];
|
||||
|
||||
if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
||||
# Multi-word string.
|
||||
$param = substr($param, 1);
|
||||
|
||||
for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
||||
if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
||||
$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
||||
last;
|
||||
}
|
||||
else {
|
||||
$param .= " ".$ebuf[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
||||
# Single-word string.
|
||||
$param = substr($param, 1, length($ebuf[1]) - 2);
|
||||
}
|
||||
elsif ($param =~ m/[0-9]/) {
|
||||
# Numeric.
|
||||
$param =~ s/[^0-9.]//g;
|
||||
}
|
||||
else {
|
||||
# Garbage.
|
||||
next;
|
||||
}
|
||||
|
||||
my @param = ($param);
|
||||
|
||||
unless (!$blk) {
|
||||
# We're inside a block.
|
||||
if ($blk =~ m/@@@/) {
|
||||
# We're inside a block with a parameter.
|
||||
my @sblk = split('@@@', $blk);
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're inside a block with no parameter.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$blk}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
ssss# Get the path to the file.
|
||||
ssssmy $self = shift;
|
||||
ssssmy $file = $self->{'config'}->{'path'};
|
||||
ssssmy $blk = 0;
|
||||
ssssmy (%rs);
|
||||
ssss
|
||||
ssss# Open, read and close it.
|
||||
ssssopen(my $FCONF, q{<}, "$file") or return 0;
|
||||
ssssmy @fbuf = <$FCONF> or return 0;
|
||||
ssssclose $FCONF or return 0;
|
||||
ssss
|
||||
ssss# Iterate the file.
|
||||
ssssforeach my $buff (@fbuf) {
|
||||
ssss # Main newline buffer.
|
||||
ssss if (defined $buff) {
|
||||
ssss # If the line begins with a #, it's a comment so ignore it.
|
||||
ssss if (substr($buff, 0, 1) eq '#') {
|
||||
ssss next;
|
||||
ssss }
|
||||
ssss
|
||||
ssss if ($buff =~ m/;/) {
|
||||
ssss # Semicolon buffer.
|
||||
ssss my @asbuf = split(';', $buff);
|
||||
ssss foreach my $asbuff (@asbuf) {
|
||||
ssss if (defined $asbuff) {
|
||||
ssss
|
||||
ssss # Space buffer.
|
||||
ssss my @ebuf = split(' ', $asbuff);
|
||||
ssss if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
||||
ssss # Garbage. Ignoring.
|
||||
ssss next;
|
||||
ssss }
|
||||
ssss my $param = $ebuf[1];
|
||||
ssss
|
||||
ssss if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
||||
ssss # Multi-word string.
|
||||
ssss $param = substr($param, 1);
|
||||
ssss
|
||||
ssss for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
||||
ssss if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
||||
ssss $param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
||||
ssss last;
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss $param .= " ".$ebuf[$i];
|
||||
ssss }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
||||
ssss # Single-word string.
|
||||
ssss $param = substr($param, 1, length($ebuf[1]) - 2);
|
||||
ssss }
|
||||
ssss elsif ($param =~ m/[0-9]/) {
|
||||
ssss # Numeric.
|
||||
ssss $param =~ s/[^0-9.]//g;
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # Garbage.
|
||||
ssss next;
|
||||
ssss }
|
||||
ssss
|
||||
ssss my @param = ($param);
|
||||
ssss
|
||||
ssss unless (!$blk) {
|
||||
ssss # We're inside a block.
|
||||
ssss if ($blk =~ m/@@@/) {
|
||||
ssss # We're inside a block with a parameter.
|
||||
ssss my @sblk = split('@@@', $blk);
|
||||
ssss
|
||||
ssss # Check to see if this config option already exists.
|
||||
ssss if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
||||
ssss # It does, so merely push this second one to the existing array.
|
||||
ssss push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # It doesn't, create it as an array.
|
||||
ssss @{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
||||
ssss }
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # We're inside a block with no parameter.
|
||||
ssss
|
||||
ssss # Check to see if this config option already exists.
|
||||
ssss if (defined $rs{$blk}{$ebuf[0]}) {
|
||||
ssss # It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$blk}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$blk}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're not inside a block.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# No semicolon space buffer.
|
||||
my @ebuf = split(' ', $buff);
|
||||
|
||||
if (!defined $ebuf[0]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined $ebuf[1]) {
|
||||
if ($ebuf[1] eq '{') {
|
||||
# This is the beginning of a block with no parameter.
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # It doesn't, create it as an array.
|
||||
ssss @{ $rs{$blk}{$ebuf[0]} } = @param;
|
||||
ssss }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # We're not inside a block.
|
||||
ssss
|
||||
ssss # Check to see if this config option already exists.
|
||||
ssss if (defined $rs{$ebuf[0]}) {
|
||||
ssss # It does, so merely push this second one to the existing array.
|
||||
ssss push(@{ $rs{$ebuf[0]} }, $param);
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # It doesn't, create it as an array.
|
||||
ssss @{ $rs{$ebuf[0]} } = @param;
|
||||
ssss }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # No semicolon space buffer.
|
||||
ssss my @ebuf = split(' ', $buff);
|
||||
ssss
|
||||
ssss if (!defined $ebuf[0]) {
|
||||
ssss # Garbage. Ignoring.
|
||||
ssss next;
|
||||
ssss }
|
||||
ssss
|
||||
ssss if (defined $ebuf[1]) {
|
||||
ssss if ($ebuf[1] eq '{') {
|
||||
ssss # This is the beginning of a block with no parameter.
|
||||
$blk = $ebuf[0];
|
||||
}
|
||||
elsif (defined $ebuf[2]) {
|
||||
if ($ebuf[2] eq '{') {
|
||||
# This is the beginning of a block with a parameter.
|
||||
my $param = $ebuf[1];
|
||||
$param =~ s/"//g;
|
||||
$blk = $ebuf[0].'@@@'.$param;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($ebuf[0] eq '}') {
|
||||
# This is the end of a block.
|
||||
$blk = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Return the configuration data.
|
||||
return %rs;
|
||||
ssss }
|
||||
ssss elsif (defined $ebuf[2]) {
|
||||
ssss if ($ebuf[2] eq '{') {
|
||||
ssss # This is the beginning of a block with a parameter.
|
||||
ssss my $param = $ebuf[1];
|
||||
ssss $param =~ s/"//g;
|
||||
ssss $blk = $ebuf[0].'@@@'.$param;
|
||||
ssss }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss if ($ebuf[0] eq '}') {
|
||||
ssss # This is the end of a block.
|
||||
ssss $blk = 0;
|
||||
ssss }
|
||||
ssss }
|
||||
ssss }
|
||||
ssss}
|
||||
ssss
|
||||
ssss# Return the configuration data.
|
||||
ssssreturn %rs;
|
||||
}
|
||||
|
||||
|
||||
|
||||
+250
-250
@@ -9,26 +9,26 @@ 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,
|
||||
ssss'001' => \&num001,
|
||||
ssss'005' => \&num005,
|
||||
ssss'353' => \&num353,
|
||||
ssss'432' => \&num432,
|
||||
ssss'433' => \&num433,
|
||||
ssss'438' => \&num438,
|
||||
ssss'465' => \&num465,
|
||||
ssss'471' => \&num471,
|
||||
ssss'473' => \&num473,
|
||||
ssss'474' => \&num474,
|
||||
ssss'475' => \&num475,
|
||||
ssss'477' => \&num477,
|
||||
ssss'JOIN' => \&cjoin,
|
||||
'KICK' => \&kick,
|
||||
'MODE' => \&mode,
|
||||
'NICK' => \&nick,
|
||||
'NOTICE' => \¬ice,
|
||||
ssss'NICK' => \&nick,
|
||||
ssss'NOTICE' => \¬ice,
|
||||
'PART' => \&part,
|
||||
'PRIVMSG' => \&privmsg,
|
||||
'QUIT' => \&quit,
|
||||
ssss'PRIVMSG' => \&privmsg,
|
||||
ssss'QUIT' => \&quit,
|
||||
'TOPIC' => \&topic,
|
||||
);
|
||||
|
||||
@@ -50,33 +50,33 @@ API::Std::event_add("on_topic");
|
||||
# Parse raw data.
|
||||
sub ircparse
|
||||
{
|
||||
my ($svr, $data) = @_;
|
||||
|
||||
# Split spaces into @ex.
|
||||
my @ex = split /\s+/, $data;
|
||||
ssssmy ($svr, $data) = @_;
|
||||
ssss
|
||||
ssss# Split spaces into @ex.
|
||||
ssssmy @ex = split /\s+/, $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]);
|
||||
}
|
||||
# If it's AUTHENTICATE
|
||||
elsif ($ex[0] eq 'AUTHENTICATE') {
|
||||
if (API::Std::mod_exists("SASLAuth")) {
|
||||
ssss# Make sure there is enough data.
|
||||
ssssif (defined $ex[0] and defined $ex[1]) {
|
||||
ssss # If it's a ping...
|
||||
ssss if ($ex[0] eq 'PING') {
|
||||
ssss # send a PONG.
|
||||
ssss Auto::socksnd($svr, "PONG ".$ex[1]);
|
||||
ssss }
|
||||
ssss # If it's AUTHENTICATE
|
||||
ssss elsif ($ex[0] eq 'AUTHENTICATE') {
|
||||
ssss if (API::Std::mod_exists("SASLAuth")) {
|
||||
M::SASLAuth::handle_authenticate($svr, @ex);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# otherwise, check %RAWC for ex[1].
|
||||
if (defined $RAWC{$ex[1]}) {
|
||||
&{ $RAWC{$ex[1]} }($svr, @ex);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
ssss }
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # otherwise, check %RAWC for ex[1].
|
||||
ssss if (defined $RAWC{$ex[1]}) {
|
||||
ssss &{ $RAWC{$ex[1]} }($svr, @ex);
|
||||
ssss }
|
||||
ssss }
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
###########################
|
||||
@@ -87,41 +87,41 @@ sub ircparse
|
||||
# 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};
|
||||
}
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
ssss
|
||||
ssss$got_001{$svr} = 1;
|
||||
ssss
|
||||
ssss# In case we don't get NICK from the server.
|
||||
ssssif (defined $botnick{$svr}{newnick}) {
|
||||
ssss $botnick{$svr}{nick} = $botnick{$svr}{newnick};
|
||||
ssss delete $botnick{$svr}{newnick};
|
||||
ssss}
|
||||
|
||||
# Trigger on_connect.
|
||||
API::Std::event_run("on_connect", $svr);
|
||||
|
||||
return 1;
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:005
|
||||
# Prefixes and channel modes.
|
||||
sub num005
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
# Find PREFIX and CHANMODES.
|
||||
foreach my $ex (@ex) {
|
||||
if ($ex =~ m/^PREFIX/xsm) {
|
||||
# Found PREFIX.
|
||||
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);
|
||||
}
|
||||
}
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
ssss
|
||||
ssss# Find PREFIX and CHANMODES.
|
||||
ssssforeach my $ex (@ex) {
|
||||
ssss if ($ex =~ m/^PREFIX/xsm) {
|
||||
ssss # Found PREFIX.
|
||||
ssss my $rpx = substr($ex, 8);
|
||||
ssss my ($pm, $pp) = split('\)', $rpx);
|
||||
ssss my @apm = split(//, $pm);
|
||||
ssss my @app = split(//, $pp);
|
||||
ssss foreach my $ppm (@apm) {
|
||||
ssss # Store data.
|
||||
ssss $csprefix{$svr}{$ppm} = shift(@app);
|
||||
ssss }
|
||||
ssss }
|
||||
elsif ($ex =~ m/^CHANMODES/xsm) {
|
||||
# Found CHANMODES.
|
||||
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
|
||||
@@ -134,186 +134,186 @@ sub num005
|
||||
# Modes without parameter.
|
||||
foreach (split(//, $mts)) { $chanmodes{$svr}{$_} = 4; }
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
ssss
|
||||
ssss# Get rid of the colon.
|
||||
ssss$ex[5] = substr($ex[5], 1);
|
||||
ssss# Delete the old chanusers hash if it exists.
|
||||
ssssdelete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
|
||||
ssss# Iterate through each user.
|
||||
ssssfor (my $i = 5; $i < scalar(@ex); $i++) {
|
||||
ssss my $fi = 0;
|
||||
ssss foreach (keys %{ $csprefix{$svr} }) {
|
||||
ssss # Check if the user has status in the channel.
|
||||
ssss if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) {
|
||||
ssss # He/she does. Lets set that.
|
||||
ssss if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) {
|
||||
ssss # If the user has multiple statuses.
|
||||
ssss $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_;
|
||||
ssss }
|
||||
ssss else {
|
||||
ssss # Or not.
|
||||
ssss $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
|
||||
ssss }
|
||||
ssss $fi = 1;
|
||||
ssss }
|
||||
ssss }
|
||||
ssss # They had status, so go to the next user.
|
||||
ssss next if $fi;
|
||||
ssss # They didn't, set them as a normal user.
|
||||
ssss if (!defined $chanusers{$svr}{$ex[4]}{lc($ex[$i])}) {
|
||||
ssss $chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1;
|
||||
ssss }
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, undef) = @_;
|
||||
ssss
|
||||
ssssif ($got_001{$svr}) {
|
||||
ssss err(3, "Got error from server[".$svr."]: Erroneous nickname.", 0);
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss err(2, "Got error from server[".$svr."] before 001: Erroneous nickname. Closing connection.", 0);
|
||||
ssss API::IRC::quit($svr, "An error occurred.");
|
||||
ssss}
|
||||
ssss
|
||||
ssssdelete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, undef) = @_;
|
||||
ssss
|
||||
ssssif (defined $botnick{$svr}{newnick}) {
|
||||
ssss API::IRC::nick($svr, $botnick{$svr}{newnick}."_");
|
||||
ssss delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
ssss
|
||||
ssssif (defined $botnick{$svr}{newnick}) {
|
||||
ssss API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub {
|
||||
ssss API::IRC::nick($Parser::IRC::botnick{$svr}{newnick});
|
||||
ssss delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
||||
ssss });
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:465
|
||||
# You're banned creep!
|
||||
sub num465
|
||||
{
|
||||
my ($svr, undef) = @_;
|
||||
|
||||
err(3, "Banned from ".$svr."! Closing link...", 0);
|
||||
|
||||
return 1;
|
||||
ssssmy ($svr, undef) = @_;
|
||||
ssss
|
||||
sssserr(3, "Banned from ".$svr."! Closing link...", 0);
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
ssss
|
||||
sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Channel is full.", 0);
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
ssss
|
||||
sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Channel is invite-only.", 0);
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
ssss
|
||||
sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0);
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
ssss
|
||||
sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0);
|
||||
ssss
|
||||
ssssreturn 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;
|
||||
ssssmy ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
ssss
|
||||
sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0);
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Parse: JOIN
|
||||
sub cjoin
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
ssssmy %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
my $chan = $ex[2];
|
||||
$chan =~ s/^://gxsm;
|
||||
|
||||
# Check if this is coming from ourselves.
|
||||
if ($src{nick} eq $botnick{$svr}{nick}) {
|
||||
$botchans{$svr}{lc $chan} = 1;
|
||||
API::Std::event_run("on_ucjoin", ($svr, $chan));
|
||||
}
|
||||
else {
|
||||
# It isn't. Update chanusers and trigger on_rcjoin.
|
||||
ssss
|
||||
ssss# Check if this is coming from ourselves.
|
||||
ssssif ($src{nick} eq $botnick{$svr}{nick}) {
|
||||
ssss $botchans{$svr}{lc $chan} = 1;
|
||||
ssss API::Std::event_run("on_ucjoin", ($svr, $chan));
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss # It isn't. Update chanusers and trigger on_rcjoin.
|
||||
$chanusers{$svr}{lc $chan}{$src{nick}} = 1;
|
||||
$src{svr} = $svr;
|
||||
API::Std::event_run("on_rcjoin", (\%src, $chan));
|
||||
}
|
||||
|
||||
return 1;
|
||||
ssss API::Std::event_run("on_rcjoin", (\%src, $chan));
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Parse: KICK
|
||||
@@ -454,35 +454,35 @@ sub mode
|
||||
# Parse: NICK
|
||||
sub nick
|
||||
{
|
||||
my ($svr, ($uex, undef, $nex)) = @_;
|
||||
ssssmy ($svr, ($uex, undef, $nex)) = @_;
|
||||
$nex = substr($nex, 1);
|
||||
|
||||
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. Update chanusers and trigger on_nick.
|
||||
ssssmy %src = API::IRC::usrc(substr($uex, 1));
|
||||
ssss
|
||||
ssss# Check if this is coming from ourselves.
|
||||
ssssif ($src{nick} eq $botnick{$svr}{nick}) {
|
||||
ssss # It is. Update bot nick hash.
|
||||
ssss $botnick{$svr}{nick} = $nex;
|
||||
ssss delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss # It isn't. Update chanusers and trigger on_nick.
|
||||
foreach my $chk (keys %{ $chanusers{$svr} }) {
|
||||
if (defined $chanusers{$svr}{$chk}{$src{nick}}) {
|
||||
$chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{nick}};
|
||||
delete $chanusers{$svr}{$chk}{$src{nick}};
|
||||
}
|
||||
}
|
||||
API::Std::event_run("on_nick", ($svr, \%src, $nex));
|
||||
}
|
||||
|
||||
return 1;
|
||||
ssss API::Std::event_run("on_nick", ($svr, \%src, $nex));
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Parse: NOTICE
|
||||
sub notice
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
|
||||
# Ensure this is coming from a user rather than a server.
|
||||
if ($ex[0] !~ m/!/xsm) { return; }
|
||||
@@ -493,11 +493,11 @@ sub notice
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
$src{svr} = $svr;
|
||||
|
||||
ssss
|
||||
# Send it off.
|
||||
API::Std::event_run("on_notice", (\%src, $target, @ex));
|
||||
|
||||
return 1;
|
||||
ssssAPI::Std::event_run("on_notice", (\%src, $target, @ex));
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Parse: PART
|
||||
@@ -529,33 +529,33 @@ sub part
|
||||
# Parse: PRIVMSG
|
||||
sub privmsg
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
my %data = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
# Ensure this is coming from a user rather than a server.
|
||||
if ($ex[0] !~ m/!/xsm) { return; }
|
||||
|
||||
my @argv;
|
||||
for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||
push(@argv, $ex[$i]);
|
||||
}
|
||||
$data{svr} = $svr;
|
||||
|
||||
my ($cmd, $cprefix, $rprefix);
|
||||
# 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.
|
||||
ssssfor (my $i = 4; $i < scalar(@ex); $i++) {
|
||||
ssss push(@argv, $ex[$i]);
|
||||
ssss}
|
||||
ssss$data{svr} = $svr;
|
||||
ssss
|
||||
ssssmy ($cmd, $cprefix, $rprefix);
|
||||
ssss# Check if it's to a channel or to us.
|
||||
ssssif (lc($ex[2]) eq lc($botnick{$svr}{nick})) {
|
||||
ssss # It is coming to us in a private message.
|
||||
|
||||
# Ensure it's a valid length.
|
||||
if (length($ex[3]) > 1) {
|
||||
$cmd = uc(substr($ex[3], 1));
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
ssss $cmd = uc(substr($ex[3], 1));
|
||||
ssss if (defined $API::Std::CMDS{$cmd}) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
ssss if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is private or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
ssss if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command requires a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
@@ -575,26 +575,26 @@ sub privmsg
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
}
|
||||
ssss }
|
||||
ssss }
|
||||
}
|
||||
|
||||
# Trigger event on_uprivmsg.
|
||||
ssss # Trigger event on_uprivmsg.
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_uprivmsg", (\%data, @ex));
|
||||
}
|
||||
else {
|
||||
# It is coming to us in a channel message.
|
||||
$data{chan} = $ex[2];
|
||||
ssss API::Std::event_run("on_uprivmsg", (\%data, @ex));
|
||||
ssss}
|
||||
sssselse {
|
||||
ssss # It is coming to us in a channel message.
|
||||
ssss $data{chan} = $ex[2];
|
||||
# Ensure it's a valid length before continuing.
|
||||
if (length($ex[3]) > 1) {
|
||||
ssss if (length($ex[3]) > 1) {
|
||||
$cprefix = (conf_get("fantasy_pf"))[0][0];
|
||||
$rprefix = substr($ex[3], 1, 1);
|
||||
$cmd = uc(substr($ex[3], 2));
|
||||
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
|
||||
ssss $rprefix = substr($ex[3], 1, 1);
|
||||
ssss $cmd = uc(substr($ex[3], 2));
|
||||
ssss if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
ssss if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is public or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
@@ -641,24 +641,24 @@ sub privmsg
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
ssss }
|
||||
}
|
||||
|
||||
# Trigger event on_cprivmsg.
|
||||
ssss # Trigger event on_cprivmsg.
|
||||
my $target = $ex[2]; delete $data{chan};
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
|
||||
}
|
||||
|
||||
return 1;
|
||||
ssss API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
# Parse: QUIT
|
||||
sub quit
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
ssssmy %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
# Set $msg to the quit message.
|
||||
my $msg = 0;
|
||||
@@ -680,23 +680,23 @@ sub quit
|
||||
# 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;
|
||||
ssssmy ($svr, @ex) = @_;
|
||||
ssssmy %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
ssss
|
||||
ssss# Ignore it if it's coming from us.
|
||||
ssssif (lc($src{nick}) ne lc($botnick{$svr}{nick})) {
|
||||
ssss $src{chan} = $ex[2];
|
||||
ssss my (@argv);
|
||||
ssss $argv[0] = substr($ex[3], 1);
|
||||
ssss if (defined $ex[4]) {
|
||||
ssss for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||
ssss push(@argv, $ex[$i]);
|
||||
ssss }
|
||||
ssss }
|
||||
ssss API::Std::event_run("on_topic", ($svr, \%src, @argv));
|
||||
ssss}
|
||||
ssss
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
+50
-50
@@ -10,56 +10,56 @@ use API::Log qw(dbug alog);
|
||||
# Parser.
|
||||
sub parse
|
||||
{
|
||||
my ($lang) = @_;
|
||||
|
||||
# Check that the language file exists.
|
||||
unless (-e "$Auto::Bin/../lang/$lang.alf") {
|
||||
# Otherwise, use English.
|
||||
dbug "Language '$lang' not found. Using English.";
|
||||
alog "Language '$lang' not found. Using English.";
|
||||
$lang = "en";
|
||||
}
|
||||
|
||||
# Open, read and close the file.
|
||||
open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0;
|
||||
my @fbuf = <$FALF>;
|
||||
close $FALF;
|
||||
|
||||
# Iterate the file buffer.
|
||||
foreach my $buff (@fbuf) {
|
||||
if (defined $buff) {
|
||||
# Space buffer.
|
||||
my @sbuf = split(' ', $buff);
|
||||
|
||||
# Check for all required values.
|
||||
if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
||||
# Missing a value.
|
||||
next;
|
||||
}
|
||||
|
||||
# Make sure the first value is "msge".
|
||||
if ($sbuf[0] ne "msge") {
|
||||
# It isn't.
|
||||
next;
|
||||
}
|
||||
|
||||
my $id = $sbuf[1];
|
||||
my $val = $sbuf[2];
|
||||
|
||||
# If the translation is multi-word, continue to parse.
|
||||
if (defined $sbuf[3]) {
|
||||
for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
||||
$val .= " ".$sbuf[$i];
|
||||
}
|
||||
}
|
||||
|
||||
# Save to memory.
|
||||
$id =~ s/"//g;
|
||||
$val =~ s/"//g;
|
||||
$API::Std::LANGE{$id} = $val;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
ssssmy ($lang) = @_;
|
||||
ssss
|
||||
ssss# Check that the language file exists.
|
||||
ssssunless (-e "$Auto::Bin/../lang/$lang.alf") {
|
||||
ssss # Otherwise, use English.
|
||||
ssss dbug "Language '$lang' not found. Using English.";
|
||||
ssss alog "Language '$lang' not found. Using English.";
|
||||
ssss $lang = "en";
|
||||
ssss}
|
||||
ssss
|
||||
ssss# Open, read and close the file.
|
||||
ssssopen(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0;
|
||||
ssssmy @fbuf = <$FALF>;
|
||||
ssssclose $FALF;
|
||||
ssss
|
||||
ssss# Iterate the file buffer.
|
||||
ssssforeach my $buff (@fbuf) {
|
||||
ssss if (defined $buff) {
|
||||
ssss # Space buffer.
|
||||
ssss my @sbuf = split(' ', $buff);
|
||||
ssss
|
||||
ssss # Check for all required values.
|
||||
ssss if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
||||
ssss # Missing a value.
|
||||
ssss next;
|
||||
ssss }
|
||||
ssss
|
||||
ssss # Make sure the first value is "msge".
|
||||
ssss if ($sbuf[0] ne "msge") {
|
||||
ssss # It isn't.
|
||||
ssss next;
|
||||
ssss }
|
||||
ssss
|
||||
ssss my $id = $sbuf[1];
|
||||
ssss my $val = $sbuf[2];
|
||||
ssss
|
||||
ssss # If the translation is multi-word, continue to parse.
|
||||
ssss if (defined $sbuf[3]) {
|
||||
ssss for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
||||
ssss $val .= " ".$sbuf[$i];
|
||||
ssss }
|
||||
ssss }
|
||||
ssss
|
||||
ssss # Save to memory.
|
||||
ssss $id =~ s/"//g;
|
||||
ssss $val =~ s/"//g;
|
||||
ssss $API::Std::LANGE{$id} = $val;
|
||||
ssss }
|
||||
ssss}
|
||||
ssssreturn 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
Reference in new issue
Block a user