Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1b853d9269 | ||
|
|
ec627df22e | ||
|
|
43e6ce1aaa | ||
|
|
a4ae87a86c | ||
|
|
7a9230c75a | ||
|
|
9288301259 | ||
|
|
85ea081435 | ||
|
|
eb3332241f | ||
|
|
deb95a7ee7 | ||
|
|
067da4d7ad | ||
|
|
49332e5d93 | ||
|
|
7108f3fdfa | ||
|
|
8077acd9ae | ||
|
|
7928f77083 | ||
|
|
f1b6e2f91b | ||
|
|
3f17cb99b2 | ||
|
|
6828aafc44 | ||
|
|
dbe32535d4 | ||
|
|
42cb5201f6 | ||
|
|
04949f38bf | ||
|
|
7dbebdeca9 | ||
|
|
f97b55a56c | ||
|
|
60cdd488ba | ||
|
|
c0aa9d981c | ||
|
|
187de7cdef | ||
|
|
42b58c73e9 | ||
|
|
795c1da38d | ||
|
|
5c9376524c | ||
|
|
c65f3afda4 | ||
|
|
c2b436f420 | ||
|
|
853c7e087e | ||
|
|
0abc3a8236 | ||
|
|
ac389ef399 | ||
|
|
a831e0c4ab | ||
|
|
e154175571 | ||
|
|
3c7e975c98 | ||
|
|
945edfaf54 | ||
|
|
bad3169336 | ||
|
|
6e61841e20 | ||
|
|
b133ef7a6f | ||
|
|
29f00aba27 | ||
|
|
df401193dc | ||
|
|
55071e09d0 | ||
|
|
7f6cd84af8 | ||
|
|
e543af08ad | ||
|
|
31e2c8b4f9 | ||
|
|
934a10d880 | ||
|
|
cf45c4468a | ||
|
|
c2e58299d7 | ||
|
|
9de515a172 | ||
|
|
f274f04c3b | ||
|
|
42cd6da78c | ||
|
|
c9181cf4ce | ||
|
|
a75e3ee771 | ||
|
|
50a3f73a82 | ||
|
|
80004fe047 | ||
|
|
6706445dff | ||
|
|
02ce09749c | ||
|
|
6bff5da689 | ||
|
|
536fc0bc48 | ||
|
|
69c9ccb917 | ||
|
|
0bbf9ae5f1 | ||
|
|
e73fe3138a | ||
|
|
20a8e8c2e4 | ||
|
|
7f4655121e | ||
|
|
650ffdd39f | ||
|
|
fe57f6df3e | ||
|
|
27e242bbef | ||
|
|
b43daecd97 | ||
|
|
e9cf2bda42 | ||
|
|
74b20cb9e7 | ||
|
|
87692dd0ea | ||
|
|
bd7f52d574 | ||
|
|
c21ed7bacb | ||
|
|
f9d624abd0 | ||
|
|
3c1cb00628 |
No files matched your search
@@ -0,0 +1,47 @@
|
||||
8""""8
|
||||
8 8 e e eeeee eeeee
|
||||
8eeee8 8 8 8 8 88
|
||||
88 8 8e 8 8e 8 8
|
||||
88 8 88 8 88 8 8
|
||||
88 8 88ee8 88 8eee8
|
||||
|
||||
3.0
|
||||
|
||||
|
||||
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 alpha4 release, we have added:
|
||||
|
||||
* MySQL support.
|
||||
* PostgreSQL support.
|
||||
* A Greet module for greeting users on join.
|
||||
* IRC logchan functionality.
|
||||
* Improved multilingual support.
|
||||
* A ChanTopics module for advanced management of channel topics.
|
||||
* buildmod now generates HTML and man(1) pages from a module's POD.
|
||||
* server:ajoin now supports channel keys by spacing the name and key.
|
||||
* A Dictionary module for looking up definitions of words.
|
||||
* Heavily improved module API.
|
||||
|
||||
Bug fixes:
|
||||
|
||||
* Commands getting Permission denied even with incorrect prefix.
|
||||
* Program not properly shutting down if all IRC connections close.
|
||||
|
||||
Incompatibilities:
|
||||
|
||||
* Database: Changed structure of the `qdb` table. Modify the configuration
|
||||
values in upgrade.pl then run it to upgrade the database.
|
||||
* database:format is now required in the config.
|
||||
* bantype is now required in the config.
|
||||
|
||||
We thank you for choosing Auto. Please remember that he is still in early
|
||||
development stages. But we hope we've piqued your interest, as Auto's upcoming
|
||||
module repository will allow modules to be 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 4!
|
||||
@@ -7,7 +7,7 @@ package Auto;
|
||||
use 5.010_000;
|
||||
use strict;
|
||||
use warnings;
|
||||
no feature qw(say state);
|
||||
no feature qw(state);
|
||||
use POSIX;
|
||||
use locale;
|
||||
use English qw(-no_match_vars);
|
||||
@@ -15,7 +15,6 @@ use Sys::Hostname;
|
||||
use IO::Socket;
|
||||
use IO::Select;
|
||||
use DBI;
|
||||
use DBD::SQLite;
|
||||
use Class::Unload;
|
||||
use FindBin qw($Bin);
|
||||
our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::ProhibitPackageVars)
|
||||
@@ -47,41 +46,41 @@ local $PROGRAM_NAME = 'auto';
|
||||
|
||||
# Check for build files.
|
||||
if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") {
|
||||
println 'Missing build file(s). Please build Auto before running it.' and exit;
|
||||
say 'Missing build file(s). Please build Auto before running it.' and exit;
|
||||
}
|
||||
|
||||
# Check build OS.
|
||||
open my $BFOS, '<', "$Bin/../build/os" or println 'Cannot start: Broken build.' and exit;
|
||||
open my $BFOS, '<', "$Bin/../build/os" or say 'Cannot start: Broken build.' and exit;
|
||||
my @BFOS = <$BFOS>;
|
||||
close $BFOS or println 'Cannot start: Broken build.' and exit;
|
||||
close $BFOS or say 'Cannot start: Broken build.' and exit;
|
||||
if ($BFOS[0] ne $OSNAME."\n") {
|
||||
println 'Cannot start: Broken build.' and exit;
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
}
|
||||
undef @BFOS;
|
||||
|
||||
# Check build features.
|
||||
our $ENFEAT;
|
||||
open my $BFFEAT, '<', "$Bin/../build/feat" or println 'Cannot start: Broken build.' and exit;
|
||||
open my $BFFEAT, '<', "$Bin/../build/feat" or say 'Cannot start: Broken build.' and exit;
|
||||
my @BFFEAT = <$BFFEAT>;
|
||||
close $BFFEAT or println 'Cannot start: Broken build.' and exit;
|
||||
close $BFFEAT or say 'Cannot start: Broken build.' and exit;
|
||||
$ENFEAT = substr $BFFEAT[0], 0, length($BFFEAT[0]) - 1;
|
||||
undef @BFFEAT;
|
||||
|
||||
# Check build Perl version.
|
||||
open my $BFPERL, '<', "$Bin/../build/perl" or println 'Cannot start: Broken build.' and exit;
|
||||
open my $BFPERL, '<', "$Bin/../build/perl" or say 'Cannot start: Broken build.' and exit;
|
||||
my @BFPERL = <$BFPERL>;
|
||||
close $BFPERL or println 'Cannot start: Broken build.' and exit;
|
||||
close $BFPERL or say 'Cannot start: Broken build.' and exit;
|
||||
if ($BFPERL[0] ne $]."\n") {
|
||||
println 'Cannot start: Broken build.' and exit;
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
}
|
||||
undef @BFPERL;
|
||||
|
||||
# Check build Auto version.
|
||||
open my $BFVER, '<', "$Bin/../build/ver" or println 'Cannot start: Broken build.' and exit;
|
||||
open my $BFVER, '<', "$Bin/../build/ver" or say 'Cannot start: Broken build.' and exit;
|
||||
my @BFVER = <$BFVER>;
|
||||
close $BFVER or println 'Cannot start: Broken build.' and exit;
|
||||
close $BFVER or say 'Cannot start: Broken build.' and exit;
|
||||
if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
|
||||
println 'Cannot start: Broken build.' and exit;
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
}
|
||||
undef @BFVER;
|
||||
|
||||
@@ -97,7 +96,7 @@ API::Std::event_add('on_sighup');
|
||||
|
||||
|
||||
# Print startup message.
|
||||
println <<'EOF';
|
||||
say <<'EOF';
|
||||
8""""8
|
||||
8 8 e e eeeee eeeee
|
||||
8eeee8 8 8 8 8 88
|
||||
@@ -105,7 +104,7 @@ println <<'EOF';
|
||||
88 8 88 8 88 8 8
|
||||
88 8 88ee8 88 8eee8
|
||||
EOF
|
||||
println '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
|
||||
say '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
|
||||
|
||||
our ($APID, %TIMERS);
|
||||
|
||||
@@ -130,21 +129,21 @@ if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6; }
|
||||
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; }
|
||||
|
||||
# Parse configuration file.
|
||||
println '* Parsing configuration file auto.conf...';
|
||||
say '* Parsing configuration file auto.conf...';
|
||||
our $CONF = Parser::Config->new('auto.conf') or err(1, 'Failed to parse configuration file!', 1);
|
||||
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
|
||||
println ' Success';
|
||||
say ' Success';
|
||||
|
||||
if (conf_get('die')) {
|
||||
if ((conf_get('die'))[0][0] == 1) {
|
||||
println '!!! You didn\'t read the whole config.';
|
||||
println '!!! Insert new user then try again.';
|
||||
say '!!! You didn\'t read the whole config.';
|
||||
say '!!! Insert new user then try again.';
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
# Check for required configuration values.
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit);
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
|
||||
foreach my $REQCVAL (@REQCVALS) {
|
||||
if (!conf_get($REQCVAL)) {
|
||||
my $err = 2;
|
||||
@@ -157,22 +156,95 @@ foreach my $REQCVAL (@REQCVALS) {
|
||||
undef @REQCVALS;
|
||||
|
||||
# Parse translations.
|
||||
println '* Parsing translation files...';
|
||||
say '* Parsing translation files...';
|
||||
our $LOCALE = (conf_get('locale'))[0][0];
|
||||
my @lang = split m/[_]/, $LOCALE;
|
||||
Parser::Lang::parse($lang[0]) or err(2, 'Failed to parse translation files!', 1);
|
||||
undef @lang;
|
||||
println ' Success';
|
||||
say ' Success';
|
||||
|
||||
# Expire old logs.
|
||||
API::Log::expire_logs();
|
||||
|
||||
# Connect to database.
|
||||
if (!-e "$Bin/../etc/auto.db") {
|
||||
system "touch $Bin/../etc/auto.db";
|
||||
system "chmod a+x $Bin/../etc/auto.db";
|
||||
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); }
|
||||
|
||||
# Import DBD::SQLite.
|
||||
require DBD::SQLite;
|
||||
|
||||
if (!-e "$Bin/../etc/".(conf_get('database:filename'))[0][0]) {
|
||||
# Create <database:filename> if it's missing.
|
||||
system "touch $Bin/../etc/".(conf_get('database:filename'))[0][0];
|
||||
system "chmod a+x $Bin/../etc/".(conf_get('database:filename'))[0][0];
|
||||
}
|
||||
# Connect to database.
|
||||
$DB = DBI->connect("dbi:SQLite:dbname=$Bin/../etc/".(conf_get('database:filename'))[0][0]) or err(2, 'Failed to connect to database!', 1);
|
||||
}
|
||||
when ('mysql') {
|
||||
# MySQL.
|
||||
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); } }
|
||||
undef @reqcval;
|
||||
|
||||
# Import DBD::mysql.
|
||||
require DBD::mysql;
|
||||
|
||||
# Connect to database.
|
||||
if (conf_get('database:port')) {
|
||||
# If we were given a port, connect with it.
|
||||
$DB = DBI->connect('DBI:mysql:database='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0].';port='.(conf_get('database:port'))[0][0],
|
||||
(conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);;
|
||||
}
|
||||
else {
|
||||
# If not, connect without specifying a port.
|
||||
$DB = DBI->connect('DBI:mysql:database='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0],
|
||||
(conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);;
|
||||
}
|
||||
}
|
||||
# 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); }
|
||||
#
|
||||
# # Import DBD::CSV.
|
||||
# require DBD::CSV;
|
||||
#
|
||||
# # Connect to database.
|
||||
# $DB = DBI->connect("dbi:CSV:f_dir=$Bin/../etc/".(conf_get('database:dir'))[0][0]) or err(2, 'Failed to connect to database!', 1);
|
||||
#}
|
||||
when ('pgsql') {
|
||||
# PostgreSQL.
|
||||
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); } }
|
||||
undef @reqcval;
|
||||
|
||||
# Import DBD::Pg.
|
||||
require DBD::Pg;
|
||||
|
||||
# Connect to database.
|
||||
if (conf_get('database:port')) {
|
||||
# If a specific port was given, use it.
|
||||
$DB = DBI->connect('dbi:Pg:db='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0].';port='.(conf_get('database:port'))[0][0],
|
||||
(conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);
|
||||
}
|
||||
else {
|
||||
# We were not given a port, connect using PGPORT (usually 5432)
|
||||
$DB = DBI->connect('dbi:Pg:db='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0],
|
||||
(conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);
|
||||
}
|
||||
}
|
||||
# Unknown database format.
|
||||
default { err(2, 'Unknown database format \''.lc((conf_get('database:format'))[0][0]).'\'. Aborting.', 1); }
|
||||
}
|
||||
our $DB = DBI->connect("dbi:SQLite:dbname=$Bin/../etc/auto.db", q{}, q{});
|
||||
|
||||
|
||||
# Ratelimit timer.
|
||||
Core::IRC::clear_usercmd_timer();
|
||||
@@ -228,12 +300,12 @@ if (conf_get('privset')) {
|
||||
|
||||
# Successful startup.
|
||||
our $STARTTIME = time;
|
||||
println '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
|
||||
say '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
|
||||
alog 'Auto successfully started.';
|
||||
|
||||
# Fork into the background if not in debug mode.
|
||||
if (!$DEBUG) {
|
||||
println '*** Becoming a daemon...';
|
||||
say '*** Becoming a daemon...';
|
||||
open STDIN, '<', '/dev/null' or err(2, "Can't read /dev/null: $ERRNO", 1);
|
||||
open STDOUT, '>>', '/dev/null' or err(2, "Can't write to /dev/null: $ERRNO", 1);
|
||||
open STDERR, '>>', '/dev/null' or err(2, "Can't write to /dev/null: $ERRNO", 1);
|
||||
@@ -404,6 +476,14 @@ while (1) {
|
||||
err(2, "Lost connection to $sockid!", 0);
|
||||
$SELECT->remove($sock);
|
||||
delete $SOCKET{$sockid};
|
||||
if (!keys %SOCKET) {
|
||||
# No more connections, stop the program.
|
||||
API::Std::event_run('on_shutdown');
|
||||
dbug '* No more IRC connections, shutting down.';
|
||||
alog '* No more IRC connections, shutting down.';
|
||||
sleep 1;
|
||||
exit;
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
|
||||
+40
-1
@@ -8,6 +8,8 @@ use strict;
|
||||
use warnings;
|
||||
use English qw(-no_match_vars);
|
||||
use FindBin qw($Bin);
|
||||
use Pod::Html;
|
||||
use Pod::Man;
|
||||
our $Bin = $Bin;
|
||||
|
||||
our $VERSION = 1.00;
|
||||
@@ -103,12 +105,49 @@ foreach (@pars) {
|
||||
print 'Checking Perl version..... '.$PERL_VERSION.' - ';
|
||||
if ($] < $val) { $die = 1; }
|
||||
say (($die) ? 'Not OK' : 'OK');
|
||||
print $RS;
|
||||
if ($die) { say 'Failed to build '.$module.'.'; exit; }
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Generate documentation.
|
||||
my $got_end = 0;
|
||||
open my $FMPH, '<', $modulep;
|
||||
my @MPBUF = <$FMPH>;
|
||||
close $FMPH;
|
||||
|
||||
say 'Generating documentation.....';
|
||||
my $podbuf;
|
||||
foreach my $line (@MPBUF) {
|
||||
if (!defined $line) { $line = ' '; }
|
||||
$line =~ s/(\r|\n)//g;
|
||||
|
||||
if ($line eq '__END__') {
|
||||
$got_end = 1;
|
||||
}
|
||||
|
||||
if ($got_end and $line ne '__END__') {
|
||||
$podbuf .= $line."\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Create the autodoc/ dir if it doesn't exist.
|
||||
if (!-d "$Bin/../autodoc") {
|
||||
mkdir "$Bin/../autodoc";
|
||||
}
|
||||
|
||||
# Save to POD file in autodoc/
|
||||
open my $FMPNH, '>', "$Bin/../autodoc/$module.pod";
|
||||
print {$FMPNH} $podbuf;
|
||||
close $FMPNH;
|
||||
|
||||
# Create HTML.
|
||||
pod2html("--infile=$Bin/../autodoc/$module.pod", "--outfile=$Bin/../autodoc/$module.html");
|
||||
# Create *roff.
|
||||
my $manifier = Pod::Man->new();
|
||||
$manifier->parse_from_file("$Bin/../autodoc/$module.pod", "$Bin/../autodoc/$module.1");
|
||||
|
||||
print $RS;
|
||||
say 'Done.';
|
||||
|
||||
# vim: set ai sw=4 ts=4:
|
||||
@@ -2,6 +2,36 @@ Auto IRC Bot 3.0: Change Log
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
3.0 Indev
|
||||
===============================================================================
|
||||
* Added a Dictionary module for looking up definitions of words.
|
||||
* server:ajoin now supports channel keys by spacing the name and key.
|
||||
* Hooks can now block events by returning -1.
|
||||
* bin/buildmod now retrieves the POD from modules and creates man(1) page
|
||||
plus HTML file.
|
||||
* cjoin() now supports a channel key as the last argument.
|
||||
* Added a ChanTopics module for advanced management of channel topics.
|
||||
* bantype is now a required configuration value.
|
||||
* Added ban() to API::IRC.
|
||||
* Changed on_cprivmsg arguments to: \%src, $channel, @msg
|
||||
* Changed on_uprivmsg arguments to: \%src, @msg
|
||||
* Bug fix: Commands getting Permission denied even with incorrect prefix.
|
||||
* Changed command callback arguments to: \%src, @args
|
||||
* Bundle server with \%src in the on_rcjoin event.
|
||||
* logchan is now joined automatically.
|
||||
* Changed on_notice arguments to: \%src, $target, @msg
|
||||
* Clean up shutdown.
|
||||
* Created event on_shutdown.
|
||||
* Shutdown if there are no more IRC connections.
|
||||
* Added the ability to use printf(3) % variables in trans().
|
||||
* Added slog() to API::Log for logging to IRC.
|
||||
* Added a Greet module for greeting users on join.
|
||||
* Added PostgreSQL support. Official modules do not support this yet.
|
||||
* database:format now a required configuration value.
|
||||
* Added support for MySQL. ./install --with-mysql
|
||||
* Added a database upgrade script for upgrading the `qdb` table in 3.0.0a3
|
||||
to the new format used by 3.0.0a4.
|
||||
|
||||
3.0 Alpha 3
|
||||
===============================================================================
|
||||
* Added command rate limiting.
|
||||
* Added module installer to ./install.
|
||||
|
||||
@@ -8,6 +8,8 @@ Legend:
|
||||
? = Being questioned.
|
||||
+ = Planned for Auto v3.1.
|
||||
|
||||
[ ] Cleanup
|
||||
[ ] Replace println with Perl 5.10's say.
|
||||
|
||||
[X] Language
|
||||
[X] Create method of translation.
|
||||
@@ -21,15 +23,17 @@ Legend:
|
||||
[X] Create basic modular functions
|
||||
[X] Create logging functions
|
||||
[X] Create command creation functions
|
||||
[!] Create user permissions (levels)
|
||||
|
||||
[!] IRC
|
||||
[X] Create IRC parser
|
||||
|
||||
[!] DB
|
||||
[X] Create Auto-Flatfile database format
|
||||
[X] Implement Auto-Flatfile as the main format
|
||||
[ ] Add MySQL support
|
||||
[O] Create Auto-Flatfile database format
|
||||
[O] Implement Auto-Flatfile as the main format
|
||||
[X] Add SQLite support as default
|
||||
[x] Add MySQL support
|
||||
[X] Add PostgreSQL support
|
||||
[O] Add Oracle DB support
|
||||
|
||||
[O] Sys
|
||||
[ ] Create system file for UNIX (or: Linux, BSD, etc.)
|
||||
@@ -42,7 +46,7 @@ Legend:
|
||||
[ ] Google Search module
|
||||
[ ] IRC Relay module
|
||||
[ ] (Google?) News module
|
||||
[ ] QDB module
|
||||
[X] QDB module
|
||||
[ ] Tumblr module
|
||||
[X] Google Calculator module
|
||||
[ ] YouTube Search module
|
||||
|
||||
@@ -86,10 +86,30 @@ user "#bot-ops" {
|
||||
privs "op";
|
||||
}
|
||||
|
||||
# Database.
|
||||
database {
|
||||
# Format. This can be one of the following:
|
||||
# sqlite Requires database:filename. Recommended.
|
||||
# mysql Requires database:name,host,username,password and that Auto be built with --with-mysql. Optional: database:port
|
||||
# pgsql Requires database:name,host,username,password and that Auto be built with --with-pgsql. Optional: database:port
|
||||
format "sqlite";
|
||||
|
||||
# If you chose SQLite, uncomment this and choose a filename.
|
||||
# filename "somebot.db";
|
||||
|
||||
# If you chose MySQL or PostgreSQL, uncomment these and set them.
|
||||
# name "auto";
|
||||
# host "localhost";
|
||||
# username "root";
|
||||
# password "moocows";
|
||||
}
|
||||
|
||||
# Locale.
|
||||
locale "en_US";
|
||||
|
||||
# Logging to IRC. Uncomment this and set it to setup an IRC logchan.
|
||||
# logchan "Freenode/#logchan";
|
||||
|
||||
# Expire logs in days. 0 disables.
|
||||
expire_logs 15;
|
||||
|
||||
@@ -103,6 +123,14 @@ ratelimit_time 6;
|
||||
# How many commands can be used by a user in each period.
|
||||
ratelimit_amount 3;
|
||||
|
||||
# Type of ban.
|
||||
# 1 - *!*@h
|
||||
# 2 - n!*@*
|
||||
# 3 - *!u@h
|
||||
# 4 - n!*u@h
|
||||
# 5 - *!*@*.h+
|
||||
bantype 1;
|
||||
|
||||
# Module autoload.
|
||||
module "HelloChan";
|
||||
|
||||
|
||||
@@ -17,28 +17,34 @@ our $VERSION = 1.00;
|
||||
our $ERROR = 0;
|
||||
|
||||
# Iterate through the arguments passed to us.
|
||||
my $features = "base ssl";
|
||||
my $features = 'base ssl sqlite';
|
||||
if (defined $ARGV[0]) {
|
||||
foreach (@ARGV) {
|
||||
if ($_ eq "-h" or $_ eq "--help") {
|
||||
println "*** ./install help ***";
|
||||
println " --enable-sasl - Enable support for SASL.";
|
||||
println " --enable-ipv6 - Enable support for IPv6.";
|
||||
println " --disable-ssl - Disable support for SSL.";
|
||||
println "*** End of Help ***";
|
||||
exit;
|
||||
if ($_ eq '-h' or $_ eq '--help') {
|
||||
println '*** ./install help ***';
|
||||
println ' --enable-sasl - Enable support for SASL.';
|
||||
println ' --enable-ipv6 - Enable support for IPv6.';
|
||||
println ' --disable-ssl - Disable support for SSL.';
|
||||
println '*** End of Help ***';
|
||||
exit 1;
|
||||
}
|
||||
elsif ($_ eq "--enable-sasl") {
|
||||
$features .= " sasl";
|
||||
elsif ($_ eq '--enable-sasl') {
|
||||
$features .= ' sasl';
|
||||
}
|
||||
elsif ($_ eq "--disable-ssl") {
|
||||
elsif ($_ eq '--disable-ssl') {
|
||||
$features =~ s/ ssl//g;
|
||||
}
|
||||
elsif ($_ eq "--enable-ipv6") {
|
||||
$features .= " ipv6";
|
||||
elsif ($_ eq '--enable-ipv6') {
|
||||
$features .= ' ipv6';
|
||||
}
|
||||
else {
|
||||
println "Warning: Unknown option '".$_."'";
|
||||
elsif ($_ eq '--with-mysql') {
|
||||
$features =~ s/(sqlite|pgsql)/mysql/g;
|
||||
}
|
||||
elsif ($_ eq '--with-pgsql') {
|
||||
$features =~ s/(sqlite|mysql)/pgsql/g;
|
||||
}
|
||||
else {
|
||||
println "Warning: Unknown option '$_'";
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -97,7 +103,9 @@ println 'Checking for required CPAN modules......';
|
||||
println "\0";
|
||||
#modfind("Mouse");
|
||||
modfind('DBI');
|
||||
modfind('DBD::SQLite');
|
||||
modfind('DBD::SQLite') if $features =~ /sqlite/;
|
||||
modfind('DBD::mysql') if $features =~ /mysql/;
|
||||
modfind('DBD::Pg') if $features =~ /pgsql/;
|
||||
modfind('Class::Unload');
|
||||
modfind('IO::Socket::INET6') if $features =~ /ipv6/;
|
||||
modfind('IO::Socket::SSL') if $features =~ /ssl/;
|
||||
|
||||
+39
-5
@@ -4,19 +4,53 @@
|
||||
package API::IRC;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(switch);
|
||||
use Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(cjoin cpart cmode umode kick privmsg notice quit nick names topic
|
||||
usrc match_mask);
|
||||
our @EXPORT_OK = qw(ban cjoin cpart cmode umode kick privmsg notice quit nick names
|
||||
topic usrc match_mask);
|
||||
|
||||
|
||||
# Set a ban, based on config bantype value.
|
||||
sub ban
|
||||
{
|
||||
my ($svr, $chan, $type, $user) = @_;
|
||||
my $cbt = (API::Std::conf_get('bantype'))[0][0];
|
||||
|
||||
# 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 = '*!'.$user->{user}.'@'.$user->{host}; }
|
||||
when (4) { $mask = $user->{nick}.'!*'.$user->{user}.'@'.$user->{host}; }
|
||||
when (5) {
|
||||
my @hd = split m/[\.]/, $user->{host};
|
||||
shift @hd;
|
||||
$mask = '*!*@*.'.join ' ', @hd;
|
||||
}
|
||||
}
|
||||
|
||||
# Now set the ban.
|
||||
if (lc $type eq 'b') {
|
||||
# We were requested to set a regular ban.
|
||||
cmode($svr, $chan, "+b $mask");
|
||||
}
|
||||
elsif (lc $type eq 'q') {
|
||||
# We were requested to set a ratbox-style quiet.
|
||||
cmode($svr, $chan, "+q $mask");
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Join a channel.
|
||||
sub cjoin
|
||||
{
|
||||
my ($svr, $chan) = @_;
|
||||
my ($svr, $chan, $key) = @_;
|
||||
|
||||
Auto::socksnd($svr, "JOIN $chan");
|
||||
Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan"));
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -125,7 +159,7 @@ sub kick
|
||||
{
|
||||
my ($svr, $chan, $nick, $msg) = @_;
|
||||
|
||||
Auto::socksnd($svr, "KICK $chan $nick :$msg");
|
||||
Auto::socksnd($svr, "KICK $chan $nick :".((defined $msg) ? $msg : 'No reason'));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
+36
-2
@@ -4,6 +4,7 @@
|
||||
package API::Log;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(say);
|
||||
use English qw(-no_match_vars);
|
||||
use POSIX;
|
||||
use Time::Local;
|
||||
@@ -11,7 +12,7 @@ use Exporter;
|
||||
use base qw(Exporter);
|
||||
use API::Std qw(conf_get);
|
||||
|
||||
our @EXPORT_OK = qw(println dbug alog);
|
||||
our @EXPORT_OK = qw(println dbug alog slog);
|
||||
|
||||
|
||||
# Print with the system newline appended.
|
||||
@@ -36,7 +37,7 @@ sub dbug
|
||||
|
||||
if ($Auto::DEBUG) {
|
||||
# We're in debug mode; print it out.
|
||||
println $out;
|
||||
say $out;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -107,6 +108,39 @@ sub expire_logs
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Subroutine for logging to an IRC logchan.
|
||||
sub slog
|
||||
{
|
||||
my ($msg) = @_;
|
||||
|
||||
# Check if logging to channel is enabled.
|
||||
if (conf_get('logchan')) {
|
||||
# It is, continue.
|
||||
|
||||
# Split the network and channel.
|
||||
my ($net, $chan) = split '/', (conf_get('logchan'))[0][0];
|
||||
$chan = lc $chan;
|
||||
|
||||
# Check if we're connected to the network.
|
||||
if (!defined $Auto::SOCKET{$net}) {
|
||||
dbug 'WARNING: slog(): Unable to log to IRC: Not connected to network.';
|
||||
alog 'WARNING: slog(): Unable to log to IRC: Not connected to network.';
|
||||
return;
|
||||
}
|
||||
|
||||
# Check if we're in the channel.
|
||||
if (!defined $Parser::IRC::botchans{$net}{$chan}) {
|
||||
dbug 'WARNING: slog(): Unable to log to IRC: Not in channel.';
|
||||
alog 'WARNING: slog(): Unable to log to IRC: Not in channel.';
|
||||
return;
|
||||
}
|
||||
|
||||
# Log to IRC.
|
||||
API::IRC::privmsg($net, $chan, "\002LOG:\002 $msg");
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
+25
-6
@@ -4,6 +4,7 @@
|
||||
package API::Std;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(say);
|
||||
use Exporter;
|
||||
use base qw(Exporter);
|
||||
|
||||
@@ -22,11 +23,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.'...'); }
|
||||
|
||||
# Check if this module is compatible with this version of Auto.
|
||||
if ($autover ne '3.0.0d') {
|
||||
if ($autover ne '3.0.0a4') {
|
||||
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.'); }
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -42,6 +45,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.'); }
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -49,6 +53,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{.}); }
|
||||
|
||||
return;
|
||||
}
|
||||
@@ -72,11 +77,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.'...'); }
|
||||
|
||||
# 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?'); }
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -89,12 +96,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{.}); }
|
||||
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{.}); }
|
||||
return;
|
||||
}
|
||||
}
|
||||
@@ -171,7 +180,8 @@ sub event_run
|
||||
|
||||
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
|
||||
foreach my $hk (keys %{ $HOOKS{lc $event} }) {
|
||||
&{ $HOOKS{lc $event}{$hk} }(@args);
|
||||
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
|
||||
if ($ri == -1) { last; }
|
||||
}
|
||||
}
|
||||
|
||||
@@ -328,11 +338,11 @@ sub conf_get
|
||||
# Translation subroutine.
|
||||
sub trans
|
||||
{
|
||||
my ($id) = @_;
|
||||
my $id = shift;
|
||||
$id =~ s/ /_/gsm;
|
||||
|
||||
if (defined $API::Std::LANGE{$id}) {
|
||||
return $API::Std::LANGE{$id};
|
||||
return sprintf $API::Std::LANGE{$id}, @_;
|
||||
}
|
||||
else {
|
||||
$id =~ s/_/ /gsm;
|
||||
@@ -430,6 +440,7 @@ sub ratelimit_check
|
||||
# If the user has not passed the rate limit.
|
||||
if ($Core::IRC::usercmd{$src{nick}.'@'.$src{host}.'/'.$src{svr}} <= (conf_get('ratelimit_amount'))[0][0]) {
|
||||
# Increment their uses and return 1.
|
||||
|
||||
$Core::IRC::usercmd{$src{nick}.'@'.$src{host}.'/'.$src{svr}}++;
|
||||
return 1;
|
||||
}
|
||||
@@ -462,12 +473,16 @@ sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
|
||||
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
API::Log::println("ERROR: $msg");
|
||||
say "ERROR: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("ERROR: $msg");
|
||||
}
|
||||
# Level 3: Log to IRC.
|
||||
if ($lvl >= 3) {
|
||||
API::Log::slog("ERROR: $msg");
|
||||
}
|
||||
|
||||
# If it's a fatal error, exit the program.
|
||||
if ($fatal) { exit; }
|
||||
@@ -487,12 +502,16 @@ sub awarn
|
||||
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
API::Log::println("WARNING: $msg");
|
||||
say "WARNING: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("WARNING: $msg");
|
||||
}
|
||||
# Level 3: Log to IRC.
|
||||
if ($lvl >= 3) {
|
||||
API::Log::slog("WARNING: $msg");
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
+44
-50
@@ -16,18 +16,17 @@ our %HELP_MODLOAD = (
|
||||
# MODLOAD callback.
|
||||
sub cmd_modload
|
||||
{
|
||||
my (%data) = @_;
|
||||
my @argv = @{ $data{args} };
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for the needed parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Check if the module is already loaded.
|
||||
if (API::Std::mod_exists($argv[0])) {
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 is already loaded.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is already loaded.");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -37,11 +36,11 @@ sub cmd_modload
|
||||
# Check if we were successful or not.
|
||||
if ($tn) {
|
||||
# We were!
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 successfully loaded.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 successfully loaded.");
|
||||
}
|
||||
else {
|
||||
# We weren't.
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 failed to load.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to load.");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -55,18 +54,17 @@ our %HELP_MODUNLOAD = (
|
||||
# MODUNLOAD callback.
|
||||
sub cmd_modunload
|
||||
{
|
||||
my (%data) = @_;
|
||||
my @argv = @{ $data{args} };
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for the needed parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Check if the module exists.
|
||||
if (!API::Std::mod_exists($argv[0])) {
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 is not loaded.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded.");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -76,11 +74,11 @@ sub cmd_modunload
|
||||
# Check if we were successful or not.
|
||||
if ($tn) {
|
||||
# We were!
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 successfully unloaded.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 successfully unloaded.");
|
||||
}
|
||||
else {
|
||||
# We weren't.
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 failed to unload.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to unload.");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -94,18 +92,17 @@ our %HELP_MODRELOAD = (
|
||||
# MODRELOAD callback.
|
||||
sub cmd_modreload
|
||||
{
|
||||
my (%data) = @_;
|
||||
my @argv = @{ $data{args} };
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for the needed parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Check if the module exists.
|
||||
if (!API::Std::mod_exists($argv[0])) {
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 is not loaded.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded.");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -117,11 +114,11 @@ sub cmd_modreload
|
||||
# Check if we were successful or not.
|
||||
if ($tvn and $tln) {
|
||||
# We were!
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 successfully reloaded.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 successfully reloaded.");
|
||||
}
|
||||
else {
|
||||
# We weren't.
|
||||
notice($data{svr}, $data{nick}, "Module \002".$argv[0]."\002 failed to reload.");
|
||||
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to reload.");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -135,15 +132,14 @@ our %HELP_SHUTDOWN = (
|
||||
# SHUTDOWN callback.
|
||||
sub cmd_shutdown
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, undef) = @_;
|
||||
|
||||
# Goodbye world!
|
||||
notice($data{svr}, $data{nick}, "Shutting down.");
|
||||
dbug "Got SHUTDOWN from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Shutting down. . .";
|
||||
alog "Got SHUTDOWN from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Shutting down. . .";
|
||||
quit($_, "SHUTDOWN from ".$data{nick}."/".$data{svr}) foreach (keys %Auto::SOCKET);
|
||||
$Auto::DB->disconnect;
|
||||
system("rm $Auto::Bin/auto.pid");
|
||||
notice($src->{svr}, $src->{nick}, "Shutting down.");
|
||||
dbug "Got SHUTDOWN from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Shutting down. . .";
|
||||
alog "Got SHUTDOWN from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Shutting down. . .";
|
||||
quit($_, "SHUTDOWN from ".$src->{nick}."/".$src->{svr}) foreach (keys %Auto::SOCKET);
|
||||
API::Std::event_run('on_shutdown');
|
||||
exit;
|
||||
|
||||
# To appease PerlCritic.
|
||||
@@ -157,15 +153,14 @@ our %HELP_RESTART = (
|
||||
# RESTART callback.
|
||||
sub cmd_restart
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, undef) = @_;
|
||||
|
||||
# Goodbye world!
|
||||
notice($data{svr}, $data{nick}, "Restarting.");
|
||||
dbug "Got RESTART from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Restarting. . .";
|
||||
alog "Got RESTART from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Restarting. . .";
|
||||
quit($_, "RESTART from ".$data{nick}."/".$data{svr}) foreach (keys %Auto::SOCKET);
|
||||
$Auto::DB->disconnect;
|
||||
system("rm $Auto::Bin/auto.pid") if -e "$Auto::Bin/auto.pid";
|
||||
notice($src->{svr}, $src->{nick}, "Restarting.");
|
||||
dbug "Got RESTART from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Restarting. . .";
|
||||
alog "Got RESTART from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Restarting. . .";
|
||||
quit($_, "RESTART from ".$src->{nick}."/".$src->{svr}) foreach (keys %Auto::SOCKET);
|
||||
API::Std::event_run('on_shutdown');
|
||||
|
||||
# Time to come back from the dead!
|
||||
if ($Auto::DEBUG) {
|
||||
@@ -187,16 +182,16 @@ our %HELP_REHASH = (
|
||||
# REHASH callback.
|
||||
sub cmd_rehash
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, undef) = @_;
|
||||
|
||||
# Send out notifications.
|
||||
notice($data{svr}, $data{nick}, "Rehashing.");
|
||||
dbug "Got REHASH from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Rehashing. . .";
|
||||
alog "Got REHASH from ".$data{nick}."!".$data{user}."@".$data{host}."/".$data{svr}."! Rehashing. . .";
|
||||
notice($src->{svr}, $src->{nick}, "Rehashing.");
|
||||
dbug "Got REHASH from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Rehashing. . .";
|
||||
alog "Got REHASH from ".$src->{nick}."!".$src->{user}."@".$src->{host}."/".$src->{svr}."! Rehashing. . .";
|
||||
|
||||
# Rehash.
|
||||
Lib::Auto::rehash();
|
||||
notice($data{svr}, $data{nick}, "Done.");
|
||||
notice($src->{svr}, $src->{nick}, "Done.");
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -208,18 +203,17 @@ our %HELP_HELP = (
|
||||
# HELP callback.
|
||||
sub cmd_help
|
||||
{
|
||||
my (%data) = @_;
|
||||
my @argv = @{ $data{args} }; delete $data{args};
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for arguments and reply accordingly.
|
||||
if (!defined $argv[0]) {
|
||||
# No command specified. List commands.
|
||||
my $cmdlist = '';
|
||||
foreach (sort keys %API::Std::CMDS) {
|
||||
if (defined $data{chan}) {
|
||||
if (defined $src->{chan}) {
|
||||
if ($API::Std::CMDS{$_}{lvl} == 0 or $API::Std::CMDS{$_}{lvl} == 2) {
|
||||
if ($API::Std::CMDS{$_}{priv}) {
|
||||
if (has_priv(match_user(%data), $API::Std::CMDS{$_}{priv})) {
|
||||
if (has_priv(match_user(%$src), $API::Std::CMDS{$_}{priv})) {
|
||||
$cmdlist .= ", \002".uc($_)."\002";
|
||||
}
|
||||
}
|
||||
@@ -231,7 +225,7 @@ sub cmd_help
|
||||
else {
|
||||
if ($API::Std::CMDS{$_}{lvl} == 1 or $API::Std::CMDS{$_}{lvl} == 2) {
|
||||
if ($API::Std::CMDS{$_}{priv}) {
|
||||
if (has_priv(match_user(%data), $API::Std::CMDS{$_}{priv})) {
|
||||
if (has_priv(match_user(%$src), $API::Std::CMDS{$_}{priv})) {
|
||||
$cmdlist .= ", \002".uc($_)."\002";
|
||||
}
|
||||
}
|
||||
@@ -243,7 +237,7 @@ sub cmd_help
|
||||
}
|
||||
$cmdlist = substr($cmdlist, 2);
|
||||
|
||||
notice($data{svr}, $data{nick}, "Command List: ".$cmdlist);
|
||||
notice($src->{svr}, $src->{nick}, "Command List: ".$cmdlist);
|
||||
}
|
||||
else {
|
||||
# Help for a specific command was requested. Lets get it.
|
||||
@@ -254,8 +248,8 @@ sub cmd_help
|
||||
|
||||
# Check for necessary privileges.
|
||||
if ($API::Std::CMDS{$rcm}{priv}) {
|
||||
if (!has_priv(match_user(%data), $API::Std::CMDS{$rcm}{priv})) {
|
||||
notice($data{svr}, $data{nick}, trans("Access denied").".");
|
||||
if (!has_priv(match_user(%$src), $API::Std::CMDS{$rcm}{priv})) {
|
||||
notice($src->{svr}, $src->{nick}, trans("Access denied").".");
|
||||
return;
|
||||
}
|
||||
}
|
||||
@@ -268,28 +262,28 @@ sub cmd_help
|
||||
|
||||
if (defined ${ $API::Std::CMDS{$rcm}{help} }{$lang}) {
|
||||
# If help for this command is available in the configured language.
|
||||
notice($data{svr}, $data{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{$lang});
|
||||
notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{$lang});
|
||||
}
|
||||
else {
|
||||
# If it isn't, default to English.
|
||||
if (defined ${ $API::Std::CMDS{$rcm}{help} }{en}) {
|
||||
# If help for this command is available in English.
|
||||
notice($data{svr}, $data{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{en});
|
||||
notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{en});
|
||||
}
|
||||
else {
|
||||
# If it isn't, no help.
|
||||
notice($data{svr}, $data{nick}, "No help for \002".$rcm."\002 available.");
|
||||
notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# If it isn't valid, no help.
|
||||
notice($data{svr}, $data{nick}, "No help for \002".$rcm."\002 available.");
|
||||
notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# If there is no help, don't give any.
|
||||
notice($data{svr}, $data{nick}, "No help for \002".$rcm."\002 available.");
|
||||
notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+35
-7
@@ -12,15 +12,14 @@ our (%usercmd);
|
||||
|
||||
# CTCP VERSION reply.
|
||||
hook_add("on_uprivmsg", "ctcp_version_reply", sub {
|
||||
my (($svr, @ex)) = @_;
|
||||
my %src = usrc(substr($ex[0], 1));
|
||||
my (($src, @msg)) = @_;
|
||||
|
||||
if ($ex[3] eq ":\001VERSION\001") {
|
||||
if ($msg[0] eq "\001VERSION\001") {
|
||||
if (Auto::RSTAGE ne 'd') {
|
||||
notice($svr, $src{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE." ".$OSNAME."\001");
|
||||
notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE." ".$OSNAME."\001");
|
||||
}
|
||||
else {
|
||||
notice($svr, $src{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-".Auto::GR." ".$OSNAME."\001");
|
||||
notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-".Auto::GR." ".$OSNAME."\001");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -76,11 +75,40 @@ hook_add("on_connect", "autojoin", sub {
|
||||
# For single-line ajoins.
|
||||
my @sajoin = split(',', $cajoin[0]);
|
||||
|
||||
API::IRC::cjoin($svr, $_) foreach (@sajoin);
|
||||
foreach (@sajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
# There was, join with it.
|
||||
my ($chan, $key) = split / /;
|
||||
API::IRC::cjoin($svr, $chan, $key);
|
||||
}
|
||||
else {
|
||||
# Else join without one.
|
||||
API::IRC::cjoin($svr, $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# For multi-line ajoins.
|
||||
API::IRC::cjoin($svr, $_) foreach (@cajoin);
|
||||
foreach (@cajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
# There was, join with it.
|
||||
my ($chan, $key) = split / /;
|
||||
API::IRC::cjoin($svr, $chan, $key);
|
||||
}
|
||||
else {
|
||||
# Else join without one.
|
||||
API::IRC::cjoin($svr, $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
# And logchan, if applicable.
|
||||
if (conf_get('logchan')) {
|
||||
my ($lcn, $lcc) = split '/', (conf_get('logchan'))[0][0];
|
||||
if ($lcn eq $svr) {
|
||||
API::IRC::cjoin($svr, $lcc);
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
+19
-14
@@ -7,10 +7,14 @@ use warnings;
|
||||
use English qw(-no_match_vars);
|
||||
use Sys::Hostname;
|
||||
use feature qw(switch);
|
||||
use API::Std qw(conf_get err);
|
||||
use API::Std qw(hook_add conf_get err);
|
||||
use API::Log qw(println dbug alog);
|
||||
our $VERSION = 3.000000;
|
||||
|
||||
# Core events.
|
||||
API::Std::event_add('on_shutdown');
|
||||
API::Std::event_add('on_rehash');
|
||||
|
||||
# Update checker.
|
||||
sub checkver
|
||||
{
|
||||
@@ -50,7 +54,7 @@ sub rehash
|
||||
my %newsettings = $Auto::CONF->parse or err(2, 'Failed to parse configuration file!', 0) and return;
|
||||
|
||||
# Check for required configuration values.
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf);
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
|
||||
foreach my $REQCVAL (@REQCVALS) {
|
||||
if (!defined $newsettings{$REQCVAL}) {
|
||||
err(2, "Missing required configuration value: $REQCVAL", 0) and return;
|
||||
@@ -200,9 +204,19 @@ sub rehash
|
||||
}
|
||||
}
|
||||
|
||||
# Now trigger on_rehash.
|
||||
API::Std::event_run('on_rehash');
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Shutdown.
|
||||
hook_add('on_shutdown', 'shutdown.core_cleanup', sub {
|
||||
if (defined $Auto::DB) { $Auto::DB->disconnect; }
|
||||
if (-e "$Auto::Bin/auto.pid") { unlink "$Auto::Bin/auto.pid"; }
|
||||
return 1;
|
||||
});
|
||||
|
||||
###################
|
||||
# Signal handlers #
|
||||
###################
|
||||
@@ -211,13 +225,10 @@ sub rehash
|
||||
sub signal_term
|
||||
{
|
||||
API::Std::event_run('on_sigterm');
|
||||
API::Std::event_run('on_shutdown');
|
||||
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGTERM'); }
|
||||
$Auto::DB->disconnect;
|
||||
dbug '!!! Caught SIGTERM; terminating...';
|
||||
alog '!!! Caught SIGTERM; terminating...';
|
||||
if (-e "$Auto::Bin/auto.pid") {
|
||||
unlink "$Auto::Bin/auto.pid";
|
||||
}
|
||||
sleep 1;
|
||||
exit;
|
||||
}
|
||||
@@ -226,13 +237,10 @@ sub signal_term
|
||||
sub signal_int
|
||||
{
|
||||
API::Std::event_run('on_sigint');
|
||||
API::Std::event_run('on_shutdown');
|
||||
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGINT'); }
|
||||
$Auto::DB->disconnect;
|
||||
dbug '!!! Caught SIGINT; terminating...';
|
||||
alog '!!! Caught SIGINT; terminating...';
|
||||
if (-e "$Auto::Bin/auto.pid") {
|
||||
unlink "$Auto::Bin/auto.pid";
|
||||
}
|
||||
sleep 1;
|
||||
exit;
|
||||
}
|
||||
@@ -266,10 +274,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!'); }
|
||||
$Auto::DB->disconnect;
|
||||
if (-e "$Auto::Bin/auto.pid") {
|
||||
unlink "$Auto::Bin/auto.pid";
|
||||
}
|
||||
API::Std::event_run('on_shutdown');
|
||||
sleep 1;
|
||||
println 'FATAL: '.$diemsg;
|
||||
exit;
|
||||
|
||||
+1
-1
@@ -119,7 +119,7 @@ sub installmods
|
||||
chomp $response;
|
||||
if (lc $response eq 'y') {
|
||||
println 'What modules would you like to install? (separate by commas)';
|
||||
println 'Available modules: Badwords, Bitly, Calc, EightBall, FML, HelloChan, IsItUp, QDB, SASLAuth, Weather';
|
||||
println 'Available modules: Badwords, Bitly, Calc, EightBall, FML, Greet, HelloChan, IsItUp, QDB, SASLAuth, Weather';
|
||||
print '> ';
|
||||
my $modules = <STDIN>; chomp $modules;
|
||||
$modules =~ s/ //g;
|
||||
|
||||
+86
-63
@@ -53,8 +53,8 @@ sub ircparse
|
||||
my ($svr, $data) = @_;
|
||||
|
||||
# Split spaces into @ex.
|
||||
my @ex = split(' ', $data);
|
||||
|
||||
my @ex = split /\s+/, $data;
|
||||
|
||||
# Make sure there is enough data.
|
||||
if (defined $ex[0] and defined $ex[1]) {
|
||||
# If it's a ping...
|
||||
@@ -65,7 +65,7 @@ sub ircparse
|
||||
# If it's AUTHENTICATE
|
||||
elsif ($ex[0] eq 'AUTHENTICATE') {
|
||||
if (API::Std::mod_exists("SASLAuth")) {
|
||||
m_SASLAuth::handle_authenticate($svr, @ex);
|
||||
M::SASLAuth::handle_authenticate($svr, @ex);
|
||||
}
|
||||
}
|
||||
else {
|
||||
@@ -298,16 +298,19 @@ sub cjoin
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
my $chan = $ex[2];
|
||||
$chan =~ s/^://gxsm;
|
||||
|
||||
# Check if this is coming from ourselves.
|
||||
if ($src{nick} eq $botnick{$svr}{nick}) {
|
||||
$botchans{$svr}{substr $ex[2], 1} = 1;
|
||||
API::Std::event_run("on_ucjoin", ($svr, substr($ex[2], 1)));
|
||||
$botchans{$svr}{lc(substr $ex[2], 1)} = 1;
|
||||
API::Std::event_run("on_ucjoin", ($svr, $chan));
|
||||
}
|
||||
else {
|
||||
# It isn't. Update chanusers and trigger on_rcjoin.
|
||||
$chanusers{$svr}{substr $ex[2], 1}{$src{nick}} = 1;
|
||||
API::Std::event_run("on_rcjoin", ($svr, \%src, substr($ex[2], 1)));
|
||||
$chanusers{$svr}{lc(substr $ex[2], 1)}{$src{nick}} = 1;
|
||||
$src{svr} = $svr;
|
||||
API::Std::event_run("on_rcjoin", (\%src, $chan));
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -480,8 +483,19 @@ sub nick
|
||||
sub notice
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
# Ensure this is coming from a user rather than a server.
|
||||
if ($ex[0] !~ m/!/xsm) { return; }
|
||||
|
||||
# Prepare all the data.
|
||||
my %src = API::IRC::usrc(substr $ex[0], 1);
|
||||
my $target = $ex[2];
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
$src{svr} = $svr;
|
||||
|
||||
API::Std::event_run("on_notice", ($svr, @ex));
|
||||
# Send it off.
|
||||
API::Std::event_run("on_notice", (\%src, $target, @ex));
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -523,84 +537,93 @@ sub privmsg
|
||||
push(@argv, $ex[$i]);
|
||||
}
|
||||
$data{svr} = $svr;
|
||||
@{ $data{args} } = @argv;
|
||||
|
||||
my ($cmd, $cprefix, $rprefix);
|
||||
# Check if it's to a channel or to us.
|
||||
if (lc($ex[2]) eq lc($botnick{$svr}{nick})) {
|
||||
# It is coming to us in a private message.
|
||||
$cmd = uc(substr($ex[3], 1));
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is private or all.
|
||||
if (!defined $Core::IRC::usercmd{$data{nick}.'@'.$data{host}}) { $Core::IRC::usercmd{$data{nick}.'@'.$data{host}} = 0; }
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command requires a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(%data);
|
||||
|
||||
# Ensure it's a valid length.
|
||||
if (length($ex[3]) > 1) {
|
||||
$cmd = uc(substr($ex[3], 1));
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is private or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command requires a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
|
||||
# Else execute the command without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else execute the command without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(%data);
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger event on_uprivmsg.
|
||||
API::Std::event_run("on_uprivmsg", ($svr, @ex));
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_uprivmsg", (\%data, @ex));
|
||||
}
|
||||
else {
|
||||
# It is coming to us in a channel message.
|
||||
$data{chan} = $ex[2];
|
||||
$cprefix = (conf_get("fantasy_pf"))[0][0];
|
||||
$rprefix = substr($ex[3], 1, 1);
|
||||
$cmd = uc(substr($ex[3], 2));
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is public or all.
|
||||
if (!defined $Core::IRC::usercmd{$data{nick}.'@'.$data{host}}) { $Core::IRC::usercmd{$data{nick}.'@'.$data{host}} = 0; }
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command takes a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(%data) if $rprefix eq $cprefix;
|
||||
# Ensure it's a valid length before continuing.
|
||||
if (length($ex[3]) > 1) {
|
||||
$cprefix = (conf_get("fantasy_pf"))[0][0];
|
||||
$rprefix = substr($ex[3], 1, 1);
|
||||
$cmd = uc(substr($ex[3], 2));
|
||||
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is public or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command takes a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
|
||||
else {
|
||||
# Else continue executing without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv) if $rprefix eq $cprefix;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else continue executing without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(%data) if $rprefix eq $cprefix;
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger event on_cprivmsg.
|
||||
API::Std::event_run("on_cprivmsg", ($svr, @ex));
|
||||
my $target = $ex[2]; delete $data{chan};
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
+14
-16
@@ -1,12 +1,12 @@
|
||||
# Module: Badwords. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_Badwords;
|
||||
package M::Badwords;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(switch);
|
||||
use API::Std qw(hook_add hook_del conf_get err);
|
||||
use API::IRC qw(privmsg notice kick cmode);
|
||||
use API::IRC qw(privmsg notice kick ban);
|
||||
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
@@ -17,7 +17,7 @@ sub _init
|
||||
return;
|
||||
}
|
||||
# Create the act_on_badword hook.
|
||||
hook_add('on_cprivmsg', 'act_on_badword', \&m_Badwords::actonbadword) or return;
|
||||
hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -36,14 +36,12 @@ sub _void
|
||||
# Callback for act_on_badword hook.
|
||||
sub actonbadword
|
||||
{
|
||||
my (($svr, @ex)) = @_;
|
||||
my %src = API::IRC::usrc(substr $ex[0], 1);
|
||||
my (($src, $chan, @msg)) = @_;
|
||||
|
||||
my $msg = substr $ex[3], 1;
|
||||
for (my $i = 4; $i < scalar @ex; $i++) { $msg .= q{ }.$ex[$i]; }
|
||||
my $msg = join ' ', @msg;
|
||||
|
||||
if (conf_get("badwords:$ex[2]:word")) {
|
||||
my @words = @{ (conf_get("badwords:$ex[2]:word"))[0] };
|
||||
if (conf_get("badwords:$chan:word")) {
|
||||
my @words = @{ (conf_get("badwords:$chan:word"))[0] };
|
||||
|
||||
foreach (@words) {
|
||||
my ($w, $a) = split m/[:]/, $_;
|
||||
@@ -51,17 +49,17 @@ sub actonbadword
|
||||
if ($msg =~ m/($w)/ixsm) {
|
||||
given ($a) {
|
||||
when ('kick') {
|
||||
kick($svr, $ex[2], $src{nick}, 'Foul language is prohibited here.');
|
||||
kick($src->{svr}, $chan, $src->{nick}, 'Foul language is prohibited here.');
|
||||
}
|
||||
when ('kickban') {
|
||||
cmode($svr, $ex[2], '+b *!*@'.$src{host});
|
||||
kick($svr, $ex[2], $src{nick}, 'Foul language is prohibited here.');
|
||||
ban($src->{svr}, $chan, 'b', $src);
|
||||
kick($src->{svr}, $chan, $src->{nick}, 'Foul language is prohibited here.');
|
||||
}
|
||||
when ('quiet') {
|
||||
cmode($svr, $ex[2], '+q *!*@'.$src{host});
|
||||
ban($src->{svr}, $chan, 'q', $src);
|
||||
}
|
||||
default {
|
||||
kick($svr, $ex[2], $src{nick}, 'Foul language is prohibited here.');
|
||||
kick($src->{svr}, $chan, $src->{nick}, 'Foul language is prohibited here.');
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -72,7 +70,7 @@ sub actonbadword
|
||||
}
|
||||
|
||||
|
||||
API::Std::mod_init("Badwords", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
@@ -124,6 +122,6 @@ Changing the obvious to your wish.
|
||||
|
||||
=over
|
||||
|
||||
This module is compatible with Auto version 3.0.0a3+.
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
=back
|
||||
+15
-17
@@ -1,7 +1,7 @@
|
||||
# Module: Bitly. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_Bitly;
|
||||
package M::Bitly;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(cmd_add cmd_del conf_get err trans);
|
||||
@@ -18,8 +18,8 @@ sub _init
|
||||
return 0;
|
||||
}
|
||||
# Create the SHORTEN and REVERSE commands.
|
||||
cmd_add("SHORTEN", 0, 0, \%m_Bitly::HELP_SHORTEN, \&m_Bitly::shorten) or return 0;
|
||||
cmd_add("REVERSE", 0, 0, \%m_Bitly::HELP_REVERSE, \&m_Bitly::reverse) or return 0;
|
||||
cmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0;
|
||||
cmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -47,7 +47,7 @@ our %HELP_REVERSE = (
|
||||
# Callback for SHORTEN command.
|
||||
sub shorten
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, @args) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
@@ -55,9 +55,8 @@ sub shorten
|
||||
$ua->timeout(2);
|
||||
|
||||
# Put together the call to the Bit.ly API.
|
||||
my @args = @{ $data{args} };
|
||||
if (!defined $args[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
|
||||
@@ -71,11 +70,11 @@ sub shorten
|
||||
my $d = $response->decoded_content;
|
||||
chomp $d;
|
||||
# And send to channel.
|
||||
privmsg($data{svr}, $data{chan}, "URL: ".$d);
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($data{svr}, $data{chan}, "An error occurred while shortening your URL.");
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while shortening your URL.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -84,7 +83,7 @@ sub shorten
|
||||
# Callback for REVERSE command.
|
||||
sub reverse
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, @args) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
@@ -92,9 +91,8 @@ sub reverse
|
||||
$ua->timeout(2);
|
||||
|
||||
# Put together the call to the Bit.ly API.
|
||||
my @args = @{ $data{args} };
|
||||
if (!defined $args[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
|
||||
@@ -108,11 +106,11 @@ sub reverse
|
||||
my $d = $response->decoded_content;
|
||||
chomp $d;
|
||||
# And send it to channel.
|
||||
privmsg($data{svr}, $data{chan}, "URL: ".$d);
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($data{svr}, $data{chan}, "An error occurred while reversing your URL.");
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -120,7 +118,7 @@ sub reverse
|
||||
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("Bitly", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent,URI::Escape perl=5.010000
|
||||
|
||||
@@ -178,9 +176,9 @@ Add Bitly to module auto-load and the following to your configuration file:
|
||||
|
||||
=over
|
||||
|
||||
This module adds extra dependencies: LWP::UserAgent and URI::Escape.
|
||||
You can get it from the CPAN <http://www.cpan.org>.
|
||||
This module adds extra dependencies: LWP::UserAgent and URI::Escape. You can
|
||||
get it from the CPAN <http://www.cpan.org>.
|
||||
|
||||
This module is compatible with Auto version 3.0.0a2+.
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
=back
|
||||
+9
-15
@@ -1,7 +1,7 @@
|
||||
# Module: Calc. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_Calc;
|
||||
package M::Calc;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(cmd_add cmd_del trans);
|
||||
@@ -13,13 +13,8 @@ use JSON -support_by_pp;
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Check for JSON::PP.
|
||||
eval {
|
||||
require JSON::PP;
|
||||
1;
|
||||
} or return 0;
|
||||
# Create the CALC command.
|
||||
cmd_add("CALC", 0, 0, \%m_Calc::HELP_CALC, \&m_Calc::calc) or return 0;
|
||||
cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -43,7 +38,7 @@ our %FHELP_CALC = (
|
||||
# Callback for CALC command.
|
||||
sub calc
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, @args) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
@@ -52,9 +47,8 @@ sub calc
|
||||
# Create an instance of JSON.
|
||||
my $json = JSON->new();
|
||||
# Put together the call to the Google Calculator API.
|
||||
my @args = @{ $data{args} };
|
||||
if (!defined $args[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my $expr = join(' ', @args);
|
||||
@@ -68,23 +62,23 @@ sub calc
|
||||
|
||||
if ($d->{error} eq "" or $d->{error} == 0) {
|
||||
# And send to channel
|
||||
privmsg($data{svr}, $data{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
|
||||
privmsg($src->{svr}, $src->{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($data{svr}, $data{chan}, "Google Calculator sent an error.");
|
||||
privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($data{svr}, $data{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;
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("Calc", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000
|
||||
|
||||
@@ -125,6 +119,6 @@ Google Calculator.
|
||||
This module requires LWP::UserAgent, URI::Escape and JSON/JSON::PP.
|
||||
All are obtainable from the CPAN <http://www.cpan.org>.
|
||||
|
||||
This module is compatible with Auto version 3.0.0a2+.
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
=back
|
||||
@@ -0,0 +1,345 @@
|
||||
# Module: ChanTopics. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package M::ChanTopics;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(cmd_add cmd_del trans);
|
||||
use API::IRC qw(notice topic);
|
||||
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# PostgreSQL is not supported.
|
||||
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;
|
||||
|
||||
# Create the TOPIC command.
|
||||
cmd_add('TOPIC', 0, 'topic.topic', \%M::ChanTopics::HELP_TOPIC, \&M::ChanTopics::cmd_topic) or return;
|
||||
# Create the DIVIDER command.
|
||||
cmd_add('DIVIDER', 0, 'topic.topic', \%M::ChanTopics::HELP_DIVIDER, \&M::ChanTopics::cmd_divider) or return;
|
||||
# Create the OWNER command.
|
||||
cmd_add('OWNER', 0, 'topic.owner', \%M::ChanTopics::HELP_OWNER, \&M::ChanTopics::cmd_owner) or return;
|
||||
# Create the VERB command.
|
||||
cmd_add('VERB', 0, 'topic.status', \%M::ChanTopics::HELP_VERB, \&M::ChanTopics::cmd_verb) or return;
|
||||
# Create the STATUS command.
|
||||
cmd_add('STATUS', 0, 'topic.status', \%M::ChanTopics::HELP_STATUS, \&M::ChanTopics::cmd_status) or return;
|
||||
# Create the OTHER command.
|
||||
cmd_add('OTHER', 0, 'topic.static', \%M::ChanTopics::HELP_OTHER, \&M::ChanTopics::cmd_other) or return;
|
||||
# Create the STATIC command.
|
||||
cmd_add('STATIC', 0, 'topic.static', \%M::ChanTopics::HELP_STATIC, \&M::ChanTopics::cmd_static) or return;
|
||||
# Create the TSYNC command.
|
||||
cmd_add('TSYNC', 0, 'topic.topic', \%M::ChanTopics::HELP_TSYNC, \&M::ChanTopics::cmd_tsync) or return;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete all the commands.
|
||||
cmd_del('TOPIC') or return;
|
||||
cmd_del('DIVIDER') or return;
|
||||
cmd_del('OWNER') or return;
|
||||
cmd_del('VERB') or return;
|
||||
cmd_del('STATUS') or return;
|
||||
cmd_del('OTHER') or return;
|
||||
cmd_del('STATIC') or return;
|
||||
cmd_del('TSYNC') or return;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hashes for the TOPIC, OWNER, VERB, STATUS, OTHER, STATIC, DIVIDER and TSYNC commands. Spanish, French and German translations needed.
|
||||
our %HELP_TOPIC = (
|
||||
'en' => "This command allows you to set the topic section of a channel topic. \002Syntax:\002 TOPIC <new topic>",
|
||||
);
|
||||
our %HELP_DIVIDER = (
|
||||
'en' => "This command allows you to set the divider for topic sections in a channel topic. \002Syntax:\002 DIVIDER <new divider>",
|
||||
);
|
||||
our %HELP_OWNER = (
|
||||
'en' => "This command allows you to set the channel owner section of a channel topic. \002Syntax:\002 OWNER <new owner>",
|
||||
);
|
||||
our %HELP_VERB = (
|
||||
'en' => "This command allows you to set the status verb section of a channel topic. \002Syntax:\002 VERB <new verb>",
|
||||
);
|
||||
our %HELP_STATUS = (
|
||||
'en' => "This command allows you to set the status section of a channel topic. \002Syntax:\002 STATUS <new status>",
|
||||
);
|
||||
our %HELP_OTHER = (
|
||||
'en' => "This command allows you to set the other static section of a channel topic. \002Syntax:\002 OTHER <new other static>",
|
||||
);
|
||||
our %HELP_STATIC = (
|
||||
'en' => "This command allows you to set the static section of a channel topic. \002Syntax:\002 STATIC <new static>",
|
||||
);
|
||||
our %HELP_TSYNC = (
|
||||
'en' => "This command allows you to sync the channel topic with the topic in the database. \002Syntax:\002 TSYNC",
|
||||
);
|
||||
|
||||
# Callback for TOPIC command.
|
||||
sub cmd_topic
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get existing topic data.
|
||||
my (undef, $div, $owner, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Query the database with the new topic.
|
||||
my $dbq = $Auto::DB->prepare('UPDATE topics SET topic = ? WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: ".join(' ', @argv)." $div $owner $verb $status $div $other $div $static");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for DIVIDER command.
|
||||
sub cmd_divider
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get existing topic data.
|
||||
my ($topic, undef, $owner, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Query the database with the new divider.
|
||||
my $dbq = $Auto::DB->prepare('UPDATE topics SET divider = ? WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute($argv[0], lc $src->{svr}, lc $src->{chan}) or return;
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: $topic $argv[0] $owner $verb $status $argv[0] $other $argv[0] $static");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for OWNER command.
|
||||
sub cmd_owner
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get existing topic data.
|
||||
my ($topic, $div, undef, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Query the database with the new owner.
|
||||
my $dbq = $Auto::DB->prepare('UPDATE topics SET owner = ? WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute($argv[0], lc $src->{svr}, lc $src->{chan}) or return;
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: $topic $div $argv[0] $verb $status $div $other $div $static");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for VERB command.
|
||||
sub cmd_verb
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get existing topic data.
|
||||
my ($topic, $div, $owner, undef, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Query the database with the new verb.
|
||||
my $dbq = $Auto::DB->prepare('UPDATE topics SET verb = ? WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute($argv[0], lc $src->{svr}, lc $src->{chan}) or return;
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $argv[0] $status $div $other $div $static");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for STATUS command.
|
||||
sub cmd_status
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get existing topic data.
|
||||
my ($topic, $div, $owner, $verb, undef, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Query the database with the new status.
|
||||
my $dbq = $Auto::DB->prepare('UPDATE topics SET status = ? WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb ".join(' ', @argv)." $div $other $div $static");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for OTHER command.
|
||||
sub cmd_other
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get existing topic data.
|
||||
my ($topic, $div, $owner, $verb, $status, undef, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Query the database with the new other.
|
||||
my $dbq = $Auto::DB->prepare('UPDATE topics SET other = ? WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb $status $div ".join(' ', @argv)." $div $static");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for STATIC command.
|
||||
sub cmd_static
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get existing topic data.
|
||||
my ($topic, $div, $owner, $verb, $status, $other, undef) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Query the database with the new static.
|
||||
my $dbq = $Auto::DB->prepare('UPDATE topics SET static = ? WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute(join(' ', @argv), lc $src->{svr}, lc $src->{chan}) or return;
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb $status $div $other $div ".join(' ', @argv));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for TSYNC command.
|
||||
sub cmd_tsync
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Get the topic data.
|
||||
my ($topic, $div, $owner, $verb, $status, $other, $static) = _getdata(lc $src->{svr}, lc $src->{chan});
|
||||
|
||||
# Set new topic.
|
||||
topic($src->{svr}, $src->{chan}, "Topic: $topic $div $owner $verb $status $div $other $div $static");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Subroutine for getting topic data.
|
||||
sub _getdata
|
||||
{
|
||||
my ($net, $chan) = @_;
|
||||
|
||||
# Check if there is a database entry for this channel.
|
||||
if (!$Auto::DB->selectrow_array('SELECT * FROM topics WHERE net = "'.$net.'" AND chan = "'.$chan.'"')) {
|
||||
# There is not; create it.
|
||||
my $dbq = $Auto::DB->prepare('INSERT INTO topics (net, chan, topic, divider, owner, verb, status, other, static) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)') or return;
|
||||
$dbq->execute($net, $chan, 'NULL', 'NULL', 'NULL', 'NULL', 'NULL', 'NULL', 'NULL') or return;
|
||||
}
|
||||
|
||||
# Now retrieve all the desired data.
|
||||
my $dbq = $Auto::DB->prepare('SELECT topic,divider,owner,verb,status,other,static FROM topics WHERE net = ? AND chan = ?') or return;
|
||||
$dbq->execute($net, $chan) or return;
|
||||
my $data = $dbq->fetchrow_hashref or return;
|
||||
|
||||
# And return it.
|
||||
return ($data->{topic}, $data->{divider}, $data->{owner}, $data->{verb}, $data->{status}, $data->{other}, $data->{static});
|
||||
}
|
||||
|
||||
|
||||
API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
=head1 ChanTopics
|
||||
|
||||
=head2 Description
|
||||
|
||||
=over
|
||||
|
||||
This module adds the TOPIC, DIVIDER, OWNER, VERB, STATUS, OTHER and STATIC
|
||||
commands for advanced yet simple management of a channel's topic.
|
||||
|
||||
Topic Format: Topic: TOPIC DIVIDER OWNER VERB STATUS DIVIDER OTHER DIVIDER STATIC
|
||||
|
||||
=back
|
||||
|
||||
=head2 How To Use
|
||||
|
||||
=over
|
||||
|
||||
This module adds the topic.topic, topic.owner, topic.status and topic.static
|
||||
privileges. topic.topic grants access to TOPIC, topic.owner to OWNER,
|
||||
topic.status to VERB and STATUS, and topic.static to OTHER and STATIC.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Examples
|
||||
|
||||
=over
|
||||
|
||||
<JohnSmith> !topic Random Nonsense
|
||||
* Auto changes topic to: Topic: Random Nonsense | JohnSmith is here | Welcome to #johnsmith | Website at http://example.com
|
||||
<JohnSmith> !status sleeping
|
||||
* Auto changes topic to: Topic: Random Nonsense | JohnSmith is sleeping | Welcome to #johnsmith | Website at http://example.com
|
||||
|
||||
=back
|
||||
|
||||
=head2 To Do
|
||||
|
||||
=over
|
||||
|
||||
* Spanish, French and German translations for the help hashes.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Technical
|
||||
|
||||
=over
|
||||
|
||||
This module adds no extra dependencies.
|
||||
|
||||
This module is not compatible with PostgreSQL, yet.
|
||||
|
||||
This module is compatible with Auto v3.0.0a4+.
|
||||
|
||||
Ported from v1.0.
|
||||
|
||||
=back
|
||||
@@ -0,0 +1,104 @@
|
||||
# Module: Dictionary. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package M::Dictionary;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Net::Dict;
|
||||
use API::Std qw(cmd_add cmd_del trans);
|
||||
use API::IRC qw(notice privmsg);
|
||||
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Create the DICT command.
|
||||
cmd_add('DICT', 0, 0, \%M::Dictionary::HELP_DICT, \&M::Dictionary::cmd_dict) or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete the DICT command.
|
||||
cmd_del('DICT') or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# Help hash for DICT. Spanish, French and German translations needed.
|
||||
our %HELP_DICT = (
|
||||
'en' => "This command allows you to lookup a word through Dict.org. \002Syntax:\002 DICT <word>",
|
||||
);
|
||||
|
||||
# Callback for DICT command.
|
||||
sub cmd_dict
|
||||
{
|
||||
my ($src, ($word)) = @_;
|
||||
|
||||
# Check for needed parameters.
|
||||
if (!defined $word) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Create an instance of Net::Dict.
|
||||
my $dictv = Net::Dict->new('dict.org');
|
||||
|
||||
# Get the definition for this word.
|
||||
my $res = $dictv->define($word);
|
||||
|
||||
# Check if there was a result.
|
||||
if (defined $res) {
|
||||
# Return the results.
|
||||
privmsg($src->{svr}, $src->{chan}, "Results for \2$word\2:");
|
||||
foreach (@{ $res }) {
|
||||
# Split the newlines.
|
||||
my @lines = split m/\n/, @$_[1];
|
||||
foreach (@lines) {
|
||||
if ($_ =~ m/[^\s]/) {
|
||||
privmsg($src->{svr}, $src->{chan}, $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else return no results.
|
||||
privmsg($src->{svr}, $src->{chan}, "No results for \2$word\2.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: cpan=Net::Dict perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
=head1 Dictionary
|
||||
|
||||
=head2 Description
|
||||
|
||||
=over
|
||||
|
||||
This module allows users to lookup definitions for words from dict.org via the
|
||||
DICT command.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Technical
|
||||
|
||||
=over
|
||||
|
||||
This module adds an extra dependency: Net::Dict. You can get it from the CPAN
|
||||
<http://www.cpan.org>.
|
||||
|
||||
This module is compatible with Auto v3.0.0a4+.
|
||||
|
||||
=back
|
||||
+14
-16
@@ -1,7 +1,7 @@
|
||||
# Module: EightBall. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_EightBall;
|
||||
package M::EightBall;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(switch);
|
||||
@@ -13,8 +13,8 @@ our $ANSWER = 0;
|
||||
sub _init
|
||||
{
|
||||
# Create the 8BALL and RIGBALL commands.
|
||||
cmd_add("8BALL", 0, 0, \%m_EightBall::HELP_8BALL, \&m_EightBall::c_8ball) or return 0;
|
||||
cmd_add("RIGBALL", 1, "cmd.rigball", \%m_EightBall::HELP_RIGBALL, \&m_EightBall::rigball) or return 0;
|
||||
cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0;
|
||||
cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -24,8 +24,8 @@ sub _init
|
||||
sub _void
|
||||
{
|
||||
# Delete the 8BALL and RIGBALL commands.
|
||||
cmd_del("8BALL") or return 0;
|
||||
cmd_del("RIGBALL") or return 0;
|
||||
cmd_del('8BALL') or return 0;
|
||||
cmd_del('RIGBALL') or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -42,15 +42,14 @@ our %HELP_RIGBALL = (
|
||||
# Callback for 8BALL command.
|
||||
sub c_8ball
|
||||
{
|
||||
my (%data) = @_;
|
||||
my @argv = @{ $data{args} }; delete $data{args};
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
if (!defined $argv[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return;
|
||||
}
|
||||
|
||||
privmsg($data{svr}, $data{chan}, "\002Question:\002 ".join(" ", @argv));
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Question:\002 ".join(" ", @argv));
|
||||
|
||||
my $a = '';
|
||||
if (!$ANSWER) {
|
||||
@@ -76,7 +75,7 @@ sub c_8ball
|
||||
$ANSWER = 0;
|
||||
}
|
||||
|
||||
privmsg($data{svr}, $data{chan}, "\002Answer:\002 ".$a);
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Answer:\002 ".$a);
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -84,24 +83,23 @@ sub c_8ball
|
||||
# Callback for RIGBALL command.
|
||||
sub rigball
|
||||
{
|
||||
my (%data) = @_;
|
||||
my @argv = @{ $data{args} }; delete $data{args};
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for necessary parameters.
|
||||
if (!defined $argv[0]) {
|
||||
privmsg($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
privmsg($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return;
|
||||
}
|
||||
|
||||
$ANSWER = join(" ", @argv);
|
||||
privmsg($data{svr}, $data{nick}, "Answer set to: ".$ANSWER);
|
||||
privmsg($src->{svr}, $src->{nick}, "Answer set to: ".$ANSWER);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("EightBall", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('EightBall', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
@@ -145,7 +143,7 @@ command for setting ("rigging") the 8-Ball's next answer.
|
||||
|
||||
=over
|
||||
|
||||
This module is compatible with Auto version 3.0.0a2+.
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
Ported from Auto 1.0.
|
||||
|
||||
|
||||
+9
-9
@@ -1,7 +1,7 @@
|
||||
# Module: FML. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_FML;
|
||||
package M::FML;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(cmd_add cmd_del trans);
|
||||
@@ -12,7 +12,7 @@ use LWP::UserAgent;
|
||||
sub _init
|
||||
{
|
||||
# Create the FML command.
|
||||
cmd_add("FML", 0, 0, \%m_FML::HELP_FML, \&m_FML::fml) or return 0;
|
||||
cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -22,7 +22,7 @@ sub _init
|
||||
sub _void
|
||||
{
|
||||
# Delete the FML command.
|
||||
cmd_del("FML") or return 0;
|
||||
cmd_del('FML') or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -36,7 +36,7 @@ our %HELP_FML = (
|
||||
# Callback for FML command.
|
||||
sub fml
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, undef) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
@@ -44,7 +44,7 @@ sub fml
|
||||
$ua->timeout(2);
|
||||
|
||||
# Get the random FML via HTTP.
|
||||
my $rp = $ua->get("http://rscript.org/lookup.php?type=fml");
|
||||
my $rp = $ua->get('http://rscript.org/lookup.php?type=fml');
|
||||
|
||||
if ($rp->is_success) {
|
||||
# If successful, decode the content.
|
||||
@@ -56,18 +56,18 @@ sub fml
|
||||
my ($fml, undef) = split('Agree:', $dfa);
|
||||
|
||||
# And send to channel.
|
||||
privmsg($data{svr}, $data{chan}, "\002Random FML:\002 ".$fml);
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($data{svr}, $data{chan}, "An error occurred while retrieving the FML.");
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving the FML.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("FML", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent perl=5.010000
|
||||
|
||||
@@ -110,7 +110,7 @@ have my hand back?" FML
|
||||
This module adds an extra dependency: LWP::UserAgent. You can get it from
|
||||
the CPAN <http://www.cpan.org>.
|
||||
|
||||
This module is compatible with Auto version 3.0.0a2+.
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
Ported from Auto 2.0.
|
||||
|
||||
|
||||
@@ -0,0 +1,159 @@
|
||||
# Module: Greet. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package M::Greet;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(switch);
|
||||
use API::Std qw(cmd_add cmd_del hook_add hook_del trans);
|
||||
use API::IRC qw(privmsg notice);
|
||||
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Not compatible with PostgreSQL.
|
||||
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;
|
||||
# Create the GREET command.
|
||||
cmd_add('GREET', 2, 'cmd.greet', \%M::Greet::HELP_GREET, \&M::Greet::cmd_greet) or return;
|
||||
# Create the greet_onjoin hook.
|
||||
hook_add('on_rcjoin', 'greet_onjoin', \&M::Greet::hook_rcjoin) or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete the GREET command.
|
||||
cmd_del('GREET') or return;
|
||||
# Delete the greet_onjoin hook.
|
||||
hook_del('on_rcjoin') or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hash for GREET. Spanish, French and German translation needed.
|
||||
our %HELP_GREET = (
|
||||
'en' => "This command allows management of greets. \002Syntax:\002 GREET (ADD|DEL) [nick] [greet]",
|
||||
);
|
||||
# Callback for GREET.
|
||||
sub cmd_greet
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for required parameters.
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Check what action we're being told to take.
|
||||
given (uc $argv[0]) {
|
||||
when ('ADD') {
|
||||
# GREET ADD
|
||||
|
||||
# Check for needed parameters.
|
||||
if (!defined $argv[1] or !defined $argv[2]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
my $nick = $argv[1]; shift @argv; shift @argv;
|
||||
$nick = lc $nick;
|
||||
my $greet = join(' ', @argv);
|
||||
|
||||
# Make sure it doesn't already exist.
|
||||
if ($Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"')) {
|
||||
notice($src->{svr}, $src->{nick}, "A greet for \002$nick\002 already exists.");
|
||||
return;
|
||||
}
|
||||
|
||||
# Insert into database.
|
||||
my $dbq = $Auto::DB->prepare('INSERT INTO greets (nick, greet) VALUES (?, ?)') or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
$dbq->execute($nick, $greet) or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
|
||||
API::Log::slog('cmd_greet(): Creating new greet.');
|
||||
# Done.
|
||||
notice($src->{svr}, $src->{nick}, "Successfully added greet for \002$nick\002.");
|
||||
}
|
||||
when ('DEL') {
|
||||
# GREET DEL
|
||||
|
||||
# Check for needed parameters.
|
||||
if (!defined $argv[1]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
my $nick = lc $argv[1];
|
||||
|
||||
# Check if there is a greet for this user.
|
||||
if (!$Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"')) {
|
||||
notice($src->{svr}, $src->{nick}, "There is no greet for \002$nick\002.");
|
||||
return;
|
||||
}
|
||||
|
||||
# Delete it.
|
||||
$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; }
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Call back for on_rcjoin hook.
|
||||
sub hook_rcjoin
|
||||
{
|
||||
my (($src, $chan)) = @_;
|
||||
my $nick = lc $src->{nick};
|
||||
|
||||
# Check if there's a greet for this user.
|
||||
if ($Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"')) {
|
||||
# Get data.
|
||||
my @data = $Auto::DB->selectrow_array('SELECT * FROM greets WHERE nick = "'.$nick.'"');
|
||||
|
||||
# Send the greet.
|
||||
privmsg($src->{svr}, $chan, "[\002".$src->{nick}."\002] ".$data[1]);
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
=head1 Greet
|
||||
|
||||
=head2 Description
|
||||
|
||||
=over
|
||||
|
||||
This module adds GREET ADD|DEL for greet management. Greets are sent when a
|
||||
user that has a greet in the database joins a channel the bot is in.
|
||||
|
||||
=back
|
||||
|
||||
=head2 To Do
|
||||
|
||||
=over
|
||||
|
||||
* Add Spanish, French and German translations for the help hash.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Technical
|
||||
|
||||
=over
|
||||
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
=back
|
||||
+13
-3
@@ -1,7 +1,7 @@
|
||||
# Module: HelloChan.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_HelloChan;
|
||||
package M::HelloChan;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(hook_add hook_del);
|
||||
@@ -11,7 +11,7 @@ use API::IRC qw(privmsg);
|
||||
sub _init
|
||||
{
|
||||
# Add a hook for when we join a channel.
|
||||
hook_add("on_ucjoin", "HelloChan", \&m_HelloChan::hello) or return 0;
|
||||
hook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -36,6 +36,16 @@ sub hello
|
||||
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("HelloChan", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
=head1 HelloChan
|
||||
|
||||
=over
|
||||
|
||||
This is an example module. Also, cows go moo.
|
||||
|
||||
=back
|
||||
+12
-13
@@ -1,7 +1,7 @@
|
||||
# Module: IsItUp. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_IsItUp;
|
||||
package M::IsItUp;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(cmd_add cmd_del trans);
|
||||
@@ -12,7 +12,7 @@ use LWP::UserAgent;
|
||||
sub _init
|
||||
{
|
||||
# Create the ISITUP command.
|
||||
cmd_add("ISITUP", 0, 0, \%m_IsItUp::HELP_ISITUP, \&m_IsItUp::check) or return 0;
|
||||
cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -22,7 +22,7 @@ sub _init
|
||||
sub _void
|
||||
{
|
||||
# Delete the ISITUP command.
|
||||
cmd_del("ISITUP") or return 0;
|
||||
cmd_del('ISITUP') or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -36,22 +36,21 @@ our %HELP_ISITUP = (
|
||||
# Callback for ISITUP command.
|
||||
sub check
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
my @args = @{ $data{args} };
|
||||
my $curl = $args[0];
|
||||
# Do we have enough parameters?
|
||||
if (!defined $args[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return 0;
|
||||
}
|
||||
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.
|
||||
@@ -59,18 +58,18 @@ sub check
|
||||
|
||||
if ($response->is_success) {
|
||||
# If successful, it's up.
|
||||
privmsg($data{svr}, $data{chan}, $curl." appears to be up from here.");
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
|
||||
}
|
||||
else {
|
||||
# Otherwise, it's down.
|
||||
privmsg($data{svr}, $data{chan}, $curl." appears to be down from here.");
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("IsItUp", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent perl=5.010000
|
||||
|
||||
@@ -111,6 +110,6 @@ appears up or down to Auto.
|
||||
This module requires LWP::UserAgent. You can get it from
|
||||
the CPAN <http://www.cpan.org>.
|
||||
|
||||
This module is compatible with Auto version 3.0.0a2+.
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
=back
|
||||
+36
-34
@@ -1,7 +1,7 @@
|
||||
# Module: QDB. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_QDB;
|
||||
package M::QDB;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(switch);
|
||||
@@ -11,10 +11,13 @@ use API::IRC qw(privmsg notice);
|
||||
sub _init
|
||||
{
|
||||
# Create the QDB command.
|
||||
cmd_add('QDB', 0, 0, \%m_QDB::HELP_QDB, \&m_QDB::cmd_qdb) or return;
|
||||
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; }
|
||||
|
||||
# Check for database table.
|
||||
$Auto::DB->do('CREATE TABLE IF NOT EXISTS qdb (key INTEGER PRIMARY KEY, creator TEXT, time INTEGER, quote TEXT)') or return;
|
||||
$Auto::DB->do('CREATE TABLE IF NOT EXISTS qdb (quoteid INTEGER PRIMARY KEY, creator TEXT, time INTEGER, quote TEXT)') or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -35,12 +38,11 @@ our %HELP_QDB = (
|
||||
);
|
||||
sub cmd_qdb
|
||||
{
|
||||
my (%data) = @_;
|
||||
my @argv = @{ $data{args} };
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Check for needed parameter.
|
||||
if (!defined $argv[0]) {
|
||||
notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -49,7 +51,7 @@ sub cmd_qdb
|
||||
when ('ADD') {
|
||||
# QDB ADD.
|
||||
if (!defined $argv[1]) {
|
||||
notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -58,85 +60,85 @@ sub cmd_qdb
|
||||
|
||||
# Insert into database.
|
||||
my $dbq = $Auto::DB->prepare('INSERT INTO qdb (creator, time, quote) VALUES (?, ?, ?)') or
|
||||
notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
|
||||
$dbq->execute($data{nick}, time, join(q{ }, @argv)) or
|
||||
notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
$dbq->execute($src->{nick}, time, join(q{ }, @argv)) or
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
|
||||
# Get ID.
|
||||
my $count = $Auto::DB->selectrow_array('SELECT COUNT(*) FROM qdb') or
|
||||
notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
|
||||
privmsg($data{svr}, $data{chan}, 'Quote successfully submitted. ID: '.$count);
|
||||
privmsg($src->{svr}, $src->{chan}, 'Quote successfully submitted. ID: '.$count);
|
||||
}
|
||||
when ('VIEW') {
|
||||
# QDB VIEW.
|
||||
if (!defined $argv[1]) {
|
||||
notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Get quote.
|
||||
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE key = ?') or
|
||||
notice($data{svr}, $data{nick}, trans('An error occurred').'. Quote might not exist.') and return;
|
||||
$dbq->execute($argv[1]) or notice($data{svr}, $data{nick}, trans('An error occurred').'. Quote might not exist.') and return;
|
||||
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE quoteid = ?') or
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.') and return;
|
||||
$dbq->execute($argv[1]) or notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.') and return;
|
||||
my @data = $dbq->fetchrow_array;
|
||||
|
||||
# Send it back.
|
||||
privmsg($data{svr}, $data{chan}, "\002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
|
||||
privmsg($data{svr}, $data{chan}, $data[3]);
|
||||
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])));
|
||||
privmsg($src->{svr}, $src->{chan}, $data[3]);
|
||||
}
|
||||
when ('COUNT') {
|
||||
# Get count.
|
||||
my $count = $Auto::DB->selectrow_array('SELECT COUNT(*) FROM qdb') or
|
||||
notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
|
||||
# Send it back.
|
||||
privmsg($data{svr}, $data{chan}, "There is currently \002$count\002 quotes in my database.");
|
||||
privmsg($src->{svr}, $src->{chan}, "There is currently \002$count\002 quotes in my database.");
|
||||
}
|
||||
when ('RAND') {
|
||||
# Get count.
|
||||
my $count = $Auto::DB->selectrow_array('SELECT COUNT(*) FROM qdb') or
|
||||
notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
|
||||
# Random number.
|
||||
my $rand = int(rand($count));
|
||||
if ($rand == 0) { $rand = $count; }
|
||||
|
||||
# Get quote.
|
||||
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE key = ?') or
|
||||
notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
|
||||
$dbq->execute($rand) or notice($data{svr}, $data{nick}, trans('An error occurred').q{.}) and return;
|
||||
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE quoteid = ?') or
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
$dbq->execute($rand) or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
my @data = $dbq->fetchrow_array;
|
||||
|
||||
# Send it back.
|
||||
privmsg($data{svr}, $data{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($data{svr}, $data{chan}, $data[3]);
|
||||
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]);
|
||||
}
|
||||
when ('DEL') {
|
||||
# Check for the cmd.qdbdel privilege.
|
||||
if (!has_priv(match_user(%data), 'cmd.qdbdel')) {
|
||||
notice($data{svr}, $data{chan}, trans('Permission denied').q{.});
|
||||
if (!has_priv(match_user(%$src), 'cmd.qdbdel')) {
|
||||
notice($src->{svr}, $src->{chan}, trans('Permission denied').q{.});
|
||||
return;
|
||||
}
|
||||
# Check for the needed parameter.
|
||||
if (!defined $argv[1]) {
|
||||
notice($data{svr}, $data{nick}, trans('Not enough parameters').q{.});
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return;
|
||||
}
|
||||
|
||||
# Update database.
|
||||
my $dbq = $Auto::DB->do("UPDATE qdb SET quote = \"NOTICE: Quote deleted.\" WHERE key = $argv[1]");
|
||||
my $dbq = $Auto::DB->do("UPDATE qdb SET quote = \"NOTICE: Quote deleted.\" WHERE quoteid = $argv[1]");
|
||||
|
||||
notice($data{svr}, $data{nick}, (($dbq) ? 'Done.' : trans('An error occurred').q{.}));
|
||||
notice($src->{svr}, $src->{nick}, (($dbq) ? 'Done.' : trans('An error occurred').q{.}));
|
||||
}
|
||||
default { notice($data{svr}, $data{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;
|
||||
}
|
||||
|
||||
|
||||
API::Std::mod_init('QDB', 'Xelhua', '1.00', '3.0.0d', __PACKAGE__);
|
||||
API::Std::mod_init('QDB', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
@@ -167,6 +169,6 @@ database.
|
||||
|
||||
=over
|
||||
|
||||
This module is compatible with Auto v3.0.0a3+.
|
||||
This module is compatible with Auto v3.0.0a4+.
|
||||
|
||||
=back
|
||||
+8
-8
@@ -1,7 +1,7 @@
|
||||
# Module: SASLAuth. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_SASLAuth;
|
||||
package M::SASLAuth;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(switch);
|
||||
@@ -19,13 +19,13 @@ sub _init
|
||||
hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); }
|
||||
) or return 0;
|
||||
# Hook for parsing CAP.
|
||||
rchook_add('CAP', \&m_SASLAuth::handle_cap) or return 0;
|
||||
rchook_add('CAP', \&M::SASLAuth::handle_cap) or return 0;
|
||||
# Hook for parsing 903.
|
||||
rchook_add('903', \&m_SASLAuth::handle_903) or return 0;
|
||||
rchook_add('903', \&M::SASLAuth::handle_903) or return 0;
|
||||
# Hook for parsing 904.
|
||||
rchook_add('904', \&m_SASLAuth::handle_904) or return 0;
|
||||
rchook_add('904', \&M::SASLAuth::handle_904) or return 0;
|
||||
# Hook for parsing 906.
|
||||
rchook_add('906', \&m_SASLAuth::handle_906) or return 0;
|
||||
rchook_add('906', \&M::SASLAuth::handle_906) or return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -130,13 +130,13 @@ sub handle_906
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("SASLAuth", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
=head1 SASL Auth
|
||||
=head1 SASLAuth
|
||||
|
||||
=head2 Description
|
||||
|
||||
@@ -188,6 +188,6 @@ block(s) you wish to use SASL with:
|
||||
This adds an extra dependency: You must build Auto with the
|
||||
--enable-sasl option.
|
||||
|
||||
This module is compatible with Auto v3.0.0a1+.
|
||||
This module is compatible with Auto v3.0.0a4+.
|
||||
|
||||
=back
|
||||
+10
-11
@@ -1,7 +1,7 @@
|
||||
# Module: Weather. See below for documentation.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
package m_Weather;
|
||||
package M::Weather;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(cmd_add cmd_del trans);
|
||||
@@ -13,7 +13,7 @@ use XML::Simple;
|
||||
sub _init
|
||||
{
|
||||
# Create the Weather command.
|
||||
cmd_add("WEATHER", 0, 0, \%m_Weather::HELP_WEATHER, \&m_Weather::weather) or return 0;
|
||||
cmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -37,16 +37,15 @@ our %HELP_WEATHER = (
|
||||
# Callback for Weather command.
|
||||
sub weather
|
||||
{
|
||||
my (%data) = @_;
|
||||
my ($src, @args) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
# Put together the call to the Wunderground API.
|
||||
my @args = @{ $data{args} };
|
||||
if (!defined $args[0]) {
|
||||
notice($data{svr}, $data{nick}, trans("Not enough parameters").".");
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my $loc = join(' ', @args);
|
||||
@@ -62,24 +61,24 @@ sub weather
|
||||
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($data{svr}, $data{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
|
||||
privmsg($data{svr}, $data{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
|
||||
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($data{svr}, $data{chan}, "Location not found.");
|
||||
privmsg($src->{svr}, $src->{chan}, "Location not found.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($data{svr}, $data{chan}, "An error occurred while retrieving your weather.");
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init("Weather", "Xelhua", "1.00", "3.0.0d", __PACKAGE__);
|
||||
API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent,XML::Simple perl=5.010000
|
||||
|
||||
@@ -122,6 +121,6 @@ From the NE at 9 MPH Gusting to 22 MPH Conditions: Overcast
|
||||
This module requires LWP::UserAgent and XML::Simple. Both are
|
||||
obtainable from CPAN <http://www.cpan.org>.
|
||||
|
||||
This module is compatible with Auto version 3.0.0a2+.
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
|
||||
=back
|
||||
Executable
+66
@@ -0,0 +1,66 @@
|
||||
# upgrade.pl - Upgrade SQLite database from 3.0.0a3 to 3.0.0a4.
|
||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||
use 5.010_000;
|
||||
use strict;
|
||||
use warnings;
|
||||
use DBI;
|
||||
use DBD::SQLite;
|
||||
use Carp;
|
||||
use Cwd;
|
||||
our $Bin = getcwd();
|
||||
|
||||
#################
|
||||
# Configuration #
|
||||
#################
|
||||
|
||||
# Old database filename. (relative to etc/)
|
||||
my $olddbfile = 'auto.db';
|
||||
# New database filename. (relative to etc/)
|
||||
my $newdbfile = 'somebot.db';
|
||||
|
||||
##########################
|
||||
# Program - Don't touch. #
|
||||
##########################
|
||||
|
||||
# Print startup message.
|
||||
say 'Converting database from Auto-3.0.0a3 format to Auto-3.0.0a4 format...';
|
||||
|
||||
# Connect to database.
|
||||
my $DB = DBI->connect("dbi:SQLite:dbname=$Bin/etc/$olddbfile") or croak 'Failed to open old DB!';
|
||||
|
||||
# Query the database for the data from the `qdb` table.
|
||||
my $dbq = $DB->prepare('SELECT * FROM qdb') or croak 'Failed to query for `qdb` data!';
|
||||
$dbq->execute() or croak 'Failed to query for `qdb` data!';
|
||||
my $data = $dbq->fetchall_hashref('key');
|
||||
my %data = %$data;
|
||||
|
||||
# Disconnect from database.
|
||||
$DB->disconnect;
|
||||
|
||||
|
||||
# Now, connect to the new database so we can enter the data in the new format.
|
||||
if (!-e "$Bin/etc/$newdbfile") {
|
||||
system "touch $Bin/etc/$newdbfile";
|
||||
chmod 0755, "$Bin/etc/$newdbfile";
|
||||
}
|
||||
|
||||
$DB = DBI->connect("dbi:SQLite:dbname=$Bin/etc/$newdbfile") or croak 'Failed to open new DB!';
|
||||
|
||||
# Create the `qdb` table.
|
||||
$DB->do('CREATE TABLE IF NOT EXISTS qdb (quoteid INTEGER PRIMARY KEY, creator TEXT, time INT, quote TEXT)') or croak 'Failed to create `qdb` table!';
|
||||
|
||||
# Iterate through the data.
|
||||
foreach my $qid (sort keys %data) {
|
||||
# Prepare query to insert data.
|
||||
my $ndbq = $DB->prepare('INSERT INTO qdb (quoteid, creator, time, quote) VALUES (?, ?, ?, ?)') or croak 'Failed to query `qdb` table!';
|
||||
|
||||
# Insert data.
|
||||
$ndbq->execute($qid, $data{$qid}{creator}, $data{$qid}{'time'}, $data{$qid}{quote}) or croak 'Failed to query `qdb` table!';
|
||||
}
|
||||
|
||||
# Disconnect from database.
|
||||
$DB->disconnect;
|
||||
|
||||
# Success.
|
||||
say 'Done.';
|
||||
Reference in new issue
Block a user