Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
e833309c4e | ||
|
|
3c81f0587a | ||
|
|
5366855f96 | ||
|
|
caf9b36b8c | ||
|
|
789cec8f80 | ||
|
|
ed72b5e444 | ||
|
|
3cfe22e5c1 | ||
|
|
ea775d4c98 | ||
|
|
153084f808 | ||
|
|
637db6bae4 | ||
|
|
7f4ea8d196 | ||
|
|
8ee16eb39b |
No files matched your search
@@ -2,3 +2,5 @@ auto.conf
|
||||
build/*
|
||||
*.swp
|
||||
autodoc/*
|
||||
*.db
|
||||
var/*
|
||||
@@ -11,30 +11,18 @@
|
||||
The future of IRC bots is here! Xelhua gives to you, Auto 3.0, a new version of
|
||||
the popular Auto IRC bot.
|
||||
|
||||
In this alpha8 release, we have added:
|
||||
In this alpha9 release, we have added:
|
||||
|
||||
* A module to get information on a package in AUR (AUR).
|
||||
* Support for installs to custom locations.
|
||||
* Support for system-wide installs. (/usr or /usr/local)
|
||||
* The `wizard` utility, for creating local Auto config directories.
|
||||
* EightBall rewritten to be much nicer.
|
||||
* A module to translate English into LOLCAT (LOLCAT).
|
||||
* Command aliasing via aliases blocks in the config.
|
||||
* Added optional uno:english and required uno:msg options. See documentation for UNO.
|
||||
* Added fastest/slowest game, most cards and most players records to UNO.
|
||||
None
|
||||
|
||||
Bug fixes:
|
||||
|
||||
* Fixed an issue in auto --help that incorrectly displayed the binary name.
|
||||
* Fixed an exploit in QDB that allowed users to use services fantasy commands
|
||||
with the bot's account.
|
||||
* Fixed a bug in LinkTitle that caused multi-line <title>'s to display wrong.
|
||||
* Fixed a bug in UNO that allowed users to join more than once.
|
||||
* UNO: Fixed a formatting issue in duration.
|
||||
* QDB: Fixed an exploit in QDB RAND.
|
||||
|
||||
Incompatibilities:
|
||||
|
||||
* UNO has a uno:msg config option. See documentation for UNO.
|
||||
* Must be re-installed, run ./install [options]
|
||||
None
|
||||
|
||||
We thank you for choosing Auto. Please remember that he is coming to late
|
||||
development stages soon, and testers are needed! But we hope we've piqued
|
||||
@@ -44,4 +32,4 @@ created by anyone and uploaded there for everyone to use.
|
||||
Auto's goal is to create an efficient, stable and highly customizable IRC bot
|
||||
in Perl. To offer an alternative to other platforms.
|
||||
|
||||
Enjoy Auto 3.0.0 Alpha 8!
|
||||
Enjoy Auto 3.0.0 Alpha 9!
|
||||
@@ -38,7 +38,8 @@ Contributors - Non-developers who contribute to the project greatly.
|
||||
|
||||
3. HOW TO INSTALL
|
||||
|
||||
Installation documentation is at: http://wiki.xelhua.org/index.php/Auto:Install
|
||||
Installation documentation is at:
|
||||
http://wiki.xelhua.org/index.php/Auto:Installation_guide
|
||||
|
||||
|
||||
4. HOW TO UPGRADE
|
||||
|
||||
@@ -42,7 +42,7 @@ greatly.
|
||||
|
||||
## 3. HOW TO INSTALL
|
||||
|
||||
Installation documentation can be found [here](http://wiki.xelhua.org/index.php/Auto:Install).
|
||||
Installation documentation can be found [here](http://wiki.xelhua.org/index.php/Auto:Installation_guide).
|
||||
|
||||
|
||||
## 4. HOW TO UPGRADE
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
:: auto.bat - Launcher for Microsoft Windows.
|
||||
:: Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
:: Released under the terms stated in doc/LICENSE.
|
||||
:: Clone of `auto`, since Windows likes Batch, not sh.
|
||||
|
||||
@echo off
|
||||
|
||||
set pidfile=bin/auto.pid
|
||||
|
||||
if "%1" == "" goto errparams
|
||||
if "%1" == "start" goto start
|
||||
if "%1" == "status" goto status
|
||||
else goto errparams
|
||||
|
||||
:errparams
|
||||
echo.
|
||||
echo Usage: auto.bat (start|status) [force]
|
||||
:end
|
||||
|
||||
:start
|
||||
echo.
|
||||
if exist "%pidfile" (
|
||||
if "%2" == "force" (
|
||||
echo Starting Auto. . .
|
||||
perl bin/auto
|
||||
)
|
||||
else (
|
||||
echo Auto appears to be running already. Run `auto.bat start force` to start anyway.
|
||||
)
|
||||
)
|
||||
else (
|
||||
echo Starting Auto. . .
|
||||
perl bin/auto
|
||||
)
|
||||
:end
|
||||
|
||||
:status
|
||||
echo.
|
||||
if exist "%pidfile" (
|
||||
echo Status: Auto appears to be running.
|
||||
)
|
||||
else (
|
||||
echo Status: Auto appears to not be running.
|
||||
)
|
||||
:end
|
||||
@@ -235,8 +235,8 @@ undef $USECONFIG;
|
||||
if (conf_get('die')) {
|
||||
if ((conf_get('die'))[0][0] == 1) {
|
||||
say '!!! You didn\'t read the whole config.';
|
||||
say '!!! Insert new user then try again.';
|
||||
exit;
|
||||
say '!!! Insert new user then try again.';
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -244,11 +244,11 @@ if (conf_get('die')) {
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
|
||||
foreach my $REQCVAL (@REQCVALS) {
|
||||
if (!conf_get($REQCVAL)) {
|
||||
my $err = 2;
|
||||
if ($REQCVAL eq 'expire_logs') {
|
||||
$err = 1;
|
||||
}
|
||||
err($err, "Missing required configuration value: $REQCVAL", 1);
|
||||
my $err = 2;
|
||||
if ($REQCVAL eq 'expire_logs') {
|
||||
$err = 1;
|
||||
}
|
||||
err($err, "Missing required configuration value: $REQCVAL", 1);
|
||||
}
|
||||
}
|
||||
undef @REQCVALS;
|
||||
@@ -356,44 +356,44 @@ if (conf_get('privset')) {
|
||||
my %tcprivs = conf_get('privset');
|
||||
|
||||
foreach my $tckpriv (keys %tcprivs) {
|
||||
# For each privset, get the inner values.
|
||||
my %mcprivs = conf_get("privset:$tckpriv");
|
||||
# For each privset, get the inner values.
|
||||
my %mcprivs = conf_get("privset:$tckpriv");
|
||||
|
||||
# Iterate through them.
|
||||
foreach my $mckpriv (keys %mcprivs) {
|
||||
# Switch statement for the values.
|
||||
given ($mckpriv) {
|
||||
# If it's 'priv', save it as a privilege.
|
||||
when ('priv') {
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
|
||||
}
|
||||
}
|
||||
# If it's 'inherit', inherit the privileges of another privset.
|
||||
when ('inherit') {
|
||||
# If the privset we're inheriting exists, continue.
|
||||
if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
|
||||
# Iterate through each privilege.
|
||||
foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
|
||||
# And save them to the privset inheriting them
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, $_;
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = ($_);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach my $mckpriv (keys %mcprivs) {
|
||||
# Switch statement for the values.
|
||||
given ($mckpriv) {
|
||||
# If it's 'priv', save it as a privilege.
|
||||
when ('priv') {
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
|
||||
}
|
||||
}
|
||||
# If it's 'inherit', inherit the privileges of another privset.
|
||||
when ('inherit') {
|
||||
# If the privset we're inheriting exists, continue.
|
||||
if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
|
||||
# Iterate through each privilege.
|
||||
foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
|
||||
# And save them to the privset inheriting them
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, $_;
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = ($_);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -423,9 +423,9 @@ if (!$DEBUG) {
|
||||
my $pidfile;
|
||||
if ($UPREFIX) { $pidfile = "$bin{cwd}/auto.pid" }
|
||||
else { $pidfile = "$Bin/auto.pid" }
|
||||
open my $FPID, '>', $pidfile or exit;
|
||||
print {$FPID} "$APID\n" or exit;
|
||||
close $FPID or exit;
|
||||
open my $FPID, '>', $pidfile or exit;
|
||||
print {$FPID} "$APID\n" or exit;
|
||||
close $FPID or exit;
|
||||
exit;
|
||||
}
|
||||
POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1);
|
||||
@@ -448,7 +448,7 @@ if (conf_get('module')) {
|
||||
alog '* Loading modules...';
|
||||
dbug '* Loading modules...';
|
||||
foreach (@{ (conf_get('module'))[0] }) {
|
||||
mod_load($_);
|
||||
mod_load($_);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -498,38 +498,38 @@ if (conf_get('aliases:alias')) {
|
||||
while (1) {
|
||||
# Timer check.
|
||||
foreach my $tk (keys %TIMERS) {
|
||||
if ($TIMERS{$tk}{time} <= time) {
|
||||
&{ $TIMERS{$tk}{sub} }();
|
||||
if ($TIMERS{$tk}{type} == 1) {
|
||||
# If it's type 1, delete from memory.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
elsif ($TIMERS{$tk}{type} == 2) {
|
||||
# If it's type 2, reset timer.
|
||||
$TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
|
||||
}
|
||||
else {
|
||||
# This should never happen.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
}
|
||||
if ($TIMERS{$tk}{time} <= time) {
|
||||
&{ $TIMERS{$tk}{sub} }();
|
||||
if ($TIMERS{$tk}{type} == 1) {
|
||||
# If it's type 1, delete from memory.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
elsif ($TIMERS{$tk}{type} == 2) {
|
||||
# If it's type 2, reset timer.
|
||||
$TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
|
||||
}
|
||||
else {
|
||||
# This should never happen.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
}
|
||||
}
|
||||
# Socket check.
|
||||
foreach my $sock ($SELECT->can_read(1)) {
|
||||
# Figure out what network is sending us data.
|
||||
my $sockid;
|
||||
foreach (keys %SOCKET) {
|
||||
if ($SOCKET{$_} eq $sock) { $sockid = $_ }
|
||||
}
|
||||
# Read the data.
|
||||
my $idata;
|
||||
sysread $sock, $idata, POSIX::BUFSIZ, 0;
|
||||
# Figure out what network is sending us data.
|
||||
my $sockid;
|
||||
foreach (keys %SOCKET) {
|
||||
if ($SOCKET{$_} eq $sock) { $sockid = $_ }
|
||||
}
|
||||
# Read the data.
|
||||
my $idata;
|
||||
sysread $sock, $idata, POSIX::BUFSIZ, 0;
|
||||
|
||||
# Check for the data.
|
||||
if (!defined $idata || length($idata) == 0) {
|
||||
# Got EOF, close socket
|
||||
err(2, "Lost connection to $sockid!", 0);
|
||||
$SELECT->remove($sock);
|
||||
# Check for the data.
|
||||
if (!defined $idata || length($idata) == 0) {
|
||||
# Got EOF, close socket
|
||||
err(2, "Lost connection to $sockid!", 0);
|
||||
$SELECT->remove($sock);
|
||||
delete $SOCKET{$sockid};
|
||||
API::Std::event_run('on_disconnect', $sockid);
|
||||
if (!keys %SOCKET) {
|
||||
@@ -541,21 +541,21 @@ while (1) {
|
||||
exit;
|
||||
}
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
# Read the buffer.
|
||||
my $data .= $idata;
|
||||
while ($data =~ s/(.*\n)//) {
|
||||
my $line = $1;
|
||||
my $data .= $idata;
|
||||
while ($data =~ s/(.*\n)//) {
|
||||
my $line = $1;
|
||||
|
||||
# Remove the newlines.
|
||||
chomp $line;
|
||||
# Debug.
|
||||
dbug $sockid.' >> '.$line;
|
||||
chomp $line;
|
||||
# Debug.
|
||||
dbug $sockid.' >> '.$line;
|
||||
|
||||
# Parse data.
|
||||
Proto::IRC::ircparse($sockid, $line);
|
||||
}
|
||||
Proto::IRC::ircparse($sockid, $line);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -568,12 +568,12 @@ sub socksnd {
|
||||
my ($svr, $data) = @_;
|
||||
|
||||
if (defined $SOCKET{$svr}) {
|
||||
syswrite $SOCKET{$svr}, $data."\r\n", POSIX::BUFSIZ, 0;
|
||||
dbug "$svr << $data";
|
||||
return 1;
|
||||
syswrite $SOCKET{$svr}, $data."\r\n", POSIX::BUFSIZ, 0;
|
||||
dbug "$svr << $data";
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -5,6 +5,11 @@ Auto IRC Bot 3.0: Change Log
|
||||
===============================================================================
|
||||
|
||||
|
||||
3.0 Alpha 9
|
||||
===============================================================================
|
||||
* Bug fix: Fixed an exploit in QDB RAND.
|
||||
* UNO: Fixed a formatting issue in duration.
|
||||
|
||||
3.0 Alpha 8
|
||||
===============================================================================
|
||||
* Full support for custom PREFIX installs (including global installs) has
|
||||
|
||||
+1
-1
@@ -25,7 +25,7 @@ sub mod_init {
|
||||
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) {
|
||||
if ($autover !~ m/^3\.0\.0a(7|8|9)$/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.') }
|
||||
|
||||
+21
-21
@@ -79,8 +79,8 @@ hook_add("on_connect", "on_connect_modes", sub {
|
||||
my ($svr) = @_;
|
||||
|
||||
if (conf_get("server:$svr:modes")) {
|
||||
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
||||
API::IRC::umode($svr, $connmodes);
|
||||
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
||||
API::IRC::umode($svr, $connmodes);
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -100,8 +100,8 @@ hook_add("on_connect", "plaintext_auth", sub {
|
||||
my ($svr) = @_;
|
||||
|
||||
if (conf_get("server:$svr:idstr")) {
|
||||
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
||||
Auto::socksnd($svr, $idstr);
|
||||
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
||||
Auto::socksnd($svr, $idstr);
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -116,9 +116,9 @@ hook_add("on_connect", "autojoin", sub {
|
||||
|
||||
# Join the channels.
|
||||
if (!defined $cajoin[1]) {
|
||||
# For single-line ajoins.
|
||||
my @sajoin = split(',', $cajoin[0]);
|
||||
|
||||
# For single-line ajoins.
|
||||
my @sajoin = split(',', $cajoin[0]);
|
||||
|
||||
foreach (@sajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
@@ -128,13 +128,13 @@ hook_add("on_connect", "autojoin", sub {
|
||||
}
|
||||
else {
|
||||
# Else join without one.
|
||||
API::IRC::cjoin($svr, $_);
|
||||
API::IRC::cjoin($svr, $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# For multi-line ajoins.
|
||||
foreach (@cajoin) {
|
||||
# For multi-line ajoins.
|
||||
foreach (@cajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
# There was, join with it.
|
||||
@@ -178,17 +178,17 @@ hook_add('on_isupport', 'core.prefixchanmode.getdata', sub {
|
||||
|
||||
# Find PREFIX and CHANMODES.
|
||||
foreach my $ex (@ex) {
|
||||
if ($ex =~ m/^PREFIX/xsm) {
|
||||
# Found PREFIX.
|
||||
my $rpx = substr($ex, 8);
|
||||
my ($pm, $pp) = split('\)', $rpx);
|
||||
my @apm = split(//, $pm);
|
||||
my @app = split(//, $pp);
|
||||
foreach my $ppm (@apm) {
|
||||
# Store data.
|
||||
$Proto::IRC::csprefix{$svr}{$ppm} = shift(@app);
|
||||
}
|
||||
}
|
||||
if ($ex =~ m/^PREFIX/xsm) {
|
||||
# Found PREFIX.
|
||||
my $rpx = substr($ex, 8);
|
||||
my ($pm, $pp) = split('\)', $rpx);
|
||||
my @apm = split(//, $pm);
|
||||
my @app = split(//, $pp);
|
||||
foreach my $ppm (@apm) {
|
||||
# Store data.
|
||||
$Proto::IRC::csprefix{$svr}{$ppm} = shift(@app);
|
||||
}
|
||||
}
|
||||
elsif ($ex =~ m/^CHANMODES/xsm) {
|
||||
# Found CHANMODES.
|
||||
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
|
||||
|
||||
+3
-3
@@ -157,10 +157,10 @@ sub ircsock {
|
||||
|
||||
# Prepare socket data.
|
||||
my %conndata = (
|
||||
Proto => 'tcp',
|
||||
Proto => 'tcp',
|
||||
LocalAddr => $cdata->{'bind'}[0],
|
||||
PeerAddr => $cdata->{'host'}[0],
|
||||
PeerPort => $cdata->{'port'}[0],
|
||||
PeerAddr => $cdata->{'host'}[0],
|
||||
PeerPort => $cdata->{'port'}[0],
|
||||
Timeout => 20,
|
||||
);
|
||||
# Set IPv6/SSL data.
|
||||
|
||||
+126
-126
@@ -14,7 +14,7 @@ sub new
|
||||
|
||||
# Check to see if the configuration file exists.
|
||||
if (!-e "$Auto::bin{etc}/$file") {
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
# Open, read and close the config.
|
||||
@@ -44,135 +44,135 @@ sub parse
|
||||
|
||||
# Iterate the file.
|
||||
foreach my $buff (@fbuf) {
|
||||
# Main newline buffer.
|
||||
if (defined $buff) {
|
||||
# If the line begins with a #, it's a comment so ignore it.
|
||||
if (substr($buff, 0, 1) eq '#') {
|
||||
next;
|
||||
}
|
||||
|
||||
if ($buff =~ m/;/) {
|
||||
# Semicolon buffer.
|
||||
my @asbuf = split(';', $buff);
|
||||
foreach my $asbuff (@asbuf) {
|
||||
if (defined $asbuff) {
|
||||
|
||||
# Space buffer.
|
||||
my @ebuf = split(' ', $asbuff);
|
||||
if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
my $param = $ebuf[1];
|
||||
|
||||
if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
||||
# Multi-word string.
|
||||
$param = substr($param, 1);
|
||||
|
||||
for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
||||
if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
||||
$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
||||
last;
|
||||
}
|
||||
else {
|
||||
$param .= " ".$ebuf[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
||||
# Single-word string.
|
||||
$param = substr($param, 1, length($ebuf[1]) - 2);
|
||||
}
|
||||
elsif ($param =~ m/[0-9]/) {
|
||||
# Numeric.
|
||||
$param =~ s/[^0-9.]//g;
|
||||
}
|
||||
else {
|
||||
# Garbage.
|
||||
next;
|
||||
}
|
||||
|
||||
my @param = ($param);
|
||||
|
||||
unless (!$blk) {
|
||||
# We're inside a block.
|
||||
if ($blk =~ m/@@@/) {
|
||||
# We're inside a block with a parameter.
|
||||
my @sblk = split('@@@', $blk);
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're inside a block with no parameter.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$blk}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
# Main newline buffer.
|
||||
if (defined $buff) {
|
||||
# If the line begins with a #, it's a comment so ignore it.
|
||||
if (substr($buff, 0, 1) eq '#') {
|
||||
next;
|
||||
}
|
||||
|
||||
if ($buff =~ m/;/) {
|
||||
# Semicolon buffer.
|
||||
my @asbuf = split(';', $buff);
|
||||
foreach my $asbuff (@asbuf) {
|
||||
if (defined $asbuff) {
|
||||
|
||||
# Space buffer.
|
||||
my @ebuf = split(' ', $asbuff);
|
||||
if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
my $param = $ebuf[1];
|
||||
|
||||
if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
||||
# Multi-word string.
|
||||
$param = substr($param, 1);
|
||||
|
||||
for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
||||
if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
||||
$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
||||
last;
|
||||
}
|
||||
else {
|
||||
$param .= " ".$ebuf[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
||||
# Single-word string.
|
||||
$param = substr($param, 1, length($ebuf[1]) - 2);
|
||||
}
|
||||
elsif ($param =~ m/[0-9]/) {
|
||||
# Numeric.
|
||||
$param =~ s/[^0-9.]//g;
|
||||
}
|
||||
else {
|
||||
# Garbage.
|
||||
next;
|
||||
}
|
||||
|
||||
my @param = ($param);
|
||||
|
||||
unless (!$blk) {
|
||||
# We're inside a block.
|
||||
if ($blk =~ m/@@@/) {
|
||||
# We're inside a block with a parameter.
|
||||
my @sblk = split('@@@', $blk);
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're inside a block with no parameter.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$blk}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$blk}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$blk}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're not inside a block.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# No semicolon space buffer.
|
||||
my @ebuf = split(' ', $buff);
|
||||
|
||||
if (!defined $ebuf[0]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined $ebuf[1]) {
|
||||
if ($ebuf[1] eq '{') {
|
||||
# This is the beginning of a block with no parameter.
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$blk}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're not inside a block.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# No semicolon space buffer.
|
||||
my @ebuf = split(' ', $buff);
|
||||
|
||||
if (!defined $ebuf[0]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined $ebuf[1]) {
|
||||
if ($ebuf[1] eq '{') {
|
||||
# This is the beginning of a block with no parameter.
|
||||
$blk = $ebuf[0];
|
||||
}
|
||||
elsif (defined $ebuf[2]) {
|
||||
if ($ebuf[2] eq '{') {
|
||||
# This is the beginning of a block with a parameter.
|
||||
my $param = $ebuf[1];
|
||||
$param =~ s/"//g;
|
||||
$blk = $ebuf[0].'@@@'.$param;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($ebuf[0] eq '}') {
|
||||
# This is the end of a block.
|
||||
$blk = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif (defined $ebuf[2]) {
|
||||
if ($ebuf[2] eq '{') {
|
||||
# This is the beginning of a block with a parameter.
|
||||
my $param = $ebuf[1];
|
||||
$param =~ s/"//g;
|
||||
$blk = $ebuf[0].'@@@'.$param;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($ebuf[0] eq '}') {
|
||||
# This is the end of a block.
|
||||
$blk = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Return the configuration data.
|
||||
return %rs;
|
||||
return %rs;
|
||||
}
|
||||
|
||||
|
||||
|
||||
+35
-35
@@ -14,10 +14,10 @@ sub parse
|
||||
|
||||
# Check that the language file exists.
|
||||
if (!-e "$Auto::bin{lng}/$lang.alf") {
|
||||
# Otherwise, use English.
|
||||
dbug "Language '$lang' not found. Using English.";
|
||||
alog "Language '$lang' not found. Using English.";
|
||||
$lang = 'en';
|
||||
# Otherwise, use English.
|
||||
dbug "Language '$lang' not found. Using English.";
|
||||
alog "Language '$lang' not found. Using English.";
|
||||
$lang = 'en';
|
||||
}
|
||||
|
||||
# Open, read and close the file.
|
||||
@@ -27,37 +27,37 @@ sub parse
|
||||
|
||||
# Iterate the file buffer.
|
||||
foreach my $buff (@fbuf) {
|
||||
if (defined $buff) {
|
||||
# Space buffer.
|
||||
my @sbuf = split(' ', $buff);
|
||||
|
||||
# Check for all required values.
|
||||
if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
||||
# Missing a value.
|
||||
next;
|
||||
}
|
||||
|
||||
# Make sure the first value is "msge".
|
||||
if ($sbuf[0] ne "msge") {
|
||||
# It isn't.
|
||||
next;
|
||||
}
|
||||
|
||||
my $id = $sbuf[1];
|
||||
my $val = $sbuf[2];
|
||||
|
||||
# If the translation is multi-word, continue to parse.
|
||||
if (defined $sbuf[3]) {
|
||||
for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
||||
$val .= " ".$sbuf[$i];
|
||||
}
|
||||
}
|
||||
|
||||
# Save to memory.
|
||||
$id =~ s/"//g;
|
||||
$val =~ s/"//g;
|
||||
$API::Std::LANGE{$id} = $val;
|
||||
}
|
||||
if (defined $buff) {
|
||||
# Space buffer.
|
||||
my @sbuf = split(' ', $buff);
|
||||
|
||||
# Check for all required values.
|
||||
if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
||||
# Missing a value.
|
||||
next;
|
||||
}
|
||||
|
||||
# Make sure the first value is "msge".
|
||||
if ($sbuf[0] ne "msge") {
|
||||
# It isn't.
|
||||
next;
|
||||
}
|
||||
|
||||
my $id = $sbuf[1];
|
||||
my $val = $sbuf[2];
|
||||
|
||||
# If the translation is multi-word, continue to parse.
|
||||
if (defined $sbuf[3]) {
|
||||
for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
||||
$val .= " ".$sbuf[$i];
|
||||
}
|
||||
}
|
||||
|
||||
# Save to memory.
|
||||
$id =~ s/"//g;
|
||||
$val =~ s/"//g;
|
||||
$API::Std::LANGE{$id} = $val;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
+21
-21
@@ -15,34 +15,34 @@ hook_add('on_namesreply', 'state.irc.names', sub {
|
||||
if (defined $chanusers{$svr}{$chan}) { delete $chanusers{$svr}{$chan} }
|
||||
# Iterate through each user.
|
||||
for (1..$#data) {
|
||||
my $fi = 0;
|
||||
my $fi = 0;
|
||||
PFITER: foreach my $spfx (keys %{ $Proto::IRC::csprefix{$svr} }) {
|
||||
# Check if the user has status in the channel.
|
||||
if (substr($data[$_], 0, 1) eq $Proto::IRC::csprefix{$svr}{$spfx}) {
|
||||
# He/she does. Lets set that.
|
||||
if (defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
|
||||
# If the user has multiple statuses.
|
||||
$chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $chanusers{$svr}{$chan}{lc $data[$_]}.$spfx;
|
||||
# Check if the user has status in the channel.
|
||||
if (substr($data[$_], 0, 1) eq $Proto::IRC::csprefix{$svr}{$spfx}) {
|
||||
# He/she does. Lets set that.
|
||||
if (defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
|
||||
# If the user has multiple statuses.
|
||||
$chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $chanusers{$svr}{$chan}{lc $data[$_]}.$spfx;
|
||||
delete $chanusers{$svr}{$chan}{lc $data[$_]};
|
||||
}
|
||||
else {
|
||||
# Or not.
|
||||
$chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $spfx;
|
||||
}
|
||||
$fi = 1;
|
||||
}
|
||||
else {
|
||||
# Or not.
|
||||
$chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $spfx;
|
||||
}
|
||||
$fi = 1;
|
||||
$data[$_] = substr $data[$_], 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
# Check if there's still a prefix.
|
||||
foreach my $spfx (keys %{$Proto::IRC::csprefix{$svr}}) {
|
||||
if (substr($data[$_], 0, 1) eq $Proto::IRC::csprefix{$svr}{$spfx}) { goto 'PFITER' }
|
||||
}
|
||||
# They had status, so go to the next user.
|
||||
next if $fi;
|
||||
# They didn't, set them as a normal user.
|
||||
if (!defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
|
||||
$chanusers{$svr}{$chan}{lc $data[$_]} = 1;
|
||||
}
|
||||
# They had status, so go to the next user.
|
||||
next if $fi;
|
||||
# They didn't, set them as a normal user.
|
||||
if (!defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
|
||||
$chanusers{$svr}{$chan}{lc $data[$_]} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
+2
-2
@@ -13,8 +13,8 @@ sub _init
|
||||
{
|
||||
# Check for required configuration values.
|
||||
if (!conf_get('badwords')) {
|
||||
err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
|
||||
return;
|
||||
err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
|
||||
return;
|
||||
}
|
||||
# Create the act_on_badword hook.
|
||||
hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return;
|
||||
|
||||
+6
-6
@@ -14,8 +14,8 @@ sub _init
|
||||
{
|
||||
# Check for required configuration values.
|
||||
if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) {
|
||||
err(2, 'Please verify that you have bitly_user and bitly_key defined in your configuration file.', 0);
|
||||
return;
|
||||
err(2, 'Please verify that you have bitly_user and bitly_key defined in your configuration file.', 0);
|
||||
return;
|
||||
}
|
||||
# Create the SHORTEN and REVERSE commands.
|
||||
cmd_add('SHORTEN', 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return;
|
||||
@@ -68,9 +68,9 @@ sub shorten
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $response->decoded_content;
|
||||
chomp $d;
|
||||
chomp $d;
|
||||
# And send to channel.
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
@@ -104,13 +104,13 @@ sub reverse
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $response->decoded_content;
|
||||
chomp $d;
|
||||
chomp $d;
|
||||
# And send it to channel.
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, 'An error occurred while reversing your URL.');
|
||||
privmsg($src->{svr}, $src->{chan}, 'An error occurred while reversing your URL.');
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
+7
-7
@@ -58,20 +58,20 @@ sub calc
|
||||
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
|
||||
my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
|
||||
|
||||
if ($d->{error} eq "" or $d->{error} == 0) {
|
||||
if ($d->{error} eq "" or $d->{error} == 0) {
|
||||
# And send to channel
|
||||
privmsg($src->{svr}, $src->{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
|
||||
}
|
||||
else {
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
|
||||
}
|
||||
privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator.");
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
+2
-2
@@ -49,14 +49,14 @@ sub fml
|
||||
if ($rp->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $rp->decoded_content;
|
||||
$d =~ s/(\n|\r)//g;
|
||||
$d =~ s/(\n|\r)//g;
|
||||
|
||||
# Get the FML.
|
||||
my (undef, $dfa) = split('Text: ', $d);
|
||||
my ($fml, undef) = split('Agree:', $dfa);
|
||||
|
||||
# And send to channel.
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
|
||||
+7
-7
@@ -44,25 +44,25 @@ sub check
|
||||
$ua->timeout(2);
|
||||
# Do we have enough parameters?
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
my $curl = $argv[0];
|
||||
# Does the URL start with http(s)?
|
||||
if ($curl !~ m/^http/) {
|
||||
$curl = 'http://'.$curl;
|
||||
$curl = 'http://'.$curl;
|
||||
}
|
||||
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($curl);
|
||||
|
||||
if ($response->is_success) {
|
||||
# If successful, it's up.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
|
||||
# If successful, it's up.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
|
||||
}
|
||||
else {
|
||||
# Otherwise, it's down.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
|
||||
# Otherwise, it's down.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
+3
-3
@@ -113,7 +113,7 @@ sub cmd_qdb
|
||||
|
||||
# Send it back.
|
||||
privmsg($src->{svr}, $src->{chan}, "\002ID:\002 $data[0] - \002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
|
||||
privmsg($src->{svr}, $src->{chan}, $data[3]);
|
||||
privmsg($src->{svr}, $src->{chan}, '> '.$data[3]);
|
||||
}
|
||||
when ('SEARCH') {
|
||||
# QDB SEARCH.
|
||||
@@ -211,7 +211,7 @@ sub cmd_qdb
|
||||
}
|
||||
|
||||
|
||||
API::Std::mod_init('QDB', 'Xelhua', '1.03', '3.0.0a7', __PACKAGE__);
|
||||
API::Std::mod_init('QDB', 'Xelhua', '1.04', '3.0.0a9', __PACKAGE__);
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -222,7 +222,7 @@ QDB - Quote database module.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
1.03
|
||||
1.04
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
||||
+9
-3
@@ -653,6 +653,8 @@ sub cmd_uno {
|
||||
while ($durtime >= 3600) { $hours++; $durtime -= 3600 }
|
||||
while ($durtime >= 60) { $mins++; $durtime -= 60 }
|
||||
while ($durtime >= 1) { $secs++; $durtime -= 1 }
|
||||
if (length $mins < 2) { $mins = "0$mins" }
|
||||
if (length $secs < 2) { $secs = "0$secs" }
|
||||
$msg .= " The fastest game ever lasted \2$hours:$mins:$secs\2; the winner was \2$data->{fast}->{winner}\2.";
|
||||
}
|
||||
}
|
||||
@@ -664,6 +666,8 @@ sub cmd_uno {
|
||||
while ($durtime >= 3600) { $hours++; $durtime -= 3600 }
|
||||
while ($durtime >= 60) { $mins++; $durtime -= 60 }
|
||||
while ($durtime >= 1) { $secs++; $durtime -= 1 }
|
||||
if (length $mins < 2) { $mins = "0$mins" }
|
||||
if (length $secs < 2) { $secs = "0$secs" }
|
||||
$msg .= " The slowest game ever lasted \2$hours:$mins:$secs\2; the winner was \2$data->{slow}->{winner}\2.";
|
||||
}
|
||||
}
|
||||
@@ -1288,6 +1292,8 @@ sub _gameover {
|
||||
while ($durtime >= 3600) { $hours++; $durtime -= 3600 }
|
||||
while ($durtime >= 60) { $mins++; $durtime -= 60 }
|
||||
while ($durtime >= 1) { $secs++; $durtime -= 1 }
|
||||
if (length $mins < 2) { $mins = "0$mins" }
|
||||
if (length $secs < 2) { $secs = "0$secs" }
|
||||
privmsg($net, $chan, "Game lasted $hours:$mins:$secs; $UNOGCC cards were played.");
|
||||
|
||||
# Reset variables.
|
||||
@@ -1438,7 +1444,7 @@ sub sendmsg {
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init('UNO', 'Xelhua', '1.09', '3.0.0a8', __PACKAGE__);
|
||||
API::Std::mod_init('UNO', 'Xelhua', '1.10', '3.0.0a9', __PACKAGE__);
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -1449,7 +1455,7 @@ UNO - Three editions of the UNO card game
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
1.09
|
||||
1.10
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
@@ -1499,7 +1505,7 @@ The commands this adds are:
|
||||
|
||||
All of which describe themselves quite well with just the name.
|
||||
|
||||
This module is compatible with Auto v3.0.0a8+.
|
||||
This module is compatible with Auto v3.0.0a9+.
|
||||
|
||||
=head1 INSTALL
|
||||
|
||||
|
||||
+14
-14
@@ -45,8 +45,8 @@ sub weather
|
||||
$ua->timeout(2);
|
||||
# Put together the call to the Wunderground API.
|
||||
if (!defined $args[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
|
||||
return;
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
|
||||
return;
|
||||
}
|
||||
my $loc = join(' ', @args);
|
||||
$loc =~ s/ /%20/g;
|
||||
@@ -56,22 +56,22 @@ sub weather
|
||||
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = XMLin($response->decoded_content);
|
||||
my $d = XMLin($response->decoded_content);
|
||||
# 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) }
|
||||
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});
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, 'Location not found.');
|
||||
}
|
||||
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) }
|
||||
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});
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, 'Location not found.');
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, 'An error occurred while retrieving your weather.');
|
||||
privmsg($src->{svr}, $src->{chan}, 'An error occurred while retrieving your weather.');
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
@@ -200,8 +200,8 @@ sub cmd_uno {
|
||||
|
||||
# Check for at least two players.
|
||||
if (keys %PLAYERS < 2) {
|
||||
notice($src->{svr}, $src->{nick}, 'Two players are required to play.');
|
||||
return;
|
||||
# Not found, join the bot.
|
||||
_botjoin();
|
||||
}
|
||||
|
||||
# Deal the cards.
|
||||
@@ -1166,6 +1166,12 @@ sub _delplyr {
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Join the bot to a game.
|
||||
sub _botjoin {
|
||||
$PLAYERS{lc $src->{nick}} = [];
|
||||
$NICKS{lc $src->{nick}} = $src->{nick};
|
||||
}
|
||||
|
||||
# For when a player has won.
|
||||
sub _gameover {
|
||||
my ($player) = @_;
|
||||
|
||||
Reference in new issue
Block a user