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

Large amounts of code cleanup.

Browse Source
This commit is contained in:
Elijah Perrault committed 2011-03-19 22:46:45 -06:00
1 parent f2deae219d
commit 3e1e2e98be
18 files changed
+286 -243
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

bin/auto
+13 -13
View File
@@ -218,13 +218,13 @@ our ($APID, %TIMERS);
Lib::Auto::checkver();
# Include IPv6 if Auto was built for it.
if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6; }
if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6 }
# Include SSL if Auto was built for it.
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; }
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL }
# Parse configuration file.
my $configfile = 'auto.conf';
if ($USECONFIG) { $configfile = $USECONFIG; }
if ($USECONFIG) { $configfile = $USECONFIG }
say "* Parsing configuration file $configfile...";
our $CONF = Parser::Config->new($configfile) or err(1, 'Failed to parse configuration file!', 1);
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
@@ -269,8 +269,8 @@ our $DB;
given (lc((conf_get('database:format'))[0][0])) {
when ('sqlite') {
# SQLite.
if ($ENFEAT !~ /sqlite/) { err(2, 'Auto not built with SQLite support. Aborting.', 1); }
if (!conf_get('database:filename')) { err(2, 'Missing required configuration value database:filename. Aborting.', 1); }
if ($ENFEAT !~ /sqlite/) { err(2, 'Auto not built with SQLite support. Aborting.', 1) }
if (!conf_get('database:filename')) { err(2, 'Missing required configuration value database:filename. Aborting.', 1) }
# Import DBD::SQLite.
require DBD::SQLite;
@@ -286,9 +286,9 @@ given (lc((conf_get('database:format'))[0][0])) {
}
when ('mysql') {
# MySQL.
if ($ENFEAT !~ /mysql/) { err(2, 'Auto not built with MySQL support. Aborting.', 1); }
if ($ENFEAT !~ /mysql/) { err(2, 'Auto not built with MySQL support. Aborting.', 1) }
my @reqcval = qw(database:host database:name database:username database:password);
foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1); } }
foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
undef @reqcval;
# Import DBD::mysql.
@@ -309,8 +309,8 @@ given (lc((conf_get('database:format'))[0][0])) {
# CSV no work. :(
#when ('csv') {
# # CSV.
# if ($ENFEAT !~ /csv/) { err(2, 'Auto not built with CSV support.', 1); }
# if (!conf_get('database:dir')) { err(2, 'Missing required configuration value database:dir. Aborting.', 1); }
# if ($ENFEAT !~ /csv/) { err(2, 'Auto not built with CSV support.', 1) }
# if (!conf_get('database:dir')) { err(2, 'Missing required configuration value database:dir. Aborting.', 1) }
#
# # Import DBD::CSV.
# require DBD::CSV;
@@ -320,9 +320,9 @@ given (lc((conf_get('database:format'))[0][0])) {
#}
when ('pgsql') {
# PostgreSQL.
if ($ENFEAT !~ /pgsql/) { err(2, 'Auto not built with PostgreSQL support. Aborting.', 1); }
if ($ENFEAT !~ /pgsql/) { err(2, 'Auto not built with PostgreSQL support. Aborting.', 1) }
my @reqcval = qw(database:name database:host database:username database:password);
foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1); } }
foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
undef @reqcval;
# Import DBD::Pg.
@@ -341,7 +341,7 @@ given (lc((conf_get('database:format'))[0][0])) {
}
}
# Unknown database format.
default { err(2, 'Unknown database format \''.lc((conf_get('database:format'))[0][0]).'\'. Aborting.', 1); }
default { err(2, 'Unknown database format \''.lc((conf_get('database:format'))[0][0]).'\'. Aborting.', 1) }
}
@@ -509,7 +509,7 @@ while (1) {
# Figure out what network is sending us data.
my $sockid;
foreach (keys %SOCKET) {
if ($SOCKET{$_} eq $sock) { $sockid = $_; }
if ($SOCKET{$_} eq $sock) { $sockid = $_ }
}
# Read the data.
my $idata;
bin/buildmod
+48 -5
View File
@@ -8,10 +8,53 @@ use strict;
use warnings;
use English qw(-no_match_vars);
use FindBin qw($Bin);
use Cwd;
use Pod::Html;
use Pod::Man;
our $Bin = $Bin;
my ($UPREFIX, %bin);
$bin{cwd} = getcwd;
if (!-e "$Bin/../build/syswide") {
# Must be a custom PREFIX install.
$bin{etc} = "$bin{cwd}/etc";
$bin{var} = "$bin{cwd}/var";
if (!-e "$Bin/lib/Lib/Auto.pm") {
# Must be a system wide install.
$bin{lib} = "$Bin/../lib/autobot/3.0.0";
$bin{bld} = "$bin{lib}/build";
$bin{lng} = "$bin{lib}/lang";
$bin{mod} = "$bin{lib}/modules";
}
else {
# Or not.
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
}
$UPREFIX = 1;
}
else {
# Must be a standard install.
$bin{etc} = "$Bin/../etc";
$bin{var} = "$Bin/../var";
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
$UPREFIX = 0;
}
# Get the name of the network this cert is for.
print 'Network Name: ';
my $net = <STDIN>;
$net =~ s/(\r|\n)//gxsm;
say q{};
# Make sure etc/certs/ exists.
if (!-d "$bin{etc}") { mkdir "$bin{etc}", 0755 }
our $VERSION = 1.00;
# Get module parameter.
@@ -95,17 +138,17 @@ foreach (@pars) {
foreach my $cpanmod (@vals) {
$res = eval('require '.$cpanmod.'; 1;');
say ' '.$cpanmod.': '.(($res) ? 'Found' : 'Not Found');
if (!$res) { $die = 1; }
if (!$res) { $die = 1 }
}
print $RS;
if ($die) { say 'Failed to build '.$module.'.'; exit; }
if ($die) { say 'Failed to build '.$module.'.'; exit }
}
when ('perl') {
print 'Checking Perl version..... '.$PERL_VERSION.' - ';
if ($] < $val) { $die = 1; }
if ($] < $val) { $die = 1 }
say (($die) ? 'Not OK' : 'OK');
if ($die) { say 'Failed to build '.$module.'.'; exit; }
if ($die) { say 'Failed to build '.$module.'.'; exit }
}
}
}
@@ -119,7 +162,7 @@ close $FMPH;
say 'Generating documentation.....';
my $podbuf;
foreach my $line (@MPBUF) {
if (!defined $line) { $line = ' '; }
if (!defined $line) { $line = ' ' }
$line =~ s/(\r|\n)//g;
if ($line eq '__END__') {
bin/genssl
+2 -2
View File
@@ -53,8 +53,8 @@ $net =~ s/(\r|\n)//gxsm;
say q{};
# Make sure etc/certs/ exists.
if (!-d "$bin{etc}") { mkdir "$bin{etc}", 0755; }
if (!-d "$bin{etc}/certs") { mkdir "$bin{etc}/certs", 0755; }
if (!-d "$bin{etc}") { mkdir "$bin{etc}", 0755 }
if (!-d "$bin{etc}/certs") { mkdir "$bin{etc}/certs", 0755 }
# Generate key and cert.
system "openssl req -nodes -newkey rsa:2048 -keyout $bin{etc}/certs/$net.key -x509 -days 3650 -out $bin{etc}/certs/$net.cert";
install
+1 -1
View File
@@ -12,7 +12,7 @@ use FindBin qw($Bin);
use File::Copy;
use File::Path qw(make_path remove_tree);
our $Bin = $Bin;
BEGIN { unshift(@INC, "$Bin/lib"); }
BEGIN { unshift(@INC, "$Bin/lib") }
use Lib::Install;
# Installation script.
lib/API/IRC.pm
+4 -4
View File
@@ -22,10 +22,10 @@ sub ban {
# Prepare the mask we're going to ban.
my $mask;
given ($cbt) {
when (1) { $mask = '*!*@'.$user->{host}; }
when (2) { $mask = $user->{nick}.'!*@*'; }
when (3) { $mask = q{*!}.$user->{user}.q{@}.$user->{host}; }
when (4) { $mask = $user->{nick}.q{!*}.$user->{user}.q{@}.$user->{host}; }
when (1) { $mask = '*!*@'.$user->{host} }
when (2) { $mask = $user->{nick}.'!*@*' }
when (3) { $mask = q{*!}.$user->{user}.q{@}.$user->{host} }
when (4) { $mask = $user->{nick}.q{!*}.$user->{user}.q{@}.$user->{host} }
when (5) {
my @hd = split m/[\.]/, $user->{host};
shift @hd;
lib/API/Std.pm
+19 -19
View File
@@ -22,13 +22,13 @@ sub mod_init {
# 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.'...');
if (keys %Auto::SOCKET) { API::Log::slog('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 !~ m/^3\.0\.0a(7|8)$/xsm) {
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.');
if (keys %Auto::SOCKET) { API::Log::slog('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;
}
@@ -44,7 +44,7 @@ sub mod_init {
API::Log::dbug('MODULES: '.$name.' successfully loaded.');
API::Log::alog('MODULES: '.$name.' successfully loaded.');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.'); }
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.') }
return 1;
}
@@ -52,7 +52,7 @@ sub mod_init {
# 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{.});
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}); }
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}) }
return;
}
@@ -62,7 +62,7 @@ sub mod_init {
sub mod_exists {
my ($name) = @_;
if (defined $API::Std::MODULE{$name}) { return 1; }
if (defined $API::Std::MODULE{$name}) { return 1 }
return;
}
@@ -74,13 +74,13 @@ sub mod_void {
# Log/debug.
API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
if (keys %Auto::SOCKET) { API::Log::slog('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?');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?'); }
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?') }
return;
}
@@ -93,14 +93,14 @@ sub mod_void {
delete $MODULE{$module};
API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
if (keys %Auto::SOCKET) { API::Log::slog('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{.});
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}); }
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}) }
return;
}
}
@@ -110,8 +110,8 @@ sub cmd_add {
my ($cmd, $lvl, $priv, $help, $sub) = @_;
$cmd = uc $cmd;
if (defined $API::Std::CMDS{$cmd}) { return; }
if ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
if (defined $API::Std::CMDS{$cmd}) { return }
if ($lvl =~ m/[^0-3]/sm) { return } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
$API::Std::CMDS{$cmd}{lvl} = $lvl;
$API::Std::CMDS{$cmd}{help} = $help;
@@ -173,7 +173,7 @@ sub event_run {
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
foreach my $hk (keys %{ $HOOKS{lc $event} }) {
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
if ($ri == -1) { last; }
if ($ri == -1) { last }
}
}
@@ -227,7 +227,7 @@ sub timer_add {
if (!defined $Auto::TIMERS{$name}) {
$Auto::TIMERS{$name}{type} = $type;
$Auto::TIMERS{$name}{time} = time + $time;
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time }
$Auto::TIMERS{$name}{sub} = $sub;
return 1;
}
@@ -345,7 +345,7 @@ sub match_user {
my (%user) = @_;
# Get data from config.
if (!conf_get('user')) { return; }
if (!conf_get('user')) { return }
my %uhp = conf_get('user');
foreach my $userkey (keys %uhp) {
@@ -376,14 +376,14 @@ sub match_user {
if (defined $Auto::SOCKET{$svr}) {
if ($ccnm eq 'CURRENT' and defined $user{chan}) {
if (defined $State::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
if ($State::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
if ($State::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
}
}
else {
foreach my $bcj (keys %{ $Proto::IRC::botchans{$svr} }) {
if (API::IRC::match_mask($bcj, $ccnm)) {
if (defined $State::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
if ($State::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
if ($State::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
}
}
}
@@ -405,7 +405,7 @@ sub has_priv {
if (defined $Auto::PRIVILEGES{$cups}) {
foreach (@{ $Auto::PRIVILEGES{$cups} }) {
if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
if ($_ eq $cpriv or $_ eq 'ALL') { return 1 }
}
}
}
@@ -508,8 +508,8 @@ sub awarn {
sub fpfmt {
my ($path) = @_;
if ($path =~ m/\s/xsm) { return "\"$path\""; }
else { return $path; }
if ($path =~ m/\s/xsm) { return "\"$path\"" }
else { return $path }
}
lib/Core/IRC.pm
+5 -5
View File
@@ -33,7 +33,7 @@ hook_add("on_quit", "quit_update_chanusers", sub {
# Delete the user from all channels.
foreach my $ccu (keys %{ $State::IRC::chanusers{$src{svr}}}) {
if (defined $State::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}) { delete $State::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}; }
if (defined $State::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}) { delete $State::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}} }
}
return 1;
@@ -158,13 +158,13 @@ hook_add('on_isupport', 'core.prefixchanmode.getdata', sub {
# Found CHANMODES.
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
# List modes.
foreach (split(//, $mtl)) { $Proto::IRC::chanmodes{$svr}{$_} = 1; }
foreach (split(//, $mtl)) { $Proto::IRC::chanmodes{$svr}{$_} = 1 }
# Modes with parameter.
foreach (split(//, $mtp)) { $Proto::IRC::chanmodes{$svr}{$_} = 2; }
foreach (split(//, $mtp)) { $Proto::IRC::chanmodes{$svr}{$_} = 2 }
# Modes with parameter when +.
foreach (split(//, $mtpp)) { $Proto::IRC::chanmodes{$svr}{$_} = 3; }
foreach (split(//, $mtpp)) { $Proto::IRC::chanmodes{$svr}{$_} = 3 }
# Modes without parameter.
foreach (split(//, $mts)) { $Proto::IRC::chanmodes{$svr}{$_} = 4; }
foreach (split(//, $mts)) { $Proto::IRC::chanmodes{$svr}{$_} = 4 }
}
}
lib/Core/IRC/Users.pm
+2 -2
View File
@@ -79,7 +79,7 @@ hook_add('on_kick', 'ircusers.onkick', sub {
my $ri = 0;
foreach my $chan (keys %{$State::IRC::chanusers{$src->{svr}}}) {
if ($chan ne $kchan) {
if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $user}) { $ri++; last; }
if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $user}) { $ri++; last }
}
}
if (!$ri) {
@@ -102,7 +102,7 @@ hook_add('on_part', 'ircusers.onpart', sub {
my $ri = 0;
foreach my $chan (keys %{$State::IRC::chanusers{$src->{svr}}}) {
if ($chan ne $pchan) {
if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $src->{nick}}) { $ri++; last; }
if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $src->{nick}}) { $ri++; last }
}
}
if (!$ri) {
lib/Lib/Auto.pm
+13 -13
View File
@@ -123,7 +123,7 @@ sub rehash
if (conf_get('module')) {
alog '* Loading modules...';
foreach (@{ (conf_get('module'))[0] }) {
if (!API::Std::mod_exists($_)) { Auto::mod_load($_); }
if (!API::Std::mod_exists($_)) { Auto::mod_load($_) }
}
}
@@ -166,15 +166,15 @@ sub ircsock {
# Set IPv6/SSL data.
my $use6 = 0;
my $usessl = 0;
if (defined $cdata->{'ipv6'}[0]) { $use6 = $cdata->{'ipv6'}[0]; }
if (defined $cdata->{'ssl'}[0]) { $usessl = $cdata->{'ssl'}[0]; }
if (defined $cdata->{'ipv6'}[0]) { $use6 = $cdata->{'ipv6'}[0] }
if (defined $cdata->{'ssl'}[0]) { $usessl = $cdata->{'ssl'}[0] }
# Check for appropriate build data.
if ($usessl) {
if ($Auto::ENFEAT !~ m/ssl/ixsm) { err(2, '** Auto not built with SSL support: Aborting connection to '.$svrname, 0); return; }
if ($Auto::ENFEAT !~ m/ssl/ixsm) { err(2, '** Auto not built with SSL support: Aborting connection to '.$svrname, 0); return }
}
if ($use6) {
if ($Auto::ENFEAT !~ m/ipv6/ixsm) { err(2, '** Auto not built with IPv6 support: Aborting connection to '.$svrname, 0); return; }
if ($Auto::ENFEAT !~ m/ipv6/ixsm) { err(2, '** Auto not built with IPv6 support: Aborting connection to '.$svrname, 0); return }
}
# CertFP.
@@ -189,7 +189,7 @@ sub ircsock {
$conndata{'SSL_key_file'} = "$Auto::bin{etc}/certs/".$cdata->{'certfp_key'}[0];
}
if (defined $cdata->{'certfp_pass'}[0]) {
$conndata{'SSL_passwd_cb'} = sub { return $cdata->{'certfp_pass'}[0]; };
$conndata{'SSL_passwd_cb'} = sub { return $cdata->{'certfp_pass'}[0] };
}
}
}
@@ -238,9 +238,9 @@ sub ircsock {
# Shutdown.
hook_add('on_shutdown', 'shutdown.core_cleanup', sub {
if (defined $Auto::DB) { $Auto::DB->disconnect; }
if ($Auto::UPREFIX) { if (-e "$Auto::bin{cwd}/auto.pid") { unlink "$Auto::bin{cwd}/auto.pid"; } }
else { if (-e "$Auto::Bin/auto.pid") { unlink "$Auto::Bin/auto.pid"; } }
if (defined $Auto::DB) { $Auto::DB->disconnect }
if ($Auto::UPREFIX) { if (-e "$Auto::bin{cwd}/auto.pid") { unlink "$Auto::bin{cwd}/auto.pid" } }
else { if (-e "$Auto::Bin/auto.pid") { unlink "$Auto::Bin/auto.pid" } }
return 1;
});
@@ -253,7 +253,7 @@ sub signal_term
{
API::Std::event_run('on_sigterm');
API::Std::event_run('on_shutdown');
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGTERM'); }
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGTERM') }
dbug '!!! Caught SIGTERM; terminating...';
alog '!!! Caught SIGTERM; terminating...';
sleep 1;
@@ -265,7 +265,7 @@ sub signal_int
{
API::Std::event_run('on_sigint');
API::Std::event_run('on_shutdown');
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGINT'); }
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGINT') }
dbug '!!! Caught SIGINT; terminating...';
alog '!!! Caught SIGINT; terminating...';
sleep 1;
@@ -288,7 +288,7 @@ sub signal_perlwarn
my ($warnmsg) = @_;
$warnmsg =~ s/(\n|\r)//xsmg;
alog 'Perl Warning: '.$warnmsg;
if ($Auto::DEBUG) { say 'Perl Warning: '.$warnmsg; }
if ($Auto::DEBUG) { say 'Perl Warning: '.$warnmsg }
return 1;
}
@@ -300,7 +300,7 @@ sub signal_perldie
return if $EXCEPTIONS_BEING_CAUGHT;
alog 'Perl Fatal: '.$diemsg.' -- Terminating program!';
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'A fatal error occurred!'); }
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'A fatal error occurred!') }
API::Std::event_run('on_shutdown');
sleep 1;
say 'FATAL: '.$diemsg;
lib/Proto/IRC.pm
+6 -6
View File
@@ -318,7 +318,7 @@ sub cap {
}
# Send CAP REQ/CAP END based on what both we and the server support.
if (!$capout) { Auto::socksnd($svr, 'CAP END'); }
if (!$capout) { Auto::socksnd($svr, 'CAP END') }
else {
$capout = substr $capout, 1;
Auto::socksnd($svr, "CAP REQ :$capout");
@@ -406,7 +406,7 @@ sub kick {
}
else {
# We weren't. Update chanusers and trigger on_kick.
if (defined $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]}; }
if (defined $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $State::IRC::chanusers{$svr}{$ex[2]}{$ex[3]} }
API::Std::event_run("on_kick", (\%src, $ex[2], $ex[3], $msg));
}
@@ -490,9 +490,9 @@ sub mode {
else {
# It is not. Lets adjust arguments accordingly.
if (defined $chanmodes{$svr}{$maf}) {
if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex; }
if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex }
if ($chanmodes{$svr}{$maf} == 3) {
if ($op == 1) { shift @ex; }
if ($op == 1) { shift @ex }
}
}
}
@@ -543,7 +543,7 @@ sub notice {
my ($svr, @ex) = @_;
# Ensure this is coming from a user rather than a server.
if ($ex[0] !~ m/!/xsm) { return; }
if ($ex[0] !~ m/!/xsm) { return }
# Prepare all the data.
my %src = API::IRC::usrc(substr $ex[0], 1);
@@ -568,7 +568,7 @@ sub part {
# Check if it's from us or someone else.
if ($src{nick} eq $botinfo{$svr}{nick}) {
# Delete this channel from botchans.
if ($botchans{$svr}{$ex[2]}) { delete $botchans{$svr}{$ex[2]}; }
if ($botchans{$svr}{$ex[2]}) { delete $botchans{$svr}{$ex[2]} }
# Trigger on_upart.
API::Std::event_run('on_upart', ($svr, $ex[2]));
}
modules/BotStats.pm
+5 -5
View File
@@ -47,10 +47,10 @@ sub stats {
# Get uptime data.
my $uptime = time - $Auto::STARTTIME;
my $days = my $hours = my $mins = my $secs = 0;
while ($uptime >= 86_400) { $days++; $uptime -= 86_400; }
while ($uptime >= 3_600) { $hours++; $uptime -= 3_600; }
while ($uptime >= 60) { $mins++; $uptime -= 60; }
while ($uptime >= 1) { $secs++; $uptime--; }
while ($uptime >= 86_400) { $days++; $uptime -= 86_400 }
while ($uptime >= 3_600) { $hours++; $uptime -= 3_600 }
while ($uptime >= 60) { $mins++; $uptime -= 60 }
while ($uptime >= 1) { $secs++; $uptime-- }
# Return it.
privmsg($src->{svr}, $target, "I have been running for \2$days\2 days, \2$hours\2 hours, \2$mins\2 minutes, and \2$secs\2 seconds.");
@@ -62,7 +62,7 @@ sub stats {
my $nets = keys %Auto::SOCKET;
my $chans;
foreach my $net (keys %Auto::SOCKET) {
foreach (keys %{$Proto::IRC::botchans{$net}}) { $chans++; }
foreach (keys %{$Proto::IRC::botchans{$net}}) { $chans++ }
}
# Return network/channel data.
modules/ChanTopics.pm
+1 -1
View File
@@ -11,7 +11,7 @@ use API::IRC qw(notice topic);
sub _init
{
# PostgreSQL is not supported.
if ($Auto::ENFEAT =~ /pgsql/) { err(3, 'Unable to load ChanTopics: PostgreSQL is not supported.', 0); return; }
if ($Auto::ENFEAT =~ /pgsql/) { err(3, 'Unable to load ChanTopics: PostgreSQL is not supported.', 0); return }
# Create database table if it's missing.
$Auto::DB->do('CREATE TABLE IF NOT EXISTS topics (net TEXT, chan TEXT, topic TEXT, divider TEXT, owner TEXT, verb TEXT, status TEXT, other TEXT, static TEXT)') or print "$!\n" and return;
modules/Eval.pm
+1 -1
View File
@@ -44,7 +44,7 @@ sub cmd_eval {
# Evaluate the expression and return the result.
my $expr = join ' ', @argv;
my $result = eval($expr);
if (!defined $result) { $result = 'None'; }
if (!defined $result) { $result = 'None' }
if ($EVAL_ERROR) {
$result = $EVAL_ERROR;
$result =~ s/(\r|\n)//gxsm;
modules/Greet.pm
+2 -2
View File
@@ -12,7 +12,7 @@ use API::IRC qw(privmsg notice);
sub _init
{
# Not compatible with PostgreSQL.
if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load Greet: PostgreSQL is not supported.', 0); return; }
if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load Greet: PostgreSQL is not supported.', 0); return }
# Create the `greets` table.
$Auto::DB->do('CREATE TABLE IF NOT EXISTS greets (nick TEXT, greet TEXT)') or return;
@@ -100,7 +100,7 @@ sub cmd_greet
$Auto::DB->do('DELETE FROM greets WHERE nick = "'.$nick.'"') or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
notice($src->{svr}, $src->{nick}, "Greet for \002$nick\002 successfully deleted.");
}
default { notice($src->{svr}, $src->{nick}, "Unknown action \002$argv[0]\002. \002Syntax:\002 GREET (ADD|DEL)"); return; }
default { notice($src->{svr}, $src->{nick}, "Unknown action \002$argv[0]\002. \002Syntax:\002 GREET (ADD|DEL)"); return }
}
return 1;
modules/QDB.pm
+6 -6
View File
@@ -15,7 +15,7 @@ sub _init
cmd_add('QDB', 0, 0, \%M::QDB::HELP_QDB, \&M::QDB::cmd_qdb) or return;
# Check the database format. Fail to load if it's PostgreSQL.
if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load QDB: PostgreSQL is not supported.', 0); return; }
if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load QDB: PostgreSQL is not supported.', 0); return }
# Check for database table.
$Auto::DB->do('CREATE TABLE IF NOT EXISTS qdb (quoteid INTEGER PRIMARY KEY, creator TEXT, time INTEGER, quote TEXT)') or return;
@@ -82,7 +82,7 @@ sub cmd_qdb
my @data = $dbq->fetchrow_array;
# Check for an unusual issue.
if (!defined $data[1]) { notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.'); return; }
if (!defined $data[1]) { notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.'); return }
# Send it back.
privmsg($src->{svr}, $src->{chan}, "\002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
@@ -103,7 +103,7 @@ sub cmd_qdb
# Random number.
my $rand = int(rand($count));
if ($rand == 0) { $rand = $count; }
if ($rand == 0) { $rand = $count }
# Get quote.
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE quoteid = ?') or
@@ -157,7 +157,7 @@ sub cmd_qdb
privmsg($src->{svr}, $src->{chan}, "\2".scalar @BUFFER."\2 results for \2$expr\2:");
my $i = 0;
my $si = 3;
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1; }
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1 }
while ($i <= $si) {
if (!defined $BUFFER[0]) {
last;
@@ -177,7 +177,7 @@ sub cmd_qdb
# Return four quotes.
my $i = 0;
my $si = 3;
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1; }
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1 }
while ($i <= $si) {
if (!defined $BUFFER[0]) {
last;
@@ -204,7 +204,7 @@ sub cmd_qdb
notice($src->{svr}, $src->{nick}, (($dbq) ? 'Done.' : trans('An error occurred').q{.}));
}
default { notice($src->{svr}, $src->{nick}, "Unknown action \002".uc($argv[0])."\002. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]"); return; }
default { notice($src->{svr}, $src->{nick}, "Unknown action \002".uc($argv[0])."\002. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]"); return }
}
return 1;
modules/SASLAuth.pm
+3 -3
View File
@@ -14,11 +14,11 @@ use API::IRC qw(privmsg);
sub _init
{
# Check if this Auto was built with SASL support.
if ($Auto::ENFEAT !~ m/sasl/xsm) { err(2, 'Auto was not built with SASL support. Aborting SASLAuth.', 0) and return; }
if ($Auto::ENFEAT !~ m/sasl/xsm) { err(2, 'Auto was not built with SASL support. Aborting SASLAuth.', 0) and return }
# Add sasl to supported CAP for servers configured with SASL.
my %servers = conf_get('server');
foreach my $svr (keys %servers) {
if (conf_get("server:$svr:sasl_username") and conf_get("server:$svr:sasl_password") and conf_get("server:$svr:sasl_timeout")) { $Proto::IRC::cap{$svr} .= ' sasl'; }
if (conf_get("server:$svr:sasl_username") and conf_get("server:$svr:sasl_password") and conf_get("server:$svr:sasl_timeout")) { $Proto::IRC::cap{$svr} .= ' sasl' }
}
# Hook for when CAP ACK sasl is received.
hook_add('on_capack', 'sasl.cap', \&M::SASLAuth::handle_capack) or return;
@@ -47,7 +47,7 @@ sub handle_capack {
if ($sacap eq 'sasl') {
Auto::socksnd($svr, 'AUTHENTICATE PLAIN');
timer_add('auth_timeout_'.$svr, 1, (conf_get("server:$svr:sasl_timeout"))[0][0], sub { Auto::socksnd($svr, 'CAP END'); });
timer_add('auth_timeout_'.$svr, 1, (conf_get("server:$svr:sasl_timeout"))[0][0], sub { Auto::socksnd($svr, 'CAP END') });
}
return 1;
modules/UNO.pm
+154 -154
View File
@@ -32,10 +32,10 @@ sub _init {
}
# If it's Any, set ANYEDITION.
if ($EDITION eq 'Any') { $ANYEDITION = 1; }
if ($EDITION eq 'Any') { $ANYEDITION = 1 }
# PostgreSQL is not supported, yet.
if ($Auto::ENFEAT =~ /pgsql/) { err(3, 'Unable to load UNO: PostgreSQL is not supported.', 0); return; }
if ($Auto::ENFEAT =~ /pgsql/) { err(3, 'Unable to load UNO: PostgreSQL is not supported.', 0); return }
# Create `unoscores` table.
$Auto::DB->do('CREATE TABLE IF NOT EXISTS unoscores (player TEXT, score INTEGER)') or return;
@@ -158,7 +158,7 @@ sub cmd_uno {
$NICKS{lc $src->{nick}} = $src->{nick};
if ($UNO) {
$ORDER .= ' '.lc $src->{nick};
for (my $i = 1; $i <= 7; $i++) { _givecard(lc $src->{nick}); }
for (my $i = 1; $i <= 7; $i++) { _givecard(lc $src->{nick}) }
}
privmsg($src->{svr}, $src->{chan}, "\2$src->{nick}\2 has joined the game.");
@@ -206,7 +206,7 @@ sub cmd_uno {
# Deal the cards.
foreach (keys %PLAYERS) {
for (my $i = 1; $i <= 7; $i++) { _givecard($_); }
for (my $i = 1; $i <= 7; $i++) { _givecard($_) }
my $cards;
foreach my $card (@{$PLAYERS{$_}}) {
$cards .= ' '._fmtcard($card);
@@ -323,7 +323,7 @@ sub cmd_uno {
# Delete the card from the player's hand.
my $delres = _delcard(lc $src->{nick}, uc $argv[1].':'.uc $argv[2]);
if ($delres == -1) { return 1; }
if ($delres == -1) { return 1 }
# Play the card.
if (defined $argv[3]) {
@@ -378,7 +378,7 @@ sub cmd_uno {
my $amnt = int rand 11;
if ($amnt > 0) {
my @dcards;
for (my $i = $amnt; $i > 0; $i--) { push @dcards, _fmtcard(_givecard(lc $src->{nick})); }
for (my $i = $amnt; $i > 0; $i--) { push @dcards, _fmtcard(_givecard(lc $src->{nick})) }
notice($src->{svr}, $src->{nick}, 'You drew: '.join(' ', @dcards));
}
my ($net, $chan) = split '/', $UNOCHAN;
@@ -448,7 +448,7 @@ sub cmd_uno {
# Tell them their cards.
my $cards;
foreach (@{$PLAYERS{lc $src->{nick}}}) { $cards .= ' '._fmtcard($_); }
foreach (@{$PLAYERS{lc $src->{nick}}}) { $cards .= ' '._fmtcard($_) }
$cards = substr $cards, 1;
notice($src->{svr}, $src->{nick}, "Your cards are: $cards");
}
@@ -611,7 +611,7 @@ sub cmd_uno {
my $str;
my $i = 0;
foreach (sort {$data->{$b}->{score} <=> $data->{$a}->{score}} keys %$data) {
if ($i > 10) { last; }
if ($i > 10) { last }
$str .= ", \2$_:".$data->{$_}->{score}."\2";
$i++;
}
@@ -643,7 +643,7 @@ sub cmd_uno {
notice($src->{svr}, $src->{nick}, trans('No data available').q{.});
}
}
default { notice($src->{svr}, $src->{nick}, trans('Unknown action', uc $argv[0]).q{.}); }
default { notice($src->{svr}, $src->{nick}, trans('Unknown action', uc $argv[0]).q{.}) }
}
return 1;
@@ -655,103 +655,103 @@ sub _givecard {
# Make sure the player exists.
if (defined $player) {
if (!defined $PLAYERS{$player}) { return; }
if (!defined $PLAYERS{$player}) { return }
}
# Get a random number for the appropriate edition.
my $rci;
given ($EDITION) {
when ('Original') { $rci = int rand 53; }
when ('Super') { $rci = int rand 64; }
when ('Advanced') { $rci = int rand 72; }
when ('Original') { $rci = int rand 53 }
when ('Super') { $rci = int rand 64 }
when ('Advanced') { $rci = int rand 72 }
}
# Now figure out what card we have here.
my $card;
given ($rci) {
when (0) { $card = 'R:1'; }
when (1) { $card = 'R:2'; }
when (2) { $card = 'R:3'; }
when (3) { $card = 'R:4'; }
when (4) { $card = 'R:5'; }
when (5) { $card = 'R:6'; }
when (6) { $card = 'R:7'; }
when (7) { $card = 'R:8'; }
when (8) { $card = 'R:9'; }
when (9) { $card = 'B:1'; }
when (10) { $card = 'B:2'; }
when (11) { $card = 'B:3'; }
when (12) { $card = 'B:4'; }
when (13) { $card = 'B:5'; }
when (14) { $card = 'B:6'; }
when (15) { $card = 'B:7'; }
when (16) { $card = 'B:8'; }
when (17) { $card = 'B:9'; }
when (18) { $card = 'Y:1'; }
when (19) { $card = 'Y:2'; }
when (20) { $card = 'Y:3'; }
when (21) { $card = 'Y:4'; }
when (22) { $card = 'Y:5'; }
when (23) { $card = 'Y:6'; }
when (24) { $card = 'Y:7'; }
when (25) { $card = 'Y:8'; }
when (26) { $card = 'Y:9'; }
when (27) { $card = 'G:1'; }
when (28) { $card = 'G:2'; }
when (29) { $card = 'G:3'; }
when (30) { $card = 'G:4'; }
when (31) { $card = 'G:5'; }
when (32) { $card = 'G:6'; }
when (33) { $card = 'G:7'; }
when (34) { $card = 'G:8'; }
when (35) { $card = 'G:9'; }
when (36) { $card = 'W:0'; }
when (37) { $card = 'W:0'; }
when (38) { $card = 'W:0'; }
when (0) { $card = 'R:1' }
when (1) { $card = 'R:2' }
when (2) { $card = 'R:3' }
when (3) { $card = 'R:4' }
when (4) { $card = 'R:5' }
when (5) { $card = 'R:6' }
when (6) { $card = 'R:7' }
when (7) { $card = 'R:8' }
when (8) { $card = 'R:9' }
when (9) { $card = 'B:1' }
when (10) { $card = 'B:2' }
when (11) { $card = 'B:3' }
when (12) { $card = 'B:4' }
when (13) { $card = 'B:5' }
when (14) { $card = 'B:6' }
when (15) { $card = 'B:7' }
when (16) { $card = 'B:8' }
when (17) { $card = 'B:9' }
when (18) { $card = 'Y:1' }
when (19) { $card = 'Y:2' }
when (20) { $card = 'Y:3' }
when (21) { $card = 'Y:4' }
when (22) { $card = 'Y:5' }
when (23) { $card = 'Y:6' }
when (24) { $card = 'Y:7' }
when (25) { $card = 'Y:8' }
when (26) { $card = 'Y:9' }
when (27) { $card = 'G:1' }
when (28) { $card = 'G:2' }
when (29) { $card = 'G:3' }
when (30) { $card = 'G:4' }
when (31) { $card = 'G:5' }
when (32) { $card = 'G:6' }
when (33) { $card = 'G:7' }
when (34) { $card = 'G:8' }
when (35) { $card = 'G:9' }
when (36) { $card = 'W:0' }
when (37) { $card = 'W:0' }
when (38) { $card = 'W:0' }
when (39) {
if ($EDITION eq 'Original') { $card = 'WD4:0'; }
else { $card = 'WHF:0'; }
if ($EDITION eq 'Original') { $card = 'WD4:0' }
else { $card = 'WHF:0' }
}
when (40) {
if ($EDITION eq 'Original') { $card = 'WD4:0'; }
else { $card = 'WHF:0'; }
if ($EDITION eq 'Original') { $card = 'WD4:0' }
else { $card = 'WHF:0' }
}
when (41) { $card = 'R:R'; }
when (42) { $card = 'B:R'; }
when (43) { $card = 'Y:R'; }
when (44) { $card = 'G:R'; }
when (45) { $card = 'R:S'; }
when (46) { $card = 'B:S'; }
when (47) { $card = 'Y:S'; }
when (48) { $card = 'G:S'; }
when (49) { $card = 'R:D2'; }
when (50) { $card = 'B:D2'; }
when (51) { $card = 'Y:D2'; }
when (52) { $card = 'G:D2'; }
when (53) { $card = 'WAH:0'; }
when (54) { $card = 'WAH:0'; }
when (55) { $card = 'WAH:0'; }
when (56) { $card = 'R:T'; }
when (57) { $card = 'B:T'; }
when (58) { $card = 'G:T'; }
when (59) { $card = 'Y:T'; }
when (60) { $card = 'R:X'; }
when (61) { $card = 'B:X'; }
when (62) { $card = 'G:X'; }
when (63) { $card = 'Y:X'; }
when (64) { $card = 'R:W'; }
when (65) { $card = 'B:W'; }
when (66) { $card = 'G:W'; }
when (67) { $card = 'Y:W'; }
when (68) { $card = 'R:B'; }
when (69) { $card = 'B:B'; }
when (70) { $card = 'G:B'; }
when (71) { $card = 'Y:B'; }
default { $card = 'W:0'; }
when (41) { $card = 'R:R' }
when (42) { $card = 'B:R' }
when (43) { $card = 'Y:R' }
when (44) { $card = 'G:R' }
when (45) { $card = 'R:S' }
when (46) { $card = 'B:S' }
when (47) { $card = 'Y:S' }
when (48) { $card = 'G:S' }
when (49) { $card = 'R:D2' }
when (50) { $card = 'B:D2' }
when (51) { $card = 'Y:D2' }
when (52) { $card = 'G:D2' }
when (53) { $card = 'WAH:0' }
when (54) { $card = 'WAH:0' }
when (55) { $card = 'WAH:0' }
when (56) { $card = 'R:T' }
when (57) { $card = 'B:T' }
when (58) { $card = 'G:T' }
when (59) { $card = 'Y:T' }
when (60) { $card = 'R:X' }
when (61) { $card = 'B:X' }
when (62) { $card = 'G:X' }
when (63) { $card = 'Y:X' }
when (64) { $card = 'R:W' }
when (65) { $card = 'B:W' }
when (66) { $card = 'G:W' }
when (67) { $card = 'Y:W' }
when (68) { $card = 'R:B' }
when (69) { $card = 'B:B' }
when (70) { $card = 'G:B' }
when (71) { $card = 'Y:B' }
default { $card = 'W:0' }
}
# Add the card to the player's arrayref.
if (defined $player) { push @{$PLAYERS{$player}}, $card; }
if (defined $player) { push @{$PLAYERS{$player}}, $card }
# Return the card.
return $card;
@@ -763,14 +763,14 @@ sub _fmtcard {
my $fmt;
my ($color, $val) = split m/[:]/, $card;
if ($color eq 'W' or $color eq 'WD4' or $color eq 'WAH' or $color eq 'WHF') { $val = $color; }
if ($color eq 'W' or $color eq 'WD4' or $color eq 'WAH' or $color eq 'WHF') { $val = $color }
given ($color) {
when ('R') { $fmt = "\00301,04[$val]\003"; }
when ('B') { $fmt = "\00300,12[$val]\003"; }
when ('G') { $fmt = "\00300,03[$val]\003"; }
when ('Y') { $fmt = "\00301,08[$val]\003"; }
default { $fmt = "\002\00300,01[$val]\003\002"; }
when ('R') { $fmt = "\00301,04[$val]\003" }
when ('B') { $fmt = "\00300,12[$val]\003" }
when ('G') { $fmt = "\00300,03[$val]\003" }
when ('Y') { $fmt = "\00301,08[$val]\003" }
default { $fmt = "\002\00300,01[$val]\003\002" }
}
return $fmt;
@@ -802,17 +802,17 @@ sub _nextturn {
# Mind, this should never happen, but must be the next person in order.
$nplayer = $order[0];
}
if ($skip eq 2) { return $nplayer; }
if ($skip eq 2) { return $nplayer }
my ($net, $chan) = split '/', $UNOCHAN;
$CURRTURN = $nplayer;
privmsg($net, $chan, "\2".$NICKS{$nplayer}."'s\2 turn. Top Card: "._fmtcard($TOPCARD));
my $cards;
foreach (@{$PLAYERS{$nplayer}}) { $cards .= ' '._fmtcard($_); }
foreach (@{$PLAYERS{$nplayer}}) { $cards .= ' '._fmtcard($_) }
$cards = substr $cards, 1;
notice($net, $NICKS{$nplayer}, "Your cards are: $cards");
if ($skip) { return $skip; }
if ($skip) { return $skip }
return 1;
}
@@ -820,7 +820,7 @@ sub _nextturn {
sub _runcard {
my ($card, $spec, @vals) = @_;
my ($ccol, $cval) = split m/[:]/, $card;
if (!defined $spec) { $spec = 0; }
if (!defined $spec) { $spec = 0 }
my ($net, $chan) = split '/', $UNOCHAN;
if ($ccol ne 'R' && $ccol ne 'B' && $ccol ne 'G' && $ccol ne 'Y') {
$TOPCARD = $cval.':0';
@@ -833,7 +833,7 @@ sub _runcard {
when (/(R|B|G|Y)/) {
given ($cval) {
when (/^[1-9]$/) {
if ($spec) { return; }
if ($spec) { return }
_nextturn(0);
}
when ('R') {
@@ -860,12 +860,12 @@ sub _runcard {
}
# Set new order.
$ORDER = 0;
for (my $i = $#nop; $i >= 0; $i--) { $ORDER .= ' '.$nop[$i]; }
for (my $i = $#nop; $i >= 0; $i--) { $ORDER .= ' '.$nop[$i] }
$ORDER = substr $ORDER, 1;
}
privmsg($net, $chan, 'Game play has been reversed!');
if (keys %PLAYERS > 2) { _nextturn(0); }
else { _nextturn(1); }
if (keys %PLAYERS > 2) { _nextturn(0) }
else { _nextturn(1) }
}
when ('S') {
if ($spec) {
@@ -887,7 +887,7 @@ sub _runcard {
else {
my $amnt = int rand 11;
if ($amnt > 0) {
for (my $i = $amnt; $i > 0; $i--) { _fmtcard(_givecard($CURRTURN)); }
for (my $i = $amnt; $i > 0; $i--) { _fmtcard(_givecard($CURRTURN)) }
}
privmsg($net, $chan, "\2".$NICKS{$CURRTURN}."\2 draws \2$amnt\2 cards and is skipped!");
}
@@ -903,7 +903,7 @@ sub _runcard {
else {
my $amnt = int rand 11;
if ($amnt > 0) {
for (my $i = $amnt; $i > 0; $i--) { _fmtcard(_givecard($victim)); }
for (my $i = $amnt; $i > 0; $i--) { _fmtcard(_givecard($victim)) }
}
privmsg($net, $chan, "\2".$NICKS{$victim}."\2 draws \2$amnt\2 cards and is skipped!");
}
@@ -915,30 +915,30 @@ sub _runcard {
my @xcards;
foreach my $ucard (@{$PLAYERS{$CURRTURN}}) {
my ($xhcol, undef) = split m/[:]/, $ucard;
if ($xhcol eq $ccol) { push @xcards, $ucard; }
if ($xhcol eq $ccol) { push @xcards, $ucard }
}
# Get a more human-readable version of the color.
my $tcol;
given ($ccol) {
when ('R') { $tcol = "\00304red\003"; }
when ('B') { $tcol = "\00312blue\003"; }
when ('G') { $tcol = "\00303green\003"; }
when ('Y') { $tcol = "\00308yellow\003"; }
when ('R') { $tcol = "\00304red\003" }
when ('B') { $tcol = "\00312blue\003" }
when ('G') { $tcol = "\00303green\003" }
when ('Y') { $tcol = "\00308yellow\003" }
}
privmsg($net, $chan, "\2".$NICKS{$CURRTURN}."\2 is discarding all his/her cards of color \2$tcol\2.");
# Delete all the cards.
my $delres;
foreach (@xcards) { $delres = _delcard($CURRTURN, $_); }
foreach (@xcards) { $delres = _delcard($CURRTURN, $_) }
if (defined $delres) {
my $str;
for (my $i = $#xcards; $i >= 0; $i--) { $str .= ' '._fmtcard($xcards[$i]); }
for (my $i = $#xcards; $i >= 0; $i--) { $str .= ' '._fmtcard($xcards[$i]) }
$str = substr $str, 1;
if ($delres != -1) {
notice($net, $NICKS{$CURRTURN}, "You discarded: $str");
_nextturn(0);
}
}
else { _nextturn(0); }
else { _nextturn(0) }
}
when ('T') {
# Get cards.
@@ -948,8 +948,8 @@ sub _runcard {
$PLAYERS{$CURRTURN} = [];
$PLAYERS{lc $vals[0]} = [];
# Set new cards.
foreach (@ucards) { push @{$PLAYERS{lc $vals[0]}}, $_; }
foreach (@rcards) { push @{$PLAYERS{$CURRTURN}}, $_; }
foreach (@ucards) { push @{$PLAYERS{lc $vals[0]}}, $_ }
foreach (@rcards) { push @{$PLAYERS{$CURRTURN}}, $_ }
# The deed, is done.
privmsg($net, $chan, "\2".$NICKS{$CURRTURN}."\2 has traded hands with \2".$NICKS{lc $vals[0]}."\2!");
_nextturn(0);
@@ -959,7 +959,7 @@ sub _runcard {
foreach my $vplyr (keys %PLAYERS) {
# Make sure it isn't the player.
if ($vplyr ne $CURRTURN) {
for (my $i = 1; $i <= 7; $i++) { _givecard($vplyr); }
for (my $i = 1; $i <= 7; $i++) { _givecard($vplyr) }
}
}
# Finished.
@@ -972,12 +972,12 @@ sub _runcard {
# Select a random player.
my $rand = int rand scalar @plyrs;
# Make sure the player isn't the victim.
while ($plyrs[$rand] eq $CURRTURN) { $rand = int rand scalar @plyrs; }
while ($plyrs[$rand] eq $CURRTURN) { $rand = int rand scalar @plyrs }
# Set victim.
my $victim = $plyrs[$rand];
# Get the cards of the victim.
my $cards;
foreach (@{$PLAYERS{$victim}}) { $cards .= ' '._fmtcard($_); }
foreach (@{$PLAYERS{$victim}}) { $cards .= ' '._fmtcard($_) }
$cards = substr $cards, 1;
# Give the victim two cards.
_givecard($victim); _givecard($victim);
@@ -994,10 +994,10 @@ sub _runcard {
when ('W') {
my $tcol;
given ($cval) {
when ('R') { $tcol = "\00304red\003"; }
when ('B') { $tcol = "\00312blue\003"; }
when ('G') { $tcol = "\00303green\003"; }
when ('Y') { $tcol = "\00308yellow\003"; }
when ('R') { $tcol = "\00304red\003" }
when ('B') { $tcol = "\00312blue\003" }
when ('G') { $tcol = "\00303green\003" }
when ('Y') { $tcol = "\00308yellow\003" }
}
privmsg($net, $chan, "\2".$NICKS{$CURRTURN}."\2 changes color to \2$tcol\2.");
_nextturn(0);
@@ -1005,13 +1005,13 @@ sub _runcard {
when ('WD4') {
my $tcol;
given ($cval) {
when ('R') { $tcol = "\00304red\003"; }
when ('B') { $tcol = "\00312blue\003"; }
when ('G') { $tcol = "\00303green\003"; }
when ('Y') { $tcol = "\00308yellow\003"; }
when ('R') { $tcol = "\00304red\003" }
when ('B') { $tcol = "\00312blue\003" }
when ('G') { $tcol = "\00303green\003" }
when ('Y') { $tcol = "\00308yellow\003" }
}
my $victim = _nextturn(2);
for (my $i = 1; $i <= 4; $i++) { _givecard($victim); }
for (my $i = 1; $i <= 4; $i++) { _givecard($victim) }
privmsg($net, $chan, "\2".$NICKS{$CURRTURN}."\2 changes color to \2$tcol\2. \2".$NICKS{$victim}."\2 draws 4 cards and is skipped!");
_nextturn(1);
}
@@ -1019,16 +1019,16 @@ sub _runcard {
# Get more human-readable version of the color.
my $tcol;
given ($cval) {
when ('R') { $tcol = "\00304red\003"; }
when ('B') { $tcol = "\00312blue\003"; }
when ('G') { $tcol = "\00303green\003"; }
when ('Y') { $tcol = "\00308yellow\003"; }
when ('R') { $tcol = "\00304red\003" }
when ('B') { $tcol = "\00312blue\003" }
when ('G') { $tcol = "\00303green\003" }
when ('Y') { $tcol = "\00308yellow\003" }
}
# Give the next player a random amount of cards.
my $victim = _nextturn(2);
my $amnt = int rand 11;
while ($amnt == 0) { $amnt = int rand 11; }
for (my $i = 1; $i <= $amnt; $i++) { _givecard($victim); }
while ($amnt == 0) { $amnt = int rand 11 }
for (my $i = 1; $i <= $amnt; $i++) { _givecard($victim) }
# All done.
privmsg($net, $chan, "\2".$NICKS{$CURRTURN}."\2 changes color to \2$tcol\2. \2".$NICKS{$victim}."\2 draws \2$amnt\2 cards and is skipped!");
_nextturn(1);
@@ -1037,17 +1037,17 @@ sub _runcard {
# Get more human-readable version of the color.
my $tcol;
given ($cval) {
when ('R') { $tcol = "\00304red\003"; }
when ('B') { $tcol = "\00312blue\003"; }
when ('G') { $tcol = "\00303green\003"; }
when ('Y') { $tcol = "\00308yellow\003"; }
when ('R') { $tcol = "\00304red\003" }
when ('B') { $tcol = "\00312blue\003" }
when ('G') { $tcol = "\00303green\003" }
when ('Y') { $tcol = "\00308yellow\003" }
}
# Iterate through all players.
foreach my $vplyr (keys %PLAYERS) {
# Make sure it isn't the player.
if ($vplyr ne $CURRTURN) {
my $amnt = int rand 11;
for (my $i = 1; $i <= $amnt; $i++) { _givecard($vplyr); }
for (my $i = 1; $i <= $amnt; $i++) { _givecard($vplyr) }
}
}
# Finished.
@@ -1066,15 +1066,15 @@ sub _hascard {
my ($player, $card) = @_;
# Check for the player arrayref.
if (!defined $PLAYERS{$player}) { return; }
if (!defined $PLAYERS{$player}) { return }
# Iterate through his/her cards.
foreach my $pc (@{$PLAYERS{$player}}) {
if ($pc eq $card) { return 1; }
if ($pc eq $card) { return 1 }
my ($pcol, undef) = split m/[:]/, $card;
if ($pcol ne 'R' && $pcol ne 'B' && $pcol ne 'G' && $pcol ne 'Y') {
my ($hcol, undef) = split m/[:]/, $pc;
if ($pcol eq $hcol) { return 1; }
if ($pcol eq $hcol) { return 1 }
}
}
@@ -1086,7 +1086,7 @@ sub _delcard {
my ($player, $card) = @_;
# Check for the player arrayref.
if (!defined $PLAYERS{$player}) { return; }
if (!defined $PLAYERS{$player}) { return }
# Iterate through his/her cards and delete the correct card.
for (my $i = 0; $i < scalar @{$PLAYERS{$player}}; $i++) {
@@ -1098,7 +1098,7 @@ sub _delcard {
my ($pcol, undef) = split m/[:]/, $card;
if ($pcol !~ m/^(R|B|G|Y)$/xsm) {
my ($hcol, undef) = split m/[:]/, $PLAYERS{$player}[$i];
if ($pcol eq $hcol) { undef $PLAYERS{$player}[$i]; last; }
if ($pcol eq $hcol) { undef $PLAYERS{$player}[$i]; last }
}
}
}
@@ -1106,11 +1106,11 @@ sub _delcard {
# Rebuild his/her hand.
my @cards = [];
foreach my $hc (@{$PLAYERS{$player}}) {
if (defined $hc) { push @cards, $hc; }
if (defined $hc) { push @cards, $hc }
}
delete $PLAYERS{$player};
$PLAYERS{$player} = [];
if (ref $cards[0] eq 'ARRAY') { shift @cards; }
if (ref $cards[0] eq 'ARRAY') { shift @cards }
if (!scalar @cards) {
_gameover($player);
return -1;
@@ -1119,7 +1119,7 @@ sub _delcard {
my ($net, $chan) = split '/', $UNOCHAN;
privmsg($net, $chan, "\2".$NICKS{$player}."\2 has \2\00303U\003\00304N\003\00312O\003\2!");
}
foreach (@cards) { push @{$PLAYERS{$player}}, $_; }
foreach (@cards) { push @{$PLAYERS{$player}}, $_ }
return 1;
}
@@ -1129,7 +1129,7 @@ sub _delplyr {
my ($player) = @_;
# Check if the player exists.
if (!defined $PLAYERS{$player}) { return; }
if (!defined $PLAYERS{$player}) { return }
my ($net, $chan) = split '/', $UNOCHAN;
# Delete their player data.
@@ -1148,17 +1148,17 @@ sub _delplyr {
# Update state data.
if ($UNO) {
if ($DEALER eq $player) {
if ($CURRTURN eq $player) { $DEALER = _nextturn(2); }
else { $DEALER = $CURRTURN; }
if ($CURRTURN eq $player) { $DEALER = _nextturn(2) }
else { $DEALER = $CURRTURN }
}
if ($CURRTURN eq $player) { _nextturn(0); }
if ($CURRTURN eq $player) { _nextturn(0) }
}
# Update order.
if ($UNO) {
my @order;
foreach (split ' ', $ORDER) {
if ($_ ne $player) { push @order, $_; }
if ($_ ne $player) { push @order, $_ }
}
$ORDER = join ' ', @order;
}
@@ -1223,8 +1223,8 @@ sub on_nick {
}
$ORDER = join ' ', @order;
}
if ($UNO) { if ($CURRTURN eq lc $src->{nick}) { $CURRTURN = lc $newnick; } }
if ($DEALER eq lc $src->{nick}) { $DEALER = lc $newnick; }
if ($UNO) { if ($CURRTURN eq lc $src->{nick}) { $CURRTURN = lc $newnick } }
if ($DEALER eq lc $src->{nick}) { $DEALER = lc $newnick }
# Delete garbage.
delete $PLAYERS{lc $src->{nick}};
delete $NICKS{lc $src->{nick}};
@@ -1298,7 +1298,7 @@ sub on_kick {
# Subroutine for when a rehash occurs.
sub on_rehash {
# Ensure a game isn't running right now.
if ($UNO or $UNOW) { awarn(3, 'on_rehash: Unable to update UNO edition: A game is currently running.'); return; }
if ($UNO or $UNOW) { awarn(3, 'on_rehash: Unable to update UNO edition: A game is currently running.'); return }
# Check if the edition is specified.
if (conf_get('uno:edition')) {
modules/Weather.pm
+1 -1
View File
@@ -60,7 +60,7 @@ sub weather
# And send to channel
if (!ref($d->{observation_location}->{country})) {
my $windc = $d->{wind_string};
if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); }
if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1) }
privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
}