12 Commits
22 changed files with 414 additions and 361 deletions

No files matched your search

+2
View File
@@ -2,3 +2,5 @@ auto.conf
build/*
*.swp
autodoc/*
*.db
var/*
+6 -18
View File
@@ -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!
+2 -1
View File
@@ -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
+1 -1
View File
@@ -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
+45
View File
@@ -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
+88 -88
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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;
+8 -2
View File
@@ -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) = @_;