From 3e1e2e98bebf13f383a5d1980d5265fa5b4c3725 Mon Sep 17 00:00:00 2001 From: Elijah Perrault Date: Sat, 19 Mar 2011 22:46:45 -0600 Subject: [PATCH] Large amounts of code cleanup. --- bin/auto | 26 ++-- bin/buildmod | 53 +++++++- bin/genssl | 4 +- install | 2 +- lib/API/IRC.pm | 8 +- lib/API/Std.pm | 38 +++--- lib/Core/IRC.pm | 10 +- lib/Core/IRC/Users.pm | 4 +- lib/Lib/Auto.pm | 26 ++-- lib/Proto/IRC.pm | 12 +- modules/BotStats.pm | 10 +- modules/ChanTopics.pm | 2 +- modules/Eval.pm | 2 +- modules/Greet.pm | 4 +- modules/QDB.pm | 12 +- modules/SASLAuth.pm | 6 +- modules/UNO.pm | 308 +++++++++++++++++++++--------------------- modules/Weather.pm | 2 +- 18 files changed, 286 insertions(+), 243 deletions(-) diff --git a/bin/auto b/bin/auto index 916d087..48d018d 100755 --- a/bin/auto +++ b/bin/auto @@ -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; diff --git a/bin/buildmod b/bin/buildmod index 4a5ad85..e544fe9 100755 --- a/bin/buildmod +++ b/bin/buildmod @@ -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 = ; +$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__') { diff --git a/bin/genssl b/bin/genssl index 5412c6a..8edcdb6 100755 --- a/bin/genssl +++ b/bin/genssl @@ -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"; diff --git a/install b/install index a37a504..0d0cc06 100755 --- a/install +++ b/install @@ -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. diff --git a/lib/API/IRC.pm b/lib/API/IRC.pm index 6d7a4a2..ce6362b 100644 --- a/lib/API/IRC.pm +++ b/lib/API/IRC.pm @@ -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; diff --git a/lib/API/Std.pm b/lib/API/Std.pm index 1b4e058..37ccba6 100644 --- a/lib/API/Std.pm +++ b/lib/API/Std.pm @@ -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 } } diff --git a/lib/Core/IRC.pm b/lib/Core/IRC.pm index f3502f9..dda3b36 100644 --- a/lib/Core/IRC.pm +++ b/lib/Core/IRC.pm @@ -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 } } } diff --git a/lib/Core/IRC/Users.pm b/lib/Core/IRC/Users.pm index b840310..78f55ba 100644 --- a/lib/Core/IRC/Users.pm +++ b/lib/Core/IRC/Users.pm @@ -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) { diff --git a/lib/Lib/Auto.pm b/lib/Lib/Auto.pm index b4c9dd1..eea28e5 100644 --- a/lib/Lib/Auto.pm +++ b/lib/Lib/Auto.pm @@ -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; diff --git a/lib/Proto/IRC.pm b/lib/Proto/IRC.pm index 1850986..7702112 100644 --- a/lib/Proto/IRC.pm +++ b/lib/Proto/IRC.pm @@ -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])); } diff --git a/modules/BotStats.pm b/modules/BotStats.pm index 80efc7b..852da51 100644 --- a/modules/BotStats.pm +++ b/modules/BotStats.pm @@ -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. diff --git a/modules/ChanTopics.pm b/modules/ChanTopics.pm index a72a2a6..81f7ee5 100644 --- a/modules/ChanTopics.pm +++ b/modules/ChanTopics.pm @@ -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; diff --git a/modules/Eval.pm b/modules/Eval.pm index d39e533..dde14eb 100644 --- a/modules/Eval.pm +++ b/modules/Eval.pm @@ -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; diff --git a/modules/Greet.pm b/modules/Greet.pm index a344be1..82d4a88 100644 --- a/modules/Greet.pm +++ b/modules/Greet.pm @@ -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; diff --git a/modules/QDB.pm b/modules/QDB.pm index 72705f0..1c03750 100644 --- a/modules/QDB.pm +++ b/modules/QDB.pm @@ -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; diff --git a/modules/SASLAuth.pm b/modules/SASLAuth.pm index 9740082..233ef8b 100644 --- a/modules/SASLAuth.pm +++ b/modules/SASLAuth.pm @@ -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; diff --git a/modules/UNO.pm b/modules/UNO.pm index 00348d0..c0bb549 100644 --- a/modules/UNO.pm +++ b/modules/UNO.pm @@ -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')) { diff --git a/modules/Weather.pm b/modules/Weather.pm index 09ee1f6..2f75daf 100644 --- a/modules/Weather.pm +++ b/modules/Weather.pm @@ -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}); }